head     56.3;
access   paws bayes jws quist brad dew jwh;
symbols  ;
locks    ; strict;
comment  @# @;


56.3
date     93.01.27.13.23.44;  author jwh;  state Exp;
branches ;
next     56.2;

56.2
date     93.01.27.12.03.42;  author jwh;  state Exp;
branches ;
next     56.1;

56.1
date     91.11.05.09.59.50;  author jwh;  state Exp;
branches ;
next     55.2;

55.2
date     91.11.04.14.33.08;  author jwh;  state Exp;
branches ;
next     55.1;

55.1
date     91.08.25.10.34.48;  author jwh;  state Exp;
branches ;
next     54.2;

54.2
date     91.08.21.12.42.13;  author jwh;  state Exp;
branches ;
next     54.1;

54.1
date     91.03.18.15.35.01;  author jwh;  state Exp;
branches ;
next     53.3;

53.3
date     91.03.18.13.35.11;  author jwh;  state Exp;
branches ;
next     53.2;

53.2
date     91.03.15.16.20.29;  author jwh;  state Exp;
branches ;
next     53.1;

53.1
date     91.03.11.19.34.39;  author jwh;  state Exp;
branches ;
next     52.2;

52.2
date     91.03.11.16.55.49;  author jwh;  state Exp;
branches ;
next     52.1;

52.1
date     91.02.19.09.20.47;  author jwh;  state Exp;
branches ;
next     51.2;

51.2
date     91.02.18.20.53.14;  author jwh;  state Exp;
branches ;
next     51.1;

51.1
date     91.01.30.16.19.20;  author jwh;  state Exp;
branches ;
next     50.2;

50.2
date     91.01.30.09.26.29;  author jwh;  state Exp;
branches ;
next     50.1;

50.1
date     90.10.29.16.33.13;  author jwh;  state Exp;
branches ;
next     49.2;

49.2
date     90.10.29.14.16.30;  author jwh;  state Exp;
branches ;
next     49.1;

49.1
date     90.08.14.14.16.55;  author jwh;  state Exp;
branches ;
next     48.2;

48.2
date     90.08.14.09.43.06;  author jwh;  state Exp;
branches ;
next     48.1;

48.1
date     90.07.26.11.23.28;  author jwh;  state Exp;
branches ;
next     47.2;

47.2
date     90.07.24.15.01.47;  author jwh;  state Exp;
branches ;
next     47.1;

47.1
date     90.05.14.11.09.35;  author dew;  state Exp;
branches ;
next     46.1;

46.1
date     90.05.07.08.56.33;  author jwh;  state Exp;
branches ;
next     45.2;

45.2
date     90.05.04.14.58.49;  author jwh;  state Exp;
branches ;
next     45.1;

45.1
date     90.04.19.16.04.42;  author jwh;  state Exp;
branches ;
next     44.2;

44.2
date     90.04.19.13.28.00;  author jwh;  state Exp;
branches ;
next     44.1;

44.1
date     90.04.01.22.22.18;  author jwh;  state Exp;
branches ;
next     43.3;

43.3
date     90.04.01.16.27.54;  author jwh;  state Exp;
branches ;
next     43.2;

43.2
date     90.03.22.11.46.22;  author jwh;  state Exp;
branches ;
next     43.1;

43.1
date     90.03.20.14.14.34;  author jwh;  state Exp;
branches ;
next     42.2;

42.2
date     90.03.19.16.15.49;  author jwh;  state Exp;
branches ;
next     42.1;

42.1
date     90.01.23.17.58.35;  author jwh;  state Exp;
branches ;
next     41.2;

41.2
date     90.01.20.16.47.28;  author jwh;  state Exp;
branches ;
next     41.1;

41.1
date     89.12.22.11.40.27;  author jwh;  state Exp;
branches ;
next     40.2;

40.2
date     89.12.21.15.10.35;  author jwh;  state Exp;
branches ;
next     40.1;

40.1
date     89.09.29.12.01.36;  author jwh;  state Exp;
branches ;
next     39.2;

39.2
date     89.09.28.17.31.28;  author jwh;  state Exp;
branches ;
next     39.1;

39.1
date     89.09.26.16.46.30;  author dew;  state Exp;
branches ;
next     38.2;

38.2
date     89.09.26.14.47.37;  author dew;  state Exp;
branches ;
next     38.1;

38.1
date     89.08.29.11.38.56;  author jwh;  state Exp;
branches ;
next     37.2;

37.2
date     89.08.28.12.30.44;  author jwh;  state Exp;
branches ;
next     37.1;

37.1
date     89.05.12.11.52.27;  author dew;  state Exp;
branches ;
next     36.2;

36.2
date     89.05.11.11.52.27;  author quist;  state Exp;
branches ;
next     36.1;

36.1
date     89.02.06.10.29.51;  author dew;  state Exp;
branches ;
next     35.1;

35.1
date     89.02.02.13.47.19;  author dew;  state Exp;
branches ;
next     34.1;

34.1
date     89.01.23.16.21.32;  author jwh;  state Exp;
branches ;
next     33.2;

33.2
date     89.01.20.16.34.42;  author jwh;  state Exp;
branches ;
next     33.1;

33.1
date     89.01.16.11.52.05;  author dew;  state Exp;
branches ;
next     32.3;

32.3
date     89.01.13.11.35.13;  author dew;  state Exp;
branches ;
next     32.2;

32.2
date     89.01.11.10.24.12;  author jws;  state Exp;
branches ;
next     32.1;

32.1
date     89.01.10.12.02.24;  author bayes;  state Exp;
branches ;
next     31.2;

31.2
date     89.01.09.12.08.54;  author dew;  state Exp;
branches ;
next     31.1;

31.1
date     88.12.14.18.23.09;  author bayes;  state Exp;
branches ;
next     30.2;

30.2
date     88.12.14.13.42.06;  author bayes;  state Exp;
branches ;
next     30.1;

30.1
date     88.12.09.13.59.53;  author dew;  state Exp;
branches ;
next     29.2;

29.2
date     88.12.08.15.50.38;  author bayes;  state Exp;
branches ;
next     29.1;

29.1
date     88.10.31.15.44.27;  author bayes;  state Exp;
branches ;
next     28.2;

28.2
date     88.10.31.10.51.54;  author bayes;  state Exp;
branches ;
next     28.1;

28.1
date     88.10.06.11.10.06;  author dew;  state Exp;
branches ;
next     27.2;

27.2
date     88.10.05.17.52.05;  author bayes;  state Exp;
branches ;
next     27.1;

27.1
date     88.09.29.11.53.55;  author bayes;  state Exp;
branches ;
next     26.1;

26.1
date     88.09.28.14.17.39;  author bayes;  state Exp;
branches ;
next     25.3;

25.3
date     88.03.18.10.23.39;  author quist;  state Exp;
branches ;
next     25.2;

25.2
date     88.03.09.09.09.37;  author quist;  state Exp;
branches ;
next     25.1;

25.1
date     88.03.02.09.50.12;  author bayes;  state Exp;
branches ;
next     24.2;

24.2
date     88.03.01.10.11.35;  author bayes;  state Exp;
branches ;
next     24.1;

24.1
date     87.08.31.10.24.46;  author jws;  state Exp;
branches ;
next     23.2;

23.2
date     87.08.30.16.40.04;  author jws;  state Exp;
branches ;
next     23.1;

23.1
date     87.08.26.11.14.24;  author bayes;  state Exp;
branches ;
next     22.2;

22.2
date     87.08.25.20.26.28;  author jws;  state Exp;
branches ;
next     22.1;

22.1
date     87.08.17.11.51.08;  author bayes;  state Exp;
branches ;
next     21.2;

21.2
date     87.08.15.18.28.27;  author larry;  state Exp;
branches ;
next     21.1;

21.1
date     87.08.12.14.36.06;  author bayes;  state Exp;
branches ;
next     20.2;

20.2
date     87.08.12.12.03.34;  author bayes;  state Exp;
branches ;
next     20.1;

20.1
date     87.07.30.11.47.20;  author bayes;  state Exp;
branches ;
next     19.2;

19.2
date     87.07.29.19.38.25;  author larry;  state Exp;
branches ;
next     19.1;

19.1
date     87.06.01.09.03.26;  author jws;  state Exp;
branches ;
next     18.2;

18.2
date     87.05.31.16.21.00;  author jws;  state Exp;
branches ;
next     18.1;

18.1
date     87.05.20.16.06.21;  author bayes;  state Exp;
branches ;
next     17.2;

17.2
date     87.05.20.12.14.15;  author bayes;  state Exp;
branches ;
next     17.1;

17.1
date     87.04.30.11.09.01;  author jws;  state Exp;
branches ;
next     16.1;

16.1
date     87.04.26.16.18.50;  author jws;  state Exp;
branches ;
next     15.2;

15.2
date     87.04.24.19.32.27;  author jws;  state Exp;
branches ;
next     15.1;

15.1
date     87.04.13.10.01.49;  author jws;  state Exp;
branches ;
next     14.2;

14.2
date     87.04.12.18.51.25;  author jws;  state Exp;
branches ;
next     14.1;

14.1
date     87.04.01.16.13.54;  author jws;  state Exp;
branches ;
next     13.2;

13.2
date     87.04.01.11.45.33;  author jws;  state Exp;
branches ;
next     13.1;

13.1
date     87.02.28.19.01.26;  author jws;  state Exp;
branches ;
next     12.2;

12.2
date     87.02.28.17.07.40;  author jws;  state Exp;
branches ;
next     12.1;

12.1
date     87.02.02.13.56.01;  author jws;  state Exp;
branches ;
next     11.2;

11.2
date     87.02.02.11.43.53;  author jws;  state Exp;
branches ;
next     11.1;

11.1
date     87.01.19.10.22.21;  author jws;  state Exp;
branches ;
next     10.2;

10.2
date     87.01.18.20.23.37;  author jws;  state Exp;
branches ;
next     10.1;

10.1
date     86.12.24.11.38.14;  author jws;  state Exp;
branches ;
next     9.2;

9.2
date     86.12.23.18.30.00;  author jws;  state Exp;
branches ;
next     9.1;

9.1
date     86.12.12.15.23.58;  author bayes;  state Exp;
branches ;
next     8.2;

8.2
date     86.12.12.12.15.25;  author bayes;  state Exp;
branches ;
next     8.1;

8.1
date     86.11.27.12.31.07;  author jws;  state Exp;
branches ;
next     7.2;

7.2
date     86.11.26.18.44.23;  author jws;  state Exp;
branches ;
next     7.1;

7.1
date     86.11.20.14.48.33;  author hal;  state Exp;
branches ;
next     6.2;

6.2
date     86.11.19.17.51.34;  author bayes;  state Exp;
branches ;
next     6.1;

6.1
date     86.11.04.18.37.06;  author paws;  state Exp;
branches ;
next     5.2;

5.2
date     86.11.04.15.06.53;  author paws;  state Exp;
branches ;
next     5.1;

5.1
date     86.10.28.17.26.17;  author hal;  state Exp;
branches ;
next     4.2;

4.2
date     86.10.28.13.06.02;  author hal;  state Exp;
branches ;
next     4.1;

4.1
date     86.09.30.20.20.53;  author hal;  state Exp;
branches ;
next     3.2;

3.2
date     86.09.30.16.42.10;  author hal;  state Exp;
branches ;
next     3.1;

3.1
date     86.09.01.12.42.32;  author hal;  state Exp;
branches ;
next     2.4;

2.4
date     86.09.01.10.19.41;  author hal;  state Exp;
branches ;
next     2.3;

2.3
date     86.08.20.14.16.09;  author danm;  state Exp;
branches ;
next     2.2;

2.2
date     86.08.19.14.37.09;  author danm;  state Exp;
branches ;
next     2.1;

2.1
date     86.07.30.15.20.07;  author hal;  state Exp;
branches ;
next     1.3;

1.3
date     86.07.30.12.10.09;  author geli;  state Exp;
branches ;
next     1.2;

1.2
date     86.07.15.18.32.16;  author geli;  state Exp;
branches ;
next     1.1;

1.1
date     86.06.30.17.24.42;  author danm;  state tmp;
branches ;
next     ;


desc
@Base file for PWS 3.2 release.

@


56.3
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@$modcal, switch_strpos, debug off, range off, ovflcheck off$

$search 'IOLIB:KERNEL', 'INIT:DRVASM', 'INIT:DISCHPIB',
	'INIT:CS80'$



program tapebkup(keyboard,input,output);  {CS80 streaming backup tape utility}


module CS80tbr; {tape backup routines}

import
  sysglobals, bkgnd, discHPIB, CS80;

export

  {
    NOTE: the following functions each perform a COMPLETE transaction. They:
	.  issue a (device or transparent) command         (Command message)
	.  transfer data if applicable                     (Execution message)
	.  return the resulting QSTAT                      (Reporting message)
  }
  function set_specified_unitvol      (uep: uep_type; unit, vol: unsgn4): unsgn8;
  function initialize_media           (uep: uep_type; options, interleave: unsgn8): unsgn8;
  function set_address_and_return_mode(uep: uep_type; address: integer): unsgn8;
  function write_file_mark            (uep: uep_type): unsgn8;
  function copy_start_address         (uep: uep_type; var csa_bytes: sva_type): unsgn8;
  function unload                     (uep: uep_type): unsgn8;
  function locate_and_verify          (uep: uep_type; length: integer): unsgn8;
  function copy_data                  (source_uep: uep_type;
				       source_blk_addr: integer;
				       destination_uep: uep_type;
				       destination_blk_addr: integer;
				       copy_length: integer): unsgn8;


implement {CS80tbr}


type
  setunitvol_type = {SET_UNIT/SET_VOLUME command pair}
    packed record
      setunit: CMD_type;
      setvol: CMD_type;
    end;


function suv_CMD_pair(uep: uep_type): setunitvol_type;
  begin {suv_CMD_pair}
    suv_CMD_pair.setunit := CMD_type(signed16(CMDset_unit_0)+uep^.du);
    suv_CMD_pair.setvol  := CMD_type(signed16(CMDset_vol_0)+uep^.dv);
  end; {suv_CMD_pair}
$page$

function set_specified_unitvol(uep: uep_type; unit, vol: unsgn4): unsgn8;
  {
    issue the following command sequence:
      .  SET_UNIT
      .  SET_VOLUME
    return the QSTAT byte
  }
  var
    suv: setunitvol_type;
  begin {set_specified_unitvol}
    suv.setunit := CMD_type(signed16(CMDset_unit_0)+unit);
    suv.setvol  := CMD_type(signed16(CMDset_vol_0)+vol);
    HPIBshort_msge_out(uep, command_sec, addr(suv), sizeof(suv));
    HPIBwait_for_ppol(uep);
    set_specified_unitvol := qstat(uep);
  end; {set_specified_unitvol}


function initialize_media(uep: uep_type; options, interleave: unsgn8): unsgn8;
  {
    issue the following command sequence:
      .  SET_UNIT
      .  SET_VOLUME
      .  INITIALIZE_MEDIA
    return the QSTAT byte
  }
  var
    im: {the 5 bytes in the command message}
      packed record
	setunitvol: setunitvol_type;
	initmedia: CMD_type;
	options: unsgn8;
	interleave: unsgn8;
      end;
  begin {initialize_media}
    im.setunitvol := suv_CMD_pair(uep);
    im.initmedia  := CMDinit_media;
    im.options    := options;
    im.interleave := interleave;
    HPIBshort_msge_out(uep, command_sec, addr(im), sizeof(im));
    HPIBwait_for_ppol(uep);
    initialize_media := qstat(uep);
  end; {initialize_media}
$page$

function set_address_and_return_mode(uep: uep_type; address: integer): unsgn8;
  {
    issue the following command sequence:
      .  SET_UNIT
      .  SET_VOLUME
      .  SET_ADDRESS_RETURN_MODE
      .  SET_ADDRESS
    return the QSTAT byte
  }
  var
    sarm: {the 12 bytes in the command message}
      packed record
	setunitvol: setunitvol_type;
	setretadd: CMD_type;
	retaddmode: unsgn8;
	nop: CMD_type;
	setadd: CMD_type;
	sva: sva_type;
      end;
  begin {set_address_and_return_mode}
    sarm.setunitvol := suv_CMD_pair(uep);
    sarm.setretadd  := CMDset_retadd_mode;
    sarm.retaddmode := 0;  {single vector!}
    sarm.nop        := CMDno_op;
    sarm.setadd     := CMDset_address_1V;
    sarm.sva.utb    := 0;
    sarm.sva.lfb    := address;
    HPIBshort_msge_out(uep, command_sec, addr(sarm), sizeof(sarm));
    HPIBwait_for_ppol(uep);
    set_address_and_return_mode := qstat(uep);
  end; {set_address_and_return_mode}


function write_file_mark(uep: uep_type): unsgn8;
  {
    issue the following command sequence:
      .  SET_UNIT
      .  SET_VOLUME
      .  WRITE_FILE_MARK
    return the QSTAT byte
  }
  var
    wfm: {the 3 bytes in the command message}
      packed record
	setunitvol: setunitvol_type;
	writefilemark: CMD_type;
      end;
  begin {write_file_mark}
    wfm.setunitvol    := suv_CMD_pair(uep);
    wfm.writefilemark := CMDwrite_file_mark;
    HPIBshort_msge_out(uep, command_sec, addr(wfm), sizeof(wfm));
    HPIBwait_for_ppol(uep);
    write_file_mark := qstat(uep);
  end; {write_file_mark}
$page$

function unload(uep: uep_type): unsgn8;
  {
    issue the following command sequence:
      .  SET_UNIT
      .  SET_VOLUME
      .  UNLOAD
    return the QSTAT byte
  }
  var
    unl: {the 3 bytes in the command message}
      packed record
	setunitvol: setunitvol_type;
	unloadcmd: CMD_type;
      end;
  begin {unload}
    unl.setunitvol := suv_CMD_pair(uep);
    unl.unloadcmd  := CMDunload;
    HPIBshort_msge_out(uep, command_sec, addr(unl), sizeof(unl));
    HPIBwait_for_ppol(uep);
    unload := qstat(uep);
  end; {unload}


function locate_and_verify(uep: uep_type; length: integer): unsgn8;
  {
    issue the following command sequence:
      .  SET_UNIT
      .  SET_VOLUME
      .  SET_LENGTH
      .  LOCATE_AND_VERIFY
    return the QSTAT byte
  }
  var
    lv: {the 9 bytes in the command message}
      packed record
	setunitvol: setunitvol_type;
	nop: CMD_type;
	setlen: CMD_type;
	len: integer;
	locateandverify: CMD_type;
      end;
  begin {locate_and_verify}
    lv.setunitvol      := suv_CMD_pair(uep);
    lv.nop             := CMDno_op;
    lv.setlen          := CMDset_length;
    lv.len             := length;
    lv.locateandverify := CMDlocate_and_ver;
    HPIBshort_msge_out(uep, command_sec, addr(lv), sizeof(lv));
    HPIBwait_for_ppol(uep);
    locate_and_verify := qstat(uep);
  end; {locate_and_verify}
$page$

function copy_data(source_uep: uep_type; source_blk_addr: integer;
		   destination_uep: uep_type; destination_blk_addr: integer;
		   copy_length: integer): unsgn8;
  {
    issue the following command sequence:
      .  SET_UNIT_15
      .  SET_LENGTH
      .  COPY_DATA
    return the QSTAT byte
  }
  var
    cd: {the 24 bytes in the command message}
      packed record
	setunit15: CMD_type;
	setlen: CMD_type;
	length: integer;
	nop: CMD_type;
	copydata: CMD_type;
	s_volunit: evu_type;
	s_setadd: CMD_type;
	s_address: sva_type;
	d_volunit: evu_type;
	d_setadd: CMD_type;
	d_address: sva_type;
      end;
  begin {copy_data}
    cd.setunit15      := CMDset_unit_15;
    cd.setlen         := CMDset_length;
    cd.length         := copy_length;
    cd.nop            := CMDno_op;
    cd.copydata       := CMDcopy_data;
    cd.s_volunit.vvvv := source_uep^.dv;
    cd.s_volunit.uuuu := source_uep^.du;
    cd.s_setadd       := CMDset_address_1v;
    cd.s_address.utb  := 0;
    cd.s_address.lfb  := source_blk_addr;
    cd.d_volunit.vvvv := destination_uep^.dv;
    cd.d_volunit.uuuu := destination_uep^.du;
    cd.d_setadd       := CMDset_address_1v;
    cd.d_address.utb  := 0;
    cd.d_address.lfb  := destination_blk_addr;
    HPIBshort_msge_out(source_uep, command_sec, addr(cd), sizeof(cd));
    HPIBwait_for_ppol(source_uep);
    copy_data := qstat(source_uep);
  end; {copy_data}
$page$

function copy_start_address(uep: uep_type; var csa_bytes: sva_type): unsgn8;
  {
    issue the following command sequence:
      .  SET_UNIT
      .  SET_VOLUME
      .  READ DRIVE TABLES: COPY START ADDRESS (7914 ONLY!!!)
    return the QSTAT byte
  }
  var
    csa: {the 5 bytes in the command message}
      packed record
	setunitvol: setunitvol_type;
	initutil: CMD_type;
	readdrivetables: unsgn8;
	tablenumber: unsgn8;
      end;
    premature_eoi: boolean;
    qs: unsgn8;
  begin {copy_start_address}
    csa.setunitvol      := suv_CMD_pair(uep);
    csa.initutil        := CMDinit_util_SEM;  {send execution message}
    csa.readdrivetables := 196;
    csa.tablenumber     := 12;
    HPIBshort_msge_out(uep, command_sec, addr(csa), sizeof(csa));
    HPIBwait_for_ppol(uep);
    try
      HPIBshort_msge_in(uep, execution_sec, addr(csa_bytes), sizeof(csa_bytes));
      premature_eoi := false;
    recover
      with bip_type(uep^.dvrtemp)^ do  {confirm the "premature" eoi}
	begin
	  if (escapecode<>-10) or (iores<>zbadhardware) then
	    escape(escapecode);
	  premature_eoi := true;
	  iores := inoerror;
	end; {with}
    HPIBwait_for_ppol(uep);
    qs := qstat(uep);
    if premature_eoi and (qs=0) then
      ioresc_bkgnd(uep, zcatchall);
    copy_start_address := qs;
  end; {copy_start_address}


end; {CS80tbr}
$page$

module CS80tbdvr;  {tape backup driver}

import
  sysglobals, misc, bkgnd, discHPIB, tapebuf, CS80, CS80dsr, CS80tbr;

export
  type
    uep_proc_type = procedure(uep: uep_type);

  var  {"var parameter" set by Qdescribe}
    describe_bytes: describe_type;
  procedure Qdescribe(uep: uep_type);

  function Qdevicename(uep: uep_type; var saved_ioresult: integer): string80;

  var  {"parameters" for Qverify}
    verify_length: integer;
    verify_block_size: integer;
  procedure Qverify(uep: uep_type);

  procedure Qtapesetup(uep: uep_type);
  procedure Qconfigure(uep: uep_type);
  procedure Qwritefilemark(uep: uep_type);
  procedure Qunload(uep: uep_type);

  var  {"parameter" for Qcertify}
    initialize_options_byte: unsgn8;
  procedure Qcertify(uep: uep_type);

  var  {"parameters" for Qcontrollercopy}
    destination_uep: uep_type;
    source_block_address: integer;
    destination_block_address: integer;
    copy_length: integer;
  procedure Qcontrollercopy(source_uep: uep_type);

  var  {"var parameter" for Qcopy_start_address}
    csa_bytes: sva_type;
  procedure Qcopy_start_address(uep: uep_type);


implement {CS80tbdvr}
$page$

procedure with_bkgnd_do(uep_proc: uep_proc_type; uep: uep_type);
  begin {with_bkgnd_do}
    try
      ioresult := ord(inoerror);
      allocate_bkgnd_info(uep);
      if HPIBamigo_identify(uep) div 256<>2 then
	ioresc_bkgnd(uep, znodevice);
      call(uep_proc, uep);
      deallocate_bkgnd_info(uep);
    recover
      begin
	abort_bkgnd_process(uep);
	ioresult := uep^.dvrtemp;
	uep^.dvrtemp := ord(inoerror);  {report the error only once}
	escape(-10);
      end; {recover}
  end; {with_bkgnd_do}


procedure Qtapesetup(uep: uep_type);

  procedure tapesetup(uep: uep_type);
    var
      retry_required: boolean;
    begin {tapesetup}
      repeat
	retry_required := false;
	if set_unitvol(uep)<>0 then
	  handle_bad_status(uep, true, retry_required);
      until not retry_required;
      repeat  {enable auto skip sparing}
	retry_required := false;
	if set_options(uep, {options byte} 6)<>0 then
	  handle_bad_status(uep, true, retry_required);
      until not retry_required;
    end; {tapesetup}

  begin {Qtapesetup}
    with_bkgnd_do(tapesetup, uep);
  end; {Qtapesetup}


procedure Qconfigure(uep: uep_type);
  begin {Qconfigure}
    with_bkgnd_do(configure, uep);
  end; {Qconfigure}
$page$

procedure Qwritefilemark(uep: uep_type);

  procedure writefilemark(uep: uep_type);
    var
      retry_required: boolean;
    begin {writefilemark}
      repeat
	retry_required := false;
	if write_file_mark(uep)<>0 then
	  handle_bad_status(uep, true, retry_required);
      until not retry_required;
    end; {writefilemark}

  begin {Qwritefilemark}
    with_bkgnd_do(writefilemark, uep);
  end; {Qwritefilemark}


procedure Qcertify(uep: uep_type);

  procedure certify(uep: uep_type);
    var
      retry_required: boolean;
    begin {certify}
      repeat  {initialize the medium}
	retry_required := false;
	if initialize_media(uep, initialize_options_byte, {interleave_factor} 0)<>0 then
	  handle_bad_status(uep, true, retry_required);
      until not retry_required;
    end; {certify}

  begin {Qcertify}
    with_bkgnd_do(certify, uep);
  end; {Qcertify}


procedure Qdescribe(uep: uep_type);

  procedure do_describe(uep: uep_type);
    var
      retry_required: boolean;
    begin {do_describe}
      repeat
	retry_required := false;
	if set_unitvol(uep)<>0 then
	  handle_bad_status(uep, true, retry_required);
      until not retry_required;
      repeat
	retry_required := false;
	if describe(uep, describe_bytes)<>0 then
	  handle_bad_status(uep, true, retry_required);
      until not retry_required;
    end; {do_describe}

  begin {Qdescribe}
    with_bkgnd_do(do_describe, uep);
  end; {Qdescribe}
$page$

function Qdevicename(uep: uep_type; var saved_ioresult: integer): string80;

  var
    devicename: string80;
    index: integer;
    bcd_product_number: {within the describe bytes}
      packed record case integer of
	0: (dn:  unsgn24);
	1: (bcd: packed array[1..6] of unsgn4);
      end;
    product_number: integer;
    fixed_vol_byte:
      packed record case integer of
	0: (byte: unsgn8);
	1: (bit:  packed array[0..7] of boolean);
      end;

  begin {Qdevicename}

    try
      Qdescribe(uep);
    recover
      if escapecode<>-10 then
	escape(escapecode);

    if saved_ioresult=ord(inoerror) then  {report any error with describe}
      saved_ioresult := ioresult;  {can be inoerror}

    if ioresult=ord(inoerror) then
      with describe_bytes do
	begin
	  bcd_product_number.dn := dn;
	  product_number := 0;
	  for index := 1 to 5 do
	    product_number := product_number*10+bcd_product_number.bcd[index];
	  devicename := 'HP';
	  strwrite(devicename, 3, index, product_number:1);
	  case dt of
	    0:        devicename := devicename+' fixed disc';
	    1:        begin
			fixed_vol_byte.byte := describe_bytes.fvb;
			if fixed_vol_byte.bit[7-uep^.dv]
			  then devicename := devicename+' fixed disc'
			  else devicename := devicename+' removeable disc';
		      end;
	    2:        devicename := devicename+' tape';
	    otherwise {can't further describe the generic device type};
	  end; {case}
	end {with}
    else
      devicename := '<inaccessible CS80 device>';

    Qdevicename := devicename;

  end; {Qdevicename}
$page$

procedure Qverify(uep: uep_type);

  var
    working_verify_length: integer;
    bad_blocks_encountered: boolean;

  procedure handle_verify_status(var retry_required: boolean);

    var
      iorval_to_report: iorsltwd;  {to hold the first reportable error}
      working_iorval: iorsltwd;  {cleared each time status is read}
      status_bytes: status_type;
      eb_scan, parameter_field_owner: errorbit_type;
      reconfiguration_needed: boolean;

    begin {handle_verify_status}

      iorval_to_report := inoerror;

      repeat

	if status(uep, status_bytes)<>0 then
	  ioresc_bkgnd(uep, zbadhardware);

	working_iorval := inoerror;
	parameter_field_owner := channel_parity_error;  {doesn't really own it!}
	reconfiguration_needed := false;

	for eb_scan := eb63 downto eb0 do
	  if status_bytes.errorbits[eb_scan] then
	    begin

	      if eb_scan in errorbits_owning_parmfield then
		parameter_field_owner := eb_scan;

	      case eb_scan of

		{specific fatal errors}
		  channel_parity_error,
		  controller_fault,
		  unit_fault,
		  diagnostic_result:
		      working_iorval := zbadhardware;
		  illegal_opcode,
		  parameter_bounds,
		  illegal_parameter:
		      working_iorval := zbadmode;  {some cmds optional in SS/80}
		  module_addressing:
		      working_iorval := znodevice;
		  address_bounds,
		  end_of_volume:
		      working_iorval := znosuchblk;
		  uninitialized_media:
		      if status_bytes.errorbits[power_fail]
			then {probably an uncertified tape; allow access anyway}
			else working_iorval := zuninitialized;
		  no_spares_available:
		      working_iorval := zinitfail;
		  not_ready:
		      working_iorval := znotready;
		  write_protect:
		      working_iorval := zprotected;
		  no_data_found,
		  end_of_file:
		      working_iorval := znoblock;
		  unrecoverable_data_overflow,
		  unrecoverable_data:
		      working_iorval := zbadblock;

		{power fail}
		  power_fail:
		      begin
			uep^.umediavalid := false;
			if uep=tapebuf_uep then
			  tapebuf_state := undefined;
			if uep^.ureportchange then
			  working_iorval := zmediumchanged;
			reconfiguration_needed := true;
			retry_required := true;
		      end;

		{retryable errors}
		  operator_release_required,
		  diagnostic_release_required,
		  internal_maintenance_required,
		  retransmit:
		      retry_required := true;

		{errors indicating release requested}
		  operator_request,
		  diagnostic_request,
		  internal_maintenance_request:
		      {do nothing here; release below if parmeter field owned};

		{errors indicating reconfiguration needed}
		  media_wear,                     {supposed to be masked out}
		  latency_induced,                {supposed to be masked out}
		  eb53,                           {supposed to be masked out}
		  eb54,                           {supposed to be masked out}
		  auto_sparing_invoked,           {supposed to be masked out}
		  eb56,                           {supposed to be masked out}
		  recoverable_data_overflow,      {supposed to be masked out}
		  marginal_data,                  {supposed to be masked out}
		  recoverable_data,               {supposed to be masked out}
		  eb60,                           {supposed to be masked out}
		  maintenance_track_overflow,     {supposed to be masked out}
		  eb62,                           {supposed to be masked out}
		  eb63:                           {supposed to be masked out}
		      reconfiguration_needed := true;

		{errors not covered by the above cases}
		  otherwise
			{ specifically including:
			  message_sequence,
			  message_length,
			  cross_unit,
			  illegal_parallel_operation }
		      working_iorval := zcatchall;

	      end; {case}

	    end; {if}

	if iorval_to_report=inoerror then  {none previously found; report this one}
	  iorval_to_report := working_iorval;  {it can be inoerror also!}

	if parameter_field_owner=unrecoverable_data then
	  begin
	    writeln('  bad block at ',status_bytes.bba.lfb:1);
	    bad_blocks_encountered := true;
	    working_verify_length := verify_length-(status_bytes.bba.lfb+1)*verify_block_size;
	    if working_verify_length>0 then
	      retry_required := true;
	  end; {if}

	if parameter_field_owner in errorbits_requesting_release then
	  if not (status_bytes.urr[1] in [0..15]) then
	    ioresc_bkgnd(uep, zcatchall)
	  else if release(uep, status_bytes.urr[1])<>0 then
	    {handle the bad qstat elsewhere; worry not, the device won't forget!};

	if reconfiguration_needed then
	  configure(uep);

      until set_unit(uep, status_bytes.current_vu.uuuu)=0;  {restore original command unit}

      if not (iorval_to_report in [inoerror, zbadblock]) then
	ioresc_bkgnd(uep, iorval_to_report);

    end; {handle_verify_status}
$page$

  procedure verify(uep: uep_type);

    var
      retry_required: boolean;

    begin {verify}

      repeat  {set address to zero and set return addressing mode}
	retry_required := false;
	if set_address_and_return_mode(uep, {address} 0)<>0 then
	  handle_bad_status(uep, true, retry_required);
      until not retry_required;

      working_verify_length := verify_length;
      bad_blocks_encountered := false;

      repeat  {verify the requested amount}
	retry_required := false;
	if locate_and_verify(uep, working_verify_length)<>0 then
	  handle_verify_status(retry_required);
      until not retry_required;

      if bad_blocks_encountered then
	ioresc_bkgnd(uep, zbadblock);

    end; {verify}

  begin {Qverify}
    with_bkgnd_do(verify, uep);
  end; {Qverify}
$page$

procedure Qcontrollercopy(source_uep: uep_type);

  procedure handle_copydata_status(var retry_required: boolean);

    var
      iorval_to_report: iorsltwd;  {to hold the first reportable error}
      working_iorval: iorsltwd;  {cleared each time status is read}
      status_bytes: status_type;
      eb_scan, parameter_field_owner: errorbit_type;
      reconfiguration_needed: boolean;
      uee_pending: boolean;
      index: signed16;

    procedure handle_uee_pending(uee_byte: signed8);
      var
	evu: {encoded volume/unit byte}
	  packed record case integer of
	    0: (sgn8: signed8);
	    1: (vu: evu_type);
	  end;
	vol, unit: unsgn4;
	retry_required: boolean;
	message: string80;
      begin {handle_uee_pending}
	evu.sgn8 := uee_byte;
	vol := evu.vu.vvvv;
	unit := evu.vu.uuuu;
	try
	  if unit=15 then
	    repeat
	      retry_required := false;
	      if set_unit(source_uep, unit)<>0 then
		handle_bad_status(source_uep, false, retry_required);
	    until not retry_required
	  else
	    repeat
	      retry_required := false;
	      if set_specified_unitvol(source_uep, unit, vol)<>0 then
		handle_bad_status(source_uep, false, retry_required);
	    until not retry_required;
	recover
	  if escapecode<>-10 then escape(escapecode);
	with bip_type(source_uep^.dvrtemp)^ do
	  if iores<>inoerror then  {we need to report it}
	    begin
	      if iorval_to_report=inoerror then  {none previously found...}
		iorval_to_report := iores;  {report this one later in a fatal way!}
	      if (vol=source_uep^.dv) and (unit=source_uep^.du) then
		writeln('  source unit error:')
	      else if (vol=destination_uep^.dv) and (unit=destination_uep^.du) then
		writeln('  destination unit error:')
	      else
		writeln('  unit: ', unit:1,', volume: ', vol:1, ' error:');
	      getioerrmsg(message, ord(iores));
	      writeln('    ',message);
	      iores := inoerror;  {now clear it out}
	    end;  {if}
      end; {handle_uee_pending}

    begin {handle_copydata_status}

      iorval_to_report := inoerror;

      repeat

	if status(source_uep, status_bytes)<>0 then
	  ioresc_bkgnd(source_uep, zbadhardware);

	working_iorval := inoerror;
	parameter_field_owner := channel_parity_error;  {doesn't really own it!}
	reconfiguration_needed := false;

	for eb_scan := eb63 downto eb0 do
	  if status_bytes.errorbits[eb_scan] then
	    begin

	      if eb_scan in errorbits_owning_parmfield then
		parameter_field_owner := eb_scan;

	      case eb_scan of

		{the expected error}
		  cross_unit:
		      {do nothing here; handle below if parmeter field owned};

		{specific fatal errors}
		  channel_parity_error,
		  controller_fault,
		  unit_fault,
		  diagnostic_result:
		      working_iorval := zbadhardware;
		  illegal_opcode,
		  parameter_bounds,
		  illegal_parameter:
		      working_iorval := zbadmode;  {some cmds optional in SS/80}
		  module_addressing:
		      working_iorval := znodevice;
		  address_bounds,
		  end_of_volume:
		      working_iorval := znosuchblk;
		  uninitialized_media:
		      if status_bytes.errorbits[power_fail]
			then {probably an uncertified tape; allow access anyway}
			else working_iorval := zuninitialized;
		  no_spares_available:
		      working_iorval := zinitfail;
		  not_ready:
		      working_iorval := znotready;
		  write_protect:
		      working_iorval := zprotected;
		  no_data_found,
		  end_of_file:
		      working_iorval := znoblock;
		  unrecoverable_data_overflow,
		  unrecoverable_data:
		      working_iorval := zbadblock;

		{power fail}
		  power_fail:
		      begin
			source_uep^.umediavalid := false;
			if source_uep=tapebuf_uep then
			  tapebuf_state := undefined;
			if source_uep^.ureportchange then
			  working_iorval := zmediumchanged;
			reconfiguration_needed := true;
			retry_required := true;
		      end;

		{retryable errors}
		  operator_release_required,
		  diagnostic_release_required,
		  internal_maintenance_required,
		  retransmit:
		      retry_required := true;

		{errors indicating release requested}
		  operator_request,
		  diagnostic_request,
		  internal_maintenance_request:
		      {do nothing here; release below if parmeter field owned};

		{errors indicating reconfiguration needed}
		  media_wear,                     {supposed to be masked out}
		  latency_induced,                {supposed to be masked out}
		  eb53,                           {supposed to be masked out}
		  eb54,                           {supposed to be masked out}
		  auto_sparing_invoked,           {supposed to be masked out}
		  eb56,                           {supposed to be masked out}
		  recoverable_data_overflow,      {supposed to be masked out}
		  marginal_data,                  {supposed to be masked out}
		  recoverable_data,               {supposed to be masked out}
		  eb60,                           {supposed to be masked out}
		  maintenance_track_overflow,     {supposed to be masked out}
		  eb62,                           {supposed to be masked out}
		  eb63:                           {supposed to be masked out}
		      reconfiguration_needed := true;

		{errors not covered by the above cases}
		  otherwise
			{ specifically including:
			  message_sequence,
			  message_length,
			  illegal_parallel_operation }
		      working_iorval := zcatchall;

	      end; {case}

	    end; {if}

	if iorval_to_report=inoerror then  {none previously found; report this one}
	  iorval_to_report := working_iorval;  {it can be inoerror also!}

	index := 0;
	if parameter_field_owner=cross_unit then
	  repeat
	    index := index+1;
	    if index<=6
	      then uee_pending := status_bytes.uee[index]>=0
	      else uee_pending := false;
	    if uee_pending then
	      handle_uee_pending(status_bytes.uee[index]);
	  until not uee_pending;

	if parameter_field_owner in errorbits_requesting_release then
	  if not (status_bytes.urr[1] in [0..15]) then
	    ioresc_bkgnd(source_uep, zcatchall)
	  else if release(source_uep, status_bytes.urr[1])<>0 then
	    {handle the bad qstat elsewhere; worry not, the device won't forget!};

	if reconfiguration_needed then
	  configure(source_uep);

      until set_unit(source_uep, status_bytes.current_vu.uuuu)=0;  {restore original command unit}

      if iorval_to_report<>inoerror then
	ioresc_bkgnd(source_uep, iorval_to_report);

    end; {handle_copydata_status}


  procedure controllercopy(uep: uep_type);
    var
      retry_required: boolean;
    begin {controllercopy}
      repeat  {copy the entire volume}
	retry_required := false;
	if copy_data(source_uep, source_block_address,
	       destination_uep, destination_block_address, copy_length)<>0 then
	  handle_copydata_status(retry_required);
      until not retry_required;
    end; {controllercopy}

  begin {Qcontrollercopy}
    with_bkgnd_do(controllercopy, source_uep);
  end; {Qcontrollercopy}
$page$

procedure Qunload(uep: uep_type);

  procedure do_unload(uep: uep_type);
    var
      retry_required: boolean;
    begin {do_unload}
      repeat
	retry_required := false;
	if unload(uep)<>0 then
	  handle_bad_status(uep, true, retry_required);
      until not retry_required;
    end; {do_unload}

  begin {Qunload}
    with_bkgnd_do(do_unload, uep);
  end; {Qunload}


procedure Qcopy_start_address(uep: uep_type);

  procedure do_copy_start_address(uep: uep_type);
    var
      retry_required: boolean;
    begin {do_copy_start_address}
      repeat
	retry_required := false;
	if copy_start_address(uep, csa_bytes)<>0 then
	  handle_bad_status(uep, true, retry_required);
      until not retry_required;
    end; {do_copy_start_address}

  begin {Qcopy_start_address}
    with_bkgnd_do(do_copy_start_address, uep);
  end; {Qcopy_start_address}


end; {CS80tbdvr}
$page$

{program tapebkup;}

import
  sysglobals, misc, sysdevs, fs, bkgnd, tapebuf, CS80tbr, CS80tbdvr;

var
  keyboard: text;

type
  proc_type = procedure;

const  {for under_lock_do procedure calls}
  verbosely = true;
  silently = false;  {if desired, set true to debug}


procedure upcchar(var ch : char);
  begin
    if (ch>='a') and (ch<='z') then ch := chr(ord(ch)-32);
  end;


function yes(prompt: string80): boolean;
  var
    answer: char;
  begin {yes}
    writeln;
    write(prompt, ' (Y/N) ');
    repeat
      read(keyboard, answer);
      upcchar(answer);
    until (answer='Y') or (answer='N');
    writeln(answer);
    yes := answer='Y';
  end; {yes}


procedure fatal_ioresult(message: string80; iores: integer);
  begin {fatal_ioresult}
    writeln(#7+message);
    getioerrmsg(message, iores);
    writeln('  ',message);
    escape(-1);
  end; {fatal_ioresult}


procedure fatal_message(message: string80);
  begin {fatal_message}
    writeln(#7+message);
    escape(-1);
  end; {fatal_message}
$page$

function on_same_medium(lun1, lun2: unitnum): boolean;
  var
    uep1, uep2: uep_type;
  begin {on_same_medium}
    uep1 := addr(unitable^[lun1]);
    uep2 := addr(unitable^[lun2]);
    on_same_medium := (uep1^.sc=uep2^.sc) and (uep1^.ba=uep2^.ba) and
		      (uep1^.du=uep2^.du) and (uep1^.dv=uep2^.dv) and
		      (uep1^.letter=uep2^.letter);
  end; {on_same_medium}


function on_same_controller(uep1, uep2: uep_type): boolean;
  begin {on_same_controller}
    on_same_controller := (uep1^.sc=uep2^.sc) and (uep1^.ba=uep2^.ba);
  end; {on_same_controller}


procedure enable_report_changes(uep: uep_type);
  begin {enable_report_changes}
    with uep^ do
      begin
	umediavalid := false;
	ureportchange := true;
      end; {with}
  end; {enable_report_changes}


procedure disable_report_changes(uep: uep_type);
  begin {disable_report_changes}
    with uep^ do
      begin
	umediavalid := false;
	ureportchange := false;
      end; {with}
  end; {disable_report_changes}


procedure user_confirmation;
  begin {user_confirmation}
    if not yes('Are you SURE you want to proceed?') then
      escape(-1);
  end; {user_confirmation}
$page$

procedure request_vol(prompt: string80; var lun: unitnum);

  const
    nonabortive_ioresult_set = [ord(inoerror), ord(zbadblock), ord(znoblock),
				ord(zuninitialized), ord(inodirectory)];
  var
    response: string80;
    fvid: vid;
    ftitle: fid;
    fsegs: integer;
    fkind: filekind;
    scantitle_ok: boolean;
    saved_ioresult: integer;
    uep: uep_type;

  begin {request_vol}

    repeat
      write(prompt,cteol);
      readln(response);
      if (strlen(response)=0) or (strpos(response,#27)<>0) then escape(-1);
      scantitle_ok := scantitle(response, fvid, ftitle, fsegs, fkind);
      if scantitle_ok and (ftitle='') then
	begin
	  lun := findvolume(fvid, true);
	  saved_ioresult := ioresult;           {for decoding below}
	  getioerrmsg(response, ord(inounit));  {for the case lun=0}
	end {then}
      else
	begin
	  lun := 0;
	  response := 'Illegal syntax: volume ID required';
	end; {else}
      if lun=0 then
	writeln('  ',response);
    until lun<>0;

    uep := addr(unitable^[lun]);
    with uep^ do
      begin
	if not (letter in ['Q', 'K']) then
	  fatal_message('Specified volume is not on a CS80 device');

	write('Device: ', Qdevicename(uep, saved_ioresult));
	writeln(', ',100*sc+ba:1,', ',du:1,', ',dv:1);
      end; {with uep^}

    write('Logical unit #',lun:1,' - ');
    if fvid[1]<>'#' then
      writeln('''',fvid,':''')
    else if saved_ioresult in nonabortive_ioresult_set then
      writeln('<no directory>')
    else
      fatal_ioresult('', saved_ioresult);

  end; {request_vol}
$page$

procedure other_volume_check(lun: unitnum);
  var
    warning_issued: boolean;
    flun: unitnum;
    line: shortint;
    CRTline, CRTcolumn, stopline: integer;
    fvid: vid;
  const
    maxlines = 10;
    fieldwidth = 16;
  begin {other_volume_check}

    warning_issued := false;

    for flun := 1 to maxunit do
      if on_same_medium(flun, lun) then
	with unitable^[flun] do
	  begin
	    if flun<>lun then
	      begin
		if not warning_issued then
		  begin
		    writeln('NOTICE: this will also affect:');
		    warning_issued := true;
		    line := 1;
		  end; {if}

		fgetxy(output,CRTcolumn, CRTline);
		write(' #',flun:1);
		fgotoxy(output,CRTcolumn+5, CRTline);
		call(dam, fvid, flun, getvolumename);
		if strlen(fvid)>0
		  then write(fvid,':')
		  else write('<no dir>');
		if CRTcolumn=0
		  then writeln               {scrolls the screen if necessary}
		  else fgotoxy(output,CRTcolumn, CRTline+1);

		line := line+1;
		if line>maxlines then
		  begin
		    fgetxy(output,CRTcolumn, stopline);
		    fgotoxy(output,CRTcolumn+fieldwidth, stopline-maxlines);
		    line := 1;
		  end; {if}

	      end; {if flun<>lun}
	    umediavalid := false;
	  end; {with}

    if warning_issued and (CRTcolumn<>0) then
      fgotoxy(output,0, stopline);

  end; {other_volume_check}
$page$

procedure preserving_status_do(proc: proc_type);
  var
    saved_escapecode: shortint;
    saved_ioresult: integer;
  begin {preserving_status_do}
    saved_escapecode := escapecode;
    saved_ioresult := ioresult;
    call(proc);
    sysescapecode := saved_escapecode;
    ioresult := saved_ioresult;
  end; {preserving_status_do}


procedure writeln_proc;
  begin {writeln_proc}
    writeln;
  end; {writeln_proc}


procedure under_lock_do(verbose: boolean; uep_proc: uep_proc_type;
				      uep: uep_type; op_description: string80);
  begin {under_lock_do}

    lockup;
    try
      if verbose then
	begin
	  writeln;
	  writeln(op_description, ' in progress');
	end; {if}
      call(uep_proc, uep);
      if verbose then
	writeln(op_description, ' completed');
      escape(0);  {to do the lockdown}
    recover
      begin
	preserving_status_do(lockdown);
	if escapecode=0 then
	  {do nothing}
	else if escapecode=-10 then
	  begin
	    if not verbose then
	      preserving_status_do(writeln_proc);
	    fatal_ioresult(op_description+' errored:', ioresult);
	  end
	else
	  escape(escapecode);
      end; {recover}

  end; {under_lock_do}
$page$

procedure medium_copy;

  var
    source_lun, destination_lun: unitnum;
    source_uep, tape_uep: uep_type;
    source_is_a_tape, destination_is_a_tape: boolean;
    source_is_a_7914, destination_is_a_7914: boolean;
    source_block_size, destination_block_size: integer;
    source_size, destination_size: integer;
    verify_destination: boolean;
    copy_attempt_completed, loop_condition: boolean;
    pass: shortint;

  procedure attempt_copy;

    procedure cleanup;
      begin {cleanup}
	if destination_is_a_tape then  {restore its configuration}
	  Qconfigure(destination_uep);
      end; {cleanup}

    begin {attempt_copy}

      if source_is_a_tape and destination_is_a_7914 then  {see where to restore}
	begin
	  under_lock_do(silently, Qcopy_start_address, source_uep, 'Copy start address request');
	  destination_block_address := csa_bytes.lfb;
	end; {if}

      if destination_is_a_tape then  {ensure it's certified; update size afterward!!!}
	begin
	  tapebuf_state := undefined;
	  initialize_options_byte := 0;  {certify only if currently uncertified}
	  under_lock_do(verbosely, Qcertify, destination_uep, 'Destination tape certification');
	  under_lock_do(silently, Qdescribe, destination_uep, 'Destination tape describe request');
	  with describe_bytes do
	    destination_size := (maxsvadd.lfb+1)*nbpb;
	end; {if}

      lockup;
      try
	if destination_is_a_tape then  {enable auto skip-sparing}
	  Qtapesetup(destination_uep);

	if source_is_a_7914 or destination_is_a_7914 then
	  begin
	    writeln;
	    writeln('Copy parameters for 7914 save/restore -');
	    writeln('  source starting block address: ', source_block_address:0);
	    writeln('  destination starting block address: ', destination_block_address:0);
	    copy_length := -1;
	  end
	else if destination_size>source_size then
	  copy_length := source_size
	else
	  copy_length := destination_size;

	under_lock_do(verbosely, Qcontrollercopy, source_uep, 'Medium copy');

	if destination_is_a_tape and (destination_size>source_size) then
	  under_lock_do(silently, Qwritefilemark, destination_uep, 'Destination tape filemark append');

	escape(0);  {to do the cleanup}
      recover
	begin
	  preserving_status_do(cleanup);
	  preserving_status_do(lockdown);
	  if escapecode<>0 then
	    escape(escapecode);
	end; {recover}

      if destination_is_a_tape and verify_destination then  {verify it}
	begin
	  if destination_size>source_size
	    then verify_length := source_size
	    else verify_length := destination_size;
	  verify_block_size := destination_block_size;
	  under_lock_do(verbosely, Qverify, destination_uep, 'Destination tape verification');
	end; {if}

    end; {attempt_copy}

  begin {medium_copy}

    writeln(clearscr);
    request_vol('Source medium for copy? ', source_lun);
    source_uep := addr(unitable^[source_lun]);
    enable_report_changes(source_uep);
    other_volume_check(source_lun);
    source_is_a_7914 := source_uep^.devid=7914;
    with describe_bytes do
      begin
	source_is_a_tape := dt=2;
	source_block_size := nbpb;
	source_size := (maxsvadd.lfb+1)*nbpb;
      end; {with}

    writeln;
    request_vol('Destination medium for copy? ', destination_lun);
    destination_uep := addr(unitable^[destination_lun]);
    enable_report_changes(destination_uep);
    if on_same_medium(source_lun, destination_lun) then
      fatal_message('Specified volumes are on the same medium');
    if not on_same_controller(source_uep, destination_uep) then
      fatal_message('Source and destination not on the same controller');
    other_volume_check(destination_lun);
    destination_is_a_7914 := destination_uep^.devid=7914;
    with describe_bytes do
      begin
	destination_is_a_tape := dt=2;
	destination_block_size := nbpb;
	destination_size := (maxsvadd.lfb+1)*nbpb;
      end; {with}

    if destination_is_a_tape and (destination_size<source_size) then
      if source_is_a_7914 then
	begin
	  writeln;
	  writeln('REMINDER: two long tapes are required for');
	  writeln('  complete 7914 backup.');
	end {then}
      else
	begin
	  writeln;
	  writeln('NOTICE: the destination tape is too small for a');
	  writeln('  complete source backup!');
	end; {else}

    user_confirmation;

    if destination_is_a_tape
      then verify_destination := yes('Verify destination tape after the copy?')
      else verify_destination := true;  {always verify discs}

    pass := 1;
    source_block_address := 0;
    destination_block_address := 0;

    repeat  {loop for swapping tapes}

      repeat  {copy attempts}
	try
	  attempt_copy;
	  copy_attempt_completed := true;
	recover
	  if escapecode<>-1 then
	    escape(escapecode)
	  else
	    if yes('Retry the current copy segment?') then
	      copy_attempt_completed := false
	    else if yes('Abort the entire medium copy sequence?') then
	      fatal_message('Medium copy sequence aborted')
	    else
	      begin
		writeln('Medium copy sequence continued');
		copy_attempt_completed := true;
	      end;
      until copy_attempt_completed;

      if source_is_a_tape then
	under_lock_do(verbosely, Qunload, source_uep, 'Source tape unload request');

      if destination_is_a_tape then
	under_lock_do(verbosely, Qunload, destination_uep, 'Destination tape unload request');

      loop_condition := (source_is_a_7914 or destination_is_a_7914) and (pass<2);

      if loop_condition then  {prepare for the next pass through the loop}
	begin

	  if destination_is_a_tape then  {update the source disc parms}
	    begin
	      source_size := source_size - destination_size;
	      source_block_address := source_block_address + destination_size div source_block_size;
	    end; {if}

	  if source_is_a_tape
	    then tape_uep := source_uep
	    else tape_uep := destination_uep;

	  writeln;
	  writeln('Waiting for a new tape to be loaded:');
	  writeln('Press <stop> to abort');

	  disable_report_changes(tape_uep);

	  repeat
	    try
	      Qcopy_start_address(tape_uep);
	    recover
	      if escapecode<>-10 then
		escape(escapecode)
	      else if ioresult<>ord(znotready) then
		fatal_ioresult('Error while awaiting new tape load:', ioresult)
	  until ioresult<>ord(znotready);

	  enable_report_changes(tape_uep);

	  pass := pass+1;

	end; {if}

    until not loop_condition;

    if not destination_is_a_tape then
      begin
	verify_length := destination_size;
	verify_block_size := destination_block_size;
	under_lock_do(verbosely, Qverify, destination_uep, 'Destination disc verification');
      end; {if}

  end; {medium_copy}
$page$

procedure verify;

  var
    lun: unitnum;
    uep: uep_type;
    auto_unload: boolean;

  begin {verify}

    writeln(clearscr);
    request_vol('Verify what medium? ', lun);
    uep := addr(unitable^[lun]);
    enable_report_changes(uep);
    other_volume_check(lun);

    user_confirmation;

    with describe_bytes do
      begin
	if dt=2
	  then auto_unload := yes('Unload tape after verification?')
	  else auto_unload := false;
	verify_length := (maxsvadd.lfb+1)*nbpb;
	verify_block_size := nbpb;
      end; {with}

    under_lock_do(verbosely, Qverify, uep, 'Verification');

    if auto_unload then
      under_lock_do(verbosely, Qunload, uep, 'Tape unload request');

  end; {verify}
$page$

procedure certify;

  var
    lun: unitnum;
    uep: uep_type;
    auto_unload: boolean;

  begin {certify}

    writeln(clearscr);
    request_vol('Certify what tape? ', lun);
    uep := addr(unitable^[lun]);
    enable_report_changes(uep);
    if describe_bytes.dt<>2 then
      fatal_message('Specified volume is not on a tape');
    other_volume_check(lun);

    user_confirmation;

    if yes('Re-certify if already certified?')
      then initialize_options_byte := 1   {force complete certification}
      else initialize_options_byte := 0;  {certify only if currently uncertified}

    auto_unload := yes('Unload tape after certification?');

    tapebuf_state := undefined;
    under_lock_do(verbosely, Qcertify, uep, 'Tape certification');

    if auto_unload then
      under_lock_do(verbosely, Qunload, uep, 'Tape unload request');

  end; {certify}
$page$

procedure commandlevel;

  var
    ch: char;

  begin {commandlevel}

    repeat

      try
	write(homechar,
	      'Tapebkup: Medium-copy Verify Certify-tape Quit  ?',
	      cteol);
	read(keyboard, ch);
	upcchar(ch);
	writeln;
	case ch of
	  'C': certify;
	  'M': medium_copy;
	  'Q': {quit};
	  'V': verify;
	  otherwise
	    write(clearscr);
	end; {case}

      recover
	if escapecode=-20 then
	  ch := 'Q'  {stop key means "quit"}
	else if escapecode=-1 then
	  {do nothing; remain in command level}
	else
	  escape(escapecode);

    until ch='Q';

  end; {commandlevel}



begin {tapebkup}
  writeln(clearscr);
  writeln('             [Version 3.25]');
  writeln;
  writeln;
  writeln;
  writeln('Copyright Hewlett-Packard Company, 1982, 1991');
  writeln('          All rights are reserved.');
  commandlevel;
end. {tapebkup}


@


56.2
log
@
pws2rcs automatic delta on Wed Jan 27 11:57:27 MST 1993
@
text
@d1 1549
@


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 1549
$modcal, switch_strpos, debug off, range off, ovflcheck off$

$search 'IOLIB:KERNEL', 'INIT:DRVASM', 'INIT:DISCHPIB',
	'INIT:CS80'$



program tapebkup(keyboard,input,output);  {CS80 streaming backup tape utility}


module CS80tbr; {tape backup routines}

import
  sysglobals, bkgnd, discHPIB, CS80;

export

  {
    NOTE: the following functions each perform a COMPLETE transaction. They:
	.  issue a (device or transparent) command         (Command message)
	.  transfer data if applicable                     (Execution message)
	.  return the resulting QSTAT                      (Reporting message)
  }
  function set_specified_unitvol      (uep: uep_type; unit, vol: unsgn4): unsgn8;
  function initialize_media           (uep: uep_type; options, interleave: unsgn8): unsgn8;
  function set_address_and_return_mode(uep: uep_type; address: integer): unsgn8;
  function write_file_mark            (uep: uep_type): unsgn8;
  function copy_start_address         (uep: uep_type; var csa_bytes: sva_type): unsgn8;
  function unload                     (uep: uep_type): unsgn8;
  function locate_and_verify          (uep: uep_type; length: integer): unsgn8;
  function copy_data                  (source_uep: uep_type;
				       source_blk_addr: integer;
				       destination_uep: uep_type;
				       destination_blk_addr: integer;
				       copy_length: integer): unsgn8;


implement {CS80tbr}


type
  setunitvol_type = {SET_UNIT/SET_VOLUME command pair}
    packed record
      setunit: CMD_type;
      setvol: CMD_type;
    end;


function suv_CMD_pair(uep: uep_type): setunitvol_type;
  begin {suv_CMD_pair}
    suv_CMD_pair.setunit := CMD_type(signed16(CMDset_unit_0)+uep^.du);
    suv_CMD_pair.setvol  := CMD_type(signed16(CMDset_vol_0)+uep^.dv);
  end; {suv_CMD_pair}
$page$

function set_specified_unitvol(uep: uep_type; unit, vol: unsgn4): unsgn8;
  {
    issue the following command sequence:
      .  SET_UNIT
      .  SET_VOLUME
    return the QSTAT byte
  }
  var
    suv: setunitvol_type;
  begin {set_specified_unitvol}
    suv.setunit := CMD_type(signed16(CMDset_unit_0)+unit);
    suv.setvol  := CMD_type(signed16(CMDset_vol_0)+vol);
    HPIBshort_msge_out(uep, command_sec, addr(suv), sizeof(suv));
    HPIBwait_for_ppol(uep);
    set_specified_unitvol := qstat(uep);
  end; {set_specified_unitvol}


function initialize_media(uep: uep_type; options, interleave: unsgn8): unsgn8;
  {
    issue the following command sequence:
      .  SET_UNIT
      .  SET_VOLUME
      .  INITIALIZE_MEDIA
    return the QSTAT byte
  }
  var
    im: {the 5 bytes in the command message}
      packed record
	setunitvol: setunitvol_type;
	initmedia: CMD_type;
	options: unsgn8;
	interleave: unsgn8;
      end;
  begin {initialize_media}
    im.setunitvol := suv_CMD_pair(uep);
    im.initmedia  := CMDinit_media;
    im.options    := options;
    im.interleave := interleave;
    HPIBshort_msge_out(uep, command_sec, addr(im), sizeof(im));
    HPIBwait_for_ppol(uep);
    initialize_media := qstat(uep);
  end; {initialize_media}
$page$

function set_address_and_return_mode(uep: uep_type; address: integer): unsgn8;
  {
    issue the following command sequence:
      .  SET_UNIT
      .  SET_VOLUME
      .  SET_ADDRESS_RETURN_MODE
      .  SET_ADDRESS
    return the QSTAT byte
  }
  var
    sarm: {the 12 bytes in the command message}
      packed record
	setunitvol: setunitvol_type;
	setretadd: CMD_type;
	retaddmode: unsgn8;
	nop: CMD_type;
	setadd: CMD_type;
	sva: sva_type;
      end;
  begin {set_address_and_return_mode}
    sarm.setunitvol := suv_CMD_pair(uep);
    sarm.setretadd  := CMDset_retadd_mode;
    sarm.retaddmode := 0;  {single vector!}
    sarm.nop        := CMDno_op;
    sarm.setadd     := CMDset_address_1V;
    sarm.sva.utb    := 0;
    sarm.sva.lfb    := address;
    HPIBshort_msge_out(uep, command_sec, addr(sarm), sizeof(sarm));
    HPIBwait_for_ppol(uep);
    set_address_and_return_mode := qstat(uep);
  end; {set_address_and_return_mode}


function write_file_mark(uep: uep_type): unsgn8;
  {
    issue the following command sequence:
      .  SET_UNIT
      .  SET_VOLUME
      .  WRITE_FILE_MARK
    return the QSTAT byte
  }
  var
    wfm: {the 3 bytes in the command message}
      packed record
	setunitvol: setunitvol_type;
	writefilemark: CMD_type;
      end;
  begin {write_file_mark}
    wfm.setunitvol    := suv_CMD_pair(uep);
    wfm.writefilemark := CMDwrite_file_mark;
    HPIBshort_msge_out(uep, command_sec, addr(wfm), sizeof(wfm));
    HPIBwait_for_ppol(uep);
    write_file_mark := qstat(uep);
  end; {write_file_mark}
$page$

function unload(uep: uep_type): unsgn8;
  {
    issue the following command sequence:
      .  SET_UNIT
      .  SET_VOLUME
      .  UNLOAD
    return the QSTAT byte
  }
  var
    unl: {the 3 bytes in the command message}
      packed record
	setunitvol: setunitvol_type;
	unloadcmd: CMD_type;
      end;
  begin {unload}
    unl.setunitvol := suv_CMD_pair(uep);
    unl.unloadcmd  := CMDunload;
    HPIBshort_msge_out(uep, command_sec, addr(unl), sizeof(unl));
    HPIBwait_for_ppol(uep);
    unload := qstat(uep);
  end; {unload}


function locate_and_verify(uep: uep_type; length: integer): unsgn8;
  {
    issue the following command sequence:
      .  SET_UNIT
      .  SET_VOLUME
      .  SET_LENGTH
      .  LOCATE_AND_VERIFY
    return the QSTAT byte
  }
  var
    lv: {the 9 bytes in the command message}
      packed record
	setunitvol: setunitvol_type;
	nop: CMD_type;
	setlen: CMD_type;
	len: integer;
	locateandverify: CMD_type;
      end;
  begin {locate_and_verify}
    lv.setunitvol      := suv_CMD_pair(uep);
    lv.nop             := CMDno_op;
    lv.setlen          := CMDset_length;
    lv.len             := length;
    lv.locateandverify := CMDlocate_and_ver;
    HPIBshort_msge_out(uep, command_sec, addr(lv), sizeof(lv));
    HPIBwait_for_ppol(uep);
    locate_and_verify := qstat(uep);
  end; {locate_and_verify}
$page$

function copy_data(source_uep: uep_type; source_blk_addr: integer;
		   destination_uep: uep_type; destination_blk_addr: integer;
		   copy_length: integer): unsgn8;
  {
    issue the following command sequence:
      .  SET_UNIT_15
      .  SET_LENGTH
      .  COPY_DATA
    return the QSTAT byte
  }
  var
    cd: {the 24 bytes in the command message}
      packed record
	setunit15: CMD_type;
	setlen: CMD_type;
	length: integer;
	nop: CMD_type;
	copydata: CMD_type;
	s_volunit: evu_type;
	s_setadd: CMD_type;
	s_address: sva_type;
	d_volunit: evu_type;
	d_setadd: CMD_type;
	d_address: sva_type;
      end;
  begin {copy_data}
    cd.setunit15      := CMDset_unit_15;
    cd.setlen         := CMDset_length;
    cd.length         := copy_length;
    cd.nop            := CMDno_op;
    cd.copydata       := CMDcopy_data;
    cd.s_volunit.vvvv := source_uep^.dv;
    cd.s_volunit.uuuu := source_uep^.du;
    cd.s_setadd       := CMDset_address_1v;
    cd.s_address.utb  := 0;
    cd.s_address.lfb  := source_blk_addr;
    cd.d_volunit.vvvv := destination_uep^.dv;
    cd.d_volunit.uuuu := destination_uep^.du;
    cd.d_setadd       := CMDset_address_1v;
    cd.d_address.utb  := 0;
    cd.d_address.lfb  := destination_blk_addr;
    HPIBshort_msge_out(source_uep, command_sec, addr(cd), sizeof(cd));
    HPIBwait_for_ppol(source_uep);
    copy_data := qstat(source_uep);
  end; {copy_data}
$page$

function copy_start_address(uep: uep_type; var csa_bytes: sva_type): unsgn8;
  {
    issue the following command sequence:
      .  SET_UNIT
      .  SET_VOLUME
      .  READ DRIVE TABLES: COPY START ADDRESS (7914 ONLY!!!)
    return the QSTAT byte
  }
  var
    csa: {the 5 bytes in the command message}
      packed record
	setunitvol: setunitvol_type;
	initutil: CMD_type;
	readdrivetables: unsgn8;
	tablenumber: unsgn8;
      end;
    premature_eoi: boolean;
    qs: unsgn8;
  begin {copy_start_address}
    csa.setunitvol      := suv_CMD_pair(uep);
    csa.initutil        := CMDinit_util_SEM;  {send execution message}
    csa.readdrivetables := 196;
    csa.tablenumber     := 12;
    HPIBshort_msge_out(uep, command_sec, addr(csa), sizeof(csa));
    HPIBwait_for_ppol(uep);
    try
      HPIBshort_msge_in(uep, execution_sec, addr(csa_bytes), sizeof(csa_bytes));
      premature_eoi := false;
    recover
      with bip_type(uep^.dvrtemp)^ do  {confirm the "premature" eoi}
	begin
	  if (escapecode<>-10) or (iores<>zbadhardware) then
	    escape(escapecode);
	  premature_eoi := true;
	  iores := inoerror;
	end; {with}
    HPIBwait_for_ppol(uep);
    qs := qstat(uep);
    if premature_eoi and (qs=0) then
      ioresc_bkgnd(uep, zcatchall);
    copy_start_address := qs;
  end; {copy_start_address}


end; {CS80tbr}
$page$

module CS80tbdvr;  {tape backup driver}

import
  sysglobals, misc, bkgnd, discHPIB, tapebuf, CS80, CS80dsr, CS80tbr;

export
  type
    uep_proc_type = procedure(uep: uep_type);

  var  {"var parameter" set by Qdescribe}
    describe_bytes: describe_type;
  procedure Qdescribe(uep: uep_type);

  function Qdevicename(uep: uep_type; var saved_ioresult: integer): string80;

  var  {"parameters" for Qverify}
    verify_length: integer;
    verify_block_size: integer;
  procedure Qverify(uep: uep_type);

  procedure Qtapesetup(uep: uep_type);
  procedure Qconfigure(uep: uep_type);
  procedure Qwritefilemark(uep: uep_type);
  procedure Qunload(uep: uep_type);

  var  {"parameter" for Qcertify}
    initialize_options_byte: unsgn8;
  procedure Qcertify(uep: uep_type);

  var  {"parameters" for Qcontrollercopy}
    destination_uep: uep_type;
    source_block_address: integer;
    destination_block_address: integer;
    copy_length: integer;
  procedure Qcontrollercopy(source_uep: uep_type);

  var  {"var parameter" for Qcopy_start_address}
    csa_bytes: sva_type;
  procedure Qcopy_start_address(uep: uep_type);


implement {CS80tbdvr}
$page$

procedure with_bkgnd_do(uep_proc: uep_proc_type; uep: uep_type);
  begin {with_bkgnd_do}
    try
      ioresult := ord(inoerror);
      allocate_bkgnd_info(uep);
      if HPIBamigo_identify(uep) div 256<>2 then
	ioresc_bkgnd(uep, znodevice);
      call(uep_proc, uep);
      deallocate_bkgnd_info(uep);
    recover
      begin
	abort_bkgnd_process(uep);
	ioresult := uep^.dvrtemp;
	uep^.dvrtemp := ord(inoerror);  {report the error only once}
	escape(-10);
      end; {recover}
  end; {with_bkgnd_do}


procedure Qtapesetup(uep: uep_type);

  procedure tapesetup(uep: uep_type);
    var
      retry_required: boolean;
    begin {tapesetup}
      repeat
	retry_required := false;
	if set_unitvol(uep)<>0 then
	  handle_bad_status(uep, true, retry_required);
      until not retry_required;
      repeat  {enable auto skip sparing}
	retry_required := false;
	if set_options(uep, {options byte} 6)<>0 then
	  handle_bad_status(uep, true, retry_required);
      until not retry_required;
    end; {tapesetup}

  begin {Qtapesetup}
    with_bkgnd_do(tapesetup, uep);
  end; {Qtapesetup}


procedure Qconfigure(uep: uep_type);
  begin {Qconfigure}
    with_bkgnd_do(configure, uep);
  end; {Qconfigure}
$page$

procedure Qwritefilemark(uep: uep_type);

  procedure writefilemark(uep: uep_type);
    var
      retry_required: boolean;
    begin {writefilemark}
      repeat
	retry_required := false;
	if write_file_mark(uep)<>0 then
	  handle_bad_status(uep, true, retry_required);
      until not retry_required;
    end; {writefilemark}

  begin {Qwritefilemark}
    with_bkgnd_do(writefilemark, uep);
  end; {Qwritefilemark}


procedure Qcertify(uep: uep_type);

  procedure certify(uep: uep_type);
    var
      retry_required: boolean;
    begin {certify}
      repeat  {initialize the medium}
	retry_required := false;
	if initialize_media(uep, initialize_options_byte, {interleave_factor} 0)<>0 then
	  handle_bad_status(uep, true, retry_required);
      until not retry_required;
    end; {certify}

  begin {Qcertify}
    with_bkgnd_do(certify, uep);
  end; {Qcertify}


procedure Qdescribe(uep: uep_type);

  procedure do_describe(uep: uep_type);
    var
      retry_required: boolean;
    begin {do_describe}
      repeat
	retry_required := false;
	if set_unitvol(uep)<>0 then
	  handle_bad_status(uep, true, retry_required);
      until not retry_required;
      repeat
	retry_required := false;
	if describe(uep, describe_bytes)<>0 then
	  handle_bad_status(uep, true, retry_required);
      until not retry_required;
    end; {do_describe}

  begin {Qdescribe}
    with_bkgnd_do(do_describe, uep);
  end; {Qdescribe}
$page$

function Qdevicename(uep: uep_type; var saved_ioresult: integer): string80;

  var
    devicename: string80;
    index: integer;
    bcd_product_number: {within the describe bytes}
      packed record case integer of
	0: (dn:  unsgn24);
	1: (bcd: packed array[1..6] of unsgn4);
      end;
    product_number: integer;
    fixed_vol_byte:
      packed record case integer of
	0: (byte: unsgn8);
	1: (bit:  packed array[0..7] of boolean);
      end;

  begin {Qdevicename}

    try
      Qdescribe(uep);
    recover
      if escapecode<>-10 then
	escape(escapecode);

    if saved_ioresult=ord(inoerror) then  {report any error with describe}
      saved_ioresult := ioresult;  {can be inoerror}

    if ioresult=ord(inoerror) then
      with describe_bytes do
	begin
	  bcd_product_number.dn := dn;
	  product_number := 0;
	  for index := 1 to 5 do
	    product_number := product_number*10+bcd_product_number.bcd[index];
	  devicename := 'HP';
	  strwrite(devicename, 3, index, product_number:1);
	  case dt of
	    0:        devicename := devicename+' fixed disc';
	    1:        begin
			fixed_vol_byte.byte := describe_bytes.fvb;
			if fixed_vol_byte.bit[7-uep^.dv]
			  then devicename := devicename+' fixed disc'
			  else devicename := devicename+' removeable disc';
		      end;
	    2:        devicename := devicename+' tape';
	    otherwise {can't further describe the generic device type};
	  end; {case}
	end {with}
    else
      devicename := '<inaccessible CS80 device>';

    Qdevicename := devicename;

  end; {Qdevicename}
$page$

procedure Qverify(uep: uep_type);

  var
    working_verify_length: integer;
    bad_blocks_encountered: boolean;

  procedure handle_verify_status(var retry_required: boolean);

    var
      iorval_to_report: iorsltwd;  {to hold the first reportable error}
      working_iorval: iorsltwd;  {cleared each time status is read}
      status_bytes: status_type;
      eb_scan, parameter_field_owner: errorbit_type;
      reconfiguration_needed: boolean;

    begin {handle_verify_status}

      iorval_to_report := inoerror;

      repeat

	if status(uep, status_bytes)<>0 then
	  ioresc_bkgnd(uep, zbadhardware);

	working_iorval := inoerror;
	parameter_field_owner := channel_parity_error;  {doesn't really own it!}
	reconfiguration_needed := false;

	for eb_scan := eb63 downto eb0 do
	  if status_bytes.errorbits[eb_scan] then
	    begin

	      if eb_scan in errorbits_owning_parmfield then
		parameter_field_owner := eb_scan;

	      case eb_scan of

		{specific fatal errors}
		  channel_parity_error,
		  controller_fault,
		  unit_fault,
		  diagnostic_result:
		      working_iorval := zbadhardware;
		  illegal_opcode,
		  parameter_bounds,
		  illegal_parameter:
		      working_iorval := zbadmode;  {some cmds optional in SS/80}
		  module_addressing:
		      working_iorval := znodevice;
		  address_bounds,
		  end_of_volume:
		      working_iorval := znosuchblk;
		  uninitialized_media:
		      if status_bytes.errorbits[power_fail]
			then {probably an uncertified tape; allow access anyway}
			else working_iorval := zuninitialized;
		  no_spares_available:
		      working_iorval := zinitfail;
		  not_ready:
		      working_iorval := znotready;
		  write_protect:
		      working_iorval := zprotected;
		  no_data_found,
		  end_of_file:
		      working_iorval := znoblock;
		  unrecoverable_data_overflow,
		  unrecoverable_data:
		      working_iorval := zbadblock;

		{power fail}
		  power_fail:
		      begin
			uep^.umediavalid := false;
			if uep=tapebuf_uep then
			  tapebuf_state := undefined;
			if uep^.ureportchange then
			  working_iorval := zmediumchanged;
			reconfiguration_needed := true;
			retry_required := true;
		      end;

		{retryable errors}
		  operator_release_required,
		  diagnostic_release_required,
		  internal_maintenance_required,
		  retransmit:
		      retry_required := true;

		{errors indicating release requested}
		  operator_request,
		  diagnostic_request,
		  internal_maintenance_request:
		      {do nothing here; release below if parmeter field owned};

		{errors indicating reconfiguration needed}
		  media_wear,                     {supposed to be masked out}
		  latency_induced,                {supposed to be masked out}
		  eb53,                           {supposed to be masked out}
		  eb54,                           {supposed to be masked out}
		  auto_sparing_invoked,           {supposed to be masked out}
		  eb56,                           {supposed to be masked out}
		  recoverable_data_overflow,      {supposed to be masked out}
		  marginal_data,                  {supposed to be masked out}
		  recoverable_data,               {supposed to be masked out}
		  eb60,                           {supposed to be masked out}
		  maintenance_track_overflow,     {supposed to be masked out}
		  eb62,                           {supposed to be masked out}
		  eb63:                           {supposed to be masked out}
		      reconfiguration_needed := true;

		{errors not covered by the above cases}
		  otherwise
			{ specifically including:
			  message_sequence,
			  message_length,
			  cross_unit,
			  illegal_parallel_operation }
		      working_iorval := zcatchall;

	      end; {case}

	    end; {if}

	if iorval_to_report=inoerror then  {none previously found; report this one}
	  iorval_to_report := working_iorval;  {it can be inoerror also!}

	if parameter_field_owner=unrecoverable_data then
	  begin
	    writeln('  bad block at ',status_bytes.bba.lfb:1);
	    bad_blocks_encountered := true;
	    working_verify_length := verify_length-(status_bytes.bba.lfb+1)*verify_block_size;
	    if working_verify_length>0 then
	      retry_required := true;
	  end; {if}

	if parameter_field_owner in errorbits_requesting_release then
	  if not (status_bytes.urr[1] in [0..15]) then
	    ioresc_bkgnd(uep, zcatchall)
	  else if release(uep, status_bytes.urr[1])<>0 then
	    {handle the bad qstat elsewhere; worry not, the device won't forget!};

	if reconfiguration_needed then
	  configure(uep);

      until set_unit(uep, status_bytes.current_vu.uuuu)=0;  {restore original command unit}

      if not (iorval_to_report in [inoerror, zbadblock]) then
	ioresc_bkgnd(uep, iorval_to_report);

    end; {handle_verify_status}
$page$

  procedure verify(uep: uep_type);

    var
      retry_required: boolean;

    begin {verify}

      repeat  {set address to zero and set return addressing mode}
	retry_required := false;
	if set_address_and_return_mode(uep, {address} 0)<>0 then
	  handle_bad_status(uep, true, retry_required);
      until not retry_required;

      working_verify_length := verify_length;
      bad_blocks_encountered := false;

      repeat  {verify the requested amount}
	retry_required := false;
	if locate_and_verify(uep, working_verify_length)<>0 then
	  handle_verify_status(retry_required);
      until not retry_required;

      if bad_blocks_encountered then
	ioresc_bkgnd(uep, zbadblock);

    end; {verify}

  begin {Qverify}
    with_bkgnd_do(verify, uep);
  end; {Qverify}
$page$

procedure Qcontrollercopy(source_uep: uep_type);

  procedure handle_copydata_status(var retry_required: boolean);

    var
      iorval_to_report: iorsltwd;  {to hold the first reportable error}
      working_iorval: iorsltwd;  {cleared each time status is read}
      status_bytes: status_type;
      eb_scan, parameter_field_owner: errorbit_type;
      reconfiguration_needed: boolean;
      uee_pending: boolean;
      index: signed16;

    procedure handle_uee_pending(uee_byte: signed8);
      var
	evu: {encoded volume/unit byte}
	  packed record case integer of
	    0: (sgn8: signed8);
	    1: (vu: evu_type);
	  end;
	vol, unit: unsgn4;
	retry_required: boolean;
	message: string80;
      begin {handle_uee_pending}
	evu.sgn8 := uee_byte;
	vol := evu.vu.vvvv;
	unit := evu.vu.uuuu;
	try
	  if unit=15 then
	    repeat
	      retry_required := false;
	      if set_unit(source_uep, unit)<>0 then
		handle_bad_status(source_uep, false, retry_required);
	    until not retry_required
	  else
	    repeat
	      retry_required := false;
	      if set_specified_unitvol(source_uep, unit, vol)<>0 then
		handle_bad_status(source_uep, false, retry_required);
	    until not retry_required;
	recover
	  if escapecode<>-10 then escape(escapecode);
	with bip_type(source_uep^.dvrtemp)^ do
	  if iores<>inoerror then  {we need to report it}
	    begin
	      if iorval_to_report=inoerror then  {none previously found...}
		iorval_to_report := iores;  {report this one later in a fatal way!}
	      if (vol=source_uep^.dv) and (unit=source_uep^.du) then
		writeln('  source unit error:')
	      else if (vol=destination_uep^.dv) and (unit=destination_uep^.du) then
		writeln('  destination unit error:')
	      else
		writeln('  unit: ', unit:1,', volume: ', vol:1, ' error:');
	      getioerrmsg(message, ord(iores));
	      writeln('    ',message);
	      iores := inoerror;  {now clear it out}
	    end;  {if}
      end; {handle_uee_pending}

    begin {handle_copydata_status}

      iorval_to_report := inoerror;

      repeat

	if status(source_uep, status_bytes)<>0 then
	  ioresc_bkgnd(source_uep, zbadhardware);

	working_iorval := inoerror;
	parameter_field_owner := channel_parity_error;  {doesn't really own it!}
	reconfiguration_needed := false;

	for eb_scan := eb63 downto eb0 do
	  if status_bytes.errorbits[eb_scan] then
	    begin

	      if eb_scan in errorbits_owning_parmfield then
		parameter_field_owner := eb_scan;

	      case eb_scan of

		{the expected error}
		  cross_unit:
		      {do nothing here; handle below if parmeter field owned};

		{specific fatal errors}
		  channel_parity_error,
		  controller_fault,
		  unit_fault,
		  diagnostic_result:
		      working_iorval := zbadhardware;
		  illegal_opcode,
		  parameter_bounds,
		  illegal_parameter:
		      working_iorval := zbadmode;  {some cmds optional in SS/80}
		  module_addressing:
		      working_iorval := znodevice;
		  address_bounds,
		  end_of_volume:
		      working_iorval := znosuchblk;
		  uninitialized_media:
		      if status_bytes.errorbits[power_fail]
			then {probably an uncertified tape; allow access anyway}
			else working_iorval := zuninitialized;
		  no_spares_available:
		      working_iorval := zinitfail;
		  not_ready:
		      working_iorval := znotready;
		  write_protect:
		      working_iorval := zprotected;
		  no_data_found,
		  end_of_file:
		      working_iorval := znoblock;
		  unrecoverable_data_overflow,
		  unrecoverable_data:
		      working_iorval := zbadblock;

		{power fail}
		  power_fail:
		      begin
			source_uep^.umediavalid := false;
			if source_uep=tapebuf_uep then
			  tapebuf_state := undefined;
			if source_uep^.ureportchange then
			  working_iorval := zmediumchanged;
			reconfiguration_needed := true;
			retry_required := true;
		      end;

		{retryable errors}
		  operator_release_required,
		  diagnostic_release_required,
		  internal_maintenance_required,
		  retransmit:
		      retry_required := true;

		{errors indicating release requested}
		  operator_request,
		  diagnostic_request,
		  internal_maintenance_request:
		      {do nothing here; release below if parmeter field owned};

		{errors indicating reconfiguration needed}
		  media_wear,                     {supposed to be masked out}
		  latency_induced,                {supposed to be masked out}
		  eb53,                           {supposed to be masked out}
		  eb54,                           {supposed to be masked out}
		  auto_sparing_invoked,           {supposed to be masked out}
		  eb56,                           {supposed to be masked out}
		  recoverable_data_overflow,      {supposed to be masked out}
		  marginal_data,                  {supposed to be masked out}
		  recoverable_data,               {supposed to be masked out}
		  eb60,                           {supposed to be masked out}
		  maintenance_track_overflow,     {supposed to be masked out}
		  eb62,                           {supposed to be masked out}
		  eb63:                           {supposed to be masked out}
		      reconfiguration_needed := true;

		{errors not covered by the above cases}
		  otherwise
			{ specifically including:
			  message_sequence,
			  message_length,
			  illegal_parallel_operation }
		      working_iorval := zcatchall;

	      end; {case}

	    end; {if}

	if iorval_to_report=inoerror then  {none previously found; report this one}
	  iorval_to_report := working_iorval;  {it can be inoerror also!}

	index := 0;
	if parameter_field_owner=cross_unit then
	  repeat
	    index := index+1;
	    if index<=6
	      then uee_pending := status_bytes.uee[index]>=0
	      else uee_pending := false;
	    if uee_pending then
	      handle_uee_pending(status_bytes.uee[index]);
	  until not uee_pending;

	if parameter_field_owner in errorbits_requesting_release then
	  if not (status_bytes.urr[1] in [0..15]) then
	    ioresc_bkgnd(source_uep, zcatchall)
	  else if release(source_uep, status_bytes.urr[1])<>0 then
	    {handle the bad qstat elsewhere; worry not, the device won't forget!};

	if reconfiguration_needed then
	  configure(source_uep);

      until set_unit(source_uep, status_bytes.current_vu.uuuu)=0;  {restore original command unit}

      if iorval_to_report<>inoerror then
	ioresc_bkgnd(source_uep, iorval_to_report);

    end; {handle_copydata_status}


  procedure controllercopy(uep: uep_type);
    var
      retry_required: boolean;
    begin {controllercopy}
      repeat  {copy the entire volume}
	retry_required := false;
	if copy_data(source_uep, source_block_address,
	       destination_uep, destination_block_address, copy_length)<>0 then
	  handle_copydata_status(retry_required);
      until not retry_required;
    end; {controllercopy}

  begin {Qcontrollercopy}
    with_bkgnd_do(controllercopy, source_uep);
  end; {Qcontrollercopy}
$page$

procedure Qunload(uep: uep_type);

  procedure do_unload(uep: uep_type);
    var
      retry_required: boolean;
    begin {do_unload}
      repeat
	retry_required := false;
	if unload(uep)<>0 then
	  handle_bad_status(uep, true, retry_required);
      until not retry_required;
    end; {do_unload}

  begin {Qunload}
    with_bkgnd_do(do_unload, uep);
  end; {Qunload}


procedure Qcopy_start_address(uep: uep_type);

  procedure do_copy_start_address(uep: uep_type);
    var
      retry_required: boolean;
    begin {do_copy_start_address}
      repeat
	retry_required := false;
	if copy_start_address(uep, csa_bytes)<>0 then
	  handle_bad_status(uep, true, retry_required);
      until not retry_required;
    end; {do_copy_start_address}

  begin {Qcopy_start_address}
    with_bkgnd_do(do_copy_start_address, uep);
  end; {Qcopy_start_address}


end; {CS80tbdvr}
$page$

{program tapebkup;}

import
  sysglobals, misc, sysdevs, fs, bkgnd, tapebuf, CS80tbr, CS80tbdvr;

var
  keyboard: text;

type
  proc_type = procedure;

const  {for under_lock_do procedure calls}
  verbosely = true;
  silently = false;  {if desired, set true to debug}


procedure upcchar(var ch : char);
  begin
    if (ch>='a') and (ch<='z') then ch := chr(ord(ch)-32);
  end;


function yes(prompt: string80): boolean;
  var
    answer: char;
  begin {yes}
    writeln;
    write(prompt, ' (Y/N) ');
    repeat
      read(keyboard, answer);
      upcchar(answer);
    until (answer='Y') or (answer='N');
    writeln(answer);
    yes := answer='Y';
  end; {yes}


procedure fatal_ioresult(message: string80; iores: integer);
  begin {fatal_ioresult}
    writeln(#7+message);
    getioerrmsg(message, iores);
    writeln('  ',message);
    escape(-1);
  end; {fatal_ioresult}


procedure fatal_message(message: string80);
  begin {fatal_message}
    writeln(#7+message);
    escape(-1);
  end; {fatal_message}
$page$

function on_same_medium(lun1, lun2: unitnum): boolean;
  var
    uep1, uep2: uep_type;
  begin {on_same_medium}
    uep1 := addr(unitable^[lun1]);
    uep2 := addr(unitable^[lun2]);
    on_same_medium := (uep1^.sc=uep2^.sc) and (uep1^.ba=uep2^.ba) and
		      (uep1^.du=uep2^.du) and (uep1^.dv=uep2^.dv) and
		      (uep1^.letter=uep2^.letter);
  end; {on_same_medium}


function on_same_controller(uep1, uep2: uep_type): boolean;
  begin {on_same_controller}
    on_same_controller := (uep1^.sc=uep2^.sc) and (uep1^.ba=uep2^.ba);
  end; {on_same_controller}


procedure enable_report_changes(uep: uep_type);
  begin {enable_report_changes}
    with uep^ do
      begin
	umediavalid := false;
	ureportchange := true;
      end; {with}
  end; {enable_report_changes}


procedure disable_report_changes(uep: uep_type);
  begin {disable_report_changes}
    with uep^ do
      begin
	umediavalid := false;
	ureportchange := false;
      end; {with}
  end; {disable_report_changes}


procedure user_confirmation;
  begin {user_confirmation}
    if not yes('Are you SURE you want to proceed?') then
      escape(-1);
  end; {user_confirmation}
$page$

procedure request_vol(prompt: string80; var lun: unitnum);

  const
    nonabortive_ioresult_set = [ord(inoerror), ord(zbadblock), ord(znoblock),
				ord(zuninitialized), ord(inodirectory)];
  var
    response: string80;
    fvid: vid;
    ftitle: fid;
    fsegs: integer;
    fkind: filekind;
    scantitle_ok: boolean;
    saved_ioresult: integer;
    uep: uep_type;

  begin {request_vol}

    repeat
      write(prompt,cteol);
      readln(response);
      if (strlen(response)=0) or (strpos(response,#27)<>0) then escape(-1);
      scantitle_ok := scantitle(response, fvid, ftitle, fsegs, fkind);
      if scantitle_ok and (ftitle='') then
	begin
	  lun := findvolume(fvid, true);
	  saved_ioresult := ioresult;           {for decoding below}
	  getioerrmsg(response, ord(inounit));  {for the case lun=0}
	end {then}
      else
	begin
	  lun := 0;
	  response := 'Illegal syntax: volume ID required';
	end; {else}
      if lun=0 then
	writeln('  ',response);
    until lun<>0;

    uep := addr(unitable^[lun]);
    with uep^ do
      begin
	if not (letter in ['Q', 'K']) then
	  fatal_message('Specified volume is not on a CS80 device');

	write('Device: ', Qdevicename(uep, saved_ioresult));
	writeln(', ',100*sc+ba:1,', ',du:1,', ',dv:1);
      end; {with uep^}

    write('Logical unit #',lun:1,' - ');
    if fvid[1]<>'#' then
      writeln('''',fvid,':''')
    else if saved_ioresult in nonabortive_ioresult_set then
      writeln('<no directory>')
    else
      fatal_ioresult('', saved_ioresult);

  end; {request_vol}
$page$

procedure other_volume_check(lun: unitnum);
  var
    warning_issued: boolean;
    flun: unitnum;
    line: shortint;
    CRTline, CRTcolumn, stopline: integer;
    fvid: vid;
  const
    maxlines = 10;
    fieldwidth = 16;
  begin {other_volume_check}

    warning_issued := false;

    for flun := 1 to maxunit do
      if on_same_medium(flun, lun) then
	with unitable^[flun] do
	  begin
	    if flun<>lun then
	      begin
		if not warning_issued then
		  begin
		    writeln('NOTICE: this will also affect:');
		    warning_issued := true;
		    line := 1;
		  end; {if}

		fgetxy(output,CRTcolumn, CRTline);
		write(' #',flun:1);
		fgotoxy(output,CRTcolumn+5, CRTline);
		call(dam, fvid, flun, getvolumename);
		if strlen(fvid)>0
		  then write(fvid,':')
		  else write('<no dir>');
		if CRTcolumn=0
		  then writeln               {scrolls the screen if necessary}
		  else fgotoxy(output,CRTcolumn, CRTline+1);

		line := line+1;
		if line>maxlines then
		  begin
		    fgetxy(output,CRTcolumn, stopline);
		    fgotoxy(output,CRTcolumn+fieldwidth, stopline-maxlines);
		    line := 1;
		  end; {if}

	      end; {if flun<>lun}
	    umediavalid := false;
	  end; {with}

    if warning_issued and (CRTcolumn<>0) then
      fgotoxy(output,0, stopline);

  end; {other_volume_check}
$page$

procedure preserving_status_do(proc: proc_type);
  var
    saved_escapecode: shortint;
    saved_ioresult: integer;
  begin {preserving_status_do}
    saved_escapecode := escapecode;
    saved_ioresult := ioresult;
    call(proc);
    sysescapecode := saved_escapecode;
    ioresult := saved_ioresult;
  end; {preserving_status_do}


procedure writeln_proc;
  begin {writeln_proc}
    writeln;
  end; {writeln_proc}


procedure under_lock_do(verbose: boolean; uep_proc: uep_proc_type;
				      uep: uep_type; op_description: string80);
  begin {under_lock_do}

    lockup;
    try
      if verbose then
	begin
	  writeln;
	  writeln(op_description, ' in progress');
	end; {if}
      call(uep_proc, uep);
      if verbose then
	writeln(op_description, ' completed');
      escape(0);  {to do the lockdown}
    recover
      begin
	preserving_status_do(lockdown);
	if escapecode=0 then
	  {do nothing}
	else if escapecode=-10 then
	  begin
	    if not verbose then
	      preserving_status_do(writeln_proc);
	    fatal_ioresult(op_description+' errored:', ioresult);
	  end
	else
	  escape(escapecode);
      end; {recover}

  end; {under_lock_do}
$page$

procedure medium_copy;

  var
    source_lun, destination_lun: unitnum;
    source_uep, tape_uep: uep_type;
    source_is_a_tape, destination_is_a_tape: boolean;
    source_is_a_7914, destination_is_a_7914: boolean;
    source_block_size, destination_block_size: integer;
    source_size, destination_size: integer;
    verify_destination: boolean;
    copy_attempt_completed, loop_condition: boolean;
    pass: shortint;

  procedure attempt_copy;

    procedure cleanup;
      begin {cleanup}
	if destination_is_a_tape then  {restore its configuration}
	  Qconfigure(destination_uep);
      end; {cleanup}

    begin {attempt_copy}

      if source_is_a_tape and destination_is_a_7914 then  {see where to restore}
	begin
	  under_lock_do(silently, Qcopy_start_address, source_uep, 'Copy start address request');
	  destination_block_address := csa_bytes.lfb;
	end; {if}

      if destination_is_a_tape then  {ensure it's certified; update size afterward!!!}
	begin
	  tapebuf_state := undefined;
	  initialize_options_byte := 0;  {certify only if currently uncertified}
	  under_lock_do(verbosely, Qcertify, destination_uep, 'Destination tape certification');
	  under_lock_do(silently, Qdescribe, destination_uep, 'Destination tape describe request');
	  with describe_bytes do
	    destination_size := (maxsvadd.lfb+1)*nbpb;
	end; {if}

      lockup;
      try
	if destination_is_a_tape then  {enable auto skip-sparing}
	  Qtapesetup(destination_uep);

	if source_is_a_7914 or destination_is_a_7914 then
	  begin
	    writeln;
	    writeln('Copy parameters for 7914 save/restore -');
	    writeln('  source starting block address: ', source_block_address:0);
	    writeln('  destination starting block address: ', destination_block_address:0);
	    copy_length := -1;
	  end
	else if destination_size>source_size then
	  copy_length := source_size
	else
	  copy_length := destination_size;

	under_lock_do(verbosely, Qcontrollercopy, source_uep, 'Medium copy');

	if destination_is_a_tape and (destination_size>source_size) then
	  under_lock_do(silently, Qwritefilemark, destination_uep, 'Destination tape filemark append');

	escape(0);  {to do the cleanup}
      recover
	begin
	  preserving_status_do(cleanup);
	  preserving_status_do(lockdown);
	  if escapecode<>0 then
	    escape(escapecode);
	end; {recover}

      if destination_is_a_tape and verify_destination then  {verify it}
	begin
	  if destination_size>source_size
	    then verify_length := source_size
	    else verify_length := destination_size;
	  verify_block_size := destination_block_size;
	  under_lock_do(verbosely, Qverify, destination_uep, 'Destination tape verification');
	end; {if}

    end; {attempt_copy}

  begin {medium_copy}

    writeln(clearscr);
    request_vol('Source medium for copy? ', source_lun);
    source_uep := addr(unitable^[source_lun]);
    enable_report_changes(source_uep);
    other_volume_check(source_lun);
    source_is_a_7914 := source_uep^.devid=7914;
    with describe_bytes do
      begin
	source_is_a_tape := dt=2;
	source_block_size := nbpb;
	source_size := (maxsvadd.lfb+1)*nbpb;
      end; {with}

    writeln;
    request_vol('Destination medium for copy? ', destination_lun);
    destination_uep := addr(unitable^[destination_lun]);
    enable_report_changes(destination_uep);
    if on_same_medium(source_lun, destination_lun) then
      fatal_message('Specified volumes are on the same medium');
    if not on_same_controller(source_uep, destination_uep) then
      fatal_message('Source and destination not on the same controller');
    other_volume_check(destination_lun);
    destination_is_a_7914 := destination_uep^.devid=7914;
    with describe_bytes do
      begin
	destination_is_a_tape := dt=2;
	destination_block_size := nbpb;
	destination_size := (maxsvadd.lfb+1)*nbpb;
      end; {with}

    if destination_is_a_tape and (destination_size<source_size) then
      if source_is_a_7914 then
	begin
	  writeln;
	  writeln('REMINDER: two long tapes are required for');
	  writeln('  complete 7914 backup.');
	end {then}
      else
	begin
	  writeln;
	  writeln('NOTICE: the destination tape is too small for a');
	  writeln('  complete source backup!');
	end; {else}

    user_confirmation;

    if destination_is_a_tape
      then verify_destination := yes('Verify destination tape after the copy?')
      else verify_destination := true;  {always verify discs}

    pass := 1;
    source_block_address := 0;
    destination_block_address := 0;

    repeat  {loop for swapping tapes}

      repeat  {copy attempts}
	try
	  attempt_copy;
	  copy_attempt_completed := true;
	recover
	  if escapecode<>-1 then
	    escape(escapecode)
	  else
	    if yes('Retry the current copy segment?') then
	      copy_attempt_completed := false
	    else if yes('Abort the entire medium copy sequence?') then
	      fatal_message('Medium copy sequence aborted')
	    else
	      begin
		writeln('Medium copy sequence continued');
		copy_attempt_completed := true;
	      end;
      until copy_attempt_completed;

      if source_is_a_tape then
	under_lock_do(verbosely, Qunload, source_uep, 'Source tape unload request');

      if destination_is_a_tape then
	under_lock_do(verbosely, Qunload, destination_uep, 'Destination tape unload request');

      loop_condition := (source_is_a_7914 or destination_is_a_7914) and (pass<2);

      if loop_condition then  {prepare for the next pass through the loop}
	begin

	  if destination_is_a_tape then  {update the source disc parms}
	    begin
	      source_size := source_size - destination_size;
	      source_block_address := source_block_address + destination_size div source_block_size;
	    end; {if}

	  if source_is_a_tape
	    then tape_uep := source_uep
	    else tape_uep := destination_uep;

	  writeln;
	  writeln('Waiting for a new tape to be loaded:');
	  writeln('Press <stop> to abort');

	  disable_report_changes(tape_uep);

	  repeat
	    try
	      Qcopy_start_address(tape_uep);
	    recover
	      if escapecode<>-10 then
		escape(escapecode)
	      else if ioresult<>ord(znotready) then
		fatal_ioresult('Error while awaiting new tape load:', ioresult)
	  until ioresult<>ord(znotready);

	  enable_report_changes(tape_uep);

	  pass := pass+1;

	end; {if}

    until not loop_condition;

    if not destination_is_a_tape then
      begin
	verify_length := destination_size;
	verify_block_size := destination_block_size;
	under_lock_do(verbosely, Qverify, destination_uep, 'Destination disc verification');
      end; {if}

  end; {medium_copy}
$page$

procedure verify;

  var
    lun: unitnum;
    uep: uep_type;
    auto_unload: boolean;

  begin {verify}

    writeln(clearscr);
    request_vol('Verify what medium? ', lun);
    uep := addr(unitable^[lun]);
    enable_report_changes(uep);
    other_volume_check(lun);

    user_confirmation;

    with describe_bytes do
      begin
	if dt=2
	  then auto_unload := yes('Unload tape after verification?')
	  else auto_unload := false;
	verify_length := (maxsvadd.lfb+1)*nbpb;
	verify_block_size := nbpb;
      end; {with}

    under_lock_do(verbosely, Qverify, uep, 'Verification');

    if auto_unload then
      under_lock_do(verbosely, Qunload, uep, 'Tape unload request');

  end; {verify}
$page$

procedure certify;

  var
    lun: unitnum;
    uep: uep_type;
    auto_unload: boolean;

  begin {certify}

    writeln(clearscr);
    request_vol('Certify what tape? ', lun);
    uep := addr(unitable^[lun]);
    enable_report_changes(uep);
    if describe_bytes.dt<>2 then
      fatal_message('Specified volume is not on a tape');
    other_volume_check(lun);

    user_confirmation;

    if yes('Re-certify if already certified?')
      then initialize_options_byte := 1   {force complete certification}
      else initialize_options_byte := 0;  {certify only if currently uncertified}

    auto_unload := yes('Unload tape after certification?');

    tapebuf_state := undefined;
    under_lock_do(verbosely, Qcertify, uep, 'Tape certification');

    if auto_unload then
      under_lock_do(verbosely, Qunload, uep, 'Tape unload request');

  end; {certify}
$page$

procedure commandlevel;

  var
    ch: char;

  begin {commandlevel}

    repeat

      try
	write(homechar,
	      'Tapebkup: Medium-copy Verify Certify-tape Quit  ?',
	      cteol);
	read(keyboard, ch);
	upcchar(ch);
	writeln;
	case ch of
	  'C': certify;
	  'M': medium_copy;
	  'Q': {quit};
	  'V': verify;
	  otherwise
	    write(clearscr);
	end; {case}

      recover
	if escapecode=-20 then
	  ch := 'Q'  {stop key means "quit"}
	else if escapecode=-1 then
	  {do nothing; remain in command level}
	else
	  escape(escapecode);

    until ch='Q';

  end; {commandlevel}



begin {tapebkup}
  writeln(clearscr);
  writeln('             [Version 3.25]');
  writeln;
  writeln;
  writeln;
  writeln('Copyright Hewlett-Packard Company, 1982, 1991');
  writeln('          All rights are reserved.');
  commandlevel;
end. {tapebkup}


@


55.2
log
@
pws2rcs automatic delta on Mon Nov  4 13:45:04 MST 1991
@
text
@@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.25A]');
@


54.2
log
@
pws2rcs automatic delta on Wed Aug 21 12:27:56 MDT 1991
@
text
@@


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.24]');
@


53.3
log
@
pws2rcs automatic delta on Mon Mar 18 13:19:08 MST 1991
@
text
@@


53.2
log
@Updated copyright message.
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.24B]');
@


53.1
log
@Automatic bump of revision number for PWS version 3.24B
@
text
@d1544 1
a1544 1
  writeln('Copyright Hewlett-Packard Company, 1982, 1990');
@


52.2
log
@
pws2rcs automatic delta on Mon Mar 11 16:41:32 MST 1991
@
text
@@


52.1
log
@Automatic bump of revision number for PWS version 3.24A
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.24A]');
@


51.2
log
@
pws2rcs automatic delta on Mon Feb 18 20:38:36 MST 1991
@
text
@@


51.1
log
@Automatic bump of revision number for PWS version 3.24d
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.24d]');
@


50.2
log
@
pws2rcs automatic delta on Wed Jan 30 09:08:19 MST 1991
@
text
@@


50.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.24c]');
@


49.2
log
@
pws2rcs automatic delta on Mon Oct 29 14:00:44 MST 1990
@
text
@@


49.1
log
@Automatic bump of revision number for PWS version 3.24b
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.24b]');
@


48.2
log
@
pws2rcs automatic delta on Tue Aug 14 09:29:26 MDT 1990
@
text
@@


48.1
log
@Automatic bump of revision number for PWS version 3.24a
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.24a]');
@


47.2
log
@
pws2rcs automatic delta on Tue Jul 24 14:47:20 MDT 1990
@
text
@@


47.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.23]');
@


46.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


45.2
log
@
pws2rcs automatic delta on Fri May  4 14:44:01 MDT 1990
@
text
@@


45.1
log
@Automatic bump of revision number for PWS version 3.23C
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.23C]');
@


44.2
log
@
pws2rcs automatic delta on Thu Apr 19 13:13:04 MDT 1990
@
text
@@


44.1
log
@Automatic bump of revision number for PWS version 3.23B
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.23B]');
@


43.3
log
@
pws2rcs automatic delta on Sun Apr  1 16:13:30 MDT 1990
@
text
@@


43.2
log
@Fixed copyright date.
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.23A]');
@


43.1
log
@Automatic bump of revision number for PWS version 3.23aA
@
text
@d1544 1
a1544 1
  writeln('Copyright Hewlett-Packard Company, 1982, 1989');
@


42.2
log
@
pws2rcs automatic delta on Mon Mar 19 16:00:53 MST 1990
@
text
@@


42.1
log
@Automatic bump of revision number for PWS version 3.23e
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.23e]');
@


41.2
log
@
pws2rcs automatic delta on Sat Jan 20 16:32:46 MST 1990
@
text
@@


41.1
log
@Automatic bump of revision number for PWS version 3.23d
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.23d]');
@


40.2
log
@
pws2rcs automatic delta on Thu Dec 21 14:54:59 MST 1989
@
text
@@


40.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.23c]');
@


39.2
log
@
pws2rcs automatic delta on Thu Sep 28 17:16:32 MDT 1989
@
text
@@


39.1
log
@Automatic bump of revision number for PWS version 3.23b
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.23b]');
@


38.2
log
@
pws2rcs automatic delta on Tue Sep 26 14:31:31 MDT 1989
@
text
@@


38.1
log
@Automatic bump of revision number for PWS version 3.23a
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.23a]');
@


37.2
log
@
pws2rcs automatic delta on Mon Aug 28 12:16:08 MDT 1989
@
text
@@


37.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.3a]');
@


36.2
log
@
pws2rcs automatic delta on Thu May 11 11:32:36 MDT 1989
@
text
@@


36.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.22]');
@


35.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


34.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


33.2
log
@
pws2rcs automatic delta on Fri Jan 20 16:16:31 MST 1989
@
text
@@


33.1
log
@Automatic bump of revision number for PWS version 3.22D
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.22D]');
@


32.3
log
@
pws2rcs automatic delta on Fri Jan 13 11:19:22 MST 1989
@
text
@@


32.2
log
@Fix copyright message

@
text
@d1540 1
a1540 1
  writeln('             [Version 3.22C]');
@


32.1
log
@Automatic bump of revision number for PWS version 3.22C
@
text
@d1544 1
a1544 1
  writeln('Copyright Hewlett-Packard Company, 1982, 1987');
@


31.2
log
@
pws2rcs automatic delta on Mon Jan  9 11:50:34 MST 1989
@
text
@@


31.1
log
@Automatic bump of revision number for PWS version 3.22B
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.22B]');
@


30.2
log
@
pws2rcs automatic delta on Wed Dec 14 13:22:28 MST 1988
@
text
@@


30.1
log
@Automatic bump of revision number for PWS version 3.22A
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.22A]');
@


29.2
log
@
pws2rcs automatic delta on Thu Dec  8 15:31:09 MST 1988
@
text
@@


29.1
log
@Automatic bump of revision number for PWS version 3.22b
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.22b]');
@


28.2
log
@
ipws2rcs automatic delta on Mon Oct 31 10:34:17 MST 1988
:w
:q
@
text
@@


28.1
log
@Automatic bump of revision number for PWS version 3.3b
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.3a]');
@


27.2
log
@pws2rcs automatic delta on Wed Oct  5 17:32:00 MDT 1988

@
text
@@


27.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.21b]');
@


26.1
log
@Automatic bump of revision number for PWS version 3.3 Synch
@
text
@@


25.3
log
@Pws2unix automatic delta on Fri Mar 18 09:13:54 MST 1988
@
text
@@


25.2
log
@Pws2unix automatic delta on Wed Mar  9 08:03:11 MST 1988
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.21a]');
@


25.1
log
@Automatic bump of revision number for PWS version 3.2Y
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.2Y]');
@


24.2
log
@Pws2unix automatic delta on Tue Mar  1 09:01:42 MST 1988
@
text
@@


24.1
log
@Automatic bump of revision number for PWS version 3.2
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.2]');
@


23.2
log
@Pws2unix automatic delta on Sun Aug 30 14:43:47 MDT 1987
@
text
@@


23.1
log
@Automatic bump of revision number for PWS version 3.2P
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.2P]');
@


22.2
log
@Pws2unix automatic delta on Tue Aug 25 18:23:33 MDT 1987
@
text
@@


22.1
log
@Automatic bump of revision number for PWS version 3.2N
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.2N]');
d1544 2
a1545 2
  writeln('  Copyright 1985 Hewlett-Packard Company');
  writeln('       All rights are reserved.');
@


21.2
log
@Pws2unix automatic delta on Sat Aug 15 16:14:36 MDT 1987
@
text
@@


21.1
log
@Automatic bump of revision number for PWS version 3.2M
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.2M]');
@


20.2
log
@Pws2unix automatic delta on Wed Aug 12 09:47:30 MDT 1987
@
text
@@


20.1
log
@Automatic bump of revision number for PWS version 3.2L
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.2L]');
@


19.2
log
@Pws2unix automatic delta on Wed Jul 29 17:29:01 MDT 1987
@
text
@@


19.1
log
@Automatic bump of revision number for PWS version 3.2K
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.2K]');
@


18.2
log
@Pws2unix automatic delta on Sun May 31 14:33:16 MDT 1987
@
text
@@


18.1
log
@Automatic bump of revision number for PWS version 3.2J
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.2J]');
@


17.2
log
@Pws2unix automatic delta on Wed May 20 09:57:02 MDT 1987
@
text
@@


17.1
log
@Automatic bump of revision number for PWS version 3.2I+
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.2I]');
@


16.1
log
@Automatic bump of revision number for PWS version 3.2I
@
text
@@


15.2
log
@Pws2unix automatic delta on Fri Apr 24 18:41:36 MDT 1987
@
text
@@


15.1
log
@Automatic bump of revision number for PWS version 3.2H
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.2H]');
@


14.2
log
@Pws2unix automatic delta on Sun Apr 12 17:10:24 MDT 1987
@
text
@@


14.1
log
@Automatic bump of revision number for PWS version 3.2G
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.2G]');
@


13.2
log
@Pws2unix automatic delta on Wed Apr  1 08:30:27 MST 1987
@
text
@@


13.1
log
@Automatic bump of revision number for PWS version 3.2F
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.2F]');
@


12.2
log
@Pws2unix automatic delta on Sat Feb 28 15:17:33 MST 1987
@
text
@@


12.1
log
@Automatic bump of revision number for PWS version 3.2E
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.2E]');
@


11.2
log
@Pws2unix automatic delta on Mon Feb  2 09:47:34 MST 1987
@
text
@@


11.1
log
@Automatic bump of revision number for PWS version 3.2D
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.2D]');
@


10.2
log
@Pws2unix automatic delta on Sun Jan 18 18:33:43 MST 1987
@
text
@@


10.1
log
@Automatic bump of revision number for PWS version 3.2C
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.2C]');
@


9.2
log
@Pws2unix automatic delta on Tue Dec 23 16:24:27 MST 1986
@
text
@@


9.1
log
@Automatic bump of revision number for PWS version 3.2B
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.2B]');
@


8.2
log
@Pws2unix automatic delta on Fri Dec 12 09:42:40 MST 1986
@
text
@@


8.1
log
@Automatic bump of revision number for PWS version 3.2A
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.1A]');
@


7.2
log
@Pws2unix automatic delta on Wed Nov 26 16:18:22 MST 1986
@
text
@@


7.1
log
@Automatic bump of revision number for PWS version 3.2l
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.2l]');
@


6.2
log
@Pws2unix automatic delta on Wed Nov 19 15:16:12 MST 1986
@
text
@@


6.1
log
@Automatic bump of revision number for PWS version 3.2k
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.2k]');
@


5.2
log
@Pws2unix automatic delta on Tue Nov  4 11:36:56 MEZ 1986
@
text
@@


5.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.2j]');
@


4.2
log
@Pws2unix automatic delta on Tue Oct 28 10:57:29 MEZ 1986
@
text
@@


4.1
log
@Automatic bump of revision number for PWS version 3.2i
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.2i]');
@


3.2
log
@Pws2unix automatic delta on Tue Sep 30 13:50:02 MEZ 1986
@
text
@@


3.1
log
@Auto bump revision for PAWS 3.2h
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.2h]');
@


2.4
log
@Pws2unix automatic delta on Mon Sep  1 08:51:28 MEZ 1986
@
text
@@


2.3
log
@Pws2unix automatic delta on Wed Aug 20 10:48:54 MEZ 1986
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.2g]');
@


2.2
log
@Pws2unix automatic delta on Tue Aug 19 10:31:55 MEZ 1986
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.2f]');
@


2.1
log
@Auto bump rev number to 2.1 for sys 3.2e.
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.2e]');
@


1.3
log
@Pws2unix automatic delta on Wed Jul 30 09:07:03 MEZ 1986
@
text
@@


1.2
log
@Pws2unix automatic delta on Tue Jul 15 16:35:26 MEZ 1986
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.2d]');
@


1.1
log
@Initial revision
@
text
@d1540 1
a1540 1
  writeln('             [Version 3.1b]');
@
