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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

1.1
date     86.06.30.14.24.41;  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$

$search 'GPIODVR', 'IOLIB:COMASM', 'IOLIB:KERNEL'$

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

program F9885init;


module F9885dvr;

import
  sysglobals, mini, gp, iodeclarations, iocomasm, misc;

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


procedure F9885io;

  type
    errors = (noerror, nopower, dooropen, nodisc, badcommand, norecord,
	      notrack, badcheckword, dataoverrun, badverify);

    primarycommands = (readblock, verifyblock, writeblock, settracksector);

    fd = {floppy disc command & status structure}
      packed record case integer of
	-1: (w: shortint);
	 0: (case primary: primarycommands of
	      readblock, verifyblock, writeblock:
		 (drv:  0..3; nrecords: 0..4095);
	      settracksector:
		 (driv: 0..3; track: 0..127; sector: 0..31));
	 1: (pad: 0..15; errcode: errors; p2, transfercomplete,
	     seekcomplete, notready, writeprotected, dooropened: boolean;
	     drve: 0..3);
      end;

    gpio_enable_type = packed array[0..1] of gpio_r3_type;

  const
    maxtries = 10;
    password = -20857;

    gpio_enable = {gpio enable bytes for the 2 DMA channels}
      gpio_enable_type
	[ gpio_r3_type
	   [ Wenab: false, W3pad:0, Wword:true, Wdmac1:false, Wdmac0:true ],
	  gpio_r3_type
	   [ Wenab: false, W3pad:0, Wword:true, Wdmac1:true, Wdmac0:false ] ];
  var
    uep: ^unitentry;
    gptr: ^gpiotype;
    tptr: pio_tmp_ptr;
    bufptr: charptr;
$page$

  procedure clear_unit;
    begin
      with gptr^ do
	if sti1 or sti0 then
	  ioresc(znodevice);
      gpioclear(gptr^);         {also tests psts while waiting for ready}
    end;


  procedure clear_and_escape(escape_value: shortint; iores_value: integer);
    begin {clear_and_escape}
      try
	gpioclear(gptr^);
      recover
	{do nothing};
      ioresult := iores_value;
      escape(escape_value);
    end; {clear_and_escape}


  procedure transfer(record_addr, total_words: integer);
    var
      gpiodma_proc: procedure(var gpio: gpiotype;
			      command: shortint; enable_byte: gpio_r3_type;
			      var dma_channel: dmachanneltype;
			      buffer: charptr; length: integer);
      status, opcode: fd;
      chan, tries, sectors: shortint;
      words: integer;
    const
      request_status = fd
	[ primary: settracksector, driv: 0, track: 127, sector: 31 ];
    begin {transfer}

      if not dma_here then ioresc(zbaddma);

      gptr^.r3 := 0;                    {setup gpio card}
      gptr^.r7 := 0;

      gpiowordout(gptr^, password);     {issue password}
      opcode := request_status;
      opcode.driv := uep^.du;
      gpiowordout(gptr^, opcode.w);     {issue request status command}
      gpiowordout(gptr^, 0);            {clear output regs & request data word}
      status.w := gpiowordin(gptr^);    {input status word}

      if (status.drve<>uep^.du) or (status.pad<>0) then
	clear_and_escape(-10, ord(zcatchall));

      if status.dooropened then
	begin
	  uep^.umediavalid := false;
	  if uep^.ureportchange then
	    ioresc(zmediumchanged);
	end; {if}
$page$

      tries := 0;
      while total_words>0 do
	begin
	  try
	    gpiowordout(gptr^, password);
	    opcode.primary := settracksector;
	    opcode.driv    := uep^.du;
	    opcode.track   := record_addr div 30;
	    opcode.sector  := record_addr mod 30;
	    gpiowordout(gptr^, opcode.w);

	    repeat
	      chan := dma_request(tptr);
	    until chan>=0;
	    if (chan<>0) and (chan<>1) then ioresc(zcatchall);

	    if total_words<=65536
	      then words := total_words
	      else words := 65536;
	    sectors := (words+127) div 128;

	    gpiowordout(gptr^, password);
	    opcode.drv := uep^.du;
	    opcode.nrecords:= sectors;
	    case request of
	      readbytes, startread:
		begin
		  opcode.primary := readblock;
		  gpiodma_proc := gpiodmain;
		end;
	      writebytes, startwrite:
		begin
		  opcode.primary := writeblock;
		  gpiodma_proc := gpiodmaout;
		end;
	    end; {case}
	    call(gpiodma_proc, gptr^, opcode.w, gpio_enable[chan], dma_port[chan], bufptr, words);

	    ioresc(inoerror);  {invoke proper cleanup}
	  recover
	    begin
	      gptr^.r3 := 0;        {disable the gpio card}
	      dma_release(tptr);    {release the dma resource}
	      if (escapecode=-10) and
		 ( (ioresult=ord(inoerror)) or (ioresult= ord(zcatchall)) )
		then ioresult := ord(inoerror)
		else clear_and_escape(escapecode, ioresult);
	    end; {recover}

	  with gptr^ do
	    begin
	      r7 := 1;                          {set the end of transfer bit}
	      Wdata := 0;                       {clear bidirectional buffer for reading status}
	      setpctl := 0;                     {request the status word}
	      status.w := gpiowordin(gptr^);    {save the status word}
	      r7 := 0;                          {clear the end of transfer bit}
	    end; {with}
$page$

	  if (status.drve<>uep^.du) or (status.pad<>0) then
	    clear_and_escape(-10, ord(zcatchall));

	  with status do
	    case errcode of
	      noerror:
		begin
		  if notready or (not seekcomplete) or (not transfercomplete) then
		    clear_and_escape(-10, ord(zcatchall));
		  tries       := 0;
		  record_addr := record_addr+sectors;
		  total_words := total_words-words;
		  bufptr      := addr(bufptr^,words*2)
		end;

	      nopower:
		ioresc(znodevice);

	      dooropen, nodisc:
		ioresc(znomedium);

	      badcommand:
		if writeprotected and ( (request=writebytes) or (request=startwrite) )
		  then ioresc(zprotected)
		  else clear_and_escape(-10, ord(zcatchall));

	      notrack:
		ioresc(znoblock);

	      norecord, badcheckword:
		begin
		  tries := tries+1;
		  if tries>=maxtries then
		    begin
		      if errcode=norecord then ioresc(znoblock);
		      if errcode=badcheckword then ioresc(zbadblock);
		      ioresc(zcatchall);
		    end; {if}
		end;

	      dataoverrun:
		ioresc(zbadhardware);

	      otherwise
		clear_and_escape(-10, ord(zcatchall));
	    end; {case}

	end; {while}

    end; {transfer}
$page$

  begin {F9885io}
    uep := addr(unitable^[fp^.funit]);
    if uep^.offline then ioresult := ord(znodevice)
    else
      begin
	lockup;
	try
	  with isc_table[uep^.sc] do
	    begin
	      if card_id<>hp98622 then ioresc(znodevice);
	      gptr := card_ptr;
	      tptr := io_tmp_ptr;
	    end; {with}

	  case request of
	    clearunit:
	      clear_unit;

	    unitstatus:
	      fp^.fbusy := false;

	    flush:
	      {do nothing};

	    readbytes, writebytes, startread, startwrite:
	      begin
		if uep^.ureportchange and not uep^.umediavalid then
		  ioresc(zmediumchanged);
		bufptr := addr(buffer);
		if (position mod 256<>0) or odd(integer(bufptr)) then
		  ioresc(zbadmode);
		if (position<0) or (length<0) or (position+length>fp^.fpeof) then
		  ioresc(ieof);
		transfer((position+fp^.fileid+uep^.byteoffset) div 256, (length+1) div 2);
	      end;

	    otherwise
	      ioresc(ibadrequest);
	  end; {cases}

	  ioresc(inoerror);  {set ioresult & perform lockdown}
	recover
	  begin
	    lockdown;
	    if escapecode<>-10 then escape(escapecode);
	    if (request=startread) or (request=startwrite) then call(fp^.feot, fp);
	  end; {recover}
      end; {else}
  end; {f9885io}

end; {f9885dvr}


{ program F9885init }

import
  loader;

begin {F9885init}
  markuser;
end. {F9885init}


@


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


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

 (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$

$search 'GPIODVR', 'IOLIB:COMASM', 'IOLIB:KERNEL'$

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

program F9885init;


module F9885dvr;

import
  sysglobals, mini, gp, iodeclarations, iocomasm, misc;

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


procedure F9885io;

  type
    errors = (noerror, nopower, dooropen, nodisc, badcommand, norecord,
	      notrack, badcheckword, dataoverrun, badverify);

    primarycommands = (readblock, verifyblock, writeblock, settracksector);

    fd = {floppy disc command & status structure}
      packed record case integer of
	-1: (w: shortint);
	 0: (case primary: primarycommands of
	      readblock, verifyblock, writeblock:
		 (drv:  0..3; nrecords: 0..4095);
	      settracksector:
		 (driv: 0..3; track: 0..127; sector: 0..31));
	 1: (pad: 0..15; errcode: errors; p2, transfercomplete,
	     seekcomplete, notready, writeprotected, dooropened: boolean;
	     drve: 0..3);
      end;

    gpio_enable_type = packed array[0..1] of gpio_r3_type;

  const
    maxtries = 10;
    password = -20857;

    gpio_enable = {gpio enable bytes for the 2 DMA channels}
      gpio_enable_type
	[ gpio_r3_type
	   [ Wenab: false, W3pad:0, Wword:true, Wdmac1:false, Wdmac0:true ],
	  gpio_r3_type
	   [ Wenab: false, W3pad:0, Wword:true, Wdmac1:true, Wdmac0:false ] ];
  var
    uep: ^unitentry;
    gptr: ^gpiotype;
    tptr: pio_tmp_ptr;
    bufptr: charptr;
$page$

  procedure clear_unit;
    begin
      with gptr^ do
	if sti1 or sti0 then
	  ioresc(znodevice);
      gpioclear(gptr^);         {also tests psts while waiting for ready}
    end;


  procedure clear_and_escape(escape_value: shortint; iores_value: integer);
    begin {clear_and_escape}
      try
	gpioclear(gptr^);
      recover
	{do nothing};
      ioresult := iores_value;
      escape(escape_value);
    end; {clear_and_escape}


  procedure transfer(record_addr, total_words: integer);
    var
      gpiodma_proc: procedure(var gpio: gpiotype;
			      command: shortint; enable_byte: gpio_r3_type;
			      var dma_channel: dmachanneltype;
			      buffer: charptr; length: integer);
      status, opcode: fd;
      chan, tries, sectors: shortint;
      words: integer;
    const
      request_status = fd
	[ primary: settracksector, driv: 0, track: 127, sector: 31 ];
    begin {transfer}

      if not dma_here then ioresc(zbaddma);

      gptr^.r3 := 0;                    {setup gpio card}
      gptr^.r7 := 0;

      gpiowordout(gptr^, password);     {issue password}
      opcode := request_status;
      opcode.driv := uep^.du;
      gpiowordout(gptr^, opcode.w);     {issue request status command}
      gpiowordout(gptr^, 0);            {clear output regs & request data word}
      status.w := gpiowordin(gptr^);    {input status word}

      if (status.drve<>uep^.du) or (status.pad<>0) then
	clear_and_escape(-10, ord(zcatchall));

      if status.dooropened then
	begin
	  uep^.umediavalid := false;
	  if uep^.ureportchange then
	    ioresc(zmediumchanged);
	end; {if}
$page$

      tries := 0;
      while total_words>0 do
	begin
	  try
	    gpiowordout(gptr^, password);
	    opcode.primary := settracksector;
	    opcode.driv    := uep^.du;
	    opcode.track   := record_addr div 30;
	    opcode.sector  := record_addr mod 30;
	    gpiowordout(gptr^, opcode.w);

	    repeat
	      chan := dma_request(tptr);
	    until chan>=0;
	    if (chan<>0) and (chan<>1) then ioresc(zcatchall);

	    if total_words<=65536
	      then words := total_words
	      else words := 65536;
	    sectors := (words+127) div 128;

	    gpiowordout(gptr^, password);
	    opcode.drv := uep^.du;
	    opcode.nrecords:= sectors;
	    case request of
	      readbytes, startread:
		begin
		  opcode.primary := readblock;
		  gpiodma_proc := gpiodmain;
		end;
	      writebytes, startwrite:
		begin
		  opcode.primary := writeblock;
		  gpiodma_proc := gpiodmaout;
		end;
	    end; {case}
	    call(gpiodma_proc, gptr^, opcode.w, gpio_enable[chan], dma_port[chan], bufptr, words);

	    ioresc(inoerror);  {invoke proper cleanup}
	  recover
	    begin
	      gptr^.r3 := 0;        {disable the gpio card}
	      dma_release(tptr);    {release the dma resource}
	      if (escapecode=-10) and
		 ( (ioresult=ord(inoerror)) or (ioresult= ord(zcatchall)) )
		then ioresult := ord(inoerror)
		else clear_and_escape(escapecode, ioresult);
	    end; {recover}

	  with gptr^ do
	    begin
	      r7 := 1;                          {set the end of transfer bit}
	      Wdata := 0;                       {clear bidirectional buffer for reading status}
	      setpctl := 0;                     {request the status word}
	      status.w := gpiowordin(gptr^);    {save the status word}
	      r7 := 0;                          {clear the end of transfer bit}
	    end; {with}
$page$

	  if (status.drve<>uep^.du) or (status.pad<>0) then
	    clear_and_escape(-10, ord(zcatchall));

	  with status do
	    case errcode of
	      noerror:
		begin
		  if notready or (not seekcomplete) or (not transfercomplete) then
		    clear_and_escape(-10, ord(zcatchall));
		  tries       := 0;
		  record_addr := record_addr+sectors;
		  total_words := total_words-words;
		  bufptr      := addr(bufptr^,words*2)
		end;

	      nopower:
		ioresc(znodevice);

	      dooropen, nodisc:
		ioresc(znomedium);

	      badcommand:
		if writeprotected and ( (request=writebytes) or (request=startwrite) )
		  then ioresc(zprotected)
		  else clear_and_escape(-10, ord(zcatchall));

	      notrack:
		ioresc(znoblock);

	      norecord, badcheckword:
		begin
		  tries := tries+1;
		  if tries>=maxtries then
		    begin
		      if errcode=norecord then ioresc(znoblock);
		      if errcode=badcheckword then ioresc(zbadblock);
		      ioresc(zcatchall);
		    end; {if}
		end;

	      dataoverrun:
		ioresc(zbadhardware);

	      otherwise
		clear_and_escape(-10, ord(zcatchall));
	    end; {case}

	end; {while}

    end; {transfer}
$page$

  begin {F9885io}
    uep := addr(unitable^[fp^.funit]);
    if uep^.offline then ioresult := ord(znodevice)
    else
      begin
	lockup;
	try
	  with isc_table[uep^.sc] do
	    begin
	      if card_id<>hp98622 then ioresc(znodevice);
	      gptr := card_ptr;
	      tptr := io_tmp_ptr;
	    end; {with}

	  case request of
	    clearunit:
	      clear_unit;

	    unitstatus:
	      fp^.fbusy := false;

	    flush:
	      {do nothing};

	    readbytes, writebytes, startread, startwrite:
	      begin
		if uep^.ureportchange and not uep^.umediavalid then
		  ioresc(zmediumchanged);
		bufptr := addr(buffer);
		if (position mod 256<>0) or odd(integer(bufptr)) then
		  ioresc(zbadmode);
		if (position<0) or (length<0) or (position+length>fp^.fpeof) then
		  ioresc(ieof);
		transfer((position+fp^.fileid+uep^.byteoffset) div 256, (length+1) div 2);
	      end;

	    otherwise
	      ioresc(ibadrequest);
	  end; {cases}

	  ioresc(inoerror);  {set ioresult & perform lockdown}
	recover
	  begin
	    lockdown;
	    if escapecode<>-10 then escape(escapecode);
	    if (request=startread) or (request=startwrite) then call(fp^.feot, fp);
	  end; {recover}
      end; {else}
  end; {f9885io}

end; {f9885dvr}


{ program F9885init }

import
  loader;

begin {F9885init}
  markuser;
end. {F9885init}


@


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


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


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


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

 (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$

$search 'GPIODVR', 'IOLIB:COMASM', 'IOLIB:KERNEL'$

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

program F9885init;


module F9885dvr;

import
  sysglobals, mini, gp, iodeclarations, iocomasm, misc;

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


procedure F9885io;

  type
    errors = (noerror, nopower, dooropen, nodisc, badcommand, norecord,
	      notrack, badcheckword, dataoverrun, badverify);

    primarycommands = (readblock, verifyblock, writeblock, settracksector);

    fd = {floppy disc command & status structure}
      packed record case integer of
	-1: (w: shortint);
	 0: (case primary: primarycommands of
	      readblock, verifyblock, writeblock:
		 (drv:  0..3; nrecords: 0..4095);
	      settracksector:
		 (driv: 0..3; track: 0..127; sector: 0..31));
	 1: (pad: 0..15; errcode: errors; p2, transfercomplete,
	     seekcomplete, notready, writeprotected, dooropened: boolean;
	     drve: 0..3);
      end;

    gpio_enable_type = packed array[0..1] of gpio_r3_type;

  const
    maxtries = 10;
    password = -20857;

    gpio_enable = {gpio enable bytes for the 2 DMA channels}
      gpio_enable_type
	[ gpio_r3_type
	   [ Wenab: false, W3pad:0, Wword:true, Wdmac1:false, Wdmac0:true ],
	  gpio_r3_type
	   [ Wenab: false, W3pad:0, Wword:true, Wdmac1:true, Wdmac0:false ] ];
  var
    uep: ^unitentry;
    gptr: ^gpiotype;
    tptr: pio_tmp_ptr;
    bufptr: charptr;
$page$

  procedure clear_unit;
    begin
      with gptr^ do
	if sti1 or sti0 then
	  ioresc(znodevice);
      gpioclear(gptr^);         {also tests psts while waiting for ready}
    end;


  procedure clear_and_escape(escape_value: shortint; iores_value: integer);
    begin {clear_and_escape}
      try
	gpioclear(gptr^);
      recover
	{do nothing};
      ioresult := iores_value;
      escape(escape_value);
    end; {clear_and_escape}


  procedure transfer(record_addr, total_words: integer);
    var
      gpiodma_proc: procedure(var gpio: gpiotype;
			      command: shortint; enable_byte: gpio_r3_type;
			      var dma_channel: dmachanneltype;
			      buffer: charptr; length: integer);
      status, opcode: fd;
      chan, tries, sectors: shortint;
      words: integer;
    const
      request_status = fd
	[ primary: settracksector, driv: 0, track: 127, sector: 31 ];
    begin {transfer}

      if not dma_here then ioresc(zbaddma);

      gptr^.r3 := 0;                    {setup gpio card}
      gptr^.r7 := 0;

      gpiowordout(gptr^, password);     {issue password}
      opcode := request_status;
      opcode.driv := uep^.du;
      gpiowordout(gptr^, opcode.w);     {issue request status command}
      gpiowordout(gptr^, 0);            {clear output regs & request data word}
      status.w := gpiowordin(gptr^);    {input status word}

      if (status.drve<>uep^.du) or (status.pad<>0) then
	clear_and_escape(-10, ord(zcatchall));

      if status.dooropened then
	begin
	  uep^.umediavalid := false;
	  if uep^.ureportchange then
	    ioresc(zmediumchanged);
	end; {if}
$page$

      tries := 0;
      while total_words>0 do
	begin
	  try
	    gpiowordout(gptr^, password);
	    opcode.primary := settracksector;
	    opcode.driv    := uep^.du;
	    opcode.track   := record_addr div 30;
	    opcode.sector  := record_addr mod 30;
	    gpiowordout(gptr^, opcode.w);

	    repeat
	      chan := dma_request(tptr);
	    until chan>=0;
	    if (chan<>0) and (chan<>1) then ioresc(zcatchall);

	    if total_words<=65536
	      then words := total_words
	      else words := 65536;
	    sectors := (words+127) div 128;

	    gpiowordout(gptr^, password);
	    opcode.drv := uep^.du;
	    opcode.nrecords:= sectors;
	    case request of
	      readbytes, startread:
		begin
		  opcode.primary := readblock;
		  gpiodma_proc := gpiodmain;
		end;
	      writebytes, startwrite:
		begin
		  opcode.primary := writeblock;
		  gpiodma_proc := gpiodmaout;
		end;
	    end; {case}
	    call(gpiodma_proc, gptr^, opcode.w, gpio_enable[chan], dma_port[chan], bufptr, words);

	    ioresc(inoerror);  {invoke proper cleanup}
	  recover
	    begin
	      gptr^.r3 := 0;        {disable the gpio card}
	      dma_release(tptr);    {release the dma resource}
	      if (escapecode=-10) and
		 ( (ioresult=ord(inoerror)) or (ioresult= ord(zcatchall)) )
		then ioresult := ord(inoerror)
		else clear_and_escape(escapecode, ioresult);
	    end; {recover}

	  with gptr^ do
	    begin
	      r7 := 1;                          {set the end of transfer bit}
	      Wdata := 0;                       {clear bidirectional buffer for reading status}
	      setpctl := 0;                     {request the status word}
	      status.w := gpiowordin(gptr^);    {save the status word}
	      r7 := 0;                          {clear the end of transfer bit}
	    end; {with}
$page$

	  if (status.drve<>uep^.du) or (status.pad<>0) then
	    clear_and_escape(-10, ord(zcatchall));

	  with status do
	    case errcode of
	      noerror:
		begin
		  if notready or (not seekcomplete) or (not transfercomplete) then
		    clear_and_escape(-10, ord(zcatchall));
		  tries       := 0;
		  record_addr := record_addr+sectors;
		  total_words := total_words-words;
		  bufptr      := addr(bufptr^,words*2)
		end;

	      nopower:
		ioresc(znodevice);

	      dooropen, nodisc:
		ioresc(znomedium);

	      badcommand:
		if writeprotected and ( (request=writebytes) or (request=startwrite) )
		  then ioresc(zprotected)
		  else clear_and_escape(-10, ord(zcatchall));

	      notrack:
		ioresc(znoblock);

	      norecord, badcheckword:
		begin
		  tries := tries+1;
		  if tries>=maxtries then
		    begin
		      if errcode=norecord then ioresc(znoblock);
		      if errcode=badcheckword then ioresc(zbadblock);
		      ioresc(zcatchall);
		    end; {if}
		end;

	      dataoverrun:
		ioresc(zbadhardware);

	      otherwise
		clear_and_escape(-10, ord(zcatchall));
	    end; {case}

	end; {while}

    end; {transfer}
$page$

  begin {F9885io}
    uep := addr(unitable^[fp^.funit]);
    if uep^.offline then ioresult := ord(znodevice)
    else
      begin
	lockup;
	try
	  with isc_table[uep^.sc] do
	    begin
	      if card_id<>hp98622 then ioresc(znodevice);
	      gptr := card_ptr;
	      tptr := io_tmp_ptr;
	    end; {with}

	  case request of
	    clearunit:
	      clear_unit;

	    unitstatus:
	      fp^.fbusy := false;

	    flush:
	      {do nothing};

	    readbytes, writebytes, startread, startwrite:
	      begin
		if uep^.ureportchange and not uep^.umediavalid then
		  ioresc(zmediumchanged);
		bufptr := addr(buffer);
		if (position mod 256<>0) or odd(integer(bufptr)) then
		  ioresc(zbadmode);
		if (position<0) or (length<0) or (position+length>fp^.fpeof) then
		  ioresc(ieof);
		transfer((position+fp^.fileid+uep^.byteoffset) div 256, (length+1) div 2);
	      end;

	    otherwise
	      ioresc(ibadrequest);
	  end; {cases}

	  ioresc(inoerror);  {set ioresult & perform lockdown}
	recover
	  begin
	    lockdown;
	    if escapecode<>-10 then escape(escapecode);
	    if (request=startread) or (request=startwrite) then call(fp^.feot, fp);
	  end; {recover}
      end; {else}
  end; {f9885io}

end; {f9885dvr}


{ program F9885init }

import
  loader;

begin {F9885init}
  markuser;
end. {F9885init}


@


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