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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

28.1
date     88.10.06.10.54.43;  author dew;  state Exp;
branches ;
next     27.1;

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

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

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

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

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

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

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

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

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

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

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

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

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

14.1
date     87.04.01.15.07.53;  author jws;  state Exp;
branches ;
next     13.1;

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

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

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

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

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

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

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

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

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

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

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

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

1.1
date     86.06.30.14.15.58;  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 4/10/85 }

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

$page$
$copyright 'COPYRIGHT (C) 1983 BY HEWLETT-PACKARD COMPANY'$


program AMIGOinit;

module CSamigo; {amigo command set}

import
  sysglobals, bkgnd, discHPIB;

export

  type

    amigo_dev_type =  {enumerated supported amigo devices}
      (HP9895, HP8290X, HP913X_A, HP913X_B, HP913X_C, HP7905, HP7906, HP7920, HP7925);

    command_type = {commands supported by the issue_cmd procedure}
      ( req_status,       { request status             }
	req_syndrome,     { request syndrome           }
	req_log_addr,     { request logical address    }
	seek_cmd,         { seek                       }
	addr_record_cmd,  { address record             }
	recalibrate_cmd,  { recalibrate                }
	unbuf_read_cmd,   { unbuffered read            }
	verify_cmd,       { verify                     }
	unbuf_write_cmd,  { unbuffered write           }
	init_d_cmd,       { initialize, setting D bits }
	format_cmd,       { format                     }
	buf_read_cmd,     { buffered read              }
	buf_write_cmd );  { buffered write             }

    ftcb_type = {first two command bytes -  structure for most commands}
      packed record
	opcode: byte;
	unit: byte;
      end;

    s1_type =  {enumerated status 1 values}
      (
normal_completion                      , illegal_opcode                         ,
unit_available                         , illegal_drive_type                     ,
s1_4                                   , s1_5                                   ,
s1_6                                   , cylinder_compare_error                 ,
uncorrectable_data_error               , head_sector_compare_error              ,
io_program_error                       , s1_11                                  ,
end_of_cylinder                        , sync_bit_not_received_in_time          ,
overrun                                , possibly_correctable_data_error        ,
illegal_access_to_spare_track          , defective_track                        ,
access_not_ready_during_data_operation , status_2_error                         ,
s1_20                                  , s1_21                                  ,
attempt_to_write_on_protected_track    , unit_unavailable                       ,
s1_24                                  , s1_25                                  ,
s1_26                                  , s1_27                                  ,
s1_28                                  , s1_29                                  ,
s1_30                                  , drive_attention
      );
$page$

    tva_type = {three vector address}
      packed record
	cyl: shortint;    { cylinder address }
	head: byte;       { head address     }
	sect: byte;       { sector address   }
      end;

    status_type = {4 bytes of returned status}
      packed record
	  { stat 1 - from previous operation }
	s: boolean;      { 15       spare track bit        }
	p: boolean;      { 14       protected track bit    }
	d: boolean;      { 13       defective track bit    }
	s1: s1_type;     { 12-8     last operation status  }
	unit: byte;      { 7-0      unit number            }
	  { stat 2 - from specified drive }
	star: boolean;   { 15       conditions *'ed below  }
	xx: 0..3;        { 14-13    undefined              }
	tttt: 0..15;     { 12-9     disc type bits         }
	r: boolean;      { 8        reserved               }
	a: boolean;      { 7        drive attention        }
	w: boolean;      { 6        write protected        }
	fmt: boolean;    { 5        format switch          }
	e: boolean;      { 4        *drive fault           }
	f: boolean;      { 3        first status bit       }
	c: boolean;      { 2        *seek check            }
	ss: 0..3;        { 1,0      *drive ready status    }
      end;

    syndrome_type = {14 bytes of returned syndrome information}
      packed record
	sb_pad1: 0..7;
	sb_s1: s1_type;
	sb_pad2: byte;
	sb_tva: tva_type;
	sb_offset: shortint;
	sb_correction_bytes: packed array[0..5] of char;
      end;

    map_type = {media addressing parameters}
      record
	cyl_per_med: shortint;  { number of cylinders per medium  }
	trk_per_cyl: shortint;  { number of tracks per cylinder   }
	sec_per_trk: shortint;  { number of sectors per track     }
      end;

    unsigned16 = 0..65535;
  $page$

  function  device             (uep: uep_type): amigo_dev_type;
  function  MI_controller      (uep: uep_type): boolean;
  function  surface_mode       (uep: uep_type): boolean;
  procedure get_map            (uep: uep_type; var map: map_type);
  function  records_per_medium (uep: uep_type): integer;
  function  decoded_addr       (uep: uep_type; tva: tva_type): integer;

  procedure issue_cmd          (uep: uep_type; command: command_type; var cmd_buffer: ftcb_type);
  function  dsj                (uep: uep_type): byte;
  procedure set_file_mask      (uep: uep_type);
  procedure recalibrate        (uep: uep_type);
  procedure status             (uep: uep_type; var status_bytes: status_type);
  procedure syndrome           (uep: uep_type; var syndrome_bytes: syndrome_type);
  procedure seek               (uep: uep_type; record_addr: integer);
  procedure addr_record        (uep: uep_type; record_addr: integer);
  function  logical_addr       (uep: uep_type): integer;

implement {CSamigo}

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


function device(uep: uep_type): amigo_dev_type;
  begin {device}
    case uep^.letter of
      'H':       device := HP9895;
      'N':       device := HP8290X;
      'U':       device := HP913X_A;
      'V':       device := HP913X_B;
      'W':       device := HP913X_C;
      'Y':       device := HP7905;
      'C':       device := HP7906;
      'P':       device := HP7920;
      'X':       device := HP7925;
      otherwise  ioresc_bkgnd(uep, znodevice);
    end {case}
  end; {device}


function MI_controller(uep: uep_type): boolean;
  begin {MI_controller}
    MI_controller := device(uep) in [HP7905, HP7906, HP7920, HP7925];
  end; {MI_controller}


function surface_mode(uep: uep_type): boolean;
  begin {surface_mode}
    surface_mode := device(uep) in [HP7905, HP7906];
  end; {surface_mode}
$page$

procedure get_map(uep: uep_type; var map: map_type);
  type
    device_maps_type = array[HP8290X..HP7925] of map_type;
  const
    DS9895_map = map_type[ cyl_per_med:  75,  trk_per_cyl: 2,  sec_per_trk: 30];
    SS9895_map = map_type[ cyl_per_med:  73,  trk_per_cyl: 1,  sec_per_trk: 30];
    device_maps = device_maps_type
     [{HP8290X}  map_type[ cyl_per_med:  33,  trk_per_cyl: 2,  sec_per_trk: 16],
      {HP913X_A} map_type[ cyl_per_med: 152,  trk_per_cyl: 4,  sec_per_trk: 31],
      {HP913X_B} map_type[ cyl_per_med: 305,  trk_per_cyl: 4,  sec_per_trk: 31],
      {HP913X_C} map_type[ cyl_per_med: 305,  trk_per_cyl: 6,  sec_per_trk: 31],
      {HP7905}   map_type[ cyl_per_med: 400,  trk_per_cyl: 2,  sec_per_trk: 48],
      {HP7906}   map_type[ cyl_per_med: 400,  trk_per_cyl: 2,  sec_per_trk: 48],
      {HP7920}   map_type[ cyl_per_med: 800,  trk_per_cyl: 5,  sec_per_trk: 48],
      {HP7925}   map_type[ cyl_per_med: 800,  trk_per_cyl: 9,  sec_per_trk: 64]  ];
  var
    this_device: amigo_dev_type;
  begin {get_map}
    this_device := device(uep);
    if this_device=HP9895 then {use single/double-sided flag set by status routine}
      case uep^.devid of
	1:  map := SS9895_map;
	2:  map := DS9895_map;
	otherwise ioresc_bkgnd(uep, zcatchall);
      end {case}
    else
      map := device_maps[this_device];
end; {get_map}


function records_per_medium(uep: uep_type): integer;
  var
    map: map_type;
  begin {records_per_medium}
    get_map(uep, map);
    with map do
      records_per_medium := sec_per_trk*trk_per_cyl*cyl_per_med;
  end; {records_per_medium}


function dsj(uep: uep_type): byte;
  var
    dsj_byte: packed record  b: byte;  end;
  const
    dsj_sec = 16;
  begin {dsj}
    HPIBshort_msge_in(uep, dsj_sec, addr(dsj_byte), sizeof(dsj_byte));
    dsj := dsj_byte.b;
  end; {dsj}
$page$

procedure issue_cmd(uep: uep_type; command: command_type; var cmd_buffer: ftcb_type);
  type
    ctet = {command table entry type}
      packed record
	sec: shortint; { secondary command     }
	oc: byte;      { opcode                }
	nb: byte;      { number of data bytes  }
      end;
    command_table_type = packed array[command_type] of ctet;
  const
    command_table = command_table_type
      [ {req_status     }  ctet[sec:  8, oc: 03, nb: 2],
	{req_syndrome   }  ctet[sec:  8, oc: 13, nb: 2],
	{req_log_addr   }  ctet[sec:  8, oc: 20, nb: 2],
	{seek_cmd       }  ctet[sec:  8, oc: 02, nb: 6],
	{addr_record_cmd}  ctet[sec:  8, oc: 12, nb: 6],
	{recalibrate_cmd}  ctet[sec:  8, oc: 01, nb: 2],
	{unbuf_read_cmd }  ctet[sec:  8, oc: 05, nb: 2],
	{verify_cmd     }  ctet[sec:  8, oc: 07, nb: 4],
	{unbuf_write_cmd}  ctet[sec:  8, oc: 08, nb: 2],
	{init_d_cmd     }  ctet[sec:  8, oc: 43, nb: 2],
	{format_cmd     }  ctet[sec: 12, oc: 24, nb: 5],
	{buf_read_cmd   }  ctet[sec: 10, oc: 05, nb: 2],
	{buf_write_cmd  }  ctet[sec:  9, oc: 08, nb: 2]  ];
  begin {issue_cmd}
    with cmd_buffer, command_table[command] do
      begin
	opcode := oc;
	unit := uep^.du;
	HPIBshort_msge_out(uep, sec, addr(cmd_buffer), nb);
      end; {with}
  end; {issue_cmd}


procedure set_file_mask(uep: uep_type);
  type
    sfm_cmd_type =  {set file mask command}
      packed record
	oc: byte;
	mask: byte;
      end;
    sfm_cmd_array_type = array[boolean] of sfm_cmd_type;
  const
    sfm_sec = 8;        {secondary}
    sfm_oc = 15;        {op code}
    sfm_cmd_array = sfm_cmd_array_type
      [ {false: cylinder mode} sfm_cmd_type[ oc: sfm_oc, mask: 7 ],
	{true:  surface mode } sfm_cmd_type[ oc: sfm_oc, mask: 5 ]  ];
  var
    sfm_cmd: sfm_cmd_type;
  begin {set_file_mask}
    sfm_cmd := sfm_cmd_array[surface_mode(uep)];
    HPIBshort_msge_out(uep, sfm_sec, addr(sfm_cmd), sizeof(sfm_cmd));
  end; {set_file_mask}
$page$

procedure recalibrate(uep: uep_type);
  var
    recalibrate_cmd_buf: ftcb_type;
  begin {recalibrate}
    issue_cmd(uep, recalibrate_cmd, recalibrate_cmd_buf);
  end; {recalibrate}


procedure status(uep: uep_type; var status_bytes: status_type);
  var
    status_cmd_buf: ftcb_type;
  const
    send_sts_sec = 8;
  begin {status}
    issue_cmd(uep, req_status, status_cmd_buf);
    if not MI_controller(uep) then HPIBwait_for_ppol(uep);
    HPIBshort_msge_in(uep, send_sts_sec, addr(status_bytes), sizeof(status_bytes));
    most_recent_status := status_bytes;  {for post-mortem diagnostic purposes only!}
    with uep^ do
      case device(uep) of
	HP9895:  {use the otherwise undefined devid field to indicate...}
	  if status_bytes.tttt in [5,6]
	    then devid := 2         {double-sided disc}
	    else devid := 1;        {single-sided disc}
	HP8290X: {use the otherwise undefined devid field to indicate...}
	  devid := ord(status_bytes.r);  {Sparrow (1) versus Chinook (0)}
	otherwise
	  {do nothing};
      end; {case}
  end; {status}


procedure syndrome(uep: uep_type; var syndrome_bytes: syndrome_type);
  var
    syndrome_cmd_buf: ftcb_type;
  const
    send_syn_sec = 8;
  begin {syndrome}
    issue_cmd(uep, req_syndrome, syndrome_cmd_buf);
    HPIBshort_msge_in(uep, send_syn_sec, addr(syndrome_bytes), sizeof(syndrome_bytes));
  end; {syndrome}
$page$

function coded_addr(uep: uep_type; record_addr: integer): tva_type;
  var
    map: map_type;
    track: integer;
  begin {coded_addr}
    get_map(uep, map);
    with map do
      begin
	coded_addr.sect  := record_addr mod sec_per_trk;
	track            := record_addr div sec_per_trk;
	if surface_mode(uep) then
	  begin  {select proper 7905/06 logical "volume"}
	    coded_addr.head := track div cyl_per_med + 2*uep^.dv;
	    coded_addr.cyl  := track mod cyl_per_med;
	  end {then}
	else
	  begin
	    coded_addr.head := track mod trk_per_cyl;
	    coded_addr.cyl  := track div trk_per_cyl;
	  end; {else}
      end; {with}
  end; {coded_addr}


function decoded_addr(uep: uep_type; tva: tva_type): integer;
  var
    map: map_type;
    track: integer;
  begin {decoded_addr}
    get_map(uep, map);
    with tva, map do
      begin
	if surface_mode(uep)
	  then track := (head-2*uep^.dv)*cyl_per_med+cyl
	  else track := cyl*trk_per_cyl+head;
	decoded_addr := track*sec_per_trk+sect;
      end; {with}
  end; {decoded_addr}
$page$

procedure seek(uep: uep_type; record_addr: integer);
  var
    seek_cmd_buf:
      packed record
	ftcb: ftcb_type;
	tva: tva_type;
      end;
  begin {seek}
    seek_cmd_buf.tva := coded_addr(uep, record_addr);
    issue_cmd(uep, seek_cmd, seek_cmd_buf.ftcb);
  end; {seek}


procedure addr_record(uep: uep_type; record_addr: integer);
  var
    addr_record_cmd_buf:
      packed record
	ftcb: ftcb_type;
	tva: tva_type;
      end;
  begin {addr_record}
    addr_record_cmd_buf.tva := coded_addr(uep, record_addr);
    issue_cmd(uep, addr_record_cmd, addr_record_cmd_buf.ftcb);
  end; {addr_record}


function logical_addr(uep: uep_type): integer;
  var
    ladd_cmd_buf: ftcb_type;
    tva: tva_type;
  const
    send_addr_sec = 8;
  begin {logical_addr}
    issue_cmd(uep, req_log_addr, ladd_cmd_buf);
    if not MI_controller(uep) then HPIBwait_for_ppol(uep);
    HPIBshort_msge_in(uep, send_addr_sec, addr(tva), sizeof(tva));
    logical_addr := decoded_addr(uep, tva);
  end; {logical_addr}


end; {CSamigo}
$page$

module amigodvr;

import
  sysglobals, drvasm, bkgnd, discHPIB, CSamigo;

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

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

implement {amigodvr}


{
  procedure used by CTABLE for self-configuring
}
procedure get_letter(uep: uep_type; ident: shortint; var letter: char);
  const
    ident_table_entries = 7;
  var
    index: shortint;
    status_bytes: status_type;
  type
    device_table_type = array[0..3] of char;
    itet = {ident_table_entry_type}
      record
	ident: shortint;
	letter: char;
      end;
    ident_table_type = array[1..ident_table_entries] of itet;
  const
    device_table = device_table_type
      [ {0} 'C', {1} 'P', {2} 'Y', {3} 'X' ];
    ident_table = ident_table_type
      [ {HP9895 }   itet[ ident: 0*256+129 {$0081}, letter: 'H' ],
	{HP8290X}   itet[ ident: 1*256+  4 {$0104}, letter: 'N' ],
	{HP913X_A}  itet[ ident: 1*256+  6 {$0106}, letter: 'U' ],
	{HP913X_B}  itet[ ident: 1*256+ 10 {$010A}, letter: 'V' ],
	{HP913X_C}  itet[ ident: 1*256+ 15 {$010F}, letter: 'W' ],
	{MAC}       itet[ ident: 0*256+  2 {$0002}, letter: 'X' ],
	{IDC}       itet[ ident: 0*256+  3 {$0003}, letter: 'X' ] ];
  begin {get_letter}

    letter := chr(255); {initially undefined}
    for index := 1 to ident_table_entries do
      if ident=ident_table[index].ident then
	letter := ident_table[index].letter;
    if letter=chr(255) then ioresc_bkgnd(uep, znodevice);

    uep^.letter := letter;  {for determining ppol wait in status routine}
    if dsj(uep)<>0 then {don't worry about it};
    HPIBamigo_clear(uep);
    HPIBwait_for_ppol(uep);
    status(uep, status_bytes);
    if dsj(uep)<>0 then ioresc_bkgnd(uep, zcatchall);
    if status_bytes.ss=2 then ioresc_bkgnd(uep, znodevice);  {"unit not present or power off"}

    if letter='X' then  {determine which 7906 family member it really is}
      begin
	if not (status_bytes.tttt in [0..3]) then
	  ioresc_bkgnd(uep, znodevice); {unrecognized unit type}
	letter := device_table[status_bytes.tttt];
      end; {if}

  end; {get_letter}


procedure clear_unit(uep:uep_type);
  type
    device_ident_type = array[HP9895..HP913X_C] of shortint;
    device_table_type = array[0..3] of amigo_dev_type;
  const
    device_ident = device_ident_type
      [ {HP9895 }   0*256+129,  {$0081}
	{HP8290X}   1*256+  4,  {$0104}
	{HP913X_A}  1*256+  6,  {$0106}
	{HP913X_B}  1*256+ 10,  {$010A}
	{HP913X_C}  1*256+ 15   {$010F} ];
    MAC_ident = 0*256+2;  {$0002}
    IDC_ident = 0*256+3;  {$0003}
    device_table = device_table_type
      [ {0} HP7906, {1} HP7920, {2} HP7905, {3} HP7925 ];
  var
    dev: amigo_dev_type;
    ident: shortint;
    dummy_dsj: byte;
    status_bytes: status_type;
  begin {clear_unit}
    dev := device(uep);
    ident := HPIBamigo_identify(uep);
    if MI_controller(uep) then  {check for MAC or IDC controller}
      begin
	if not ((ident=MAC_ident) or ((ident=IDC_ident) and Simon_DMA(uep))) then
	  ioresc_bkgnd(uep, znodevice);
      end {then}
    else  {require EXACT device/ident match}
      if ident<>device_ident[dev] then ioresc_bkgnd(uep, znodevice);
    if dev=HP8290X then {avoid the amigo clear; it takes too much time!}
      dummy_dsj := dsj(uep)  {just remove the power-on holdoff}
    else  {go ahead and do the hard clear}
      begin
	HPIBamigo_clear(uep);
	HPIBwait_for_ppol(uep);
      end; {else}
    status(uep, status_bytes);
    if dsj(uep)<>0 then ioresc_bkgnd(uep, zcatchall);
    if status_bytes.ss=2 then ioresc_bkgnd(uep, znodevice);     {"unit not present or power off"}
    if MI_controller(uep) then  {we need to check the exact type of THIS particular unit}
      begin
	if not (status_bytes.tttt in [0..3]) then
	  ioresc_bkgnd(uep, znodevice); {unrecognized unit type}
	if dev<>device_table[status_bytes.tttt] then
	  ioresc_bkgnd(uep, znodevice); {wrong unit type}
      end; {then}
  end; {clear_unit}
$page$

{
  procedures in the background transfer chain
}
procedure initial_seek           (uep: uep_type);  forward;
procedure enter_transfer_chain   (uep: anyptr);    forward;
procedure issue_transfer_request (uep: uep_type);  forward;
procedure initiate_data_transfer (uep: anyptr);    forward;
procedure upon_data_transfer_comp(uep: anyptr);    forward;
procedure check_dsj              (uep: anyptr);    forward;


{
  main driver procedure
}
procedure amigoio;

  var
    uep: uep_type;
    ident: shortint;
    asynchronous: boolean;

  begin {amigoio}

    uep := addr(unitable^[fp^.funit]);
    asynchronous := (request=startread) or (request=startwrite);

    if uep^.offline then
      ioresult := ord(znodevice)
    else
      try

	ioresult := ord(inoerror);

	case request of

	  clearunit:
	    begin
	      uep^.umediavalid := false;
	      unit_wait(uep);
	      ioresult := ord(inoerror);  {forget any previous error}
	      allocate_bkgnd_info(uep);
	      HPIBcheck_sc(uep);
	      clear_unit(uep);
	      deallocate_bkgnd_info(uep);
	    end;

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

	  flush:
	    {do nothing};

	  readbytes, writebytes, startread, startwrite:
	    begin {transfer operations}
	      unit_wait(uep);
	      ioresult := ord(inoerror);  {forget any previous error}
	      allocate_bkgnd_info(uep);

	      with bip_type(uep^.dvrtemp)^ do
		begin
		  feot := fp^.feot;       {end of transfer procedure}
		  fibptr := fp;           {parmeter to the eot procedure}
		  async := asynchronous;  {determines whether or not to call eot proc}

		  if Simon_no_dma(uep) then
		    ioresc_bkgnd(uep, zbaddma);
		  if uep^.ureportchange and not uep^.umediavalid then
		    ioresc_bkgnd(uep, zmediumchanged);
		  if position mod 256<>0 then
		    ioresc_bkgnd(uep, zbadmode);
		  if (position<0) or (length<0) or (position+length>fp^.fpeof) then
		    ioresc_bkgnd(uep, ieof);

		  HPIBcheck_sc(uep);
		  ident := HPIBamigo_identify(uep);  {confirm device present}
		  if dsj(uep)<>0 then {do nothing};  {remove power-on holdoff if any}

		  if length=0 then
		    deallocate_bkgnd_info(uep)  {nothing to transfer}
		  else
		    begin
		      read_operation      :=  (request=readbytes) or (request=startread);
		      xfr_chain_semaphore :=  false;
		      bx_tries            :=  0;
		      bx_strt_rcrd        :=  (position+fp^.fileid+uep^.byteoffset) div 256;
		      bx_bufptr           :=  addr(buffer);
		      bx_length           :=  length;
		      initial_seek(uep);  {initiate the transfer}
		    end; {else}
		end; {with}

	      if not asynchronous then
		begin
		  unit_wait(uep);
		  uep^.dvrtemp := ord(inoerror);  {report synchronous errors only once}
		end; {if}
	    end; {transfer operations}

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

	end; {cases}

      recover
	begin
	  abort_bkgnd_process(uep);
	  ioresult := uep^.dvrtemp;
	  if not asynchronous then
	    uep^.dvrtemp := ord(inoerror);  {report synchronous errors only once}
	end; {recover}

  end; {amigoio}
$page$

procedure initial_seek(uep: uep_type);
  var
    status_bytes: status_type;
  begin {initial_seek}

    if device(uep)=HP9895 then  {read status to determine single or double-sided}
      begin
	status(uep, status_bytes);
	with status_bytes do  {specifically disallow non HP-formatted discs}
	  begin
	    if f then
	      begin
		uep^.umediavalid := false;
		if uep^.ureportchange then
		  ioresc_bkgnd(uep, zmediumchanged);
	      end; {if}
	    if (ss=0) and not (tttt in [2,6]) then
	      ioresc_bkgnd(uep, zuninitialized)
	  end; {with}
      end; {if}

    with bip_type(uep^.dvrtemp)^ do
      begin

	if MI_controller(uep) then
	  begin
	    set_file_mask(uep);
	    buffered_transfer := not Simon_DMA(uep);
	    HPIBwait_for_ppol(uep);  {shouldn't take very long!}
	  end {then}
	else
	  if device(uep)=HP8290X
	    then buffered_transfer := uep^.devid=0  {Sparrow (1) versus Chinook (0)}
	    else buffered_transfer := false;

	if device(uep) in [HP913X_A..HP913X_C]
	  then addr_record(uep, bx_strt_rcrd)   {allows greater overlapping with 9914}
	  else seek       (uep, bx_strt_rcrd);

	HPIBupon_ppol_resp(uep, enter_transfer_chain);

      end; {with}

  end; {initial_seek}


procedure enter_transfer_chain(uep: anyptr);
  begin {enter_transfer_chain}
    with bip_type(uep_type(uep)^.dvrtemp)^ do
      if not test_and_toggle(xfr_chain_semaphore) then
	repeat
	  issue_transfer_request(uep);
	until test_and_toggle(xfr_chain_semaphore);
  end; {enter_transfer_chain}
$page$

procedure issue_transfer_request(uep: uep_type);
  const
    sect_per_surf = 400*48;  {only valid for 7905/06!!!}
  var
    transfer_command: command_type;
    transfer_cmd_buf: ftcb_type;
    max_tfr_length: integer;
    remaining_surf_bytes: integer;
    wait_for_ppol: boolean;
  begin {issue_transfer_request}
    with bip_type(uep^.dvrtemp)^ do
      try
	if buffered_transfer then
	  begin
	    if read_operation
	      then transfer_command := buf_read_cmd
	      else transfer_command := buf_write_cmd;
	    max_tfr_length := 256;
	  end {then}
	else
	  begin
	    if read_operation
	      then transfer_command := unbuf_read_cmd
	      else transfer_command := unbuf_write_cmd;
	    if MI_controller(uep) then
	      begin
		max_tfr_length := 65536;  {max DMA burst length}
		if surface_mode(uep) then {don't try to cross a surface boundary}
		  begin
		    remaining_surf_bytes := (sect_per_surf-bx_strt_rcrd mod sect_per_surf)*256;
		    if remaining_surf_bytes<max_tfr_length then
		      max_tfr_length := remaining_surf_bytes;
		  end; {then}
	      end {then}
	    else
	      max_tfr_length := maxint;
	  end; {else}

	if bx_length<=max_tfr_length
	  then bx_tfr_length := bx_length
	  else bx_tfr_length := max_tfr_length;

	wait_for_ppol := buffered_transfer or (device(uep)=HP8290X);
	issue_cmd(uep, transfer_command, transfer_cmd_buf);
	if wait_for_ppol  {computed above because of critical MAC/IDC timing!}
	  then HPIBupon_ppol_resp(uep, initiate_data_transfer)
	  else initiate_data_transfer(uep);
      recover
	abort_bkgnd_process(uep);
  end; {issue_transfer_request}
$page$

procedure initiate_data_transfer(uep: anyptr);
  const
    tfr_data_sec = 0;
  begin {initiate_data_transfer}
    with bip_type(uep_type(uep)^.dvrtemp)^ do
      try
	HPIBupon_dxfr_comp(uep, tfr_data_sec, bx_bufptr, bx_tfr_length, upon_data_transfer_comp);
      recover
	abort_bkgnd_process(uep);
  end; {initiate_data_transfer}


procedure upon_data_transfer_comp(uep: anyptr);
  begin {upon_data_transfer_comp}
    try
      if bip_type(uep_type(uep)^.dvrtemp)^.iores<>inoerror then escape(-10);
      HPIBupon_ppol_resp(uep, check_dsj);
    recover
      abort_bkgnd_process(uep);
  end; {upon_data_transfer_comp}


procedure check_dsj(uep: anyptr);
  var
    transfer_successful: boolean;
  const
    maxtries = 10;

  procedure process_errors(uep: uep_type);
    var
      status_bytes: status_type;
      syndrome_bytes: syndrome_type;
      cb_ptr: charptr;
      cb_index: shortint;
      e_rcrd: integer;
      possible_bytes_transferred: integer;
    begin {process_errors}
      with bip_type(uep^.dvrtemp)^ do
	begin
	  status(uep, status_bytes);
	  if dsj(uep)<>0 then ioresc_bkgnd(uep, zcatchall);
	  with status_bytes do
	    case s1 of
	      {retryable errors}
		cylinder_compare_error,
		uncorrectable_data_error,
		head_sector_compare_error,
		end_of_cylinder,
		sync_bit_not_received_in_time,
		overrun,
		possibly_correctable_data_error,
		illegal_access_to_spare_track,
		defective_track,
		access_not_ready_during_data_operation:
		  begin  {retryable errors case}
		    if s1=overrun
		      then e_rcrd := bx_strt_rcrd  {addr untrustworthy after overrun}
		      else e_rcrd := logical_addr(uep);

		    if s1=cylinder_compare_error then
		      if MI_controller(uep) then  {recalibrate & retry}
			begin
			  recalibrate(uep);
			  HPIBwait_for_ppol(uep); {shouldn't happen very often!}
			end {then}
		      else if e_rcrd=bx_strt_rcrd then  {don't retry...}
			ioresc_bkgnd(uep, znoblock);  {Chinook takes 25 secs/retry!!!}

		    if e_rcrd<=bx_strt_rcrd then  {careful with MAC/IDC verify address!}
		      begin
			bx_tries := bx_tries+1;
			transfer_successful := false;  {unless correctable below}
			if (s1=possibly_correctable_data_error) and (bx_tries>5) then
			  with syndrome_bytes do
			    begin
			      syndrome(uep, syndrome_bytes);
			      if (sb_s1=possibly_correctable_data_error)  and
				 (decoded_addr(uep, sb_tva)=e_rcrd)       and
				 (sb_offset>=0)                           and
				 (sb_offset<=125)                         then {it's correctable!}
				begin
				  cb_ptr := addr(bx_bufptr^,2*sb_offset);
				  cb_index := 0;
				  while (cb_index<6) and
					(integer(cb_ptr)<integer(bx_bufptr)+bx_tfr_length) do
				    begin
				      eor(sb_correction_bytes[cb_index], cb_ptr);
				      cb_ptr := addr(cb_ptr^, 1);
				      cb_index := cb_index+1;
				    end; {while}
				  e_rcrd := e_rcrd+1;  {this record has been corrected!}
				  bx_tries := 0;  {no attempts made on the next record yet}
				  transfer_successful := true;  {at least partially!}
				end; {then}
			    end; {with}
		      end {then}
		    else
		      begin
			bx_tries := 1;  {first attempt on this record}
			transfer_successful := true;  {at least partially!}
		      end; {else}

		    if transfer_successful then
		      begin
			possible_bytes_transferred := (e_rcrd-bx_strt_rcrd)*256;
			if bx_tfr_length>possible_bytes_transferred then
			  bx_tfr_length := possible_bytes_transferred;
		      end {then}
		    else
		      if bx_tries>=maxtries then
			if s1 in [uncorrectable_data_error, possibly_correctable_data_error]
			  then ioresc_bkgnd(uep, zbadblock)
			  else ioresc_bkgnd(uep, znoblock);
		  end;  {retryable errors case}

	      {immediate escape errors}
		illegal_drive_type,
		unit_unavailable:
		  ioresc_bkgnd(uep, znodevice);
		attempt_to_write_on_protected_track:
		  ioresc_bkgnd(uep, zprotected);

	      {errors requiring status 2 processing}
		status_2_error:
		  begin
		    if f then
		      uep^.umediavalid := false;
		    if e then ioresc_bkgnd(uep, zbadhardware);
		    case ss of
		      1: ioresc_bkgnd(uep, znotready);
		      2: ioresc_bkgnd(uep, znodevice);
		      3: ioresc_bkgnd(uep, znomedium);
		      otherwise {test further conditions below};
		    end; {case}
		    if not read_operation and w then
		      ioresc_bkgnd(uep, zprotected);
		    if not MI_controller(uep) and not (tttt in [2,6]) then
		      ioresc_bkgnd(uep, zuninitialized);
		    if f then
		      begin
			if uep^.ureportchange then
			  ioresc_bkgnd(uep, zmediumchanged);
			bx_tries := bx_tries+1;
			if bx_tries>1 then
			  ioresc_bkgnd(uep, zcatchall);
			transfer_successful := false;
		      end {then}
		    else
		      ioresc_bkgnd(uep, zcatchall);
		  end;
		drive_attention:
		  begin
		    if e then ioresc_bkgnd(uep, zbadhardware);
		    if c then
		      begin
			e_rcrd := logical_addr(uep);
			if e_rcrd>(bx_strt_rcrd+(bx_tfr_length-1)div 256) then
			  transfer_successful := true  {already transferred enough bytes}
			else
			  if e_rcrd>=records_per_medium(uep)
			    then ioresc_bkgnd(uep, znosuchblk)
			    else ioresc_bkgnd(uep, znoblock);
		      end {then}
		    else
		      ioresc_bkgnd(uep, zcatchall);
		  end;

	      {other errors}
		otherwise
		  ioresc_bkgnd(uep, zcatchall);
	    end; {case}
	end; {with}
    end; {process_errors}
$page$

  begin {check_dsj}
    with bip_type(uep_type(uep)^.dvrtemp)^ do
      try

	if dsj(uep)=0 then
	  if bdx_pre_eoi
	    then ioresc_bkgnd(uep, zcatchall)  {unresolved premature eoi!}
	    else transfer_successful := true
	else
	  process_errors(uep);  {will set/clear transfer_successful, or escape}

	if transfer_successful then
	  begin
	    bx_strt_rcrd := bx_strt_rcrd+bx_tfr_length div 256;
	    bx_bufptr := addr(bx_bufptr^, bx_tfr_length);
	    bx_length := bx_length-bx_tfr_length;
	  end; {then}

	if bx_length>0 then
	  if MI_controller(uep) or not transfer_successful then
	    begin
	      if device(uep) in [HP913X_A..HP913X_C, HP7905..HP7925]
		then addr_record(uep, bx_strt_rcrd)
		else seek       (uep, bx_strt_rcrd);
	      HPIBupon_ppol_resp(uep, enter_transfer_chain);
	    end {then}
	  else
	    enter_transfer_chain(uep)
	else
	  deallocate_bkgnd_info(uep);

      recover
	abort_bkgnd_process(uep);
  end; {check_dsj}


end; {amigodvr}



{ program AMIGOinit }

import
  loader;

begin {AMIGOinit}
  markuser;
end. {AMIGOinit}


@


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


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

 (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 4/10/85 }

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

$page$
$copyright 'COPYRIGHT (C) 1983 BY HEWLETT-PACKARD COMPANY'$


program AMIGOinit;

module CSamigo; {amigo command set}

import
  sysglobals, bkgnd, discHPIB;

export

  type

    amigo_dev_type =  {enumerated supported amigo devices}
      (HP9895, HP8290X, HP913X_A, HP913X_B, HP913X_C, HP7905, HP7906, HP7920, HP7925);

    command_type = {commands supported by the issue_cmd procedure}
      ( req_status,       { request status             }
	req_syndrome,     { request syndrome           }
	req_log_addr,     { request logical address    }
	seek_cmd,         { seek                       }
	addr_record_cmd,  { address record             }
	recalibrate_cmd,  { recalibrate                }
	unbuf_read_cmd,   { unbuffered read            }
	verify_cmd,       { verify                     }
	unbuf_write_cmd,  { unbuffered write           }
	init_d_cmd,       { initialize, setting D bits }
	format_cmd,       { format                     }
	buf_read_cmd,     { buffered read              }
	buf_write_cmd );  { buffered write             }

    ftcb_type = {first two command bytes -  structure for most commands}
      packed record
	opcode: byte;
	unit: byte;
      end;

    s1_type =  {enumerated status 1 values}
      (
normal_completion                      , illegal_opcode                         ,
unit_available                         , illegal_drive_type                     ,
s1_4                                   , s1_5                                   ,
s1_6                                   , cylinder_compare_error                 ,
uncorrectable_data_error               , head_sector_compare_error              ,
io_program_error                       , s1_11                                  ,
end_of_cylinder                        , sync_bit_not_received_in_time          ,
overrun                                , possibly_correctable_data_error        ,
illegal_access_to_spare_track          , defective_track                        ,
access_not_ready_during_data_operation , status_2_error                         ,
s1_20                                  , s1_21                                  ,
attempt_to_write_on_protected_track    , unit_unavailable                       ,
s1_24                                  , s1_25                                  ,
s1_26                                  , s1_27                                  ,
s1_28                                  , s1_29                                  ,
s1_30                                  , drive_attention
      );
$page$

    tva_type = {three vector address}
      packed record
	cyl: shortint;    { cylinder address }
	head: byte;       { head address     }
	sect: byte;       { sector address   }
      end;

    status_type = {4 bytes of returned status}
      packed record
	  { stat 1 - from previous operation }
	s: boolean;      { 15       spare track bit        }
	p: boolean;      { 14       protected track bit    }
	d: boolean;      { 13       defective track bit    }
	s1: s1_type;     { 12-8     last operation status  }
	unit: byte;      { 7-0      unit number            }
	  { stat 2 - from specified drive }
	star: boolean;   { 15       conditions *'ed below  }
	xx: 0..3;        { 14-13    undefined              }
	tttt: 0..15;     { 12-9     disc type bits         }
	r: boolean;      { 8        reserved               }
	a: boolean;      { 7        drive attention        }
	w: boolean;      { 6        write protected        }
	fmt: boolean;    { 5        format switch          }
	e: boolean;      { 4        *drive fault           }
	f: boolean;      { 3        first status bit       }
	c: boolean;      { 2        *seek check            }
	ss: 0..3;        { 1,0      *drive ready status    }
      end;

    syndrome_type = {14 bytes of returned syndrome information}
      packed record
	sb_pad1: 0..7;
	sb_s1: s1_type;
	sb_pad2: byte;
	sb_tva: tva_type;
	sb_offset: shortint;
	sb_correction_bytes: packed array[0..5] of char;
      end;

    map_type = {media addressing parameters}
      record
	cyl_per_med: shortint;  { number of cylinders per medium  }
	trk_per_cyl: shortint;  { number of tracks per cylinder   }
	sec_per_trk: shortint;  { number of sectors per track     }
      end;

    unsigned16 = 0..65535;
  $page$

  function  device             (uep: uep_type): amigo_dev_type;
  function  MI_controller      (uep: uep_type): boolean;
  function  surface_mode       (uep: uep_type): boolean;
  procedure get_map            (uep: uep_type; var map: map_type);
  function  records_per_medium (uep: uep_type): integer;
  function  decoded_addr       (uep: uep_type; tva: tva_type): integer;

  procedure issue_cmd          (uep: uep_type; command: command_type; var cmd_buffer: ftcb_type);
  function  dsj                (uep: uep_type): byte;
  procedure set_file_mask      (uep: uep_type);
  procedure recalibrate        (uep: uep_type);
  procedure status             (uep: uep_type; var status_bytes: status_type);
  procedure syndrome           (uep: uep_type; var syndrome_bytes: syndrome_type);
  procedure seek               (uep: uep_type; record_addr: integer);
  procedure addr_record        (uep: uep_type; record_addr: integer);
  function  logical_addr       (uep: uep_type): integer;

implement {CSamigo}

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


function device(uep: uep_type): amigo_dev_type;
  begin {device}
    case uep^.letter of
      'H':       device := HP9895;
      'N':       device := HP8290X;
      'U':       device := HP913X_A;
      'V':       device := HP913X_B;
      'W':       device := HP913X_C;
      'Y':       device := HP7905;
      'C':       device := HP7906;
      'P':       device := HP7920;
      'X':       device := HP7925;
      otherwise  ioresc_bkgnd(uep, znodevice);
    end {case}
  end; {device}


function MI_controller(uep: uep_type): boolean;
  begin {MI_controller}
    MI_controller := device(uep) in [HP7905, HP7906, HP7920, HP7925];
  end; {MI_controller}


function surface_mode(uep: uep_type): boolean;
  begin {surface_mode}
    surface_mode := device(uep) in [HP7905, HP7906];
  end; {surface_mode}
$page$

procedure get_map(uep: uep_type; var map: map_type);
  type
    device_maps_type = array[HP8290X..HP7925] of map_type;
  const
    DS9895_map = map_type[ cyl_per_med:  75,  trk_per_cyl: 2,  sec_per_trk: 30];
    SS9895_map = map_type[ cyl_per_med:  73,  trk_per_cyl: 1,  sec_per_trk: 30];
    device_maps = device_maps_type
     [{HP8290X}  map_type[ cyl_per_med:  33,  trk_per_cyl: 2,  sec_per_trk: 16],
      {HP913X_A} map_type[ cyl_per_med: 152,  trk_per_cyl: 4,  sec_per_trk: 31],
      {HP913X_B} map_type[ cyl_per_med: 305,  trk_per_cyl: 4,  sec_per_trk: 31],
      {HP913X_C} map_type[ cyl_per_med: 305,  trk_per_cyl: 6,  sec_per_trk: 31],
      {HP7905}   map_type[ cyl_per_med: 400,  trk_per_cyl: 2,  sec_per_trk: 48],
      {HP7906}   map_type[ cyl_per_med: 400,  trk_per_cyl: 2,  sec_per_trk: 48],
      {HP7920}   map_type[ cyl_per_med: 800,  trk_per_cyl: 5,  sec_per_trk: 48],
      {HP7925}   map_type[ cyl_per_med: 800,  trk_per_cyl: 9,  sec_per_trk: 64]  ];
  var
    this_device: amigo_dev_type;
  begin {get_map}
    this_device := device(uep);
    if this_device=HP9895 then {use single/double-sided flag set by status routine}
      case uep^.devid of
	1:  map := SS9895_map;
	2:  map := DS9895_map;
	otherwise ioresc_bkgnd(uep, zcatchall);
      end {case}
    else
      map := device_maps[this_device];
end; {get_map}


function records_per_medium(uep: uep_type): integer;
  var
    map: map_type;
  begin {records_per_medium}
    get_map(uep, map);
    with map do
      records_per_medium := sec_per_trk*trk_per_cyl*cyl_per_med;
  end; {records_per_medium}


function dsj(uep: uep_type): byte;
  var
    dsj_byte: packed record  b: byte;  end;
  const
    dsj_sec = 16;
  begin {dsj}
    HPIBshort_msge_in(uep, dsj_sec, addr(dsj_byte), sizeof(dsj_byte));
    dsj := dsj_byte.b;
  end; {dsj}
$page$

procedure issue_cmd(uep: uep_type; command: command_type; var cmd_buffer: ftcb_type);
  type
    ctet = {command table entry type}
      packed record
	sec: shortint; { secondary command     }
	oc: byte;      { opcode                }
	nb: byte;      { number of data bytes  }
      end;
    command_table_type = packed array[command_type] of ctet;
  const
    command_table = command_table_type
      [ {req_status     }  ctet[sec:  8, oc: 03, nb: 2],
	{req_syndrome   }  ctet[sec:  8, oc: 13, nb: 2],
	{req_log_addr   }  ctet[sec:  8, oc: 20, nb: 2],
	{seek_cmd       }  ctet[sec:  8, oc: 02, nb: 6],
	{addr_record_cmd}  ctet[sec:  8, oc: 12, nb: 6],
	{recalibrate_cmd}  ctet[sec:  8, oc: 01, nb: 2],
	{unbuf_read_cmd }  ctet[sec:  8, oc: 05, nb: 2],
	{verify_cmd     }  ctet[sec:  8, oc: 07, nb: 4],
	{unbuf_write_cmd}  ctet[sec:  8, oc: 08, nb: 2],
	{init_d_cmd     }  ctet[sec:  8, oc: 43, nb: 2],
	{format_cmd     }  ctet[sec: 12, oc: 24, nb: 5],
	{buf_read_cmd   }  ctet[sec: 10, oc: 05, nb: 2],
	{buf_write_cmd  }  ctet[sec:  9, oc: 08, nb: 2]  ];
  begin {issue_cmd}
    with cmd_buffer, command_table[command] do
      begin
	opcode := oc;
	unit := uep^.du;
	HPIBshort_msge_out(uep, sec, addr(cmd_buffer), nb);
      end; {with}
  end; {issue_cmd}


procedure set_file_mask(uep: uep_type);
  type
    sfm_cmd_type =  {set file mask command}
      packed record
	oc: byte;
	mask: byte;
      end;
    sfm_cmd_array_type = array[boolean] of sfm_cmd_type;
  const
    sfm_sec = 8;        {secondary}
    sfm_oc = 15;        {op code}
    sfm_cmd_array = sfm_cmd_array_type
      [ {false: cylinder mode} sfm_cmd_type[ oc: sfm_oc, mask: 7 ],
	{true:  surface mode } sfm_cmd_type[ oc: sfm_oc, mask: 5 ]  ];
  var
    sfm_cmd: sfm_cmd_type;
  begin {set_file_mask}
    sfm_cmd := sfm_cmd_array[surface_mode(uep)];
    HPIBshort_msge_out(uep, sfm_sec, addr(sfm_cmd), sizeof(sfm_cmd));
  end; {set_file_mask}
$page$

procedure recalibrate(uep: uep_type);
  var
    recalibrate_cmd_buf: ftcb_type;
  begin {recalibrate}
    issue_cmd(uep, recalibrate_cmd, recalibrate_cmd_buf);
  end; {recalibrate}


procedure status(uep: uep_type; var status_bytes: status_type);
  var
    status_cmd_buf: ftcb_type;
  const
    send_sts_sec = 8;
  begin {status}
    issue_cmd(uep, req_status, status_cmd_buf);
    if not MI_controller(uep) then HPIBwait_for_ppol(uep);
    HPIBshort_msge_in(uep, send_sts_sec, addr(status_bytes), sizeof(status_bytes));
    most_recent_status := status_bytes;  {for post-mortem diagnostic purposes only!}
    with uep^ do
      case device(uep) of
	HP9895:  {use the otherwise undefined devid field to indicate...}
	  if status_bytes.tttt in [5,6]
	    then devid := 2         {double-sided disc}
	    else devid := 1;        {single-sided disc}
	HP8290X: {use the otherwise undefined devid field to indicate...}
	  devid := ord(status_bytes.r);  {Sparrow (1) versus Chinook (0)}
	otherwise
	  {do nothing};
      end; {case}
  end; {status}


procedure syndrome(uep: uep_type; var syndrome_bytes: syndrome_type);
  var
    syndrome_cmd_buf: ftcb_type;
  const
    send_syn_sec = 8;
  begin {syndrome}
    issue_cmd(uep, req_syndrome, syndrome_cmd_buf);
    HPIBshort_msge_in(uep, send_syn_sec, addr(syndrome_bytes), sizeof(syndrome_bytes));
  end; {syndrome}
$page$

function coded_addr(uep: uep_type; record_addr: integer): tva_type;
  var
    map: map_type;
    track: integer;
  begin {coded_addr}
    get_map(uep, map);
    with map do
      begin
	coded_addr.sect  := record_addr mod sec_per_trk;
	track            := record_addr div sec_per_trk;
	if surface_mode(uep) then
	  begin  {select proper 7905/06 logical "volume"}
	    coded_addr.head := track div cyl_per_med + 2*uep^.dv;
	    coded_addr.cyl  := track mod cyl_per_med;
	  end {then}
	else
	  begin
	    coded_addr.head := track mod trk_per_cyl;
	    coded_addr.cyl  := track div trk_per_cyl;
	  end; {else}
      end; {with}
  end; {coded_addr}


function decoded_addr(uep: uep_type; tva: tva_type): integer;
  var
    map: map_type;
    track: integer;
  begin {decoded_addr}
    get_map(uep, map);
    with tva, map do
      begin
	if surface_mode(uep)
	  then track := (head-2*uep^.dv)*cyl_per_med+cyl
	  else track := cyl*trk_per_cyl+head;
	decoded_addr := track*sec_per_trk+sect;
      end; {with}
  end; {decoded_addr}
$page$

procedure seek(uep: uep_type; record_addr: integer);
  var
    seek_cmd_buf:
      packed record
	ftcb: ftcb_type;
	tva: tva_type;
      end;
  begin {seek}
    seek_cmd_buf.tva := coded_addr(uep, record_addr);
    issue_cmd(uep, seek_cmd, seek_cmd_buf.ftcb);
  end; {seek}


procedure addr_record(uep: uep_type; record_addr: integer);
  var
    addr_record_cmd_buf:
      packed record
	ftcb: ftcb_type;
	tva: tva_type;
      end;
  begin {addr_record}
    addr_record_cmd_buf.tva := coded_addr(uep, record_addr);
    issue_cmd(uep, addr_record_cmd, addr_record_cmd_buf.ftcb);
  end; {addr_record}


function logical_addr(uep: uep_type): integer;
  var
    ladd_cmd_buf: ftcb_type;
    tva: tva_type;
  const
    send_addr_sec = 8;
  begin {logical_addr}
    issue_cmd(uep, req_log_addr, ladd_cmd_buf);
    if not MI_controller(uep) then HPIBwait_for_ppol(uep);
    HPIBshort_msge_in(uep, send_addr_sec, addr(tva), sizeof(tva));
    logical_addr := decoded_addr(uep, tva);
  end; {logical_addr}


end; {CSamigo}
$page$

module amigodvr;

import
  sysglobals, drvasm, bkgnd, discHPIB, CSamigo;

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

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

implement {amigodvr}


{
  procedure used by CTABLE for self-configuring
}
procedure get_letter(uep: uep_type; ident: shortint; var letter: char);
  const
    ident_table_entries = 7;
  var
    index: shortint;
    status_bytes: status_type;
  type
    device_table_type = array[0..3] of char;
    itet = {ident_table_entry_type}
      record
	ident: shortint;
	letter: char;
      end;
    ident_table_type = array[1..ident_table_entries] of itet;
  const
    device_table = device_table_type
      [ {0} 'C', {1} 'P', {2} 'Y', {3} 'X' ];
    ident_table = ident_table_type
      [ {HP9895 }   itet[ ident: 0*256+129 {$0081}, letter: 'H' ],
	{HP8290X}   itet[ ident: 1*256+  4 {$0104}, letter: 'N' ],
	{HP913X_A}  itet[ ident: 1*256+  6 {$0106}, letter: 'U' ],
	{HP913X_B}  itet[ ident: 1*256+ 10 {$010A}, letter: 'V' ],
	{HP913X_C}  itet[ ident: 1*256+ 15 {$010F}, letter: 'W' ],
	{MAC}       itet[ ident: 0*256+  2 {$0002}, letter: 'X' ],
	{IDC}       itet[ ident: 0*256+  3 {$0003}, letter: 'X' ] ];
  begin {get_letter}

    letter := chr(255); {initially undefined}
    for index := 1 to ident_table_entries do
      if ident=ident_table[index].ident then
	letter := ident_table[index].letter;
    if letter=chr(255) then ioresc_bkgnd(uep, znodevice);

    uep^.letter := letter;  {for determining ppol wait in status routine}
    if dsj(uep)<>0 then {don't worry about it};
    HPIBamigo_clear(uep);
    HPIBwait_for_ppol(uep);
    status(uep, status_bytes);
    if dsj(uep)<>0 then ioresc_bkgnd(uep, zcatchall);
    if status_bytes.ss=2 then ioresc_bkgnd(uep, znodevice);  {"unit not present or power off"}

    if letter='X' then  {determine which 7906 family member it really is}
      begin
	if not (status_bytes.tttt in [0..3]) then
	  ioresc_bkgnd(uep, znodevice); {unrecognized unit type}
	letter := device_table[status_bytes.tttt];
      end; {if}

  end; {get_letter}


procedure clear_unit(uep:uep_type);
  type
    device_ident_type = array[HP9895..HP913X_C] of shortint;
    device_table_type = array[0..3] of amigo_dev_type;
  const
    device_ident = device_ident_type
      [ {HP9895 }   0*256+129,  {$0081}
	{HP8290X}   1*256+  4,  {$0104}
	{HP913X_A}  1*256+  6,  {$0106}
	{HP913X_B}  1*256+ 10,  {$010A}
	{HP913X_C}  1*256+ 15   {$010F} ];
    MAC_ident = 0*256+2;  {$0002}
    IDC_ident = 0*256+3;  {$0003}
    device_table = device_table_type
      [ {0} HP7906, {1} HP7920, {2} HP7905, {3} HP7925 ];
  var
    dev: amigo_dev_type;
    ident: shortint;
    dummy_dsj: byte;
    status_bytes: status_type;
  begin {clear_unit}
    dev := device(uep);
    ident := HPIBamigo_identify(uep);
    if MI_controller(uep) then  {check for MAC or IDC controller}
      begin
	if not ((ident=MAC_ident) or ((ident=IDC_ident) and Simon_DMA(uep))) then
	  ioresc_bkgnd(uep, znodevice);
      end {then}
    else  {require EXACT device/ident match}
      if ident<>device_ident[dev] then ioresc_bkgnd(uep, znodevice);
    if dev=HP8290X then {avoid the amigo clear; it takes too much time!}
      dummy_dsj := dsj(uep)  {just remove the power-on holdoff}
    else  {go ahead and do the hard clear}
      begin
	HPIBamigo_clear(uep);
	HPIBwait_for_ppol(uep);
      end; {else}
    status(uep, status_bytes);
    if dsj(uep)<>0 then ioresc_bkgnd(uep, zcatchall);
    if status_bytes.ss=2 then ioresc_bkgnd(uep, znodevice);     {"unit not present or power off"}
    if MI_controller(uep) then  {we need to check the exact type of THIS particular unit}
      begin
	if not (status_bytes.tttt in [0..3]) then
	  ioresc_bkgnd(uep, znodevice); {unrecognized unit type}
	if dev<>device_table[status_bytes.tttt] then
	  ioresc_bkgnd(uep, znodevice); {wrong unit type}
      end; {then}
  end; {clear_unit}
$page$

{
  procedures in the background transfer chain
}
procedure initial_seek           (uep: uep_type);  forward;
procedure enter_transfer_chain   (uep: anyptr);    forward;
procedure issue_transfer_request (uep: uep_type);  forward;
procedure initiate_data_transfer (uep: anyptr);    forward;
procedure upon_data_transfer_comp(uep: anyptr);    forward;
procedure check_dsj              (uep: anyptr);    forward;


{
  main driver procedure
}
procedure amigoio;

  var
    uep: uep_type;
    ident: shortint;
    asynchronous: boolean;

  begin {amigoio}

    uep := addr(unitable^[fp^.funit]);
    asynchronous := (request=startread) or (request=startwrite);

    if uep^.offline then
      ioresult := ord(znodevice)
    else
      try

	ioresult := ord(inoerror);

	case request of

	  clearunit:
	    begin
	      uep^.umediavalid := false;
	      unit_wait(uep);
	      ioresult := ord(inoerror);  {forget any previous error}
	      allocate_bkgnd_info(uep);
	      HPIBcheck_sc(uep);
	      clear_unit(uep);
	      deallocate_bkgnd_info(uep);
	    end;

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

	  flush:
	    {do nothing};

	  readbytes, writebytes, startread, startwrite:
	    begin {transfer operations}
	      unit_wait(uep);
	      ioresult := ord(inoerror);  {forget any previous error}
	      allocate_bkgnd_info(uep);

	      with bip_type(uep^.dvrtemp)^ do
		begin
		  feot := fp^.feot;       {end of transfer procedure}
		  fibptr := fp;           {parmeter to the eot procedure}
		  async := asynchronous;  {determines whether or not to call eot proc}

		  if Simon_no_dma(uep) then
		    ioresc_bkgnd(uep, zbaddma);
		  if uep^.ureportchange and not uep^.umediavalid then
		    ioresc_bkgnd(uep, zmediumchanged);
		  if position mod 256<>0 then
		    ioresc_bkgnd(uep, zbadmode);
		  if (position<0) or (length<0) or (position+length>fp^.fpeof) then
		    ioresc_bkgnd(uep, ieof);

		  HPIBcheck_sc(uep);
		  ident := HPIBamigo_identify(uep);  {confirm device present}
		  if dsj(uep)<>0 then {do nothing};  {remove power-on holdoff if any}

		  if length=0 then
		    deallocate_bkgnd_info(uep)  {nothing to transfer}
		  else
		    begin
		      read_operation      :=  (request=readbytes) or (request=startread);
		      xfr_chain_semaphore :=  false;
		      bx_tries            :=  0;
		      bx_strt_rcrd        :=  (position+fp^.fileid+uep^.byteoffset) div 256;
		      bx_bufptr           :=  addr(buffer);
		      bx_length           :=  length;
		      initial_seek(uep);  {initiate the transfer}
		    end; {else}
		end; {with}

	      if not asynchronous then
		begin
		  unit_wait(uep);
		  uep^.dvrtemp := ord(inoerror);  {report synchronous errors only once}
		end; {if}
	    end; {transfer operations}

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

	end; {cases}

      recover
	begin
	  abort_bkgnd_process(uep);
	  ioresult := uep^.dvrtemp;
	  if not asynchronous then
	    uep^.dvrtemp := ord(inoerror);  {report synchronous errors only once}
	end; {recover}

  end; {amigoio}
$page$

procedure initial_seek(uep: uep_type);
  var
    status_bytes: status_type;
  begin {initial_seek}

    if device(uep)=HP9895 then  {read status to determine single or double-sided}
      begin
	status(uep, status_bytes);
	with status_bytes do  {specifically disallow non HP-formatted discs}
	  begin
	    if f then
	      begin
		uep^.umediavalid := false;
		if uep^.ureportchange then
		  ioresc_bkgnd(uep, zmediumchanged);
	      end; {if}
	    if (ss=0) and not (tttt in [2,6]) then
	      ioresc_bkgnd(uep, zuninitialized)
	  end; {with}
      end; {if}

    with bip_type(uep^.dvrtemp)^ do
      begin

	if MI_controller(uep) then
	  begin
	    set_file_mask(uep);
	    buffered_transfer := not Simon_DMA(uep);
	    HPIBwait_for_ppol(uep);  {shouldn't take very long!}
	  end {then}
	else
	  if device(uep)=HP8290X
	    then buffered_transfer := uep^.devid=0  {Sparrow (1) versus Chinook (0)}
	    else buffered_transfer := false;

	if device(uep) in [HP913X_A..HP913X_C]
	  then addr_record(uep, bx_strt_rcrd)   {allows greater overlapping with 9914}
	  else seek       (uep, bx_strt_rcrd);

	HPIBupon_ppol_resp(uep, enter_transfer_chain);

      end; {with}

  end; {initial_seek}


procedure enter_transfer_chain(uep: anyptr);
  begin {enter_transfer_chain}
    with bip_type(uep_type(uep)^.dvrtemp)^ do
      if not test_and_toggle(xfr_chain_semaphore) then
	repeat
	  issue_transfer_request(uep);
	until test_and_toggle(xfr_chain_semaphore);
  end; {enter_transfer_chain}
$page$

procedure issue_transfer_request(uep: uep_type);
  const
    sect_per_surf = 400*48;  {only valid for 7905/06!!!}
  var
    transfer_command: command_type;
    transfer_cmd_buf: ftcb_type;
    max_tfr_length: integer;
    remaining_surf_bytes: integer;
    wait_for_ppol: boolean;
  begin {issue_transfer_request}
    with bip_type(uep^.dvrtemp)^ do
      try
	if buffered_transfer then
	  begin
	    if read_operation
	      then transfer_command := buf_read_cmd
	      else transfer_command := buf_write_cmd;
	    max_tfr_length := 256;
	  end {then}
	else
	  begin
	    if read_operation
	      then transfer_command := unbuf_read_cmd
	      else transfer_command := unbuf_write_cmd;
	    if MI_controller(uep) then
	      begin
		max_tfr_length := 65536;  {max DMA burst length}
		if surface_mode(uep) then {don't try to cross a surface boundary}
		  begin
		    remaining_surf_bytes := (sect_per_surf-bx_strt_rcrd mod sect_per_surf)*256;
		    if remaining_surf_bytes<max_tfr_length then
		      max_tfr_length := remaining_surf_bytes;
		  end; {then}
	      end {then}
	    else
	      max_tfr_length := maxint;
	  end; {else}

	if bx_length<=max_tfr_length
	  then bx_tfr_length := bx_length
	  else bx_tfr_length := max_tfr_length;

	wait_for_ppol := buffered_transfer or (device(uep)=HP8290X);
	issue_cmd(uep, transfer_command, transfer_cmd_buf);
	if wait_for_ppol  {computed above because of critical MAC/IDC timing!}
	  then HPIBupon_ppol_resp(uep, initiate_data_transfer)
	  else initiate_data_transfer(uep);
      recover
	abort_bkgnd_process(uep);
  end; {issue_transfer_request}
$page$

procedure initiate_data_transfer(uep: anyptr);
  const
    tfr_data_sec = 0;
  begin {initiate_data_transfer}
    with bip_type(uep_type(uep)^.dvrtemp)^ do
      try
	HPIBupon_dxfr_comp(uep, tfr_data_sec, bx_bufptr, bx_tfr_length, upon_data_transfer_comp);
      recover
	abort_bkgnd_process(uep);
  end; {initiate_data_transfer}


procedure upon_data_transfer_comp(uep: anyptr);
  begin {upon_data_transfer_comp}
    try
      if bip_type(uep_type(uep)^.dvrtemp)^.iores<>inoerror then escape(-10);
      HPIBupon_ppol_resp(uep, check_dsj);
    recover
      abort_bkgnd_process(uep);
  end; {upon_data_transfer_comp}


procedure check_dsj(uep: anyptr);
  var
    transfer_successful: boolean;
  const
    maxtries = 10;

  procedure process_errors(uep: uep_type);
    var
      status_bytes: status_type;
      syndrome_bytes: syndrome_type;
      cb_ptr: charptr;
      cb_index: shortint;
      e_rcrd: integer;
      possible_bytes_transferred: integer;
    begin {process_errors}
      with bip_type(uep^.dvrtemp)^ do
	begin
	  status(uep, status_bytes);
	  if dsj(uep)<>0 then ioresc_bkgnd(uep, zcatchall);
	  with status_bytes do
	    case s1 of
	      {retryable errors}
		cylinder_compare_error,
		uncorrectable_data_error,
		head_sector_compare_error,
		end_of_cylinder,
		sync_bit_not_received_in_time,
		overrun,
		possibly_correctable_data_error,
		illegal_access_to_spare_track,
		defective_track,
		access_not_ready_during_data_operation:
		  begin  {retryable errors case}
		    if s1=overrun
		      then e_rcrd := bx_strt_rcrd  {addr untrustworthy after overrun}
		      else e_rcrd := logical_addr(uep);

		    if s1=cylinder_compare_error then
		      if MI_controller(uep) then  {recalibrate & retry}
			begin
			  recalibrate(uep);
			  HPIBwait_for_ppol(uep); {shouldn't happen very often!}
			end {then}
		      else if e_rcrd=bx_strt_rcrd then  {don't retry...}
			ioresc_bkgnd(uep, znoblock);  {Chinook takes 25 secs/retry!!!}

		    if e_rcrd<=bx_strt_rcrd then  {careful with MAC/IDC verify address!}
		      begin
			bx_tries := bx_tries+1;
			transfer_successful := false;  {unless correctable below}
			if (s1=possibly_correctable_data_error) and (bx_tries>5) then
			  with syndrome_bytes do
			    begin
			      syndrome(uep, syndrome_bytes);
			      if (sb_s1=possibly_correctable_data_error)  and
				 (decoded_addr(uep, sb_tva)=e_rcrd)       and
				 (sb_offset>=0)                           and
				 (sb_offset<=125)                         then {it's correctable!}
				begin
				  cb_ptr := addr(bx_bufptr^,2*sb_offset);
				  cb_index := 0;
				  while (cb_index<6) and
					(integer(cb_ptr)<integer(bx_bufptr)+bx_tfr_length) do
				    begin
				      eor(sb_correction_bytes[cb_index], cb_ptr);
				      cb_ptr := addr(cb_ptr^, 1);
				      cb_index := cb_index+1;
				    end; {while}
				  e_rcrd := e_rcrd+1;  {this record has been corrected!}
				  bx_tries := 0;  {no attempts made on the next record yet}
				  transfer_successful := true;  {at least partially!}
				end; {then}
			    end; {with}
		      end {then}
		    else
		      begin
			bx_tries := 1;  {first attempt on this record}
			transfer_successful := true;  {at least partially!}
		      end; {else}

		    if transfer_successful then
		      begin
			possible_bytes_transferred := (e_rcrd-bx_strt_rcrd)*256;
			if bx_tfr_length>possible_bytes_transferred then
			  bx_tfr_length := possible_bytes_transferred;
		      end {then}
		    else
		      if bx_tries>=maxtries then
			if s1 in [uncorrectable_data_error, possibly_correctable_data_error]
			  then ioresc_bkgnd(uep, zbadblock)
			  else ioresc_bkgnd(uep, znoblock);
		  end;  {retryable errors case}

	      {immediate escape errors}
		illegal_drive_type,
		unit_unavailable:
		  ioresc_bkgnd(uep, znodevice);
		attempt_to_write_on_protected_track:
		  ioresc_bkgnd(uep, zprotected);

	      {errors requiring status 2 processing}
		status_2_error:
		  begin
		    if f then
		      uep^.umediavalid := false;
		    if e then ioresc_bkgnd(uep, zbadhardware);
		    case ss of
		      1: ioresc_bkgnd(uep, znotready);
		      2: ioresc_bkgnd(uep, znodevice);
		      3: ioresc_bkgnd(uep, znomedium);
		      otherwise {test further conditions below};
		    end; {case}
		    if not read_operation and w then
		      ioresc_bkgnd(uep, zprotected);
		    if not MI_controller(uep) and not (tttt in [2,6]) then
		      ioresc_bkgnd(uep, zuninitialized);
		    if f then
		      begin
			if uep^.ureportchange then
			  ioresc_bkgnd(uep, zmediumchanged);
			bx_tries := bx_tries+1;
			if bx_tries>1 then
			  ioresc_bkgnd(uep, zcatchall);
			transfer_successful := false;
		      end {then}
		    else
		      ioresc_bkgnd(uep, zcatchall);
		  end;
		drive_attention:
		  begin
		    if e then ioresc_bkgnd(uep, zbadhardware);
		    if c then
		      begin
			e_rcrd := logical_addr(uep);
			if e_rcrd>(bx_strt_rcrd+(bx_tfr_length-1)div 256) then
			  transfer_successful := true  {already transferred enough bytes}
			else
			  if e_rcrd>=records_per_medium(uep)
			    then ioresc_bkgnd(uep, znosuchblk)
			    else ioresc_bkgnd(uep, znoblock);
		      end {then}
		    else
		      ioresc_bkgnd(uep, zcatchall);
		  end;

	      {other errors}
		otherwise
		  ioresc_bkgnd(uep, zcatchall);
	    end; {case}
	end; {with}
    end; {process_errors}
$page$

  begin {check_dsj}
    with bip_type(uep_type(uep)^.dvrtemp)^ do
      try

	if dsj(uep)=0 then
	  if bdx_pre_eoi
	    then ioresc_bkgnd(uep, zcatchall)  {unresolved premature eoi!}
	    else transfer_successful := true
	else
	  process_errors(uep);  {will set/clear transfer_successful, or escape}

	if transfer_successful then
	  begin
	    bx_strt_rcrd := bx_strt_rcrd+bx_tfr_length div 256;
	    bx_bufptr := addr(bx_bufptr^, bx_tfr_length);
	    bx_length := bx_length-bx_tfr_length;
	  end; {then}

	if bx_length>0 then
	  if MI_controller(uep) or not transfer_successful then
	    begin
	      if device(uep) in [HP913X_A..HP913X_C, HP7905..HP7925]
		then addr_record(uep, bx_strt_rcrd)
		else seek       (uep, bx_strt_rcrd);
	      HPIBupon_ppol_resp(uep, enter_transfer_chain);
	    end {then}
	  else
	    enter_transfer_chain(uep)
	else
	  deallocate_bkgnd_info(uep);

      recover
	abort_bkgnd_process(uep);
  end; {check_dsj}


end; {amigodvr}



{ program AMIGOinit }

import
  loader;

begin {AMIGOinit}
  markuser;
end. {AMIGOinit}


@


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


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


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


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

 (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 4/10/85 }

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

$page$
$copyright 'COPYRIGHT (C) 1983 BY HEWLETT-PACKARD COMPANY'$


program AMIGOinit;

module CSamigo; {amigo command set}

import
  sysglobals, bkgnd, discHPIB;

export

  type

    amigo_dev_type =  {enumerated supported amigo devices}
      (HP9895, HP8290X, HP913X_A, HP913X_B, HP913X_C, HP7905, HP7906, HP7920, HP7925);

    command_type = {commands supported by the issue_cmd procedure}
      ( req_status,       { request status             }
	req_syndrome,     { request syndrome           }
	req_log_addr,     { request logical address    }
	seek_cmd,         { seek                       }
	addr_record_cmd,  { address record             }
	recalibrate_cmd,  { recalibrate                }
	unbuf_read_cmd,   { unbuffered read            }
	verify_cmd,       { verify                     }
	unbuf_write_cmd,  { unbuffered write           }
	init_d_cmd,       { initialize, setting D bits }
	format_cmd,       { format                     }
	buf_read_cmd,     { buffered read              }
	buf_write_cmd );  { buffered write             }

    ftcb_type = {first two command bytes -  structure for most commands}
      packed record
	opcode: byte;
	unit: byte;
      end;

    s1_type =  {enumerated status 1 values}
      (
normal_completion                      , illegal_opcode                         ,
unit_available                         , illegal_drive_type                     ,
s1_4                                   , s1_5                                   ,
s1_6                                   , cylinder_compare_error                 ,
uncorrectable_data_error               , head_sector_compare_error              ,
io_program_error                       , s1_11                                  ,
end_of_cylinder                        , sync_bit_not_received_in_time          ,
overrun                                , possibly_correctable_data_error        ,
illegal_access_to_spare_track          , defective_track                        ,
access_not_ready_during_data_operation , status_2_error                         ,
s1_20                                  , s1_21                                  ,
attempt_to_write_on_protected_track    , unit_unavailable                       ,
s1_24                                  , s1_25                                  ,
s1_26                                  , s1_27                                  ,
s1_28                                  , s1_29                                  ,
s1_30                                  , drive_attention
      );
$page$

    tva_type = {three vector address}
      packed record
	cyl: shortint;    { cylinder address }
	head: byte;       { head address     }
	sect: byte;       { sector address   }
      end;

    status_type = {4 bytes of returned status}
      packed record
	  { stat 1 - from previous operation }
	s: boolean;      { 15       spare track bit        }
	p: boolean;      { 14       protected track bit    }
	d: boolean;      { 13       defective track bit    }
	s1: s1_type;     { 12-8     last operation status  }
	unit: byte;      { 7-0      unit number            }
	  { stat 2 - from specified drive }
	star: boolean;   { 15       conditions *'ed below  }
	xx: 0..3;        { 14-13    undefined              }
	tttt: 0..15;     { 12-9     disc type bits         }
	r: boolean;      { 8        reserved               }
	a: boolean;      { 7        drive attention        }
	w: boolean;      { 6        write protected        }
	fmt: boolean;    { 5        format switch          }
	e: boolean;      { 4        *drive fault           }
	f: boolean;      { 3        first status bit       }
	c: boolean;      { 2        *seek check            }
	ss: 0..3;        { 1,0      *drive ready status    }
      end;

    syndrome_type = {14 bytes of returned syndrome information}
      packed record
	sb_pad1: 0..7;
	sb_s1: s1_type;
	sb_pad2: byte;
	sb_tva: tva_type;
	sb_offset: shortint;
	sb_correction_bytes: packed array[0..5] of char;
      end;

    map_type = {media addressing parameters}
      record
	cyl_per_med: shortint;  { number of cylinders per medium  }
	trk_per_cyl: shortint;  { number of tracks per cylinder   }
	sec_per_trk: shortint;  { number of sectors per track     }
      end;

    unsigned16 = 0..65535;
  $page$

  function  device             (uep: uep_type): amigo_dev_type;
  function  MI_controller      (uep: uep_type): boolean;
  function  surface_mode       (uep: uep_type): boolean;
  procedure get_map            (uep: uep_type; var map: map_type);
  function  records_per_medium (uep: uep_type): integer;
  function  decoded_addr       (uep: uep_type; tva: tva_type): integer;

  procedure issue_cmd          (uep: uep_type; command: command_type; var cmd_buffer: ftcb_type);
  function  dsj                (uep: uep_type): byte;
  procedure set_file_mask      (uep: uep_type);
  procedure recalibrate        (uep: uep_type);
  procedure status             (uep: uep_type; var status_bytes: status_type);
  procedure syndrome           (uep: uep_type; var syndrome_bytes: syndrome_type);
  procedure seek               (uep: uep_type; record_addr: integer);
  procedure addr_record        (uep: uep_type; record_addr: integer);
  function  logical_addr       (uep: uep_type): integer;

implement {CSamigo}

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


function device(uep: uep_type): amigo_dev_type;
  begin {device}
    case uep^.letter of
      'H':       device := HP9895;
      'N':       device := HP8290X;
      'U':       device := HP913X_A;
      'V':       device := HP913X_B;
      'W':       device := HP913X_C;
      'Y':       device := HP7905;
      'C':       device := HP7906;
      'P':       device := HP7920;
      'X':       device := HP7925;
      otherwise  ioresc_bkgnd(uep, znodevice);
    end {case}
  end; {device}


function MI_controller(uep: uep_type): boolean;
  begin {MI_controller}
    MI_controller := device(uep) in [HP7905, HP7906, HP7920, HP7925];
  end; {MI_controller}


function surface_mode(uep: uep_type): boolean;
  begin {surface_mode}
    surface_mode := device(uep) in [HP7905, HP7906];
  end; {surface_mode}
$page$

procedure get_map(uep: uep_type; var map: map_type);
  type
    device_maps_type = array[HP8290X..HP7925] of map_type;
  const
    DS9895_map = map_type[ cyl_per_med:  75,  trk_per_cyl: 2,  sec_per_trk: 30];
    SS9895_map = map_type[ cyl_per_med:  73,  trk_per_cyl: 1,  sec_per_trk: 30];
    device_maps = device_maps_type
     [{HP8290X}  map_type[ cyl_per_med:  33,  trk_per_cyl: 2,  sec_per_trk: 16],
      {HP913X_A} map_type[ cyl_per_med: 152,  trk_per_cyl: 4,  sec_per_trk: 31],
      {HP913X_B} map_type[ cyl_per_med: 305,  trk_per_cyl: 4,  sec_per_trk: 31],
      {HP913X_C} map_type[ cyl_per_med: 305,  trk_per_cyl: 6,  sec_per_trk: 31],
      {HP7905}   map_type[ cyl_per_med: 400,  trk_per_cyl: 2,  sec_per_trk: 48],
      {HP7906}   map_type[ cyl_per_med: 400,  trk_per_cyl: 2,  sec_per_trk: 48],
      {HP7920}   map_type[ cyl_per_med: 800,  trk_per_cyl: 5,  sec_per_trk: 48],
      {HP7925}   map_type[ cyl_per_med: 800,  trk_per_cyl: 9,  sec_per_trk: 64]  ];
  var
    this_device: amigo_dev_type;
  begin {get_map}
    this_device := device(uep);
    if this_device=HP9895 then {use single/double-sided flag set by status routine}
      case uep^.devid of
	1:  map := SS9895_map;
	2:  map := DS9895_map;
	otherwise ioresc_bkgnd(uep, zcatchall);
      end {case}
    else
      map := device_maps[this_device];
end; {get_map}


function records_per_medium(uep: uep_type): integer;
  var
    map: map_type;
  begin {records_per_medium}
    get_map(uep, map);
    with map do
      records_per_medium := sec_per_trk*trk_per_cyl*cyl_per_med;
  end; {records_per_medium}


function dsj(uep: uep_type): byte;
  var
    dsj_byte: packed record  b: byte;  end;
  const
    dsj_sec = 16;
  begin {dsj}
    HPIBshort_msge_in(uep, dsj_sec, addr(dsj_byte), sizeof(dsj_byte));
    dsj := dsj_byte.b;
  end; {dsj}
$page$

procedure issue_cmd(uep: uep_type; command: command_type; var cmd_buffer: ftcb_type);
  type
    ctet = {command table entry type}
      packed record
	sec: shortint; { secondary command     }
	oc: byte;      { opcode                }
	nb: byte;      { number of data bytes  }
      end;
    command_table_type = packed array[command_type] of ctet;
  const
    command_table = command_table_type
      [ {req_status     }  ctet[sec:  8, oc: 03, nb: 2],
	{req_syndrome   }  ctet[sec:  8, oc: 13, nb: 2],
	{req_log_addr   }  ctet[sec:  8, oc: 20, nb: 2],
	{seek_cmd       }  ctet[sec:  8, oc: 02, nb: 6],
	{addr_record_cmd}  ctet[sec:  8, oc: 12, nb: 6],
	{recalibrate_cmd}  ctet[sec:  8, oc: 01, nb: 2],
	{unbuf_read_cmd }  ctet[sec:  8, oc: 05, nb: 2],
	{verify_cmd     }  ctet[sec:  8, oc: 07, nb: 4],
	{unbuf_write_cmd}  ctet[sec:  8, oc: 08, nb: 2],
	{init_d_cmd     }  ctet[sec:  8, oc: 43, nb: 2],
	{format_cmd     }  ctet[sec: 12, oc: 24, nb: 5],
	{buf_read_cmd   }  ctet[sec: 10, oc: 05, nb: 2],
	{buf_write_cmd  }  ctet[sec:  9, oc: 08, nb: 2]  ];
  begin {issue_cmd}
    with cmd_buffer, command_table[command] do
      begin
	opcode := oc;
	unit := uep^.du;
	HPIBshort_msge_out(uep, sec, addr(cmd_buffer), nb);
      end; {with}
  end; {issue_cmd}


procedure set_file_mask(uep: uep_type);
  type
    sfm_cmd_type =  {set file mask command}
      packed record
	oc: byte;
	mask: byte;
      end;
    sfm_cmd_array_type = array[boolean] of sfm_cmd_type;
  const
    sfm_sec = 8;        {secondary}
    sfm_oc = 15;        {op code}
    sfm_cmd_array = sfm_cmd_array_type
      [ {false: cylinder mode} sfm_cmd_type[ oc: sfm_oc, mask: 7 ],
	{true:  surface mode } sfm_cmd_type[ oc: sfm_oc, mask: 5 ]  ];
  var
    sfm_cmd: sfm_cmd_type;
  begin {set_file_mask}
    sfm_cmd := sfm_cmd_array[surface_mode(uep)];
    HPIBshort_msge_out(uep, sfm_sec, addr(sfm_cmd), sizeof(sfm_cmd));
  end; {set_file_mask}
$page$

procedure recalibrate(uep: uep_type);
  var
    recalibrate_cmd_buf: ftcb_type;
  begin {recalibrate}
    issue_cmd(uep, recalibrate_cmd, recalibrate_cmd_buf);
  end; {recalibrate}


procedure status(uep: uep_type; var status_bytes: status_type);
  var
    status_cmd_buf: ftcb_type;
  const
    send_sts_sec = 8;
  begin {status}
    issue_cmd(uep, req_status, status_cmd_buf);
    if not MI_controller(uep) then HPIBwait_for_ppol(uep);
    HPIBshort_msge_in(uep, send_sts_sec, addr(status_bytes), sizeof(status_bytes));
    most_recent_status := status_bytes;  {for post-mortem diagnostic purposes only!}
    with uep^ do
      case device(uep) of
	HP9895:  {use the otherwise undefined devid field to indicate...}
	  if status_bytes.tttt in [5,6]
	    then devid := 2         {double-sided disc}
	    else devid := 1;        {single-sided disc}
	HP8290X: {use the otherwise undefined devid field to indicate...}
	  devid := ord(status_bytes.r);  {Sparrow (1) versus Chinook (0)}
	otherwise
	  {do nothing};
      end; {case}
  end; {status}


procedure syndrome(uep: uep_type; var syndrome_bytes: syndrome_type);
  var
    syndrome_cmd_buf: ftcb_type;
  const
    send_syn_sec = 8;
  begin {syndrome}
    issue_cmd(uep, req_syndrome, syndrome_cmd_buf);
    HPIBshort_msge_in(uep, send_syn_sec, addr(syndrome_bytes), sizeof(syndrome_bytes));
  end; {syndrome}
$page$

function coded_addr(uep: uep_type; record_addr: integer): tva_type;
  var
    map: map_type;
    track: integer;
  begin {coded_addr}
    get_map(uep, map);
    with map do
      begin
	coded_addr.sect  := record_addr mod sec_per_trk;
	track            := record_addr div sec_per_trk;
	if surface_mode(uep) then
	  begin  {select proper 7905/06 logical "volume"}
	    coded_addr.head := track div cyl_per_med + 2*uep^.dv;
	    coded_addr.cyl  := track mod cyl_per_med;
	  end {then}
	else
	  begin
	    coded_addr.head := track mod trk_per_cyl;
	    coded_addr.cyl  := track div trk_per_cyl;
	  end; {else}
      end; {with}
  end; {coded_addr}


function decoded_addr(uep: uep_type; tva: tva_type): integer;
  var
    map: map_type;
    track: integer;
  begin {decoded_addr}
    get_map(uep, map);
    with tva, map do
      begin
	if surface_mode(uep)
	  then track := (head-2*uep^.dv)*cyl_per_med+cyl
	  else track := cyl*trk_per_cyl+head;
	decoded_addr := track*sec_per_trk+sect;
      end; {with}
  end; {decoded_addr}
$page$

procedure seek(uep: uep_type; record_addr: integer);
  var
    seek_cmd_buf:
      packed record
	ftcb: ftcb_type;
	tva: tva_type;
      end;
  begin {seek}
    seek_cmd_buf.tva := coded_addr(uep, record_addr);
    issue_cmd(uep, seek_cmd, seek_cmd_buf.ftcb);
  end; {seek}


procedure addr_record(uep: uep_type; record_addr: integer);
  var
    addr_record_cmd_buf:
      packed record
	ftcb: ftcb_type;
	tva: tva_type;
      end;
  begin {addr_record}
    addr_record_cmd_buf.tva := coded_addr(uep, record_addr);
    issue_cmd(uep, addr_record_cmd, addr_record_cmd_buf.ftcb);
  end; {addr_record}


function logical_addr(uep: uep_type): integer;
  var
    ladd_cmd_buf: ftcb_type;
    tva: tva_type;
  const
    send_addr_sec = 8;
  begin {logical_addr}
    issue_cmd(uep, req_log_addr, ladd_cmd_buf);
    if not MI_controller(uep) then HPIBwait_for_ppol(uep);
    HPIBshort_msge_in(uep, send_addr_sec, addr(tva), sizeof(tva));
    logical_addr := decoded_addr(uep, tva);
  end; {logical_addr}


end; {CSamigo}
$page$

module amigodvr;

import
  sysglobals, drvasm, bkgnd, discHPIB, CSamigo;

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

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

implement {amigodvr}


{
  procedure used by CTABLE for self-configuring
}
procedure get_letter(uep: uep_type; ident: shortint; var letter: char);
  const
    ident_table_entries = 7;
  var
    index: shortint;
    status_bytes: status_type;
  type
    device_table_type = array[0..3] of char;
    itet = {ident_table_entry_type}
      record
	ident: shortint;
	letter: char;
      end;
    ident_table_type = array[1..ident_table_entries] of itet;
  const
    device_table = device_table_type
      [ {0} 'C', {1} 'P', {2} 'Y', {3} 'X' ];
    ident_table = ident_table_type
      [ {HP9895 }   itet[ ident: 0*256+129 {$0081}, letter: 'H' ],
	{HP8290X}   itet[ ident: 1*256+  4 {$0104}, letter: 'N' ],
	{HP913X_A}  itet[ ident: 1*256+  6 {$0106}, letter: 'U' ],
	{HP913X_B}  itet[ ident: 1*256+ 10 {$010A}, letter: 'V' ],
	{HP913X_C}  itet[ ident: 1*256+ 15 {$010F}, letter: 'W' ],
	{MAC}       itet[ ident: 0*256+  2 {$0002}, letter: 'X' ],
	{IDC}       itet[ ident: 0*256+  3 {$0003}, letter: 'X' ] ];
  begin {get_letter}

    letter := chr(255); {initially undefined}
    for index := 1 to ident_table_entries do
      if ident=ident_table[index].ident then
	letter := ident_table[index].letter;
    if letter=chr(255) then ioresc_bkgnd(uep, znodevice);

    uep^.letter := letter;  {for determining ppol wait in status routine}
    if dsj(uep)<>0 then {don't worry about it};
    HPIBamigo_clear(uep);
    HPIBwait_for_ppol(uep);
    status(uep, status_bytes);
    if dsj(uep)<>0 then ioresc_bkgnd(uep, zcatchall);
    if status_bytes.ss=2 then ioresc_bkgnd(uep, znodevice);  {"unit not present or power off"}

    if letter='X' then  {determine which 7906 family member it really is}
      begin
	if not (status_bytes.tttt in [0..3]) then
	  ioresc_bkgnd(uep, znodevice); {unrecognized unit type}
	letter := device_table[status_bytes.tttt];
      end; {if}

  end; {get_letter}


procedure clear_unit(uep:uep_type);
  type
    device_ident_type = array[HP9895..HP913X_C] of shortint;
    device_table_type = array[0..3] of amigo_dev_type;
  const
    device_ident = device_ident_type
      [ {HP9895 }   0*256+129,  {$0081}
	{HP8290X}   1*256+  4,  {$0104}
	{HP913X_A}  1*256+  6,  {$0106}
	{HP913X_B}  1*256+ 10,  {$010A}
	{HP913X_C}  1*256+ 15   {$010F} ];
    MAC_ident = 0*256+2;  {$0002}
    IDC_ident = 0*256+3;  {$0003}
    device_table = device_table_type
      [ {0} HP7906, {1} HP7920, {2} HP7905, {3} HP7925 ];
  var
    dev: amigo_dev_type;
    ident: shortint;
    dummy_dsj: byte;
    status_bytes: status_type;
  begin {clear_unit}
    dev := device(uep);
    ident := HPIBamigo_identify(uep);
    if MI_controller(uep) then  {check for MAC or IDC controller}
      begin
	if not ((ident=MAC_ident) or ((ident=IDC_ident) and Simon_DMA(uep))) then
	  ioresc_bkgnd(uep, znodevice);
      end {then}
    else  {require EXACT device/ident match}
      if ident<>device_ident[dev] then ioresc_bkgnd(uep, znodevice);
    if dev=HP8290X then {avoid the amigo clear; it takes too much time!}
      dummy_dsj := dsj(uep)  {just remove the power-on holdoff}
    else  {go ahead and do the hard clear}
      begin
	HPIBamigo_clear(uep);
	HPIBwait_for_ppol(uep);
      end; {else}
    status(uep, status_bytes);
    if dsj(uep)<>0 then ioresc_bkgnd(uep, zcatchall);
    if status_bytes.ss=2 then ioresc_bkgnd(uep, znodevice);     {"unit not present or power off"}
    if MI_controller(uep) then  {we need to check the exact type of THIS particular unit}
      begin
	if not (status_bytes.tttt in [0..3]) then
	  ioresc_bkgnd(uep, znodevice); {unrecognized unit type}
	if dev<>device_table[status_bytes.tttt] then
	  ioresc_bkgnd(uep, znodevice); {wrong unit type}
      end; {then}
  end; {clear_unit}
$page$

{
  procedures in the background transfer chain
}
procedure initial_seek           (uep: uep_type);  forward;
procedure enter_transfer_chain   (uep: anyptr);    forward;
procedure issue_transfer_request (uep: uep_type);  forward;
procedure initiate_data_transfer (uep: anyptr);    forward;
procedure upon_data_transfer_comp(uep: anyptr);    forward;
procedure check_dsj              (uep: anyptr);    forward;


{
  main driver procedure
}
procedure amigoio;

  var
    uep: uep_type;
    ident: shortint;
    asynchronous: boolean;

  begin {amigoio}

    uep := addr(unitable^[fp^.funit]);
    asynchronous := (request=startread) or (request=startwrite);

    if uep^.offline then
      ioresult := ord(znodevice)
    else
      try

	ioresult := ord(inoerror);

	case request of

	  clearunit:
	    begin
	      uep^.umediavalid := false;
	      unit_wait(uep);
	      ioresult := ord(inoerror);  {forget any previous error}
	      allocate_bkgnd_info(uep);
	      HPIBcheck_sc(uep);
	      clear_unit(uep);
	      deallocate_bkgnd_info(uep);
	    end;

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

	  flush:
	    {do nothing};

	  readbytes, writebytes, startread, startwrite:
	    begin {transfer operations}
	      unit_wait(uep);
	      ioresult := ord(inoerror);  {forget any previous error}
	      allocate_bkgnd_info(uep);

	      with bip_type(uep^.dvrtemp)^ do
		begin
		  feot := fp^.feot;       {end of transfer procedure}
		  fibptr := fp;           {parmeter to the eot procedure}
		  async := asynchronous;  {determines whether or not to call eot proc}

		  if Simon_no_dma(uep) then
		    ioresc_bkgnd(uep, zbaddma);
		  if uep^.ureportchange and not uep^.umediavalid then
		    ioresc_bkgnd(uep, zmediumchanged);
		  if position mod 256<>0 then
		    ioresc_bkgnd(uep, zbadmode);
		  if (position<0) or (length<0) or (position+length>fp^.fpeof) then
		    ioresc_bkgnd(uep, ieof);

		  HPIBcheck_sc(uep);
		  ident := HPIBamigo_identify(uep);  {confirm device present}
		  if dsj(uep)<>0 then {do nothing};  {remove power-on holdoff if any}

		  if length=0 then
		    deallocate_bkgnd_info(uep)  {nothing to transfer}
		  else
		    begin
		      read_operation      :=  (request=readbytes) or (request=startread);
		      xfr_chain_semaphore :=  false;
		      bx_tries            :=  0;
		      bx_strt_rcrd        :=  (position+fp^.fileid+uep^.byteoffset) div 256;
		      bx_bufptr           :=  addr(buffer);
		      bx_length           :=  length;
		      initial_seek(uep);  {initiate the transfer}
		    end; {else}
		end; {with}

	      if not asynchronous then
		begin
		  unit_wait(uep);
		  uep^.dvrtemp := ord(inoerror);  {report synchronous errors only once}
		end; {if}
	    end; {transfer operations}

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

	end; {cases}

      recover
	begin
	  abort_bkgnd_process(uep);
	  ioresult := uep^.dvrtemp;
	  if not asynchronous then
	    uep^.dvrtemp := ord(inoerror);  {report synchronous errors only once}
	end; {recover}

  end; {amigoio}
$page$

procedure initial_seek(uep: uep_type);
  var
    status_bytes: status_type;
  begin {initial_seek}

    if device(uep)=HP9895 then  {read status to determine single or double-sided}
      begin
	status(uep, status_bytes);
	with status_bytes do  {specifically disallow non HP-formatted discs}
	  begin
	    if f then
	      begin
		uep^.umediavalid := false;
		if uep^.ureportchange then
		  ioresc_bkgnd(uep, zmediumchanged);
	      end; {if}
	    if (ss=0) and not (tttt in [2,6]) then
	      ioresc_bkgnd(uep, zuninitialized)
	  end; {with}
      end; {if}

    with bip_type(uep^.dvrtemp)^ do
      begin

	if MI_controller(uep) then
	  begin
	    set_file_mask(uep);
	    buffered_transfer := not Simon_DMA(uep);
	    HPIBwait_for_ppol(uep);  {shouldn't take very long!}
	  end {then}
	else
	  if device(uep)=HP8290X
	    then buffered_transfer := uep^.devid=0  {Sparrow (1) versus Chinook (0)}
	    else buffered_transfer := false;

	if device(uep) in [HP913X_A..HP913X_C]
	  then addr_record(uep, bx_strt_rcrd)   {allows greater overlapping with 9914}
	  else seek       (uep, bx_strt_rcrd);

	HPIBupon_ppol_resp(uep, enter_transfer_chain);

      end; {with}

  end; {initial_seek}


procedure enter_transfer_chain(uep: anyptr);
  begin {enter_transfer_chain}
    with bip_type(uep_type(uep)^.dvrtemp)^ do
      if not test_and_toggle(xfr_chain_semaphore) then
	repeat
	  issue_transfer_request(uep);
	until test_and_toggle(xfr_chain_semaphore);
  end; {enter_transfer_chain}
$page$

procedure issue_transfer_request(uep: uep_type);
  const
    sect_per_surf = 400*48;  {only valid for 7905/06!!!}
  var
    transfer_command: command_type;
    transfer_cmd_buf: ftcb_type;
    max_tfr_length: integer;
    remaining_surf_bytes: integer;
    wait_for_ppol: boolean;
  begin {issue_transfer_request}
    with bip_type(uep^.dvrtemp)^ do
      try
	if buffered_transfer then
	  begin
	    if read_operation
	      then transfer_command := buf_read_cmd
	      else transfer_command := buf_write_cmd;
	    max_tfr_length := 256;
	  end {then}
	else
	  begin
	    if read_operation
	      then transfer_command := unbuf_read_cmd
	      else transfer_command := unbuf_write_cmd;
	    if MI_controller(uep) then
	      begin
		max_tfr_length := 65536;  {max DMA burst length}
		if surface_mode(uep) then {don't try to cross a surface boundary}
		  begin
		    remaining_surf_bytes := (sect_per_surf-bx_strt_rcrd mod sect_per_surf)*256;
		    if remaining_surf_bytes<max_tfr_length then
		      max_tfr_length := remaining_surf_bytes;
		  end; {then}
	      end {then}
	    else
	      max_tfr_length := maxint;
	  end; {else}

	if bx_length<=max_tfr_length
	  then bx_tfr_length := bx_length
	  else bx_tfr_length := max_tfr_length;

	wait_for_ppol := buffered_transfer or (device(uep)=HP8290X);
	issue_cmd(uep, transfer_command, transfer_cmd_buf);
	if wait_for_ppol  {computed above because of critical MAC/IDC timing!}
	  then HPIBupon_ppol_resp(uep, initiate_data_transfer)
	  else initiate_data_transfer(uep);
      recover
	abort_bkgnd_process(uep);
  end; {issue_transfer_request}
$page$

procedure initiate_data_transfer(uep: anyptr);
  const
    tfr_data_sec = 0;
  begin {initiate_data_transfer}
    with bip_type(uep_type(uep)^.dvrtemp)^ do
      try
	HPIBupon_dxfr_comp(uep, tfr_data_sec, bx_bufptr, bx_tfr_length, upon_data_transfer_comp);
      recover
	abort_bkgnd_process(uep);
  end; {initiate_data_transfer}


procedure upon_data_transfer_comp(uep: anyptr);
  begin {upon_data_transfer_comp}
    try
      if bip_type(uep_type(uep)^.dvrtemp)^.iores<>inoerror then escape(-10);
      HPIBupon_ppol_resp(uep, check_dsj);
    recover
      abort_bkgnd_process(uep);
  end; {upon_data_transfer_comp}


procedure check_dsj(uep: anyptr);
  var
    transfer_successful: boolean;
  const
    maxtries = 10;

  procedure process_errors(uep: uep_type);
    var
      status_bytes: status_type;
      syndrome_bytes: syndrome_type;
      cb_ptr: charptr;
      cb_index: shortint;
      e_rcrd: integer;
      possible_bytes_transferred: integer;
    begin {process_errors}
      with bip_type(uep^.dvrtemp)^ do
	begin
	  status(uep, status_bytes);
	  if dsj(uep)<>0 then ioresc_bkgnd(uep, zcatchall);
	  with status_bytes do
	    case s1 of
	      {retryable errors}
		cylinder_compare_error,
		uncorrectable_data_error,
		head_sector_compare_error,
		end_of_cylinder,
		sync_bit_not_received_in_time,
		overrun,
		possibly_correctable_data_error,
		illegal_access_to_spare_track,
		defective_track,
		access_not_ready_during_data_operation:
		  begin  {retryable errors case}
		    if s1=overrun
		      then e_rcrd := bx_strt_rcrd  {addr untrustworthy after overrun}
		      else e_rcrd := logical_addr(uep);

		    if s1=cylinder_compare_error then
		      if MI_controller(uep) then  {recalibrate & retry}
			begin
			  recalibrate(uep);
			  HPIBwait_for_ppol(uep); {shouldn't happen very often!}
			end {then}
		      else if e_rcrd=bx_strt_rcrd then  {don't retry...}
			ioresc_bkgnd(uep, znoblock);  {Chinook takes 25 secs/retry!!!}

		    if e_rcrd<=bx_strt_rcrd then  {careful with MAC/IDC verify address!}
		      begin
			bx_tries := bx_tries+1;
			transfer_successful := false;  {unless correctable below}
			if (s1=possibly_correctable_data_error) and (bx_tries>5) then
			  with syndrome_bytes do
			    begin
			      syndrome(uep, syndrome_bytes);
			      if (sb_s1=possibly_correctable_data_error)  and
				 (decoded_addr(uep, sb_tva)=e_rcrd)       and
				 (sb_offset>=0)                           and
				 (sb_offset<=125)                         then {it's correctable!}
				begin
				  cb_ptr := addr(bx_bufptr^,2*sb_offset);
				  cb_index := 0;
				  while (cb_index<6) and
					(integer(cb_ptr)<integer(bx_bufptr)+bx_tfr_length) do
				    begin
				      eor(sb_correction_bytes[cb_index], cb_ptr);
				      cb_ptr := addr(cb_ptr^, 1);
				      cb_index := cb_index+1;
				    end; {while}
				  e_rcrd := e_rcrd+1;  {this record has been corrected!}
				  bx_tries := 0;  {no attempts made on the next record yet}
				  transfer_successful := true;  {at least partially!}
				end; {then}
			    end; {with}
		      end {then}
		    else
		      begin
			bx_tries := 1;  {first attempt on this record}
			transfer_successful := true;  {at least partially!}
		      end; {else}

		    if transfer_successful then
		      begin
			possible_bytes_transferred := (e_rcrd-bx_strt_rcrd)*256;
			if bx_tfr_length>possible_bytes_transferred then
			  bx_tfr_length := possible_bytes_transferred;
		      end {then}
		    else
		      if bx_tries>=maxtries then
			if s1 in [uncorrectable_data_error, possibly_correctable_data_error]
			  then ioresc_bkgnd(uep, zbadblock)
			  else ioresc_bkgnd(uep, znoblock);
		  end;  {retryable errors case}

	      {immediate escape errors}
		illegal_drive_type,
		unit_unavailable:
		  ioresc_bkgnd(uep, znodevice);
		attempt_to_write_on_protected_track:
		  ioresc_bkgnd(uep, zprotected);

	      {errors requiring status 2 processing}
		status_2_error:
		  begin
		    if f then
		      uep^.umediavalid := false;
		    if e then ioresc_bkgnd(uep, zbadhardware);
		    case ss of
		      1: ioresc_bkgnd(uep, znotready);
		      2: ioresc_bkgnd(uep, znodevice);
		      3: ioresc_bkgnd(uep, znomedium);
		      otherwise {test further conditions below};
		    end; {case}
		    if not read_operation and w then
		      ioresc_bkgnd(uep, zprotected);
		    if not MI_controller(uep) and not (tttt in [2,6]) then
		      ioresc_bkgnd(uep, zuninitialized);
		    if f then
		      begin
			if uep^.ureportchange then
			  ioresc_bkgnd(uep, zmediumchanged);
			bx_tries := bx_tries+1;
			if bx_tries>1 then
			  ioresc_bkgnd(uep, zcatchall);
			transfer_successful := false;
		      end {then}
		    else
		      ioresc_bkgnd(uep, zcatchall);
		  end;
		drive_attention:
		  begin
		    if e then ioresc_bkgnd(uep, zbadhardware);
		    if c then
		      begin
			e_rcrd := logical_addr(uep);
			if e_rcrd>(bx_strt_rcrd+(bx_tfr_length-1)div 256) then
			  transfer_successful := true  {already transferred enough bytes}
			else
			  if e_rcrd>=records_per_medium(uep)
			    then ioresc_bkgnd(uep, znosuchblk)
			    else ioresc_bkgnd(uep, znoblock);
		      end {then}
		    else
		      ioresc_bkgnd(uep, zcatchall);
		  end;

	      {other errors}
		otherwise
		  ioresc_bkgnd(uep, zcatchall);
	    end; {case}
	end; {with}
    end; {process_errors}
$page$

  begin {check_dsj}
    with bip_type(uep_type(uep)^.dvrtemp)^ do
      try

	if dsj(uep)=0 then
	  if bdx_pre_eoi
	    then ioresc_bkgnd(uep, zcatchall)  {unresolved premature eoi!}
	    else transfer_successful := true
	else
	  process_errors(uep);  {will set/clear transfer_successful, or escape}

	if transfer_successful then
	  begin
	    bx_strt_rcrd := bx_strt_rcrd+bx_tfr_length div 256;
	    bx_bufptr := addr(bx_bufptr^, bx_tfr_length);
	    bx_length := bx_length-bx_tfr_length;
	  end; {then}

	if bx_length>0 then
	  if MI_controller(uep) or not transfer_successful then
	    begin
	      if device(uep) in [HP913X_A..HP913X_C, HP7905..HP7925]
		then addr_record(uep, bx_strt_rcrd)
		else seek       (uep, bx_strt_rcrd);
	      HPIBupon_ppol_resp(uep, enter_transfer_chain);
	    end {then}
	  else
	    enter_transfer_chain(uep)
	else
	  deallocate_bkgnd_info(uep);

      recover
	abort_bkgnd_process(uep);
  end; {check_dsj}


end; {amigodvr}



{ program AMIGOinit }

import
  loader;

begin {AMIGOinit}
  markuser;
end. {AMIGOinit}


@


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


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


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