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


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

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

56.1
date     91.11.05.09.39.22;  author jwh;  state Exp;
branches ;
next     55.1;

55.1
date     91.08.25.10.18.00;  author jwh;  state Exp;
branches ;
next     54.3;

54.3
date     91.08.21.12.34.46;  author jwh;  state Exp;
branches ;
next     54.2;

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

54.1
date     91.03.18.15.23.39;  author jwh;  state Exp;
branches ;
next     53.1;

53.1
date     91.03.11.19.24.51;  author jwh;  state Exp;
branches ;
next     52.1;

52.1
date     91.02.19.09.08.29;  author jwh;  state Exp;
branches ;
next     51.1;

51.1
date     91.01.30.16.07.56;  author jwh;  state Exp;
branches ;
next     50.1;

50.1
date     90.10.29.16.23.04;  author jwh;  state Exp;
branches ;
next     49.1;

49.1
date     90.08.14.14.07.21;  author jwh;  state Exp;
branches ;
next     48.1;

48.1
date     90.07.26.11.13.14;  author jwh;  state Exp;
branches ;
next     47.1;

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

46.1
date     90.05.07.08.40.52;  author jwh;  state Exp;
branches ;
next     45.1;

45.1
date     90.04.19.15.48.11;  author jwh;  state Exp;
branches ;
next     44.1;

44.1
date     90.04.01.22.06.00;  author jwh;  state Exp;
branches ;
next     43.1;

43.1
date     90.03.20.13.56.27;  author jwh;  state Exp;
branches ;
next     42.1;

42.1
date     90.01.23.17.41.27;  author jwh;  state Exp;
branches ;
next     41.1;

41.1
date     89.12.22.11.24.22;  author jwh;  state Exp;
branches ;
next     40.1;

40.1
date     89.09.29.11.46.43;  author jwh;  state Exp;
branches ;
next     39.1;

39.1
date     89.09.26.16.31.27;  author dew;  state Exp;
branches ;
next     38.1;

38.1
date     89.08.29.11.22.45;  author jwh;  state Exp;
branches ;
next     37.1;

37.1
date     89.05.12.11.35.49;  author dew;  state Exp;
branches ;
next     36.1;

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

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

34.1
date     89.01.23.16.03.00;  author jwh;  state Exp;
branches ;
next     33.1;

33.1
date     89.01.16.11.36.32;  author dew;  state Exp;
branches ;
next     32.1;

32.1
date     89.01.10.11.43.46;  author bayes;  state Exp;
branches ;
next     31.1;

31.1
date     88.12.14.18.04.54;  author bayes;  state Exp;
branches ;
next     30.1;

30.1
date     88.12.09.13.42.27;  author dew;  state Exp;
branches ;
next     29.1;

29.1
date     88.10.31.15.26.57;  author bayes;  state Exp;
branches ;
next     28.1;

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

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

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

26.1
date     88.09.28.12.59.51;  author bayes;  state Exp;
branches ;
next     25.1;

25.1
date     88.03.02.09.20.58;  author bayes;  state Exp;
branches ;
next     24.1;

24.1
date     87.08.31.09.38.07;  author jws;  state Exp;
branches ;
next     23.1;

23.1
date     87.08.26.10.14.46;  author bayes;  state Exp;
branches ;
next     22.1;

22.1
date     87.08.17.10.57.43;  author bayes;  state Exp;
branches ;
next     21.1;

21.1
date     87.08.12.13.42.53;  author bayes;  state Exp;
branches ;
next     20.1;

20.1
date     87.07.30.10.55.46;  author bayes;  state Exp;
branches ;
next     19.1;

19.1
date     87.06.01.08.12.10;  author jws;  state Exp;
branches ;
next     18.1;

18.1
date     87.05.20.15.07.57;  author bayes;  state Exp;
branches ;
next     17.1;

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

16.1
date     87.04.26.15.36.36;  author jws;  state Exp;
branches ;
next     15.1;

15.1
date     87.04.13.09.08.49;  author jws;  state Exp;
branches ;
next     14.1;

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

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

13.1
date     87.02.28.18.22.58;  author jws;  state Exp;
branches ;
next     12.1;

12.1
date     87.02.02.13.12.17;  author jws;  state Exp;
branches ;
next     11.1;

11.1
date     87.01.19.09.38.06;  author jws;  state Exp;
branches ;
next     10.1;

10.1
date     86.12.24.10.45.40;  author jws;  state Exp;
branches ;
next     9.1;

9.1
date     86.12.12.14.21.32;  author bayes;  state Exp;
branches ;
next     8.1;

8.1
date     86.11.27.11.42.54;  author jws;  state Exp;
branches ;
next     7.1;

7.1
date     86.11.20.13.31.51;  author hal;  state Exp;
branches ;
next     6.1;

6.1
date     86.11.04.17.41.12;  author paws;  state Exp;
branches ;
next     5.1;

5.1
date     86.10.28.16.28.05;  author hal;  state Exp;
branches ;
next     4.1;

4.1
date     86.09.30.19.35.08;  author hal;  state Exp;
branches ;
next     3.1;

3.1
date     86.09.01.11.44.51;  author hal;  state Exp;
branches ;
next     2.1;

2.1
date     86.07.30.14.29.36;  author hal;  state Exp;
branches ;
next     1.1;

1.1
date     86.06.30.14.21.39;  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
@					      (*

 (c) Copyright Hewlett-Packard Company, 1983.
All rights are reserved.  Copying or other
reproduction of this program except for archival
purposes is prohibited without the prior
written consent of Hewlett-Packard Company.


	    RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the Government
is subject to restrictions as set forth in
paragraph (b) (3) (B) of the Rights in Technical
Data and Computer Software clause in
DAR 7-104.9(a).

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)


$modcal$
$debug off, range off, ovflcheck off$
$stackcheck off, iocheck off$
$ALLOW_PACKED ON$   {JWS 3/31/87}
$copyright 'COPYRIGHT (C) 1983 BY HEWLETT-PACKARD COMPANY'$

$search 'DRVASM', 'DISCHPIB', 'IOLIB:KERNEL'$
{$SEARCH 'DRVASM','DISCHPIB'$}

program CS80init;

module tapebuf;

import
  sysglobals, bkgnd;

export
  const
    tapebuf_maxsize = 1024;
  type
    tapebuf_type = packed array[0..tapebuf_maxsize-1] of byte;
    tapebuf_state_type = (undefined, unmodified, modified);
  var
    tapebuf_ptr: ^tapebuf_type;
    tapebuf_state: tapebuf_state_type;
    tapebuf_uep: uep_type;
    tapebuf_block: integer;
    tapebuf_size: integer;
  procedure init_tapebuf;

implement {tapebuf}

procedure init_tapebuf;
  begin {init_tapebuf}
    if tapebuf_ptr=nil then
      new(tapebuf_ptr);
    tapebuf_state := undefined;
  end; {init_tapebuf}

end; {tapebuf}
$page$

module CS80; {Command Set '80}

import
  sysglobals, bkgnd, discHPIB;

export

  type
    signed16 = -32768..32767;
    signed8  = -128..127;

    unsgn24  = 0..16777215;
    unsgn8   = 0..255;
    unsgn4   = 0..15;

    ct_type =  {controller type field in describe}
      packed record
	b7, b6, b5, b4, b3:  boolean;
	subset80:            boolean;
	multiport:           boolean;
	multiunit:           boolean;
      end;

    sva_type = {single-vector address (6 bytes)}
      packed record
	utb: signed16;  {upper two bytes}
	lfb: integer;   {lower four bytes (all we manage internally)}
      end;

    describe_type = {info returned by describe of unit other than controller}
      packed record
			{CONTROLLER DESCRIPTION FIELD}
	iu: signed16;                   {installed unit word: 1 bit per unit}
	mitr: signed16;                 {max instantaneous xfr rate (Kbytes)}
	ct: ct_type;                    {controller type}
			{UNIT DESCRIPTION FIELD}
	dt: signed8;                    {generic device type}
	dn: unsgn24;                    {device number (6 BCD digits)}
	nbpb: signed16;                 {# of bytes per block}
	nbb: unsgn8;                    {# of blocks which can be buffered}
	rbs: unsgn8;                    {recommended burst size}
	blocktime: signed16;            {block time in microseconds}
	catr: signed16;                 {continuous avg xfr rate (Kbytes)}
	ort: signed16;                  {optimal retry time in centiseconds}
	atp: signed16;                  {access time parameter in centiseconds}
	mif: unsgn8;                    {maximum interleave factor}
	fvb: unsgn8;                    {fixed volume byte: 1 bit/volume}
	rvb: unsgn8;                    {removeable volume byte: 1 bit/vol}
		      {VOLUME DESCRIPTION FIELD}
	maxcadd: unsgn24;               {maximum cylinder address}
	maxhadd: unsgn8;                {maximum head address}
	maxsadd: signed16;              {maximum sector address}
	maxsvadd: sva_type;             {maximum single-vector address}
	currentif: unsgn8;              {current interleave factor}
      end;
$page$

    evu_type = {encoded volume/unit (1 byte) - status & copy commands}
      packed record case integer of
	0: (vvvv: unsgn4;       {volume number}
	    uuuu: unsgn4);      {unit number}
	1: (evu_byte: signed8); {for -1 test}
      end;


    errorbit_type = {error bit assignments in status & status mask}
      (
		  {REJECT ERRORS FIELD}
	{ 0}  eb0,
	{ 1}  eb1,
	{ 2}  channel_parity_error,
	{ 3}  eb3,
	{ 4}  eb4,
	{ 5}  illegal_opcode,
	{ 6}  module_addressing,
	{ 7}  address_bounds,
	{ 8}  parameter_bounds,
	{ 9}  illegal_parameter,
	{10}  message_sequence,
	{11}  eb11,
	{12}  message_length,
	{13}  eb13,
	{14}  eb14,
	{15}  eb15,
		  {FAULT ERRORS FIELD}
	{16}  eb16,
	{17}  cross_unit,
	{18}  eb18,
	{19}  controller_fault,
	{20}  eb20,
	{21}  eb21,
	{22}  unit_fault,
	{23}  eb23,
	{24}  diagnostic_result,
	{25}  eb25,
	{26}  operator_release_required,
	{27}  diagnostic_release_required,
	{28}  internal_maintenance_required,
	{29}  eb29,
	{30}  power_fail,
	{31}  retransmit,
		  {ACCESS ERRORS FIELD}
	{32}  illegal_parallel_operation,
	{33}  uninitialized_media,
	{34}  no_spares_available,
	{35}  not_ready,
	{36}  write_protect,
	{37}  no_data_found,
	{38}  eb38,
	{39}  eb39,
	{40}  unrecoverable_data_overflow,
	{41}  unrecoverable_data,
	{42}  eb42,
	{43}  end_of_file,
	{44}  end_of_volume,
	{45}  eb45,
	{46}  eb46,
	{47}  eb47,
		  {INFORMATION ERRORS FIELD}
	{48}  operator_request,
	{49}  diagnostic_request,
	{50}  internal_maintenance_request,
	{51}  media_wear,
	{52}  latency_induced,
	{53}  eb53,
	{54}  eb54,
	{55}  auto_sparing_invoked,
	{56}  eb56,
	{57}  recoverable_data_overflow,
	{58}  marginal_data,
	{59}  recoverable_data,
	{60}  eb60,
	{61}  maintenance_track_overflow,
	{62}  eb62,
	{63}  eb63
      );


    status_mask_type =
      packed array[errorbit_type] of boolean;


    status_type =
      packed record
			{IDENTIFICATION FIELD}
	current_vu: evu_type;                           {current volume/unit}
	requesting_unit: signed8;                       {unit requesting service}
			{ERROR REPORTING FIELDS}
	errorbits: status_mask_type;
			{PARAMETER FIELD}
	case integer of
	  {positive cases correspond to error bits}
	  -1: (nta: sva_type;                            {new target address}
	       faultlog: integer);                       {fault log}
	  -2: (aaa: sva_type;                            {affected area address}
	       afl: integer);                            {affected field length}
	  17: (uee: packed array[1..6] of signed8);      {units experiencing errors}
	  24: (dor: packed array[1..6] of unsgn8);       {diagnostic results}
	  38: (ta: sva_type);                            {target address}
	  41: (bba: sva_type);                           {bad block address}
      48..50: (urr: packed array[1..6] of signed8);      {units requesting release}
	  58: (btbs: sva_type);                          {block to be spared}
	  59: (rba: sva_type);                           {recoverable block address}
	end; {case}
$page$

    t_type = {'T' parameter in SET_RELEASE}
      (   allow_release_timeout,        {power-on default}
       suppress_release_timeout);


    z_type = {'Z' parameter in SET_RELEASE}
      (disable_auto_release,            {power-on default}
	enable_auto_release);


    CMD_type = {enumerated opcodes for device commands}
(CMDlocate_and_read, CMD1              , CMDlocate_and_wrt , CMD3              ,
 CMDlocate_and_ver , CMD5              , CMDspare_block    , CMD7              ,
 CMDcopy_data      , CMD9              , CMDcold_load_read , CMD11             ,
 CMD12             , CMDrequest_status , CMDrelease        , CMDrelease_denied ,
 CMDset_address_1V , CMDset_address_3V , CMDset_block_disp , CMD19             ,
 CMD20             , CMD21             , CMD22             , CMD23             ,
 CMDset_length     , CMD25             , CMD26             , CMD27             ,
 CMD28             , CMD29             , CMD30             , CMD31             ,
 CMDset_unit_0     , CMDset_unit_1     , CMDset_unit_2     , CMDset_unit_3     ,
 CMDset_unit_4     , CMDset_unit_5     , CMDset_unit_6     , CMDset_unit_7     ,
 CMDset_unit_8     , CMDset_unit_9     , CMDset_unit_10    , CMDset_unit_11    ,
 CMDset_unit_12    , CMDset_unit_13    , CMDset_unit_14    , CMDset_unit_15    ,
 CMDinit_util_NEM  , CMDinit_util_REM  , CMDinit_util_SEM  , CMDinit_diagnostic,
 CMDno_op          , CMDdescribe       , CMD54             , CMDinit_media     ,
 CMDset_options    , CMDset_rps        , CMDset_retry_time , CMDset_release    ,
 CMDset_burst_LBO  , CMDset_burst_ABT  , CMDset_status_mask, CMD63             ,
 CMDset_vol_0      , CMDset_vol_1      , CMDset_vol_2      , CMDset_vol_3      ,
 CMDset_vol_4      , CMDset_vol_5      , CMDset_vol_6      , CMDset_vol_7      ,
 CMDset_retadd_mode, CMDwrite_file_mark, CMDunload         , CMD75             ,
 CMD76             , CMD77             , CMD78             , CMD79             ,
 CMD80             , CMD81             , CMD82             , CMD83             ,
 CMD84             , CMD85             , CMD86             , CMD87             ,
 CMD88             , CMD89             , CMD90             , CMD91             ,
 CMD92             , CMD93             , CMD94             , CMD95             ,
 CMD96             , CMD97             , CMD98             , CMD99             ,
 CMD100            , CMD101            , CMD102            , CMD103            ,
 CMD104            , CMD105            , CMD106            , CMD107            ,
 CMD108            , CMD109            , CMD110            , CMD111            ,
 CMD112            , CMD113            , CMD114            , CMD115            ,
 CMD116            , CMD117            , CMD118            , CMD119            ,
 CMD120            , CMD121            , CMD122            , CMD123            ,
 CMD124            , CMD125            , CMD126            , CMD127            ,
 CMD128 {the field width is forced to 8 bits for packing considerations}  );

  const
    transparent_sec = 18;
    command_sec = 5;
    execution_sec = 14;
    reporting_sec = 16;
$page$

    errorbits_owning_parmfield = {errorbits which set the parameter field}
      [
		  {REJECT ERRORS FIELD}
	{ 0}  eb0,                              {unknown, but assumed}
	{ 1}  eb1,                              {unknown, but assumed}
	{ 3}  eb3,                              {unknown, but assumed}
	{ 4}  eb4,                              {unknown, but assumed}
	{11}  eb11,                             {unknown, but assumed}
	{13}  eb13,                             {unknown, but assumed}
	{14}  eb14,                             {unknown, but assumed}
	{15}  eb15,                             {unknown, but assumed}
		  {FAULT ERRORS FIELD}
	{16}  eb16,                             {unknown, but assumed}
	{17}  cross_unit,
	{18}  eb18,                             {unknown, but assumed}
	{20}  eb20,                             {unknown, but assumed}
	{21}  eb21,                             {unknown, but assumed}
	{23}  eb23,                             {unknown, but assumed}
	{24}  diagnostic_result,
	{25}  eb25,                             {unknown, but assumed}
	{29}  eb29,                             {unknown, but assumed}
		  {ACCESS ERRORS FIELD}
	{38}  eb38,                             {unknown, but assumed}
	{39}  eb39,                             {unknown, but assumed}
	{41}  unrecoverable_data,
	{42}  eb42,                             {unknown, but assumed}
	{45}  eb45,                             {unknown, but assumed}
	{46}  eb46,                             {unknown, but assumed}
	{47}  eb47,                             {unknown, but assumed}
		  {INFORMATION ERRORS FIELD}
	{48}  operator_request,
	{49}  diagnostic_request,
	{50}  internal_maintenance_request,
	{53}  eb53,                             {unknown, but assumed}
	{54}  eb54,                             {unknown, but assumed}
	{56}  eb56,                             {unknown, but assumed}
	{58}  marginal_data,
	{59}  recoverable_data,
	{60}  eb60,                             {unknown, but assumed}
	{62}  eb62,                             {unknown, but assumed}
	{63}  eb63                              {unknown, but assumed}
      ];


    errorbits_requesting_release = {errorbits which request release}
      [
	{48}  operator_request,
	{49}  diagnostic_request,
	{50}  internal_maintenance_request
      ];
$page$

  {
    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 chan_indep_clr  (uep: uep_type): unsgn8;
  function set_unit        (uep: uep_type; unit: unsgn4): unsgn8;
  function set_unitvol     (uep: uep_type): unsgn8;
  function status          (uep: uep_type; var status_bytes: status_type): unsgn8;
  function release         (uep: uep_type; unit: unsgn4): unsgn8;
  function describe        (uep: uep_type; var describe_bytes: describe_type): unsgn8;
  function set_release     (uep: uep_type; t: t_type; z: z_type): unsgn8;
  function set_options     (uep: uep_type; options_byte: unsgn8): unsgn8;
  function set_status_mask (uep: uep_type; status_mask: status_mask_type): unsgn8;


  {
    NOTE: The following routines do not, in themselves, perform a complete
	  transaction. They provide some of the messages necessary for
	  transactions which are broken apart to allow overlapped transfers.
  }
  procedure ICuvalc (uep: uep_type; address, len: integer; cmd: CMD_type);
  function qstat    (uep: uep_type): unsgn8;

implement {CS80}


var
  most_recent_status: status_type;  {for post-mortem diagnostic purposes only!!!}


function qstat(uep: uep_type): unsgn8;
  {
    receive a REPORTING message
    return the QSTAT byte
  }
  var
    qstat_byte: {the 1 byte in the reporting message}
      packed record
	b: unsgn8;
      end;
  begin {qstat}
    HPIBshort_msge_in(uep, reporting_sec, addr(qstat_byte), sizeof(qstat_byte));
    qstat := qstat_byte.b;
  end; {qstat}
$page$

function chan_indep_clr(uep: uep_type): unsgn8;
  {
    issue the CHANNEL_INDEPENDENT_CLEAR command
    return the QSTAT byte
  }
  var
    cic: {the 2 bytes in the channel independent clear command message}
      packed record
	setunit: CMD_type;
	ci_clr: unsgn8;
      end;
  begin {chan_indep_clr}
    cic.setunit := CMD_type(signed16(CMDset_unit_0)+uep^.du);
    cic.ci_clr := 8;
    HPIBshort_msge_out(uep, transparent_sec, addr(cic), sizeof(cic));
    HPIBwait_for_ppol(uep);
    chan_indep_clr := qstat(uep);
  end; {chan_indep_clr}


procedure ICc(uep: uep_type; cmd: CMD_type);
  {
    issue the specified command
  }
  var
    c: {the 1-byte command message}
      packed record
	cmd: CMD_type;
      end;
  begin {ICc}
    c.cmd := cmd;
    HPIBshort_msge_out(uep, command_sec, addr(c), sizeof(c));
  end; {ICc}


procedure ICuc(uep: uep_type; unit: unsgn4; cmd: CMD_type);
  {
    issue the specified SET_UNIT & command
  }
  var
    uc: {the 2-byte command message}
      packed record
	setunit: CMD_type;
	cmd: CMD_type;
      end;
  begin {ICuc}
    uc.setunit := CMD_type(signed16(CMDset_unit_0)+unit);
    uc.cmd := cmd;
    HPIBshort_msge_out(uep, command_sec, addr(uc), sizeof(uc));
  end; {ICuc}
$page$

function set_unit(uep: uep_type; unit: unsgn4): unsgn8;
  {
    issue the SET_UNIT command
    return the QSTAT byte
  }
  begin {set_unit}
    ICc(uep, CMD_type(signed16(CMDset_unit_0)+unit));
    HPIBwait_for_ppol(uep);
    set_unit := qstat(uep);
  end; {set_unit}


function set_unitvol(uep: uep_type): unsgn8;
  {
    issue the SET_UNIT & SET_VOLUME commands
    return the QSTAT byte
  }
  begin {set_unitvol}
    ICuc(uep, uep^.du, CMD_type(signed16(CMDset_vol_0)+uep^.dv));
    HPIBwait_for_ppol(uep);
    set_unitvol := qstat(uep);
  end; {set_unitvol}


function status(uep: uep_type; var status_bytes: status_type): unsgn8;
  {
    issue the REQUEST_STATUS command
    place the 20 bytes of status in the passed variable 'status_bytes'
    return the QSTAT byte
  }
  begin {status}
    ICc(uep, CMDrequest_status);
    HPIBwait_for_ppol(uep);
    HPIBshort_msge_in(uep, execution_sec, addr(status_bytes), sizeof(status_bytes));
    most_recent_status := status_bytes;  {for post-mortem diagnostic purposes only!!!}
    HPIBwait_for_ppol(uep);
    status := qstat(uep);
  end; {status}


function release(uep: uep_type; unit: unsgn4): unsgn8;
  {
    SET_UNIT & issue the RELEASE command
    return the QSTAT byte
  }
  begin {release}
    ICuc(uep, unit, CMDrelease);
    HPIBwait_for_ppol(uep);
    release := qstat(uep);
  end; {release}
$page$

function describe(uep: uep_type; var describe_bytes: describe_type): unsgn8;
  {
    issue the DESCRIBE command
    place the 37 bytes of description in the passed variable 'describe_bytes'
    return the QSTAT byte
  }
  begin {describe}
    ICc(uep, CMDdescribe);
    HPIBwait_for_ppol(uep);
    HPIBshort_msge_in(uep, execution_sec, addr(describe_bytes), sizeof(describe_bytes));
    HPIBwait_for_ppol(uep);
    describe := qstat(uep);
  end; {describe}


function set_release(uep: uep_type; t: t_type; z: z_type): unsgn8;
  var
    sr: {the 3 bytes in the SET_UNIT & SET_RELEASE command message}
      packed record
	setunit: CMD_type;
	setrel: CMD_type;
	Tbit: t_type;
	Zbit: z_type;
	pad: 0..63;
      end;
  begin {set_release}
    sr.setunit := CMDset_unit_15;  {always addressed to the controller}
    sr.setrel  := CMDset_release;
    sr.Tbit    := t;
    sr.Zbit    := z;
    sr.pad     := 0;
    HPIBshort_msge_out(uep, command_sec, addr(sr), sizeof(sr));
    HPIBwait_for_ppol(uep);
    set_release := qstat(uep);
  end; {set_release}


function set_options(uep: uep_type; options_byte: unsgn8): unsgn8;
  var
    so: {the 2 bytes in the SET_OPTIONS command message}
      packed record
	setoptn: CMD_type;
	ob: unsgn8;
      end;
  begin {set_options}
    so.setoptn := CMDset_options;
    so.ob      := options_byte;
    HPIBshort_msge_out(uep, command_sec, addr(so), sizeof(so));
    HPIBwait_for_ppol(uep);
    set_options := qstat(uep);
  end; {set_options}
$page$

function set_status_mask(uep: uep_type; status_mask: status_mask_type): unsgn8;
  var
    ssm: {the 10 bytes in the SET_STATUS_MASK command message}
      packed record
	nop: CMD_type;
	setstsmsk: CMD_type;
	stsmsk: status_mask_type;
      end;
  begin {set_status_mask}
    ssm.nop       := CMDno_op;
    ssm.setstsmsk := CMDset_status_mask;
    ssm.stsmsk    := status_mask;
    HPIBshort_msge_out(uep, command_sec, addr(ssm), sizeof(ssm));
    HPIBwait_for_ppol(uep);
    set_status_mask := qstat(uep);
  end; {set_status_mask}


procedure ICuvalc(uep: uep_type; address, len: integer; cmd: CMD_type);
  {
    issue the following command sequence:
      .  SET_UNIT               (u)
      .  SET_VOLUME             (v)
      .  SET_ADDRESS            (a)
      .  SET_LENGTH             (l)
      .  specified COMMAND      (c)
  }
  var
    uvalc: {the 17 bytes in the command message}
      packed record
	setunit: CMD_type;      {set unit}
	setvol: CMD_type;       {set volume}
	nop1: CMD_type;         {nop}
	setadd: CMD_type;       {set address}
	sva: sva_type;          {single vector address}
	nop2: CMD_type;         {nop}
	setlen: CMD_type;       {set length}
	length: integer;        {length}
	cmd: CMD_type;          {specified command}
      end;
  begin {ICuvalc}
    uvalc.setunit := CMD_type(signed16(CMDset_unit_0)+uep^.du);
    uvalc.setvol  := CMD_type(signed16(CMDset_vol_0)+uep^.dv);
    uvalc.nop1    := CMDno_op;
    uvalc.setadd  := CMDset_address_1V;
    uvalc.sva.utb := 0;
    uvalc.sva.lfb := address;
    uvalc.nop2    := CMDno_op;
    uvalc.setlen  := CMDset_length;
    uvalc.length  := len;
    uvalc.cmd     := cmd;
    HPIBshort_msge_out(uep, command_sec, addr(uvalc), sizeof(uvalc));
  end; {ICuvalc}

end; {CS80}
$page$

module CS80dsr; {Command Set '80 Driver Support Routines}

import
  sysglobals, bkgnd, tapebuf, CS80;

export

  procedure invalidate_stateinfo(uep: uep_type);

  procedure handle_bad_status(uep: uep_type; ok_to_config: boolean; var retry_required: boolean);

  procedure configure(uep: uep_type);

implement {CS80dsr}


procedure invalidate_stateinfo(uep: uep_type);
  var
    lun: unitnum;
    scanner_uep: uep_type;
  begin {invalidate_stateinfo}
    for lun := 1 to maxunit do
      begin
	scanner_uep := addr(unitable^[lun]);
	if (scanner_uep^.letter='Q') and
	   (scanner_uep^.sc = uep^.sc) and
	   (scanner_uep^.ba = uep^.ba) and
	   (scanner_uep^.du = uep^.du)
	   {don't qualify dv because all volumes ARE affected!}
	then  {invalidate all CS80 state info!}
	  begin
	    scanner_uep^.umediavalid := false;  {media possibly changed}
	    scanner_uep^.dvrtemp2 := -1;        {block size possibly changed!}
	    if scanner_uep=tapebuf_uep then
	      tapebuf_state := undefined;
	  end; {if}
      end; {for}
  end; {invalidate_stateinfo}
$page$

procedure handle_bad_status(uep: uep_type; ok_to_config: boolean; 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_bad_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
		      invalidate_stateinfo(uep);
		      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}
$page$

      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 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 and ok_to_config then
	configure(uep);

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

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

  end; {handle_bad_status}


procedure configure(uep: uep_type);

  var
    escape_caught: boolean;
    saved_ureportchange: boolean;
    retry_required: boolean;
    describe_bytes: describe_type;
    bcd_prod_num: {within the describe bytes}
      packed record case integer of
	0: (dn:  unsgn24);
	1: (bcd: packed array[1..6] of unsgn4);
      end;
    fixed_volume_byte:
      packed record case integer of
	0: (b: unsgn8);
	1: (bit: packed array[0..7] of boolean);
      end;
    prod_num: signed16;
    index: signed16;

  const
    masked = true;
    unmasked = false;

    my_status_mask = status_mask_type
      [
		   {REJECT ERRORS FIELD}
      { 0  eb0:                            }  unmasked,
      { 1  eb1:                            }  unmasked,
      { 2  channel_parity_error:           }  unmasked,
      { 3  eb3:                            }  unmasked,
      { 4  eb4:                            }  unmasked,
      { 5  illegal_opcode:                 }  unmasked,
      { 6  module_addressing:              }  unmasked,
      { 7  address_bounds:                 }  unmasked,
      { 8  parameter_bounds:               }  unmasked,
      { 9  illegal_parameter:              }  unmasked,
      {10  message_sequence:               }  unmasked,
      {11  eb11:                           }  unmasked,
      {12  message_length:                 }  unmasked,
      {13  eb13:                           }  unmasked,
      {14  eb14:                           }  unmasked,
      {15  eb15:                           }  unmasked,
		{FAULT ERRORS FIELD}
      {16  eb16:                           }  unmasked,   {unmaskable error}
      {17  cross_unit:                     }  unmasked,   {unmaskable error}
      {18  eb18:                           }  unmasked,   {unmaskable error}
      {19  controller_fault:               }  unmasked,   {unmaskable error}
      {20  eb20:                           }  unmasked,   {unmaskable error}
      {21  eb21:                           }  unmasked,   {unmaskable error}
      {22  unit_fault:                     }  unmasked,   {unmaskable error}
      {23  eb23:                           }  unmasked,   {unmaskable error}
      {24  diagnostic_result:              }  unmasked,   {unmaskable error}
      {25  eb25:                           }  unmasked,   {unmaskable error}
      {26  operator_release_required:      }  unmasked,   {unmaskable error}
      {27  diagnostic_release_required:    }  unmasked,   {unmaskable error}
      {28  internal_maintenance_required:  }  unmasked,   {unmaskable error}
      {29  eb29:                           }  unmasked,   {unmaskable error}
      {30  power_fail:                     }  unmasked,   {unmaskable error}
      {31  retransmit:                     }  unmasked,   {unmaskable error}
		{ACCESS ERRORS FIELD}
      {32  illegal_parallel_operation:     }  unmasked,
      {33  uninitialized_media:            }  unmasked,
      {34  no_spares_available:            }  unmasked,
      {35  not_ready:                      }  unmasked,
      {36  write_protect:                  }  unmasked,
      {37  no_data_found:                  }  unmasked,
      {38  eb38:                           }  unmasked,
      {39  eb39:                           }  unmasked,
      {40  unrecoverable_data_overflow:    }  unmasked,
      {41  unrecoverable_data:             }  unmasked,
      {42  eb42:                           }  unmasked,
      {43  end_of_file:                    }  unmasked,
      {44  end_of_volume:                  }  unmasked,
      {45  eb45:                           }  unmasked,
      {46  eb46:                           }  unmasked,
      {47  eb47:                           }  unmasked,
		{INFORMATION ERRORS FIELD}
      {48  operator_request:               }  unmasked,
      {49  diagnostic_request:             }  unmasked,
      {50  internal_maintenance_request:   }  unmasked,
      {51  media_wear:                     }  masked,
      {52  latency_induced:                }  masked,
      {53  eb53:                           }  masked,
      {54  eb54:                           }  masked,
      {55  auto_sparing_invoked:           }  masked,
      {56  eb56:                           }  masked,
      {57  recoverable_data_overflow:      }  masked,
      {58  marginal_data:                  }  masked,
      {59  recoverable_data:               }  masked,
      {60  eb60:                           }  masked,
      {61  maintenance_track_overflow:     }  masked,
      {62  eb62:                           }  masked,
      {63  eb63:                           }  masked
      ];
$page$

  begin {configure}

    with uep^ do
      begin

	escape_caught := false;
	saved_ureportchange := ureportchange;
	try
	  ureportchange := false;  {NEVER report media change while in configure}

	  {configure the control unit}

	  repeat
	    retry_required := false;
	    if set_release(uep, allow_release_timeout, disable_auto_release)<>0 then
	      handle_bad_status(uep, false, retry_required);
	  until not retry_required;

	  repeat
	    retry_required := false;
	    if set_status_mask(uep, my_status_mask)<>0 then
	      handle_bad_status(uep, false, retry_required);
	  until not retry_required;


	  {configure the required unit}

	  repeat
	    retry_required := false;
	    if chan_indep_clr(uep)<>0 then
	      handle_bad_status(uep, false, retry_required);
	  until not retry_required;

	  repeat
	    retry_required := false;
	    if set_unitvol(uep)<>0 then
	      handle_bad_status(uep, false, retry_required);
	  until not retry_required;

	  repeat
	    retry_required := false;
	    if describe(uep, describe_bytes)<>0 then
	      handle_bad_status(uep, false, retry_required);
	  until not retry_required;

	  with describe_bytes do
	    begin

	      bcd_prod_num.dn := dn;
	      prod_num := 0;
	      for index := 1 to 5 do
		prod_num := prod_num*10+bcd_prod_num.bcd[index];

	      if ( (devid<>prod_num) and (devid<>-1) )  {wrong product number}
		 or ( dt<0 )                            {can't detect media change}
		then ioresc_bkgnd(uep, znodevice);

	      dvrtemp2 := 0;
	      index := nbpb;
	      while (index>0) and not odd(index) do
		begin
		  dvrtemp2 := dvrtemp2+1;
		  index := index div 2;
		end; {while}
	      if index<>1 then  {blocksize isn't a power of 2!}
		dvrtemp2 := -1; {don't panic; might be just no medium present}

	      fixed_volume_byte.b := fvb;  {fixed volume byte}
	      uisfixed := fixed_volume_byte.bit[7-dv];

	      if devid=-1 then  {variable-sized removeable volume; set its size}
		umaxbytes := (maxsvadd.lfb+1)*nbpb;

	      if dt=2 then  {it's a tape}
		repeat  {enable auto-jump sparing}
		  retry_required := false;
		  if set_options(uep, 4)<>0 then
		    handle_bad_status(uep, false, retry_required);
		until not retry_required;

	      repeat
		retry_required := false;
		if set_status_mask(uep, my_status_mask)<>0 then
		  handle_bad_status(uep, false, retry_required);
	      until not retry_required;

	    end; {with}

	recover
	  escape_caught := true;
	ureportchange := saved_ureportchange;
	if escape_caught then
	  escape(escapecode);

      end; {with}

  end; {configure}

end; {CS80dsr}
$page$

module CS80dvr; {Command Set '80 Driver}

import
  sysglobals, asm, mini, drvasm, bkgnd, discHPIB, tapebuf, CS80, CS80dsr;

export
  type
    mp_type =  {media parameters}
      record
	tpm: integer;  {tracks per medium}
	bpt: integer;  {bytes per track}
      end;

  procedure get_letter(uep: uep_type; ident: shortint; var letter: char);

  procedure get_parms(var devtype: byte; var devid: integer;
		      var hardvols: shortint; var mp: mp_type);

  procedure CS80io(fp: fibp; request: amrequesttype;
		   anyvar buffer: window; length, position: integer);

implement {CS80dvr}

var
  CS80_devtype: byte;
  CS80_devid: integer;
  CS80_hardvols: shortint;
  CS80_mp: mp_type;


procedure clear_unit(uep: uep_type);
  begin {clear_unit}
    try
      allocate_bkgnd_info(uep);
      HPIBcheck_sc(uep);
      if HPIBamigo_identify(uep) div 256<>2 then
	ioresc_bkgnd(uep, znodevice);
      configure(uep);
      deallocate_bkgnd_info(uep);
    recover
      abort_bkgnd_process(uep);
  end; {clear_unit}


{
  procedures for CTABLE self-configuration
}

procedure get_parms(var devtype: byte; var devid: integer;
		    var hardvols: shortint; var mp: mp_type);
  begin {get_parms}
    devtype := CS80_devtype;
    devid := CS80_devid;
    hardvols := CS80_hardvols;
    mp := CS80_mp;
  end; {get_parms}
$page$

procedure get_letter(uep: uep_type; ident: shortint; var letter: char);
  var
    retry_required: boolean;
    describe_bytes: describe_type;
    bcd_prod_num: {within the describe bytes}
      packed record case integer of
	0: (dn:  unsgn24);
	1: (bcd: packed array[1..6] of unsgn4);
      end;
    index: signed16;
    volumes_byte: {with the describe bytes}
      packed record case integer of
	0: (vb:  unsgn8);
	1: (bools: packed array[0..7] of boolean);
      end;
  begin {get_letter}
    uep^.ureportchange := false;  {don't report media changes/power-on now!!!}

    repeat  {cmd w/o execution msge avoids escape if in power-on holdoff!}
      retry_required := false;
      if set_unitvol(uep)<>0 then
	handle_bad_status(uep, false, retry_required);  {don't configure!!!}
    until not retry_required;

    repeat
      retry_required := false;
      if describe(uep, describe_bytes)<>0 then
	handle_bad_status(uep, false, retry_required);  {don't configure!!!}
    until not retry_required;

    with describe_bytes do
      begin
	CS80_devtype := dt;

	bcd_prod_num.dn := dn;
	CS80_devid := 0;
	for index := 1 to 5 do
	  CS80_devid := CS80_devid*10+bcd_prod_num.bcd[index];

	volumes_byte.vb := fvb+rvb;
	CS80_hardvols := 0;
	for index := 0 to 7 do
	  CS80_hardvols := CS80_hardvols+ord(volumes_byte.bools[index]);

	with CS80_mp do
	  begin
	    tpm := (maxcadd+1)*(maxhadd+1);   {tracks per medium}
	    if tpm=1  {only single-vector addressing info given}
	      then bpt := (maxsvadd.lfb+1)*nbpb   {bytes per track}
	      else bpt := (maxsadd+1)*nbpb;       {bytes per track}
	  end; {with}

      end; {with}
    letter := 'Q';
  end; {get_letter}
$page$

{
  low-level read/write routines
}

procedure flagit(uep: anyptr);
  begin {flagit}
    bip_type(uep_type(uep)^.dvrtemp)^.xfr_chain_semaphore := false;
  end; {flagit}


procedure xfr(uep: uep_type; request: amrequesttype;
	      bufptr: anyptr; block_address, length: integer);
  var
    command: CMD_type;
    retry_required: boolean;
  begin {xfr}
    allocate_bkgnd_info(uep);
    with bip_type(uep^.dvrtemp)^ do
      try
	if HPIBamigo_identify(uep) div 256<>2 then
	  ioresc_bkgnd(uep, znodevice);

	read_operation := (request=readbytes) or (request=startread);
	if read_operation
	  then command := CMDlocate_and_read
	  else command := CMDlocate_and_wrt;
	ICuvalc(uep, block_address, length, command);

	if length>0 then
	  begin
	    HPIBwait_for_ppol(uep);
	    xfr_chain_semaphore := true;  {merely a flag for xfr busy here}
	    HPIBupon_dxfr_comp(uep, execution_sec, bufptr, length, flagit);
	    while xfr_chain_semaphore do
	      {nothing};
	    if iores<>inoerror then escape(-10);
	  end {if}
	else
	  bdx_pre_eoi := false;

	HPIBwait_for_ppol(uep);
	retry_required := false;
	if qstat(uep)<>0 then
	  handle_bad_status(uep, true, retry_required)
	else if bdx_pre_eoi then
	  ioresc_bkgnd(uep, zcatchall);  {unresolved premature eoi!}

	deallocate_bkgnd_info(uep);
      recover
	abort_bkgnd_process(uep);
    ioresult  := uep^.dvrtemp;
    if (ioresult<>ord(inoerror)) or retry_required then
      escape(-10);
  end; {xfr}
$page$

{
  tapebuf manipulation routines
}

procedure flush_tapebuf;
  var
    escape_caught: boolean;
    saved_ureportchange: boolean;
  begin {flush_tapebuf}
    if tapebuf_state=modified then
      with tapebuf_uep^ do
	begin
	  escape_caught := false;
	  saved_ureportchange := ureportchange;
	  try
	    ureportchange := true;  {don't flush out to different media!}
	    tapebuf_state := undefined;  {while attempting the write}
	    xfr(tapebuf_uep, writebytes, tapebuf_ptr, tapebuf_block, tapebuf_size);
	    tapebuf_state := unmodified;  {write was successful!}
	  recover
	    escape_caught := true;
	  ureportchange := saved_ureportchange;
	  if escape_caught then
	    escape(escapecode);
	end; {with}
  end; {flush_tapebuf}


procedure load_tapebuf(uep: uep_type; request: amrequesttype; block: integer);
  var
    xfr_required: boolean;
  begin {load_tapebuf}
    xfr_required := (tapebuf_uep<>uep) or (tapebuf_block<>block) or (tapebuf_state=undefined);
    if xfr_required then
      begin
	flush_tapebuf;
	tapebuf_uep := uep;
	tapebuf_block := block;
	tapebuf_state := undefined;
      end; {if}

    if not xfr_required        {then confirm media present & unchanged}
       or (request=writebytes) {then confirm media not write protected}
       then
      begin
	xfr(tapebuf_uep, request, nil, tapebuf_block, 0);
	if tapebuf_state=undefined then
	  xfr_required := true;
      end; {if}

    if xfr_required then
      begin
	tapebuf_size := shifted_left(1, uep^.dvrtemp2);
	xfr(tapebuf_uep, readbytes, tapebuf_ptr, tapebuf_block, tapebuf_size);
	tapebuf_state := unmodified;  {read was successful!}
      end; {if}
  end; {load_tapebuf}
$page$

{
  read/write routine

  The new Subset/80 devices coming out which support multiple block
  sizes have forced us to abandon the 2.X driver's essentially never-
  used asynchronous capabilities.  It's simply too difficult to handle
  the media change situation when the media's block size also changes.
  For instance, an asynchronous transfer started on the 256-byte block
  assumption might discover new media formatted to 1024-byte blocks, in
  which case entire transfer would need re-starting, this time using
  tapebuf for buffering.  This situation would not be detected until
  well into the asynchronous transfer chain, at which point we could
  be deadlocked.

  bug 1: 10 june 88 partial sector writes were resulting in i/o errors
	 changes were made to always do full sector/block writes
}

procedure transfer(uep: uep_type; fp: fibp; request: amrequesttype;
		   bufptr: charptr; abs_position, length: integer);
  type
    cp = ^char;
  var
    retry_required: boolean;
    blockpower: shortint;
    blocksize: integer;
    block, intra_block_offset, partial_length: integer;

  begin {transfer}

    repeat
      retry_required := false;

      try
	if uep^.dvrtemp2<0 then  {block size unknown; try to determine}
	  begin
	    clear_unit(uep);
	    ioresult := uep^.dvrtemp;
	    if ioresult<>ord(inoerror) then
	      escape(-10);
	  end; {if}

	blockpower := uep^.dvrtemp2;
	if blockpower<0 then
	  ioresc(znomedium);  {this or block size isn't a power of 2!!!}

	blocksize := shifted_left(1, blockpower);
	if blocksize>tapebuf_maxsize then
	  ioresc(zuninitialized);  {our buffer is too small to handle}

	block := shifted_right(abs_position, blockpower);
	intra_block_offset := mod_power_of_2(abs_position, blockpower);

	if blockpower<=8 then
	  begin {handle a 256-byte or smaller block media}
	    {bug 1 fix is to now just enforce block boundary start}
	    if intra_block_offset<>0 then ioresc(zbadmode);
	    { xfr(uep, request, bufptr, block, length); } {bug 1 fix}
	  end ; {handle a 256-byte or smaller block device}
$page$

	{else} {rdq removed to force all operations thru buffer handeling code }
	  begin {handle buffering for up to tapebuf_maxsize block media}

	    partial_length := blocksize-intra_block_offset;
	    if partial_length>length then partial_length := length;

	    case request of

	      readbytes, startread:
		begin {read operations}

		  if intra_block_offset>0 then  {partial block at front}
		    begin
		      load_tapebuf(uep, readbytes, block);
		      moveleft(tapebuf_ptr^[intra_block_offset], bufptr^, partial_length);
		      bufptr := addr(bufptr^, partial_length);
		      abs_position := abs_position+partial_length;
		      block := shifted_right(abs_position, blockpower);
		      length := length-partial_length;
		    end; {if}

		  if (length>=blocksize)  {one or more blocks remain}
		     or (blockpower<=8) then {bug 1, keep read performance for small blocks  }
		    begin
		      flush_tapebuf;  {because we may travel far, far away}
		      xfr(uep, readbytes, bufptr, block, length);
		    end
		  else if length>0 then  {partial block at back}
		    begin
		      load_tapebuf(uep, readbytes, block);
		      moveleft(tapebuf_ptr^, bufptr^, length);
		    end;

		end; {read operations}

	      writebytes, startwrite:
		begin {write operations}

		  if intra_block_offset>0 then  {partial block at front}
		    begin
		      load_tapebuf(uep, writebytes, block);
		      tapebuf_state := modified;
		      moveleft(bufptr^, tapebuf_ptr^[intra_block_offset], partial_length);
		      bufptr := addr(bufptr^, partial_length);
		      abs_position := abs_position+partial_length;
		      block := shifted_right(abs_position, blockpower);
		      length := length-partial_length;
		    end; {if}

		  partial_length := length-mod_power_of_2(length, blockpower);
		  if partial_length>0 then  {one or more whole blocks remain}
		    begin
		      flush_tapebuf;  {because we may travel far, far away}
		      tapebuf_state := undefined;  {in case this overwrites!}
		      xfr(uep, writebytes, bufptr, block, partial_length);
		      bufptr := addr(bufptr^, partial_length);
		      abs_position := abs_position+partial_length;
		      block := shifted_right(abs_position, blockpower);
		      length := length-partial_length;
		    end; {if}

		  if length>0 then  {a partial block remains}
		    {rdq bug 1 fix, new code to zero pad small sectors instead of
		     the read modify write operation used for big block sizes}
		    if blockpower<=8 then
		    begin { zero pad for blocksize<=256 }
		       moveleft(bufptr^, tapebuf_ptr^, length);
		       tapebuf_ptr^[length] := 0;
		       moveleft(cp(addr(tapebuf_ptr^[length]))^,
				cp(addr(tapebuf_ptr^[length+1]))^,
				blocksize-length-1);
		       xfr(uep, writebytes, tapebuf_ptr, block, blocksize);
		    end
		    else
		    begin
		      load_tapebuf(uep, writebytes, block);
		      tapebuf_state := modified;
		      moveleft(bufptr^, tapebuf_ptr^, length);
		    end; {if}

		  flush_tapebuf;  {so errors get reported in the right place!}

		end; {write operations}

	    end; {case}

	  end; {handle buffering for up to tapebuf_maxsize block media}

      recover
	begin
	  if escapecode<>-10 then
	    escape(escapecode);
	  if ioresult=ord(inoerror) then  {media changed; restart}
	    retry_required := true;
	end; {recover}

    until not retry_required;

    if (request=startread) or (request=startwrite) then
      call(fp^.feot, fp)  {call the end of transfer procedure}
    else
      uep^.dvrtemp := ord(inoerror);  {report synchronous errors only once}

  end; {transfer}
$page$

{
  CS80 transfer method request handler
}

procedure CS80io;
  var
    uep: uep_type;
  begin {CS80io}

    ioresult := ord(inoerror);
    uep := addr(unitable^[fp^.funit]);

    if uep^.offline then
      ioresult := ord(znodevice)
    else
      case request of

	clearunit:
	  begin
	    clear_unit(uep);
	    ioresult := uep^.dvrtemp;
	    uep^.dvrtemp := ord(inoerror);  {report synchronous errors only once}
	    if uep=tapebuf_uep then tapebuf_state := undefined;
	  end;

	unitstatus:
	  fp^.fbusy := unit_busy(uep);

	flush:
	  begin
	    if uep=tapebuf_uep then
	      try
		flush_tapebuf;
	      recover
		if escapecode<>-10 then escape(escapecode);
	    uep^.dvrtemp := ord(inoerror);  {report synchronous errors only once}
	  end;

	readbytes, writebytes, startread, startwrite:
	  begin
	    uep^.dvrtemp := ord(inoerror);  {report synchronous errors only once}
	    if Simon_no_DMA(uep) then
	      ioresult := ord(zbaddma)
	    else if uep^.ureportchange and not uep^.umediavalid then
	      ioresult := ord(zmediumchanged)
	    else if (position<0) or (length<0) or (position+length>fp^.fpeof) then
	      ioresult := ord(ieof)
	    else
	      transfer(uep, fp, request, addr(buffer), position+fp^.fileid+uep^.byteoffset, length);
	  end;

	otherwise  {unrecognized request}
	  ioresult := ord(ibadrequest);

      end; {cases}
  end; {CS80io}

end; {CS80dvr}
$page$


{ program CS80init }

import
  tapebuf, loader;

begin {CS80init}
  init_tapebuf;
  markuser;
end. {CS80init}

@


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


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 1437
					      (*

 (c) Copyright Hewlett-Packard Company, 1983.
All rights are reserved.  Copying or other
reproduction of this program except for archival
purposes is prohibited without the prior
written consent of Hewlett-Packard Company.


	    RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the Government
is subject to restrictions as set forth in
paragraph (b) (3) (B) of the Rights in Technical
Data and Computer Software clause in
DAR 7-104.9(a).

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)


$modcal$
$debug off, range off, ovflcheck off$
$stackcheck off, iocheck off$
$ALLOW_PACKED ON$   {JWS 3/31/87}
$copyright 'COPYRIGHT (C) 1983 BY HEWLETT-PACKARD COMPANY'$

$search 'DRVASM', 'DISCHPIB', 'IOLIB:KERNEL'$
{$SEARCH 'DRVASM','DISCHPIB'$}

program CS80init;

module tapebuf;

import
  sysglobals, bkgnd;

export
  const
    tapebuf_maxsize = 1024;
  type
    tapebuf_type = packed array[0..tapebuf_maxsize-1] of byte;
    tapebuf_state_type = (undefined, unmodified, modified);
  var
    tapebuf_ptr: ^tapebuf_type;
    tapebuf_state: tapebuf_state_type;
    tapebuf_uep: uep_type;
    tapebuf_block: integer;
    tapebuf_size: integer;
  procedure init_tapebuf;

implement {tapebuf}

procedure init_tapebuf;
  begin {init_tapebuf}
    if tapebuf_ptr=nil then
      new(tapebuf_ptr);
    tapebuf_state := undefined;
  end; {init_tapebuf}

end; {tapebuf}
$page$

module CS80; {Command Set '80}

import
  sysglobals, bkgnd, discHPIB;

export

  type
    signed16 = -32768..32767;
    signed8  = -128..127;

    unsgn24  = 0..16777215;
    unsgn8   = 0..255;
    unsgn4   = 0..15;

    ct_type =  {controller type field in describe}
      packed record
	b7, b6, b5, b4, b3:  boolean;
	subset80:            boolean;
	multiport:           boolean;
	multiunit:           boolean;
      end;

    sva_type = {single-vector address (6 bytes)}
      packed record
	utb: signed16;  {upper two bytes}
	lfb: integer;   {lower four bytes (all we manage internally)}
      end;

    describe_type = {info returned by describe of unit other than controller}
      packed record
			{CONTROLLER DESCRIPTION FIELD}
	iu: signed16;                   {installed unit word: 1 bit per unit}
	mitr: signed16;                 {max instantaneous xfr rate (Kbytes)}
	ct: ct_type;                    {controller type}
			{UNIT DESCRIPTION FIELD}
	dt: signed8;                    {generic device type}
	dn: unsgn24;                    {device number (6 BCD digits)}
	nbpb: signed16;                 {# of bytes per block}
	nbb: unsgn8;                    {# of blocks which can be buffered}
	rbs: unsgn8;                    {recommended burst size}
	blocktime: signed16;            {block time in microseconds}
	catr: signed16;                 {continuous avg xfr rate (Kbytes)}
	ort: signed16;                  {optimal retry time in centiseconds}
	atp: signed16;                  {access time parameter in centiseconds}
	mif: unsgn8;                    {maximum interleave factor}
	fvb: unsgn8;                    {fixed volume byte: 1 bit/volume}
	rvb: unsgn8;                    {removeable volume byte: 1 bit/vol}
		      {VOLUME DESCRIPTION FIELD}
	maxcadd: unsgn24;               {maximum cylinder address}
	maxhadd: unsgn8;                {maximum head address}
	maxsadd: signed16;              {maximum sector address}
	maxsvadd: sva_type;             {maximum single-vector address}
	currentif: unsgn8;              {current interleave factor}
      end;
$page$

    evu_type = {encoded volume/unit (1 byte) - status & copy commands}
      packed record case integer of
	0: (vvvv: unsgn4;       {volume number}
	    uuuu: unsgn4);      {unit number}
	1: (evu_byte: signed8); {for -1 test}
      end;


    errorbit_type = {error bit assignments in status & status mask}
      (
		  {REJECT ERRORS FIELD}
	{ 0}  eb0,
	{ 1}  eb1,
	{ 2}  channel_parity_error,
	{ 3}  eb3,
	{ 4}  eb4,
	{ 5}  illegal_opcode,
	{ 6}  module_addressing,
	{ 7}  address_bounds,
	{ 8}  parameter_bounds,
	{ 9}  illegal_parameter,
	{10}  message_sequence,
	{11}  eb11,
	{12}  message_length,
	{13}  eb13,
	{14}  eb14,
	{15}  eb15,
		  {FAULT ERRORS FIELD}
	{16}  eb16,
	{17}  cross_unit,
	{18}  eb18,
	{19}  controller_fault,
	{20}  eb20,
	{21}  eb21,
	{22}  unit_fault,
	{23}  eb23,
	{24}  diagnostic_result,
	{25}  eb25,
	{26}  operator_release_required,
	{27}  diagnostic_release_required,
	{28}  internal_maintenance_required,
	{29}  eb29,
	{30}  power_fail,
	{31}  retransmit,
		  {ACCESS ERRORS FIELD}
	{32}  illegal_parallel_operation,
	{33}  uninitialized_media,
	{34}  no_spares_available,
	{35}  not_ready,
	{36}  write_protect,
	{37}  no_data_found,
	{38}  eb38,
	{39}  eb39,
	{40}  unrecoverable_data_overflow,
	{41}  unrecoverable_data,
	{42}  eb42,
	{43}  end_of_file,
	{44}  end_of_volume,
	{45}  eb45,
	{46}  eb46,
	{47}  eb47,
		  {INFORMATION ERRORS FIELD}
	{48}  operator_request,
	{49}  diagnostic_request,
	{50}  internal_maintenance_request,
	{51}  media_wear,
	{52}  latency_induced,
	{53}  eb53,
	{54}  eb54,
	{55}  auto_sparing_invoked,
	{56}  eb56,
	{57}  recoverable_data_overflow,
	{58}  marginal_data,
	{59}  recoverable_data,
	{60}  eb60,
	{61}  maintenance_track_overflow,
	{62}  eb62,
	{63}  eb63
      );


    status_mask_type =
      packed array[errorbit_type] of boolean;


    status_type =
      packed record
			{IDENTIFICATION FIELD}
	current_vu: evu_type;                           {current volume/unit}
	requesting_unit: signed8;                       {unit requesting service}
			{ERROR REPORTING FIELDS}
	errorbits: status_mask_type;
			{PARAMETER FIELD}
	case integer of
	  {positive cases correspond to error bits}
	  -1: (nta: sva_type;                            {new target address}
	       faultlog: integer);                       {fault log}
	  -2: (aaa: sva_type;                            {affected area address}
	       afl: integer);                            {affected field length}
	  17: (uee: packed array[1..6] of signed8);      {units experiencing errors}
	  24: (dor: packed array[1..6] of unsgn8);       {diagnostic results}
	  38: (ta: sva_type);                            {target address}
	  41: (bba: sva_type);                           {bad block address}
      48..50: (urr: packed array[1..6] of signed8);      {units requesting release}
	  58: (btbs: sva_type);                          {block to be spared}
	  59: (rba: sva_type);                           {recoverable block address}
	end; {case}
$page$

    t_type = {'T' parameter in SET_RELEASE}
      (   allow_release_timeout,        {power-on default}
       suppress_release_timeout);


    z_type = {'Z' parameter in SET_RELEASE}
      (disable_auto_release,            {power-on default}
	enable_auto_release);


    CMD_type = {enumerated opcodes for device commands}
(CMDlocate_and_read, CMD1              , CMDlocate_and_wrt , CMD3              ,
 CMDlocate_and_ver , CMD5              , CMDspare_block    , CMD7              ,
 CMDcopy_data      , CMD9              , CMDcold_load_read , CMD11             ,
 CMD12             , CMDrequest_status , CMDrelease        , CMDrelease_denied ,
 CMDset_address_1V , CMDset_address_3V , CMDset_block_disp , CMD19             ,
 CMD20             , CMD21             , CMD22             , CMD23             ,
 CMDset_length     , CMD25             , CMD26             , CMD27             ,
 CMD28             , CMD29             , CMD30             , CMD31             ,
 CMDset_unit_0     , CMDset_unit_1     , CMDset_unit_2     , CMDset_unit_3     ,
 CMDset_unit_4     , CMDset_unit_5     , CMDset_unit_6     , CMDset_unit_7     ,
 CMDset_unit_8     , CMDset_unit_9     , CMDset_unit_10    , CMDset_unit_11    ,
 CMDset_unit_12    , CMDset_unit_13    , CMDset_unit_14    , CMDset_unit_15    ,
 CMDinit_util_NEM  , CMDinit_util_REM  , CMDinit_util_SEM  , CMDinit_diagnostic,
 CMDno_op          , CMDdescribe       , CMD54             , CMDinit_media     ,
 CMDset_options    , CMDset_rps        , CMDset_retry_time , CMDset_release    ,
 CMDset_burst_LBO  , CMDset_burst_ABT  , CMDset_status_mask, CMD63             ,
 CMDset_vol_0      , CMDset_vol_1      , CMDset_vol_2      , CMDset_vol_3      ,
 CMDset_vol_4      , CMDset_vol_5      , CMDset_vol_6      , CMDset_vol_7      ,
 CMDset_retadd_mode, CMDwrite_file_mark, CMDunload         , CMD75             ,
 CMD76             , CMD77             , CMD78             , CMD79             ,
 CMD80             , CMD81             , CMD82             , CMD83             ,
 CMD84             , CMD85             , CMD86             , CMD87             ,
 CMD88             , CMD89             , CMD90             , CMD91             ,
 CMD92             , CMD93             , CMD94             , CMD95             ,
 CMD96             , CMD97             , CMD98             , CMD99             ,
 CMD100            , CMD101            , CMD102            , CMD103            ,
 CMD104            , CMD105            , CMD106            , CMD107            ,
 CMD108            , CMD109            , CMD110            , CMD111            ,
 CMD112            , CMD113            , CMD114            , CMD115            ,
 CMD116            , CMD117            , CMD118            , CMD119            ,
 CMD120            , CMD121            , CMD122            , CMD123            ,
 CMD124            , CMD125            , CMD126            , CMD127            ,
 CMD128 {the field width is forced to 8 bits for packing considerations}  );

  const
    transparent_sec = 18;
    command_sec = 5;
    execution_sec = 14;
    reporting_sec = 16;
$page$

    errorbits_owning_parmfield = {errorbits which set the parameter field}
      [
		  {REJECT ERRORS FIELD}
	{ 0}  eb0,                              {unknown, but assumed}
	{ 1}  eb1,                              {unknown, but assumed}
	{ 3}  eb3,                              {unknown, but assumed}
	{ 4}  eb4,                              {unknown, but assumed}
	{11}  eb11,                             {unknown, but assumed}
	{13}  eb13,                             {unknown, but assumed}
	{14}  eb14,                             {unknown, but assumed}
	{15}  eb15,                             {unknown, but assumed}
		  {FAULT ERRORS FIELD}
	{16}  eb16,                             {unknown, but assumed}
	{17}  cross_unit,
	{18}  eb18,                             {unknown, but assumed}
	{20}  eb20,                             {unknown, but assumed}
	{21}  eb21,                             {unknown, but assumed}
	{23}  eb23,                             {unknown, but assumed}
	{24}  diagnostic_result,
	{25}  eb25,                             {unknown, but assumed}
	{29}  eb29,                             {unknown, but assumed}
		  {ACCESS ERRORS FIELD}
	{38}  eb38,                             {unknown, but assumed}
	{39}  eb39,                             {unknown, but assumed}
	{41}  unrecoverable_data,
	{42}  eb42,                             {unknown, but assumed}
	{45}  eb45,                             {unknown, but assumed}
	{46}  eb46,                             {unknown, but assumed}
	{47}  eb47,                             {unknown, but assumed}
		  {INFORMATION ERRORS FIELD}
	{48}  operator_request,
	{49}  diagnostic_request,
	{50}  internal_maintenance_request,
	{53}  eb53,                             {unknown, but assumed}
	{54}  eb54,                             {unknown, but assumed}
	{56}  eb56,                             {unknown, but assumed}
	{58}  marginal_data,
	{59}  recoverable_data,
	{60}  eb60,                             {unknown, but assumed}
	{62}  eb62,                             {unknown, but assumed}
	{63}  eb63                              {unknown, but assumed}
      ];


    errorbits_requesting_release = {errorbits which request release}
      [
	{48}  operator_request,
	{49}  diagnostic_request,
	{50}  internal_maintenance_request
      ];
$page$

  {
    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 chan_indep_clr  (uep: uep_type): unsgn8;
  function set_unit        (uep: uep_type; unit: unsgn4): unsgn8;
  function set_unitvol     (uep: uep_type): unsgn8;
  function status          (uep: uep_type; var status_bytes: status_type): unsgn8;
  function release         (uep: uep_type; unit: unsgn4): unsgn8;
  function describe        (uep: uep_type; var describe_bytes: describe_type): unsgn8;
  function set_release     (uep: uep_type; t: t_type; z: z_type): unsgn8;
  function set_options     (uep: uep_type; options_byte: unsgn8): unsgn8;
  function set_status_mask (uep: uep_type; status_mask: status_mask_type): unsgn8;


  {
    NOTE: The following routines do not, in themselves, perform a complete
	  transaction. They provide some of the messages necessary for
	  transactions which are broken apart to allow overlapped transfers.
  }
  procedure ICuvalc (uep: uep_type; address, len: integer; cmd: CMD_type);
  function qstat    (uep: uep_type): unsgn8;

implement {CS80}


var
  most_recent_status: status_type;  {for post-mortem diagnostic purposes only!!!}


function qstat(uep: uep_type): unsgn8;
  {
    receive a REPORTING message
    return the QSTAT byte
  }
  var
    qstat_byte: {the 1 byte in the reporting message}
      packed record
	b: unsgn8;
      end;
  begin {qstat}
    HPIBshort_msge_in(uep, reporting_sec, addr(qstat_byte), sizeof(qstat_byte));
    qstat := qstat_byte.b;
  end; {qstat}
$page$

function chan_indep_clr(uep: uep_type): unsgn8;
  {
    issue the CHANNEL_INDEPENDENT_CLEAR command
    return the QSTAT byte
  }
  var
    cic: {the 2 bytes in the channel independent clear command message}
      packed record
	setunit: CMD_type;
	ci_clr: unsgn8;
      end;
  begin {chan_indep_clr}
    cic.setunit := CMD_type(signed16(CMDset_unit_0)+uep^.du);
    cic.ci_clr := 8;
    HPIBshort_msge_out(uep, transparent_sec, addr(cic), sizeof(cic));
    HPIBwait_for_ppol(uep);
    chan_indep_clr := qstat(uep);
  end; {chan_indep_clr}


procedure ICc(uep: uep_type; cmd: CMD_type);
  {
    issue the specified command
  }
  var
    c: {the 1-byte command message}
      packed record
	cmd: CMD_type;
      end;
  begin {ICc}
    c.cmd := cmd;
    HPIBshort_msge_out(uep, command_sec, addr(c), sizeof(c));
  end; {ICc}


procedure ICuc(uep: uep_type; unit: unsgn4; cmd: CMD_type);
  {
    issue the specified SET_UNIT & command
  }
  var
    uc: {the 2-byte command message}
      packed record
	setunit: CMD_type;
	cmd: CMD_type;
      end;
  begin {ICuc}
    uc.setunit := CMD_type(signed16(CMDset_unit_0)+unit);
    uc.cmd := cmd;
    HPIBshort_msge_out(uep, command_sec, addr(uc), sizeof(uc));
  end; {ICuc}
$page$

function set_unit(uep: uep_type; unit: unsgn4): unsgn8;
  {
    issue the SET_UNIT command
    return the QSTAT byte
  }
  begin {set_unit}
    ICc(uep, CMD_type(signed16(CMDset_unit_0)+unit));
    HPIBwait_for_ppol(uep);
    set_unit := qstat(uep);
  end; {set_unit}


function set_unitvol(uep: uep_type): unsgn8;
  {
    issue the SET_UNIT & SET_VOLUME commands
    return the QSTAT byte
  }
  begin {set_unitvol}
    ICuc(uep, uep^.du, CMD_type(signed16(CMDset_vol_0)+uep^.dv));
    HPIBwait_for_ppol(uep);
    set_unitvol := qstat(uep);
  end; {set_unitvol}


function status(uep: uep_type; var status_bytes: status_type): unsgn8;
  {
    issue the REQUEST_STATUS command
    place the 20 bytes of status in the passed variable 'status_bytes'
    return the QSTAT byte
  }
  begin {status}
    ICc(uep, CMDrequest_status);
    HPIBwait_for_ppol(uep);
    HPIBshort_msge_in(uep, execution_sec, addr(status_bytes), sizeof(status_bytes));
    most_recent_status := status_bytes;  {for post-mortem diagnostic purposes only!!!}
    HPIBwait_for_ppol(uep);
    status := qstat(uep);
  end; {status}


function release(uep: uep_type; unit: unsgn4): unsgn8;
  {
    SET_UNIT & issue the RELEASE command
    return the QSTAT byte
  }
  begin {release}
    ICuc(uep, unit, CMDrelease);
    HPIBwait_for_ppol(uep);
    release := qstat(uep);
  end; {release}
$page$

function describe(uep: uep_type; var describe_bytes: describe_type): unsgn8;
  {
    issue the DESCRIBE command
    place the 37 bytes of description in the passed variable 'describe_bytes'
    return the QSTAT byte
  }
  begin {describe}
    ICc(uep, CMDdescribe);
    HPIBwait_for_ppol(uep);
    HPIBshort_msge_in(uep, execution_sec, addr(describe_bytes), sizeof(describe_bytes));
    HPIBwait_for_ppol(uep);
    describe := qstat(uep);
  end; {describe}


function set_release(uep: uep_type; t: t_type; z: z_type): unsgn8;
  var
    sr: {the 3 bytes in the SET_UNIT & SET_RELEASE command message}
      packed record
	setunit: CMD_type;
	setrel: CMD_type;
	Tbit: t_type;
	Zbit: z_type;
	pad: 0..63;
      end;
  begin {set_release}
    sr.setunit := CMDset_unit_15;  {always addressed to the controller}
    sr.setrel  := CMDset_release;
    sr.Tbit    := t;
    sr.Zbit    := z;
    sr.pad     := 0;
    HPIBshort_msge_out(uep, command_sec, addr(sr), sizeof(sr));
    HPIBwait_for_ppol(uep);
    set_release := qstat(uep);
  end; {set_release}


function set_options(uep: uep_type; options_byte: unsgn8): unsgn8;
  var
    so: {the 2 bytes in the SET_OPTIONS command message}
      packed record
	setoptn: CMD_type;
	ob: unsgn8;
      end;
  begin {set_options}
    so.setoptn := CMDset_options;
    so.ob      := options_byte;
    HPIBshort_msge_out(uep, command_sec, addr(so), sizeof(so));
    HPIBwait_for_ppol(uep);
    set_options := qstat(uep);
  end; {set_options}
$page$

function set_status_mask(uep: uep_type; status_mask: status_mask_type): unsgn8;
  var
    ssm: {the 10 bytes in the SET_STATUS_MASK command message}
      packed record
	nop: CMD_type;
	setstsmsk: CMD_type;
	stsmsk: status_mask_type;
      end;
  begin {set_status_mask}
    ssm.nop       := CMDno_op;
    ssm.setstsmsk := CMDset_status_mask;
    ssm.stsmsk    := status_mask;
    HPIBshort_msge_out(uep, command_sec, addr(ssm), sizeof(ssm));
    HPIBwait_for_ppol(uep);
    set_status_mask := qstat(uep);
  end; {set_status_mask}


procedure ICuvalc(uep: uep_type; address, len: integer; cmd: CMD_type);
  {
    issue the following command sequence:
      .  SET_UNIT               (u)
      .  SET_VOLUME             (v)
      .  SET_ADDRESS            (a)
      .  SET_LENGTH             (l)
      .  specified COMMAND      (c)
  }
  var
    uvalc: {the 17 bytes in the command message}
      packed record
	setunit: CMD_type;      {set unit}
	setvol: CMD_type;       {set volume}
	nop1: CMD_type;         {nop}
	setadd: CMD_type;       {set address}
	sva: sva_type;          {single vector address}
	nop2: CMD_type;         {nop}
	setlen: CMD_type;       {set length}
	length: integer;        {length}
	cmd: CMD_type;          {specified command}
      end;
  begin {ICuvalc}
    uvalc.setunit := CMD_type(signed16(CMDset_unit_0)+uep^.du);
    uvalc.setvol  := CMD_type(signed16(CMDset_vol_0)+uep^.dv);
    uvalc.nop1    := CMDno_op;
    uvalc.setadd  := CMDset_address_1V;
    uvalc.sva.utb := 0;
    uvalc.sva.lfb := address;
    uvalc.nop2    := CMDno_op;
    uvalc.setlen  := CMDset_length;
    uvalc.length  := len;
    uvalc.cmd     := cmd;
    HPIBshort_msge_out(uep, command_sec, addr(uvalc), sizeof(uvalc));
  end; {ICuvalc}

end; {CS80}
$page$

module CS80dsr; {Command Set '80 Driver Support Routines}

import
  sysglobals, bkgnd, tapebuf, CS80;

export

  procedure invalidate_stateinfo(uep: uep_type);

  procedure handle_bad_status(uep: uep_type; ok_to_config: boolean; var retry_required: boolean);

  procedure configure(uep: uep_type);

implement {CS80dsr}


procedure invalidate_stateinfo(uep: uep_type);
  var
    lun: unitnum;
    scanner_uep: uep_type;
  begin {invalidate_stateinfo}
    for lun := 1 to maxunit do
      begin
	scanner_uep := addr(unitable^[lun]);
	if (scanner_uep^.letter='Q') and
	   (scanner_uep^.sc = uep^.sc) and
	   (scanner_uep^.ba = uep^.ba) and
	   (scanner_uep^.du = uep^.du)
	   {don't qualify dv because all volumes ARE affected!}
	then  {invalidate all CS80 state info!}
	  begin
	    scanner_uep^.umediavalid := false;  {media possibly changed}
	    scanner_uep^.dvrtemp2 := -1;        {block size possibly changed!}
	    if scanner_uep=tapebuf_uep then
	      tapebuf_state := undefined;
	  end; {if}
      end; {for}
  end; {invalidate_stateinfo}
$page$

procedure handle_bad_status(uep: uep_type; ok_to_config: boolean; 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_bad_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
		      invalidate_stateinfo(uep);
		      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}
$page$

      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 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 and ok_to_config then
	configure(uep);

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

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

  end; {handle_bad_status}


procedure configure(uep: uep_type);

  var
    escape_caught: boolean;
    saved_ureportchange: boolean;
    retry_required: boolean;
    describe_bytes: describe_type;
    bcd_prod_num: {within the describe bytes}
      packed record case integer of
	0: (dn:  unsgn24);
	1: (bcd: packed array[1..6] of unsgn4);
      end;
    fixed_volume_byte:
      packed record case integer of
	0: (b: unsgn8);
	1: (bit: packed array[0..7] of boolean);
      end;
    prod_num: signed16;
    index: signed16;

  const
    masked = true;
    unmasked = false;

    my_status_mask = status_mask_type
      [
		   {REJECT ERRORS FIELD}
      { 0  eb0:                            }  unmasked,
      { 1  eb1:                            }  unmasked,
      { 2  channel_parity_error:           }  unmasked,
      { 3  eb3:                            }  unmasked,
      { 4  eb4:                            }  unmasked,
      { 5  illegal_opcode:                 }  unmasked,
      { 6  module_addressing:              }  unmasked,
      { 7  address_bounds:                 }  unmasked,
      { 8  parameter_bounds:               }  unmasked,
      { 9  illegal_parameter:              }  unmasked,
      {10  message_sequence:               }  unmasked,
      {11  eb11:                           }  unmasked,
      {12  message_length:                 }  unmasked,
      {13  eb13:                           }  unmasked,
      {14  eb14:                           }  unmasked,
      {15  eb15:                           }  unmasked,
		{FAULT ERRORS FIELD}
      {16  eb16:                           }  unmasked,   {unmaskable error}
      {17  cross_unit:                     }  unmasked,   {unmaskable error}
      {18  eb18:                           }  unmasked,   {unmaskable error}
      {19  controller_fault:               }  unmasked,   {unmaskable error}
      {20  eb20:                           }  unmasked,   {unmaskable error}
      {21  eb21:                           }  unmasked,   {unmaskable error}
      {22  unit_fault:                     }  unmasked,   {unmaskable error}
      {23  eb23:                           }  unmasked,   {unmaskable error}
      {24  diagnostic_result:              }  unmasked,   {unmaskable error}
      {25  eb25:                           }  unmasked,   {unmaskable error}
      {26  operator_release_required:      }  unmasked,   {unmaskable error}
      {27  diagnostic_release_required:    }  unmasked,   {unmaskable error}
      {28  internal_maintenance_required:  }  unmasked,   {unmaskable error}
      {29  eb29:                           }  unmasked,   {unmaskable error}
      {30  power_fail:                     }  unmasked,   {unmaskable error}
      {31  retransmit:                     }  unmasked,   {unmaskable error}
		{ACCESS ERRORS FIELD}
      {32  illegal_parallel_operation:     }  unmasked,
      {33  uninitialized_media:            }  unmasked,
      {34  no_spares_available:            }  unmasked,
      {35  not_ready:                      }  unmasked,
      {36  write_protect:                  }  unmasked,
      {37  no_data_found:                  }  unmasked,
      {38  eb38:                           }  unmasked,
      {39  eb39:                           }  unmasked,
      {40  unrecoverable_data_overflow:    }  unmasked,
      {41  unrecoverable_data:             }  unmasked,
      {42  eb42:                           }  unmasked,
      {43  end_of_file:                    }  unmasked,
      {44  end_of_volume:                  }  unmasked,
      {45  eb45:                           }  unmasked,
      {46  eb46:                           }  unmasked,
      {47  eb47:                           }  unmasked,
		{INFORMATION ERRORS FIELD}
      {48  operator_request:               }  unmasked,
      {49  diagnostic_request:             }  unmasked,
      {50  internal_maintenance_request:   }  unmasked,
      {51  media_wear:                     }  masked,
      {52  latency_induced:                }  masked,
      {53  eb53:                           }  masked,
      {54  eb54:                           }  masked,
      {55  auto_sparing_invoked:           }  masked,
      {56  eb56:                           }  masked,
      {57  recoverable_data_overflow:      }  masked,
      {58  marginal_data:                  }  masked,
      {59  recoverable_data:               }  masked,
      {60  eb60:                           }  masked,
      {61  maintenance_track_overflow:     }  masked,
      {62  eb62:                           }  masked,
      {63  eb63:                           }  masked
      ];
$page$

  begin {configure}

    with uep^ do
      begin

	escape_caught := false;
	saved_ureportchange := ureportchange;
	try
	  ureportchange := false;  {NEVER report media change while in configure}

	  {configure the control unit}

	  repeat
	    retry_required := false;
	    if set_release(uep, allow_release_timeout, disable_auto_release)<>0 then
	      handle_bad_status(uep, false, retry_required);
	  until not retry_required;

	  repeat
	    retry_required := false;
	    if set_status_mask(uep, my_status_mask)<>0 then
	      handle_bad_status(uep, false, retry_required);
	  until not retry_required;


	  {configure the required unit}

	  repeat
	    retry_required := false;
	    if chan_indep_clr(uep)<>0 then
	      handle_bad_status(uep, false, retry_required);
	  until not retry_required;

	  repeat
	    retry_required := false;
	    if set_unitvol(uep)<>0 then
	      handle_bad_status(uep, false, retry_required);
	  until not retry_required;

	  repeat
	    retry_required := false;
	    if describe(uep, describe_bytes)<>0 then
	      handle_bad_status(uep, false, retry_required);
	  until not retry_required;

	  with describe_bytes do
	    begin

	      bcd_prod_num.dn := dn;
	      prod_num := 0;
	      for index := 1 to 5 do
		prod_num := prod_num*10+bcd_prod_num.bcd[index];

	      if ( (devid<>prod_num) and (devid<>-1) )  {wrong product number}
		 or ( dt<0 )                            {can't detect media change}
		then ioresc_bkgnd(uep, znodevice);

	      dvrtemp2 := 0;
	      index := nbpb;
	      while (index>0) and not odd(index) do
		begin
		  dvrtemp2 := dvrtemp2+1;
		  index := index div 2;
		end; {while}
	      if index<>1 then  {blocksize isn't a power of 2!}
		dvrtemp2 := -1; {don't panic; might be just no medium present}

	      fixed_volume_byte.b := fvb;  {fixed volume byte}
	      uisfixed := fixed_volume_byte.bit[7-dv];

	      if devid=-1 then  {variable-sized removeable volume; set its size}
		umaxbytes := (maxsvadd.lfb+1)*nbpb;

	      if dt=2 then  {it's a tape}
		repeat  {enable auto-jump sparing}
		  retry_required := false;
		  if set_options(uep, 4)<>0 then
		    handle_bad_status(uep, false, retry_required);
		until not retry_required;

	      repeat
		retry_required := false;
		if set_status_mask(uep, my_status_mask)<>0 then
		  handle_bad_status(uep, false, retry_required);
	      until not retry_required;

	    end; {with}

	recover
	  escape_caught := true;
	ureportchange := saved_ureportchange;
	if escape_caught then
	  escape(escapecode);

      end; {with}

  end; {configure}

end; {CS80dsr}
$page$

module CS80dvr; {Command Set '80 Driver}

import
  sysglobals, asm, mini, drvasm, bkgnd, discHPIB, tapebuf, CS80, CS80dsr;

export
  type
    mp_type =  {media parameters}
      record
	tpm: integer;  {tracks per medium}
	bpt: integer;  {bytes per track}
      end;

  procedure get_letter(uep: uep_type; ident: shortint; var letter: char);

  procedure get_parms(var devtype: byte; var devid: integer;
		      var hardvols: shortint; var mp: mp_type);

  procedure CS80io(fp: fibp; request: amrequesttype;
		   anyvar buffer: window; length, position: integer);

implement {CS80dvr}

var
  CS80_devtype: byte;
  CS80_devid: integer;
  CS80_hardvols: shortint;
  CS80_mp: mp_type;


procedure clear_unit(uep: uep_type);
  begin {clear_unit}
    try
      allocate_bkgnd_info(uep);
      HPIBcheck_sc(uep);
      if HPIBamigo_identify(uep) div 256<>2 then
	ioresc_bkgnd(uep, znodevice);
      configure(uep);
      deallocate_bkgnd_info(uep);
    recover
      abort_bkgnd_process(uep);
  end; {clear_unit}


{
  procedures for CTABLE self-configuration
}

procedure get_parms(var devtype: byte; var devid: integer;
		    var hardvols: shortint; var mp: mp_type);
  begin {get_parms}
    devtype := CS80_devtype;
    devid := CS80_devid;
    hardvols := CS80_hardvols;
    mp := CS80_mp;
  end; {get_parms}
$page$

procedure get_letter(uep: uep_type; ident: shortint; var letter: char);
  var
    retry_required: boolean;
    describe_bytes: describe_type;
    bcd_prod_num: {within the describe bytes}
      packed record case integer of
	0: (dn:  unsgn24);
	1: (bcd: packed array[1..6] of unsgn4);
      end;
    index: signed16;
    volumes_byte: {with the describe bytes}
      packed record case integer of
	0: (vb:  unsgn8);
	1: (bools: packed array[0..7] of boolean);
      end;
  begin {get_letter}
    uep^.ureportchange := false;  {don't report media changes/power-on now!!!}

    repeat  {cmd w/o execution msge avoids escape if in power-on holdoff!}
      retry_required := false;
      if set_unitvol(uep)<>0 then
	handle_bad_status(uep, false, retry_required);  {don't configure!!!}
    until not retry_required;

    repeat
      retry_required := false;
      if describe(uep, describe_bytes)<>0 then
	handle_bad_status(uep, false, retry_required);  {don't configure!!!}
    until not retry_required;

    with describe_bytes do
      begin
	CS80_devtype := dt;

	bcd_prod_num.dn := dn;
	CS80_devid := 0;
	for index := 1 to 5 do
	  CS80_devid := CS80_devid*10+bcd_prod_num.bcd[index];

	volumes_byte.vb := fvb+rvb;
	CS80_hardvols := 0;
	for index := 0 to 7 do
	  CS80_hardvols := CS80_hardvols+ord(volumes_byte.bools[index]);

	with CS80_mp do
	  begin
	    tpm := (maxcadd+1)*(maxhadd+1);   {tracks per medium}
	    if tpm=1  {only single-vector addressing info given}
	      then bpt := (maxsvadd.lfb+1)*nbpb   {bytes per track}
	      else bpt := (maxsadd+1)*nbpb;       {bytes per track}
	  end; {with}

      end; {with}
    letter := 'Q';
  end; {get_letter}
$page$

{
  low-level read/write routines
}

procedure flagit(uep: anyptr);
  begin {flagit}
    bip_type(uep_type(uep)^.dvrtemp)^.xfr_chain_semaphore := false;
  end; {flagit}


procedure xfr(uep: uep_type; request: amrequesttype;
	      bufptr: anyptr; block_address, length: integer);
  var
    command: CMD_type;
    retry_required: boolean;
  begin {xfr}
    allocate_bkgnd_info(uep);
    with bip_type(uep^.dvrtemp)^ do
      try
	if HPIBamigo_identify(uep) div 256<>2 then
	  ioresc_bkgnd(uep, znodevice);

	read_operation := (request=readbytes) or (request=startread);
	if read_operation
	  then command := CMDlocate_and_read
	  else command := CMDlocate_and_wrt;
	ICuvalc(uep, block_address, length, command);

	if length>0 then
	  begin
	    HPIBwait_for_ppol(uep);
	    xfr_chain_semaphore := true;  {merely a flag for xfr busy here}
	    HPIBupon_dxfr_comp(uep, execution_sec, bufptr, length, flagit);
	    while xfr_chain_semaphore do
	      {nothing};
	    if iores<>inoerror then escape(-10);
	  end {if}
	else
	  bdx_pre_eoi := false;

	HPIBwait_for_ppol(uep);
	retry_required := false;
	if qstat(uep)<>0 then
	  handle_bad_status(uep, true, retry_required)
	else if bdx_pre_eoi then
	  ioresc_bkgnd(uep, zcatchall);  {unresolved premature eoi!}

	deallocate_bkgnd_info(uep);
      recover
	abort_bkgnd_process(uep);
    ioresult  := uep^.dvrtemp;
    if (ioresult<>ord(inoerror)) or retry_required then
      escape(-10);
  end; {xfr}
$page$

{
  tapebuf manipulation routines
}

procedure flush_tapebuf;
  var
    escape_caught: boolean;
    saved_ureportchange: boolean;
  begin {flush_tapebuf}
    if tapebuf_state=modified then
      with tapebuf_uep^ do
	begin
	  escape_caught := false;
	  saved_ureportchange := ureportchange;
	  try
	    ureportchange := true;  {don't flush out to different media!}
	    tapebuf_state := undefined;  {while attempting the write}
	    xfr(tapebuf_uep, writebytes, tapebuf_ptr, tapebuf_block, tapebuf_size);
	    tapebuf_state := unmodified;  {write was successful!}
	  recover
	    escape_caught := true;
	  ureportchange := saved_ureportchange;
	  if escape_caught then
	    escape(escapecode);
	end; {with}
  end; {flush_tapebuf}


procedure load_tapebuf(uep: uep_type; request: amrequesttype; block: integer);
  var
    xfr_required: boolean;
  begin {load_tapebuf}
    xfr_required := (tapebuf_uep<>uep) or (tapebuf_block<>block) or (tapebuf_state=undefined);
    if xfr_required then
      begin
	flush_tapebuf;
	tapebuf_uep := uep;
	tapebuf_block := block;
	tapebuf_state := undefined;
      end; {if}

    if not xfr_required        {then confirm media present & unchanged}
       or (request=writebytes) {then confirm media not write protected}
       then
      begin
	xfr(tapebuf_uep, request, nil, tapebuf_block, 0);
	if tapebuf_state=undefined then
	  xfr_required := true;
      end; {if}

    if xfr_required then
      begin
	tapebuf_size := shifted_left(1, uep^.dvrtemp2);
	xfr(tapebuf_uep, readbytes, tapebuf_ptr, tapebuf_block, tapebuf_size);
	tapebuf_state := unmodified;  {read was successful!}
      end; {if}
  end; {load_tapebuf}
$page$

{
  read/write routine

  The new Subset/80 devices coming out which support multiple block
  sizes have forced us to abandon the 2.X driver's essentially never-
  used asynchronous capabilities.  It's simply too difficult to handle
  the media change situation when the media's block size also changes.
  For instance, an asynchronous transfer started on the 256-byte block
  assumption might discover new media formatted to 1024-byte blocks, in
  which case entire transfer would need re-starting, this time using
  tapebuf for buffering.  This situation would not be detected until
  well into the asynchronous transfer chain, at which point we could
  be deadlocked.

  bug 1: 10 june 88 partial sector writes were resulting in i/o errors
	 changes were made to always do full sector/block writes
}

procedure transfer(uep: uep_type; fp: fibp; request: amrequesttype;
		   bufptr: charptr; abs_position, length: integer);
  type
    cp = ^char;
  var
    retry_required: boolean;
    blockpower: shortint;
    blocksize: integer;
    block, intra_block_offset, partial_length: integer;

  begin {transfer}

    repeat
      retry_required := false;

      try
	if uep^.dvrtemp2<0 then  {block size unknown; try to determine}
	  begin
	    clear_unit(uep);
	    ioresult := uep^.dvrtemp;
	    if ioresult<>ord(inoerror) then
	      escape(-10);
	  end; {if}

	blockpower := uep^.dvrtemp2;
	if blockpower<0 then
	  ioresc(znomedium);  {this or block size isn't a power of 2!!!}

	blocksize := shifted_left(1, blockpower);
	if blocksize>tapebuf_maxsize then
	  ioresc(zuninitialized);  {our buffer is too small to handle}

	block := shifted_right(abs_position, blockpower);
	intra_block_offset := mod_power_of_2(abs_position, blockpower);

	if blockpower<=8 then
	  begin {handle a 256-byte or smaller block media}
	    {bug 1 fix is to now just enforce block boundary start}
	    if intra_block_offset<>0 then ioresc(zbadmode);
	    { xfr(uep, request, bufptr, block, length); } {bug 1 fix}
	  end ; {handle a 256-byte or smaller block device}
$page$

	{else} {rdq removed to force all operations thru buffer handeling code }
	  begin {handle buffering for up to tapebuf_maxsize block media}

	    partial_length := blocksize-intra_block_offset;
	    if partial_length>length then partial_length := length;

	    case request of

	      readbytes, startread:
		begin {read operations}

		  if intra_block_offset>0 then  {partial block at front}
		    begin
		      load_tapebuf(uep, readbytes, block);
		      moveleft(tapebuf_ptr^[intra_block_offset], bufptr^, partial_length);
		      bufptr := addr(bufptr^, partial_length);
		      abs_position := abs_position+partial_length;
		      block := shifted_right(abs_position, blockpower);
		      length := length-partial_length;
		    end; {if}

		  if (length>=blocksize)  {one or more blocks remain}
		     or (blockpower<=8) then {bug 1, keep read performance for small blocks  }
		    begin
		      flush_tapebuf;  {because we may travel far, far away}
		      xfr(uep, readbytes, bufptr, block, length);
		    end
		  else if length>0 then  {partial block at back}
		    begin
		      load_tapebuf(uep, readbytes, block);
		      moveleft(tapebuf_ptr^, bufptr^, length);
		    end;

		end; {read operations}

	      writebytes, startwrite:
		begin {write operations}

		  if intra_block_offset>0 then  {partial block at front}
		    begin
		      load_tapebuf(uep, writebytes, block);
		      tapebuf_state := modified;
		      moveleft(bufptr^, tapebuf_ptr^[intra_block_offset], partial_length);
		      bufptr := addr(bufptr^, partial_length);
		      abs_position := abs_position+partial_length;
		      block := shifted_right(abs_position, blockpower);
		      length := length-partial_length;
		    end; {if}

		  partial_length := length-mod_power_of_2(length, blockpower);
		  if partial_length>0 then  {one or more whole blocks remain}
		    begin
		      flush_tapebuf;  {because we may travel far, far away}
		      tapebuf_state := undefined;  {in case this overwrites!}
		      xfr(uep, writebytes, bufptr, block, partial_length);
		      bufptr := addr(bufptr^, partial_length);
		      abs_position := abs_position+partial_length;
		      block := shifted_right(abs_position, blockpower);
		      length := length-partial_length;
		    end; {if}

		  if length>0 then  {a partial block remains}
		    {rdq bug 1 fix, new code to zero pad small sectors instead of
		     the read modify write operation used for big block sizes}
		    if blockpower<=8 then
		    begin { zero pad for blocksize<=256 }
		       moveleft(bufptr^, tapebuf_ptr^, length);
		       tapebuf_ptr^[length] := 0;
		       moveleft(cp(addr(tapebuf_ptr^[length]))^,
				cp(addr(tapebuf_ptr^[length+1]))^,
				blocksize-length-1);
		       xfr(uep, writebytes, tapebuf_ptr, block, blocksize);
		    end
		    else
		    begin
		      load_tapebuf(uep, writebytes, block);
		      tapebuf_state := modified;
		      moveleft(bufptr^, tapebuf_ptr^, length);
		    end; {if}

		  flush_tapebuf;  {so errors get reported in the right place!}

		end; {write operations}

	    end; {case}

	  end; {handle buffering for up to tapebuf_maxsize block media}

      recover
	begin
	  if escapecode<>-10 then
	    escape(escapecode);
	  if ioresult=ord(inoerror) then  {media changed; restart}
	    retry_required := true;
	end; {recover}

    until not retry_required;

    if (request=startread) or (request=startwrite) then
      call(fp^.feot, fp)  {call the end of transfer procedure}
    else
      uep^.dvrtemp := ord(inoerror);  {report synchronous errors only once}

  end; {transfer}
$page$

{
  CS80 transfer method request handler
}

procedure CS80io;
  var
    uep: uep_type;
  begin {CS80io}

    ioresult := ord(inoerror);
    uep := addr(unitable^[fp^.funit]);

    if uep^.offline then
      ioresult := ord(znodevice)
    else
      case request of

	clearunit:
	  begin
	    clear_unit(uep);
	    ioresult := uep^.dvrtemp;
	    uep^.dvrtemp := ord(inoerror);  {report synchronous errors only once}
	    if uep=tapebuf_uep then tapebuf_state := undefined;
	  end;

	unitstatus:
	  fp^.fbusy := unit_busy(uep);

	flush:
	  begin
	    if uep=tapebuf_uep then
	      try
		flush_tapebuf;
	      recover
		if escapecode<>-10 then escape(escapecode);
	    uep^.dvrtemp := ord(inoerror);  {report synchronous errors only once}
	  end;

	readbytes, writebytes, startread, startwrite:
	  begin
	    uep^.dvrtemp := ord(inoerror);  {report synchronous errors only once}
	    if Simon_no_DMA(uep) then
	      ioresult := ord(zbaddma)
	    else if uep^.ureportchange and not uep^.umediavalid then
	      ioresult := ord(zmediumchanged)
	    else if (position<0) or (length<0) or (position+length>fp^.fpeof) then
	      ioresult := ord(ieof)
	    else
	      transfer(uep, fp, request, addr(buffer), position+fp^.fileid+uep^.byteoffset, length);
	  end;

	otherwise  {unrecognized request}
	  ioresult := ord(ibadrequest);

      end; {cases}
  end; {CS80io}

end; {CS80dvr}
$page$


{ program CS80init }

import
  tapebuf, loader;

begin {CS80init}
  init_tapebuf;
  markuser;
end. {CS80init}

@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@@


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


54.2
log
@
pws2rcs automatic delta on Wed Aug 21 09:35:48 MDT 1991
@
text
@d1 1437
@


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@a0 1437
					      (*

 (c) Copyright Hewlett-Packard Company, 1983.
All rights are reserved.  Copying or other
reproduction of this program except for archival
purposes is prohibited without the prior
written consent of Hewlett-Packard Company.


	    RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the Government
is subject to restrictions as set forth in
paragraph (b) (3) (B) of the Rights in Technical
Data and Computer Software clause in
DAR 7-104.9(a).

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)


$modcal$
$debug off, range off, ovflcheck off$
$stackcheck off, iocheck off$
$ALLOW_PACKED ON$   {JWS 3/31/87}
$copyright 'COPYRIGHT (C) 1983 BY HEWLETT-PACKARD COMPANY'$

$search 'DRVASM', 'DISCHPIB', 'IOLIB:KERNEL'$
{$SEARCH 'DRVASM','DISCHPIB'$}

program CS80init;

module tapebuf;

import
  sysglobals, bkgnd;

export
  const
    tapebuf_maxsize = 1024;
  type
    tapebuf_type = packed array[0..tapebuf_maxsize-1] of byte;
    tapebuf_state_type = (undefined, unmodified, modified);
  var
    tapebuf_ptr: ^tapebuf_type;
    tapebuf_state: tapebuf_state_type;
    tapebuf_uep: uep_type;
    tapebuf_block: integer;
    tapebuf_size: integer;
  procedure init_tapebuf;

implement {tapebuf}

procedure init_tapebuf;
  begin {init_tapebuf}
    if tapebuf_ptr=nil then
      new(tapebuf_ptr);
    tapebuf_state := undefined;
  end; {init_tapebuf}

end; {tapebuf}
$page$

module CS80; {Command Set '80}

import
  sysglobals, bkgnd, discHPIB;

export

  type
    signed16 = -32768..32767;
    signed8  = -128..127;

    unsgn24  = 0..16777215;
    unsgn8   = 0..255;
    unsgn4   = 0..15;

    ct_type =  {controller type field in describe}
      packed record
	b7, b6, b5, b4, b3:  boolean;
	subset80:            boolean;
	multiport:           boolean;
	multiunit:           boolean;
      end;

    sva_type = {single-vector address (6 bytes)}
      packed record
	utb: signed16;  {upper two bytes}
	lfb: integer;   {lower four bytes (all we manage internally)}
      end;

    describe_type = {info returned by describe of unit other than controller}
      packed record
			{CONTROLLER DESCRIPTION FIELD}
	iu: signed16;                   {installed unit word: 1 bit per unit}
	mitr: signed16;                 {max instantaneous xfr rate (Kbytes)}
	ct: ct_type;                    {controller type}
			{UNIT DESCRIPTION FIELD}
	dt: signed8;                    {generic device type}
	dn: unsgn24;                    {device number (6 BCD digits)}
	nbpb: signed16;                 {# of bytes per block}
	nbb: unsgn8;                    {# of blocks which can be buffered}
	rbs: unsgn8;                    {recommended burst size}
	blocktime: signed16;            {block time in microseconds}
	catr: signed16;                 {continuous avg xfr rate (Kbytes)}
	ort: signed16;                  {optimal retry time in centiseconds}
	atp: signed16;                  {access time parameter in centiseconds}
	mif: unsgn8;                    {maximum interleave factor}
	fvb: unsgn8;                    {fixed volume byte: 1 bit/volume}
	rvb: unsgn8;                    {removeable volume byte: 1 bit/vol}
		      {VOLUME DESCRIPTION FIELD}
	maxcadd: unsgn24;               {maximum cylinder address}
	maxhadd: unsgn8;                {maximum head address}
	maxsadd: signed16;              {maximum sector address}
	maxsvadd: sva_type;             {maximum single-vector address}
	currentif: unsgn8;              {current interleave factor}
      end;
$page$

    evu_type = {encoded volume/unit (1 byte) - status & copy commands}
      packed record case integer of
	0: (vvvv: unsgn4;       {volume number}
	    uuuu: unsgn4);      {unit number}
	1: (evu_byte: signed8); {for -1 test}
      end;


    errorbit_type = {error bit assignments in status & status mask}
      (
		  {REJECT ERRORS FIELD}
	{ 0}  eb0,
	{ 1}  eb1,
	{ 2}  channel_parity_error,
	{ 3}  eb3,
	{ 4}  eb4,
	{ 5}  illegal_opcode,
	{ 6}  module_addressing,
	{ 7}  address_bounds,
	{ 8}  parameter_bounds,
	{ 9}  illegal_parameter,
	{10}  message_sequence,
	{11}  eb11,
	{12}  message_length,
	{13}  eb13,
	{14}  eb14,
	{15}  eb15,
		  {FAULT ERRORS FIELD}
	{16}  eb16,
	{17}  cross_unit,
	{18}  eb18,
	{19}  controller_fault,
	{20}  eb20,
	{21}  eb21,
	{22}  unit_fault,
	{23}  eb23,
	{24}  diagnostic_result,
	{25}  eb25,
	{26}  operator_release_required,
	{27}  diagnostic_release_required,
	{28}  internal_maintenance_required,
	{29}  eb29,
	{30}  power_fail,
	{31}  retransmit,
		  {ACCESS ERRORS FIELD}
	{32}  illegal_parallel_operation,
	{33}  uninitialized_media,
	{34}  no_spares_available,
	{35}  not_ready,
	{36}  write_protect,
	{37}  no_data_found,
	{38}  eb38,
	{39}  eb39,
	{40}  unrecoverable_data_overflow,
	{41}  unrecoverable_data,
	{42}  eb42,
	{43}  end_of_file,
	{44}  end_of_volume,
	{45}  eb45,
	{46}  eb46,
	{47}  eb47,
		  {INFORMATION ERRORS FIELD}
	{48}  operator_request,
	{49}  diagnostic_request,
	{50}  internal_maintenance_request,
	{51}  media_wear,
	{52}  latency_induced,
	{53}  eb53,
	{54}  eb54,
	{55}  auto_sparing_invoked,
	{56}  eb56,
	{57}  recoverable_data_overflow,
	{58}  marginal_data,
	{59}  recoverable_data,
	{60}  eb60,
	{61}  maintenance_track_overflow,
	{62}  eb62,
	{63}  eb63
      );


    status_mask_type =
      packed array[errorbit_type] of boolean;


    status_type =
      packed record
			{IDENTIFICATION FIELD}
	current_vu: evu_type;                           {current volume/unit}
	requesting_unit: signed8;                       {unit requesting service}
			{ERROR REPORTING FIELDS}
	errorbits: status_mask_type;
			{PARAMETER FIELD}
	case integer of
	  {positive cases correspond to error bits}
	  -1: (nta: sva_type;                            {new target address}
	       faultlog: integer);                       {fault log}
	  -2: (aaa: sva_type;                            {affected area address}
	       afl: integer);                            {affected field length}
	  17: (uee: packed array[1..6] of signed8);      {units experiencing errors}
	  24: (dor: packed array[1..6] of unsgn8);       {diagnostic results}
	  38: (ta: sva_type);                            {target address}
	  41: (bba: sva_type);                           {bad block address}
      48..50: (urr: packed array[1..6] of signed8);      {units requesting release}
	  58: (btbs: sva_type);                          {block to be spared}
	  59: (rba: sva_type);                           {recoverable block address}
	end; {case}
$page$

    t_type = {'T' parameter in SET_RELEASE}
      (   allow_release_timeout,        {power-on default}
       suppress_release_timeout);


    z_type = {'Z' parameter in SET_RELEASE}
      (disable_auto_release,            {power-on default}
	enable_auto_release);


    CMD_type = {enumerated opcodes for device commands}
(CMDlocate_and_read, CMD1              , CMDlocate_and_wrt , CMD3              ,
 CMDlocate_and_ver , CMD5              , CMDspare_block    , CMD7              ,
 CMDcopy_data      , CMD9              , CMDcold_load_read , CMD11             ,
 CMD12             , CMDrequest_status , CMDrelease        , CMDrelease_denied ,
 CMDset_address_1V , CMDset_address_3V , CMDset_block_disp , CMD19             ,
 CMD20             , CMD21             , CMD22             , CMD23             ,
 CMDset_length     , CMD25             , CMD26             , CMD27             ,
 CMD28             , CMD29             , CMD30             , CMD31             ,
 CMDset_unit_0     , CMDset_unit_1     , CMDset_unit_2     , CMDset_unit_3     ,
 CMDset_unit_4     , CMDset_unit_5     , CMDset_unit_6     , CMDset_unit_7     ,
 CMDset_unit_8     , CMDset_unit_9     , CMDset_unit_10    , CMDset_unit_11    ,
 CMDset_unit_12    , CMDset_unit_13    , CMDset_unit_14    , CMDset_unit_15    ,
 CMDinit_util_NEM  , CMDinit_util_REM  , CMDinit_util_SEM  , CMDinit_diagnostic,
 CMDno_op          , CMDdescribe       , CMD54             , CMDinit_media     ,
 CMDset_options    , CMDset_rps        , CMDset_retry_time , CMDset_release    ,
 CMDset_burst_LBO  , CMDset_burst_ABT  , CMDset_status_mask, CMD63             ,
 CMDset_vol_0      , CMDset_vol_1      , CMDset_vol_2      , CMDset_vol_3      ,
 CMDset_vol_4      , CMDset_vol_5      , CMDset_vol_6      , CMDset_vol_7      ,
 CMDset_retadd_mode, CMDwrite_file_mark, CMDunload         , CMD75             ,
 CMD76             , CMD77             , CMD78             , CMD79             ,
 CMD80             , CMD81             , CMD82             , CMD83             ,
 CMD84             , CMD85             , CMD86             , CMD87             ,
 CMD88             , CMD89             , CMD90             , CMD91             ,
 CMD92             , CMD93             , CMD94             , CMD95             ,
 CMD96             , CMD97             , CMD98             , CMD99             ,
 CMD100            , CMD101            , CMD102            , CMD103            ,
 CMD104            , CMD105            , CMD106            , CMD107            ,
 CMD108            , CMD109            , CMD110            , CMD111            ,
 CMD112            , CMD113            , CMD114            , CMD115            ,
 CMD116            , CMD117            , CMD118            , CMD119            ,
 CMD120            , CMD121            , CMD122            , CMD123            ,
 CMD124            , CMD125            , CMD126            , CMD127            ,
 CMD128 {the field width is forced to 8 bits for packing considerations}  );

  const
    transparent_sec = 18;
    command_sec = 5;
    execution_sec = 14;
    reporting_sec = 16;
$page$

    errorbits_owning_parmfield = {errorbits which set the parameter field}
      [
		  {REJECT ERRORS FIELD}
	{ 0}  eb0,                              {unknown, but assumed}
	{ 1}  eb1,                              {unknown, but assumed}
	{ 3}  eb3,                              {unknown, but assumed}
	{ 4}  eb4,                              {unknown, but assumed}
	{11}  eb11,                             {unknown, but assumed}
	{13}  eb13,                             {unknown, but assumed}
	{14}  eb14,                             {unknown, but assumed}
	{15}  eb15,                             {unknown, but assumed}
		  {FAULT ERRORS FIELD}
	{16}  eb16,                             {unknown, but assumed}
	{17}  cross_unit,
	{18}  eb18,                             {unknown, but assumed}
	{20}  eb20,                             {unknown, but assumed}
	{21}  eb21,                             {unknown, but assumed}
	{23}  eb23,                             {unknown, but assumed}
	{24}  diagnostic_result,
	{25}  eb25,                             {unknown, but assumed}
	{29}  eb29,                             {unknown, but assumed}
		  {ACCESS ERRORS FIELD}
	{38}  eb38,                             {unknown, but assumed}
	{39}  eb39,                             {unknown, but assumed}
	{41}  unrecoverable_data,
	{42}  eb42,                             {unknown, but assumed}
	{45}  eb45,                             {unknown, but assumed}
	{46}  eb46,                             {unknown, but assumed}
	{47}  eb47,                             {unknown, but assumed}
		  {INFORMATION ERRORS FIELD}
	{48}  operator_request,
	{49}  diagnostic_request,
	{50}  internal_maintenance_request,
	{53}  eb53,                             {unknown, but assumed}
	{54}  eb54,                             {unknown, but assumed}
	{56}  eb56,                             {unknown, but assumed}
	{58}  marginal_data,
	{59}  recoverable_data,
	{60}  eb60,                             {unknown, but assumed}
	{62}  eb62,                             {unknown, but assumed}
	{63}  eb63                              {unknown, but assumed}
      ];


    errorbits_requesting_release = {errorbits which request release}
      [
	{48}  operator_request,
	{49}  diagnostic_request,
	{50}  internal_maintenance_request
      ];
$page$

  {
    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 chan_indep_clr  (uep: uep_type): unsgn8;
  function set_unit        (uep: uep_type; unit: unsgn4): unsgn8;
  function set_unitvol     (uep: uep_type): unsgn8;
  function status          (uep: uep_type; var status_bytes: status_type): unsgn8;
  function release         (uep: uep_type; unit: unsgn4): unsgn8;
  function describe        (uep: uep_type; var describe_bytes: describe_type): unsgn8;
  function set_release     (uep: uep_type; t: t_type; z: z_type): unsgn8;
  function set_options     (uep: uep_type; options_byte: unsgn8): unsgn8;
  function set_status_mask (uep: uep_type; status_mask: status_mask_type): unsgn8;


  {
    NOTE: The following routines do not, in themselves, perform a complete
	  transaction. They provide some of the messages necessary for
	  transactions which are broken apart to allow overlapped transfers.
  }
  procedure ICuvalc (uep: uep_type; address, len: integer; cmd: CMD_type);
  function qstat    (uep: uep_type): unsgn8;

implement {CS80}


var
  most_recent_status: status_type;  {for post-mortem diagnostic purposes only!!!}


function qstat(uep: uep_type): unsgn8;
  {
    receive a REPORTING message
    return the QSTAT byte
  }
  var
    qstat_byte: {the 1 byte in the reporting message}
      packed record
	b: unsgn8;
      end;
  begin {qstat}
    HPIBshort_msge_in(uep, reporting_sec, addr(qstat_byte), sizeof(qstat_byte));
    qstat := qstat_byte.b;
  end; {qstat}
$page$

function chan_indep_clr(uep: uep_type): unsgn8;
  {
    issue the CHANNEL_INDEPENDENT_CLEAR command
    return the QSTAT byte
  }
  var
    cic: {the 2 bytes in the channel independent clear command message}
      packed record
	setunit: CMD_type;
	ci_clr: unsgn8;
      end;
  begin {chan_indep_clr}
    cic.setunit := CMD_type(signed16(CMDset_unit_0)+uep^.du);
    cic.ci_clr := 8;
    HPIBshort_msge_out(uep, transparent_sec, addr(cic), sizeof(cic));
    HPIBwait_for_ppol(uep);
    chan_indep_clr := qstat(uep);
  end; {chan_indep_clr}


procedure ICc(uep: uep_type; cmd: CMD_type);
  {
    issue the specified command
  }
  var
    c: {the 1-byte command message}
      packed record
	cmd: CMD_type;
      end;
  begin {ICc}
    c.cmd := cmd;
    HPIBshort_msge_out(uep, command_sec, addr(c), sizeof(c));
  end; {ICc}


procedure ICuc(uep: uep_type; unit: unsgn4; cmd: CMD_type);
  {
    issue the specified SET_UNIT & command
  }
  var
    uc: {the 2-byte command message}
      packed record
	setunit: CMD_type;
	cmd: CMD_type;
      end;
  begin {ICuc}
    uc.setunit := CMD_type(signed16(CMDset_unit_0)+unit);
    uc.cmd := cmd;
    HPIBshort_msge_out(uep, command_sec, addr(uc), sizeof(uc));
  end; {ICuc}
$page$

function set_unit(uep: uep_type; unit: unsgn4): unsgn8;
  {
    issue the SET_UNIT command
    return the QSTAT byte
  }
  begin {set_unit}
    ICc(uep, CMD_type(signed16(CMDset_unit_0)+unit));
    HPIBwait_for_ppol(uep);
    set_unit := qstat(uep);
  end; {set_unit}


function set_unitvol(uep: uep_type): unsgn8;
  {
    issue the SET_UNIT & SET_VOLUME commands
    return the QSTAT byte
  }
  begin {set_unitvol}
    ICuc(uep, uep^.du, CMD_type(signed16(CMDset_vol_0)+uep^.dv));
    HPIBwait_for_ppol(uep);
    set_unitvol := qstat(uep);
  end; {set_unitvol}


function status(uep: uep_type; var status_bytes: status_type): unsgn8;
  {
    issue the REQUEST_STATUS command
    place the 20 bytes of status in the passed variable 'status_bytes'
    return the QSTAT byte
  }
  begin {status}
    ICc(uep, CMDrequest_status);
    HPIBwait_for_ppol(uep);
    HPIBshort_msge_in(uep, execution_sec, addr(status_bytes), sizeof(status_bytes));
    most_recent_status := status_bytes;  {for post-mortem diagnostic purposes only!!!}
    HPIBwait_for_ppol(uep);
    status := qstat(uep);
  end; {status}


function release(uep: uep_type; unit: unsgn4): unsgn8;
  {
    SET_UNIT & issue the RELEASE command
    return the QSTAT byte
  }
  begin {release}
    ICuc(uep, unit, CMDrelease);
    HPIBwait_for_ppol(uep);
    release := qstat(uep);
  end; {release}
$page$

function describe(uep: uep_type; var describe_bytes: describe_type): unsgn8;
  {
    issue the DESCRIBE command
    place the 37 bytes of description in the passed variable 'describe_bytes'
    return the QSTAT byte
  }
  begin {describe}
    ICc(uep, CMDdescribe);
    HPIBwait_for_ppol(uep);
    HPIBshort_msge_in(uep, execution_sec, addr(describe_bytes), sizeof(describe_bytes));
    HPIBwait_for_ppol(uep);
    describe := qstat(uep);
  end; {describe}


function set_release(uep: uep_type; t: t_type; z: z_type): unsgn8;
  var
    sr: {the 3 bytes in the SET_UNIT & SET_RELEASE command message}
      packed record
	setunit: CMD_type;
	setrel: CMD_type;
	Tbit: t_type;
	Zbit: z_type;
	pad: 0..63;
      end;
  begin {set_release}
    sr.setunit := CMDset_unit_15;  {always addressed to the controller}
    sr.setrel  := CMDset_release;
    sr.Tbit    := t;
    sr.Zbit    := z;
    sr.pad     := 0;
    HPIBshort_msge_out(uep, command_sec, addr(sr), sizeof(sr));
    HPIBwait_for_ppol(uep);
    set_release := qstat(uep);
  end; {set_release}


function set_options(uep: uep_type; options_byte: unsgn8): unsgn8;
  var
    so: {the 2 bytes in the SET_OPTIONS command message}
      packed record
	setoptn: CMD_type;
	ob: unsgn8;
      end;
  begin {set_options}
    so.setoptn := CMDset_options;
    so.ob      := options_byte;
    HPIBshort_msge_out(uep, command_sec, addr(so), sizeof(so));
    HPIBwait_for_ppol(uep);
    set_options := qstat(uep);
  end; {set_options}
$page$

function set_status_mask(uep: uep_type; status_mask: status_mask_type): unsgn8;
  var
    ssm: {the 10 bytes in the SET_STATUS_MASK command message}
      packed record
	nop: CMD_type;
	setstsmsk: CMD_type;
	stsmsk: status_mask_type;
      end;
  begin {set_status_mask}
    ssm.nop       := CMDno_op;
    ssm.setstsmsk := CMDset_status_mask;
    ssm.stsmsk    := status_mask;
    HPIBshort_msge_out(uep, command_sec, addr(ssm), sizeof(ssm));
    HPIBwait_for_ppol(uep);
    set_status_mask := qstat(uep);
  end; {set_status_mask}


procedure ICuvalc(uep: uep_type; address, len: integer; cmd: CMD_type);
  {
    issue the following command sequence:
      .  SET_UNIT               (u)
      .  SET_VOLUME             (v)
      .  SET_ADDRESS            (a)
      .  SET_LENGTH             (l)
      .  specified COMMAND      (c)
  }
  var
    uvalc: {the 17 bytes in the command message}
      packed record
	setunit: CMD_type;      {set unit}
	setvol: CMD_type;       {set volume}
	nop1: CMD_type;         {nop}
	setadd: CMD_type;       {set address}
	sva: sva_type;          {single vector address}
	nop2: CMD_type;         {nop}
	setlen: CMD_type;       {set length}
	length: integer;        {length}
	cmd: CMD_type;          {specified command}
      end;
  begin {ICuvalc}
    uvalc.setunit := CMD_type(signed16(CMDset_unit_0)+uep^.du);
    uvalc.setvol  := CMD_type(signed16(CMDset_vol_0)+uep^.dv);
    uvalc.nop1    := CMDno_op;
    uvalc.setadd  := CMDset_address_1V;
    uvalc.sva.utb := 0;
    uvalc.sva.lfb := address;
    uvalc.nop2    := CMDno_op;
    uvalc.setlen  := CMDset_length;
    uvalc.length  := len;
    uvalc.cmd     := cmd;
    HPIBshort_msge_out(uep, command_sec, addr(uvalc), sizeof(uvalc));
  end; {ICuvalc}

end; {CS80}
$page$

module CS80dsr; {Command Set '80 Driver Support Routines}

import
  sysglobals, bkgnd, tapebuf, CS80;

export

  procedure invalidate_stateinfo(uep: uep_type);

  procedure handle_bad_status(uep: uep_type; ok_to_config: boolean; var retry_required: boolean);

  procedure configure(uep: uep_type);

implement {CS80dsr}


procedure invalidate_stateinfo(uep: uep_type);
  var
    lun: unitnum;
    scanner_uep: uep_type;
  begin {invalidate_stateinfo}
    for lun := 1 to maxunit do
      begin
	scanner_uep := addr(unitable^[lun]);
	if (scanner_uep^.letter='Q') and
	   (scanner_uep^.sc = uep^.sc) and
	   (scanner_uep^.ba = uep^.ba) and
	   (scanner_uep^.du = uep^.du)
	   {don't qualify dv because all volumes ARE affected!}
	then  {invalidate all CS80 state info!}
	  begin
	    scanner_uep^.umediavalid := false;  {media possibly changed}
	    scanner_uep^.dvrtemp2 := -1;        {block size possibly changed!}
	    if scanner_uep=tapebuf_uep then
	      tapebuf_state := undefined;
	  end; {if}
      end; {for}
  end; {invalidate_stateinfo}
$page$

procedure handle_bad_status(uep: uep_type; ok_to_config: boolean; 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_bad_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
		      invalidate_stateinfo(uep);
		      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}
$page$

      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 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 and ok_to_config then
	configure(uep);

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

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

  end; {handle_bad_status}


procedure configure(uep: uep_type);

  var
    escape_caught: boolean;
    saved_ureportchange: boolean;
    retry_required: boolean;
    describe_bytes: describe_type;
    bcd_prod_num: {within the describe bytes}
      packed record case integer of
	0: (dn:  unsgn24);
	1: (bcd: packed array[1..6] of unsgn4);
      end;
    fixed_volume_byte:
      packed record case integer of
	0: (b: unsgn8);
	1: (bit: packed array[0..7] of boolean);
      end;
    prod_num: signed16;
    index: signed16;

  const
    masked = true;
    unmasked = false;

    my_status_mask = status_mask_type
      [
		   {REJECT ERRORS FIELD}
      { 0  eb0:                            }  unmasked,
      { 1  eb1:                            }  unmasked,
      { 2  channel_parity_error:           }  unmasked,
      { 3  eb3:                            }  unmasked,
      { 4  eb4:                            }  unmasked,
      { 5  illegal_opcode:                 }  unmasked,
      { 6  module_addressing:              }  unmasked,
      { 7  address_bounds:                 }  unmasked,
      { 8  parameter_bounds:               }  unmasked,
      { 9  illegal_parameter:              }  unmasked,
      {10  message_sequence:               }  unmasked,
      {11  eb11:                           }  unmasked,
      {12  message_length:                 }  unmasked,
      {13  eb13:                           }  unmasked,
      {14  eb14:                           }  unmasked,
      {15  eb15:                           }  unmasked,
		{FAULT ERRORS FIELD}
      {16  eb16:                           }  unmasked,   {unmaskable error}
      {17  cross_unit:                     }  unmasked,   {unmaskable error}
      {18  eb18:                           }  unmasked,   {unmaskable error}
      {19  controller_fault:               }  unmasked,   {unmaskable error}
      {20  eb20:                           }  unmasked,   {unmaskable error}
      {21  eb21:                           }  unmasked,   {unmaskable error}
      {22  unit_fault:                     }  unmasked,   {unmaskable error}
      {23  eb23:                           }  unmasked,   {unmaskable error}
      {24  diagnostic_result:              }  unmasked,   {unmaskable error}
      {25  eb25:                           }  unmasked,   {unmaskable error}
      {26  operator_release_required:      }  unmasked,   {unmaskable error}
      {27  diagnostic_release_required:    }  unmasked,   {unmaskable error}
      {28  internal_maintenance_required:  }  unmasked,   {unmaskable error}
      {29  eb29:                           }  unmasked,   {unmaskable error}
      {30  power_fail:                     }  unmasked,   {unmaskable error}
      {31  retransmit:                     }  unmasked,   {unmaskable error}
		{ACCESS ERRORS FIELD}
      {32  illegal_parallel_operation:     }  unmasked,
      {33  uninitialized_media:            }  unmasked,
      {34  no_spares_available:            }  unmasked,
      {35  not_ready:                      }  unmasked,
      {36  write_protect:                  }  unmasked,
      {37  no_data_found:                  }  unmasked,
      {38  eb38:                           }  unmasked,
      {39  eb39:                           }  unmasked,
      {40  unrecoverable_data_overflow:    }  unmasked,
      {41  unrecoverable_data:             }  unmasked,
      {42  eb42:                           }  unmasked,
      {43  end_of_file:                    }  unmasked,
      {44  end_of_volume:                  }  unmasked,
      {45  eb45:                           }  unmasked,
      {46  eb46:                           }  unmasked,
      {47  eb47:                           }  unmasked,
		{INFORMATION ERRORS FIELD}
      {48  operator_request:               }  unmasked,
      {49  diagnostic_request:             }  unmasked,
      {50  internal_maintenance_request:   }  unmasked,
      {51  media_wear:                     }  masked,
      {52  latency_induced:                }  masked,
      {53  eb53:                           }  masked,
      {54  eb54:                           }  masked,
      {55  auto_sparing_invoked:           }  masked,
      {56  eb56:                           }  masked,
      {57  recoverable_data_overflow:      }  masked,
      {58  marginal_data:                  }  masked,
      {59  recoverable_data:               }  masked,
      {60  eb60:                           }  masked,
      {61  maintenance_track_overflow:     }  masked,
      {62  eb62:                           }  masked,
      {63  eb63:                           }  masked
      ];
$page$

  begin {configure}

    with uep^ do
      begin

	escape_caught := false;
	saved_ureportchange := ureportchange;
	try
	  ureportchange := false;  {NEVER report media change while in configure}

	  {configure the control unit}

	  repeat
	    retry_required := false;
	    if set_release(uep, allow_release_timeout, disable_auto_release)<>0 then
	      handle_bad_status(uep, false, retry_required);
	  until not retry_required;

	  repeat
	    retry_required := false;
	    if set_status_mask(uep, my_status_mask)<>0 then
	      handle_bad_status(uep, false, retry_required);
	  until not retry_required;


	  {configure the required unit}

	  repeat
	    retry_required := false;
	    if chan_indep_clr(uep)<>0 then
	      handle_bad_status(uep, false, retry_required);
	  until not retry_required;

	  repeat
	    retry_required := false;
	    if set_unitvol(uep)<>0 then
	      handle_bad_status(uep, false, retry_required);
	  until not retry_required;

	  repeat
	    retry_required := false;
	    if describe(uep, describe_bytes)<>0 then
	      handle_bad_status(uep, false, retry_required);
	  until not retry_required;

	  with describe_bytes do
	    begin

	      bcd_prod_num.dn := dn;
	      prod_num := 0;
	      for index := 1 to 5 do
		prod_num := prod_num*10+bcd_prod_num.bcd[index];

	      if ( (devid<>prod_num) and (devid<>-1) )  {wrong product number}
		 or ( dt<0 )                            {can't detect media change}
		then ioresc_bkgnd(uep, znodevice);

	      dvrtemp2 := 0;
	      index := nbpb;
	      while (index>0) and not odd(index) do
		begin
		  dvrtemp2 := dvrtemp2+1;
		  index := index div 2;
		end; {while}
	      if index<>1 then  {blocksize isn't a power of 2!}
		dvrtemp2 := -1; {don't panic; might be just no medium present}

	      fixed_volume_byte.b := fvb;  {fixed volume byte}
	      uisfixed := fixed_volume_byte.bit[7-dv];

	      if devid=-1 then  {variable-sized removeable volume; set its size}
		umaxbytes := (maxsvadd.lfb+1)*nbpb;

	      if dt=2 then  {it's a tape}
		repeat  {enable auto-jump sparing}
		  retry_required := false;
		  if set_options(uep, 4)<>0 then
		    handle_bad_status(uep, false, retry_required);
		until not retry_required;

	      repeat
		retry_required := false;
		if set_status_mask(uep, my_status_mask)<>0 then
		  handle_bad_status(uep, false, retry_required);
	      until not retry_required;

	    end; {with}

	recover
	  escape_caught := true;
	ureportchange := saved_ureportchange;
	if escape_caught then
	  escape(escapecode);

      end; {with}

  end; {configure}

end; {CS80dsr}
$page$

module CS80dvr; {Command Set '80 Driver}

import
  sysglobals, asm, mini, drvasm, bkgnd, discHPIB, tapebuf, CS80, CS80dsr;

export
  type
    mp_type =  {media parameters}
      record
	tpm: integer;  {tracks per medium}
	bpt: integer;  {bytes per track}
      end;

  procedure get_letter(uep: uep_type; ident: shortint; var letter: char);

  procedure get_parms(var devtype: byte; var devid: integer;
		      var hardvols: shortint; var mp: mp_type);

  procedure CS80io(fp: fibp; request: amrequesttype;
		   anyvar buffer: window; length, position: integer);

implement {CS80dvr}

var
  CS80_devtype: byte;
  CS80_devid: integer;
  CS80_hardvols: shortint;
  CS80_mp: mp_type;


procedure clear_unit(uep: uep_type);
  begin {clear_unit}
    try
      allocate_bkgnd_info(uep);
      HPIBcheck_sc(uep);
      if HPIBamigo_identify(uep) div 256<>2 then
	ioresc_bkgnd(uep, znodevice);
      configure(uep);
      deallocate_bkgnd_info(uep);
    recover
      abort_bkgnd_process(uep);
  end; {clear_unit}


{
  procedures for CTABLE self-configuration
}

procedure get_parms(var devtype: byte; var devid: integer;
		    var hardvols: shortint; var mp: mp_type);
  begin {get_parms}
    devtype := CS80_devtype;
    devid := CS80_devid;
    hardvols := CS80_hardvols;
    mp := CS80_mp;
  end; {get_parms}
$page$

procedure get_letter(uep: uep_type; ident: shortint; var letter: char);
  var
    retry_required: boolean;
    describe_bytes: describe_type;
    bcd_prod_num: {within the describe bytes}
      packed record case integer of
	0: (dn:  unsgn24);
	1: (bcd: packed array[1..6] of unsgn4);
      end;
    index: signed16;
    volumes_byte: {with the describe bytes}
      packed record case integer of
	0: (vb:  unsgn8);
	1: (bools: packed array[0..7] of boolean);
      end;
  begin {get_letter}
    uep^.ureportchange := false;  {don't report media changes/power-on now!!!}

    repeat  {cmd w/o execution msge avoids escape if in power-on holdoff!}
      retry_required := false;
      if set_unitvol(uep)<>0 then
	handle_bad_status(uep, false, retry_required);  {don't configure!!!}
    until not retry_required;

    repeat
      retry_required := false;
      if describe(uep, describe_bytes)<>0 then
	handle_bad_status(uep, false, retry_required);  {don't configure!!!}
    until not retry_required;

    with describe_bytes do
      begin
	CS80_devtype := dt;

	bcd_prod_num.dn := dn;
	CS80_devid := 0;
	for index := 1 to 5 do
	  CS80_devid := CS80_devid*10+bcd_prod_num.bcd[index];

	volumes_byte.vb := fvb+rvb;
	CS80_hardvols := 0;
	for index := 0 to 7 do
	  CS80_hardvols := CS80_hardvols+ord(volumes_byte.bools[index]);

	with CS80_mp do
	  begin
	    tpm := (maxcadd+1)*(maxhadd+1);   {tracks per medium}
	    if tpm=1  {only single-vector addressing info given}
	      then bpt := (maxsvadd.lfb+1)*nbpb   {bytes per track}
	      else bpt := (maxsadd+1)*nbpb;       {bytes per track}
	  end; {with}

      end; {with}
    letter := 'Q';
  end; {get_letter}
$page$

{
  low-level read/write routines
}

procedure flagit(uep: anyptr);
  begin {flagit}
    bip_type(uep_type(uep)^.dvrtemp)^.xfr_chain_semaphore := false;
  end; {flagit}


procedure xfr(uep: uep_type; request: amrequesttype;
	      bufptr: anyptr; block_address, length: integer);
  var
    command: CMD_type;
    retry_required: boolean;
  begin {xfr}
    allocate_bkgnd_info(uep);
    with bip_type(uep^.dvrtemp)^ do
      try
	if HPIBamigo_identify(uep) div 256<>2 then
	  ioresc_bkgnd(uep, znodevice);

	read_operation := (request=readbytes) or (request=startread);
	if read_operation
	  then command := CMDlocate_and_read
	  else command := CMDlocate_and_wrt;
	ICuvalc(uep, block_address, length, command);

	if length>0 then
	  begin
	    HPIBwait_for_ppol(uep);
	    xfr_chain_semaphore := true;  {merely a flag for xfr busy here}
	    HPIBupon_dxfr_comp(uep, execution_sec, bufptr, length, flagit);
	    while xfr_chain_semaphore do
	      {nothing};
	    if iores<>inoerror then escape(-10);
	  end {if}
	else
	  bdx_pre_eoi := false;

	HPIBwait_for_ppol(uep);
	retry_required := false;
	if qstat(uep)<>0 then
	  handle_bad_status(uep, true, retry_required)
	else if bdx_pre_eoi then
	  ioresc_bkgnd(uep, zcatchall);  {unresolved premature eoi!}

	deallocate_bkgnd_info(uep);
      recover
	abort_bkgnd_process(uep);
    ioresult  := uep^.dvrtemp;
    if (ioresult<>ord(inoerror)) or retry_required then
      escape(-10);
  end; {xfr}
$page$

{
  tapebuf manipulation routines
}

procedure flush_tapebuf;
  var
    escape_caught: boolean;
    saved_ureportchange: boolean;
  begin {flush_tapebuf}
    if tapebuf_state=modified then
      with tapebuf_uep^ do
	begin
	  escape_caught := false;
	  saved_ureportchange := ureportchange;
	  try
	    ureportchange := true;  {don't flush out to different media!}
	    tapebuf_state := undefined;  {while attempting the write}
	    xfr(tapebuf_uep, writebytes, tapebuf_ptr, tapebuf_block, tapebuf_size);
	    tapebuf_state := unmodified;  {write was successful!}
	  recover
	    escape_caught := true;
	  ureportchange := saved_ureportchange;
	  if escape_caught then
	    escape(escapecode);
	end; {with}
  end; {flush_tapebuf}


procedure load_tapebuf(uep: uep_type; request: amrequesttype; block: integer);
  var
    xfr_required: boolean;
  begin {load_tapebuf}
    xfr_required := (tapebuf_uep<>uep) or (tapebuf_block<>block) or (tapebuf_state=undefined);
    if xfr_required then
      begin
	flush_tapebuf;
	tapebuf_uep := uep;
	tapebuf_block := block;
	tapebuf_state := undefined;
      end; {if}

    if not xfr_required        {then confirm media present & unchanged}
       or (request=writebytes) {then confirm media not write protected}
       then
      begin
	xfr(tapebuf_uep, request, nil, tapebuf_block, 0);
	if tapebuf_state=undefined then
	  xfr_required := true;
      end; {if}

    if xfr_required then
      begin
	tapebuf_size := shifted_left(1, uep^.dvrtemp2);
	xfr(tapebuf_uep, readbytes, tapebuf_ptr, tapebuf_block, tapebuf_size);
	tapebuf_state := unmodified;  {read was successful!}
      end; {if}
  end; {load_tapebuf}
$page$

{
  read/write routine

  The new Subset/80 devices coming out which support multiple block
  sizes have forced us to abandon the 2.X driver's essentially never-
  used asynchronous capabilities.  It's simply too difficult to handle
  the media change situation when the media's block size also changes.
  For instance, an asynchronous transfer started on the 256-byte block
  assumption might discover new media formatted to 1024-byte blocks, in
  which case entire transfer would need re-starting, this time using
  tapebuf for buffering.  This situation would not be detected until
  well into the asynchronous transfer chain, at which point we could
  be deadlocked.

  bug 1: 10 june 88 partial sector writes were resulting in i/o errors
	 changes were made to always do full sector/block writes
}

procedure transfer(uep: uep_type; fp: fibp; request: amrequesttype;
		   bufptr: charptr; abs_position, length: integer);
  type
    cp = ^char;
  var
    retry_required: boolean;
    blockpower: shortint;
    blocksize: integer;
    block, intra_block_offset, partial_length: integer;

  begin {transfer}

    repeat
      retry_required := false;

      try
	if uep^.dvrtemp2<0 then  {block size unknown; try to determine}
	  begin
	    clear_unit(uep);
	    ioresult := uep^.dvrtemp;
	    if ioresult<>ord(inoerror) then
	      escape(-10);
	  end; {if}

	blockpower := uep^.dvrtemp2;
	if blockpower<0 then
	  ioresc(znomedium);  {this or block size isn't a power of 2!!!}

	blocksize := shifted_left(1, blockpower);
	if blocksize>tapebuf_maxsize then
	  ioresc(zuninitialized);  {our buffer is too small to handle}

	block := shifted_right(abs_position, blockpower);
	intra_block_offset := mod_power_of_2(abs_position, blockpower);

	if blockpower<=8 then
	  begin {handle a 256-byte or smaller block media}
	    {bug 1 fix is to now just enforce block boundary start}
	    if intra_block_offset<>0 then ioresc(zbadmode);
	    { xfr(uep, request, bufptr, block, length); } {bug 1 fix}
	  end ; {handle a 256-byte or smaller block device}
$page$

	{else} {rdq removed to force all operations thru buffer handeling code }
	  begin {handle buffering for up to tapebuf_maxsize block media}

	    partial_length := blocksize-intra_block_offset;
	    if partial_length>length then partial_length := length;

	    case request of

	      readbytes, startread:
		begin {read operations}

		  if intra_block_offset>0 then  {partial block at front}
		    begin
		      load_tapebuf(uep, readbytes, block);
		      moveleft(tapebuf_ptr^[intra_block_offset], bufptr^, partial_length);
		      bufptr := addr(bufptr^, partial_length);
		      abs_position := abs_position+partial_length;
		      block := shifted_right(abs_position, blockpower);
		      length := length-partial_length;
		    end; {if}

		  if (length>=blocksize)  {one or more blocks remain}
		     or (blockpower<=8) then {bug 1, keep read performance for small blocks  }
		    begin
		      flush_tapebuf;  {because we may travel far, far away}
		      xfr(uep, readbytes, bufptr, block, length);
		    end
		  else if length>0 then  {partial block at back}
		    begin
		      load_tapebuf(uep, readbytes, block);
		      moveleft(tapebuf_ptr^, bufptr^, length);
		    end;

		end; {read operations}

	      writebytes, startwrite:
		begin {write operations}

		  if intra_block_offset>0 then  {partial block at front}
		    begin
		      load_tapebuf(uep, writebytes, block);
		      tapebuf_state := modified;
		      moveleft(bufptr^, tapebuf_ptr^[intra_block_offset], partial_length);
		      bufptr := addr(bufptr^, partial_length);
		      abs_position := abs_position+partial_length;
		      block := shifted_right(abs_position, blockpower);
		      length := length-partial_length;
		    end; {if}

		  partial_length := length-mod_power_of_2(length, blockpower);
		  if partial_length>0 then  {one or more whole blocks remain}
		    begin
		      flush_tapebuf;  {because we may travel far, far away}
		      tapebuf_state := undefined;  {in case this overwrites!}
		      xfr(uep, writebytes, bufptr, block, partial_length);
		      bufptr := addr(bufptr^, partial_length);
		      abs_position := abs_position+partial_length;
		      block := shifted_right(abs_position, blockpower);
		      length := length-partial_length;
		    end; {if}

		  if length>0 then  {a partial block remains}
		    {rdq bug 1 fix, new code to zero pad small sectors instead of
		     the read modify write operation used for big block sizes}
		    if blockpower<=8 then
		    begin { zero pad for blocksize<=256 }
		       moveleft(bufptr^, tapebuf_ptr^, length);
		       tapebuf_ptr^[length] := 0;
		       moveleft(cp(addr(tapebuf_ptr^[length]))^,
				cp(addr(tapebuf_ptr^[length+1]))^,
				blocksize-length-1);
		       xfr(uep, writebytes, tapebuf_ptr, block, blocksize);
		    end
		    else
		    begin
		      load_tapebuf(uep, writebytes, block);
		      tapebuf_state := modified;
		      moveleft(bufptr^, tapebuf_ptr^, length);
		    end; {if}

		  flush_tapebuf;  {so errors get reported in the right place!}

		end; {write operations}

	    end; {case}

	  end; {handle buffering for up to tapebuf_maxsize block media}

      recover
	begin
	  if escapecode<>-10 then
	    escape(escapecode);
	  if ioresult=ord(inoerror) then  {media changed; restart}
	    retry_required := true;
	end; {recover}

    until not retry_required;

    if (request=startread) or (request=startwrite) then
      call(fp^.feot, fp)  {call the end of transfer procedure}
    else
      uep^.dvrtemp := ord(inoerror);  {report synchronous errors only once}

  end; {transfer}
$page$

{
  CS80 transfer method request handler
}

procedure CS80io;
  var
    uep: uep_type;
  begin {CS80io}

    ioresult := ord(inoerror);
    uep := addr(unitable^[fp^.funit]);

    if uep^.offline then
      ioresult := ord(znodevice)
    else
      case request of

	clearunit:
	  begin
	    clear_unit(uep);
	    ioresult := uep^.dvrtemp;
	    uep^.dvrtemp := ord(inoerror);  {report synchronous errors only once}
	    if uep=tapebuf_uep then tapebuf_state := undefined;
	  end;

	unitstatus:
	  fp^.fbusy := unit_busy(uep);

	flush:
	  begin
	    if uep=tapebuf_uep then
	      try
		flush_tapebuf;
	      recover
		if escapecode<>-10 then escape(escapecode);
	    uep^.dvrtemp := ord(inoerror);  {report synchronous errors only once}
	  end;

	readbytes, writebytes, startread, startwrite:
	  begin
	    uep^.dvrtemp := ord(inoerror);  {report synchronous errors only once}
	    if Simon_no_DMA(uep) then
	      ioresult := ord(zbaddma)
	    else if uep^.ureportchange and not uep^.umediavalid then
	      ioresult := ord(zmediumchanged)
	    else if (position<0) or (length<0) or (position+length>fp^.fpeof) then
	      ioresult := ord(ieof)
	    else
	      transfer(uep, fp, request, addr(buffer), position+fp^.fileid+uep^.byteoffset, length);
	  end;

	otherwise  {unrecognized request}
	  ioresult := ord(ibadrequest);

      end; {cases}
  end; {CS80io}

end; {CS80dvr}
$page$


{ program CS80init }

import
  tapebuf, loader;

begin {CS80init}
  init_tapebuf;
  markuser;
end. {CS80init}

@


53.1
log
@Automatic bump of revision number for PWS version 3.24B
@
text
@@


52.1
log
@Automatic bump of revision number for PWS version 3.24A
@
text
@@


51.1
log
@Automatic bump of revision number for PWS version 3.24d
@
text
@@


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


49.1
log
@Automatic bump of revision number for PWS version 3.24b
@
text
@@


48.1
log
@Automatic bump of revision number for PWS version 3.24a
@
text
@@


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


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


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


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


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


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


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


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


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


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


37.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


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


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.1
log
@Automatic bump of revision number for PWS version 3.22D
@
text
@@


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


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


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


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


28.1
log
@Automatic bump of revision number for PWS version 3.3b
@
text
@@


27.2
log
@Contains Robert Quist's patch for "3-byte bug". Patch forces all <256
byte transfers through CS80 TM buffer.
RDQ and SFB
@
text
@@


27.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@d29 1
a30 1

d1213 3
d1220 2
d1255 1
d1257 2
a1258 2
	    xfr(uep, request, bufptr, block, length);
	  end {handle a 256-byte or smaller block device}
d1261 1
a1261 1
	else
d1282 2
a1283 1
		  if length>=blocksize then  {one or more blocks remain}
d1323 12
@


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


25.1
log
@Automatic bump of revision number for PWS version 3.2Y
@
text
@@


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


23.1
log
@Automatic bump of revision number for PWS version 3.2P
@
text
@@


22.1
log
@Automatic bump of revision number for PWS version 3.2N
@
text
@@


21.1
log
@Automatic bump of revision number for PWS version 3.2M
@
text
@@


20.1
log
@Automatic bump of revision number for PWS version 3.2L
@
text
@@


19.1
log
@Automatic bump of revision number for PWS version 3.2K
@
text
@@


18.1
log
@Automatic bump of revision number for PWS version 3.2J
@
text
@@


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


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


15.1
log
@Automatic bump of revision number for PWS version 3.2H
@
text
@@


14.1
log
@Automatic bump of revision number for PWS version 3.2G
@
text
@@


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
@d25 1
@


12.1
log
@Automatic bump of revision number for PWS version 3.2E
@
text
@@


11.1
log
@Automatic bump of revision number for PWS version 3.2D
@
text
@@


10.1
log
@Automatic bump of revision number for PWS version 3.2C
@
text
@@


9.1
log
@Automatic bump of revision number for PWS version 3.2B
@
text
@@


8.1
log
@Automatic bump of revision number for PWS version 3.2A
@
text
@@


7.1
log
@Automatic bump of revision number for PWS version 3.2l
@
text
@@


6.1
log
@Automatic bump of revision number for PWS version 3.2k
@
text
@@


5.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@@


4.1
log
@Automatic bump of revision number for PWS version 3.2i
@
text
@@


3.1
log
@Automatic bump of revision number for PWS version 3.2h
@
text
@@


2.1
log
@Auto bump rev number to 2.1 for sys 3.2e.
@
text
@@


1.1
log
@Initial revision
@
text
@@
