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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

39.1
date     89.09.26.16.32.39;  author dew;  state Exp;
branches ;
next     38.4;

38.4
date     89.09.21.10.18.59;  author jwh;  state Exp;
branches ;
next     38.3;

38.3
date     89.09.21.10.10.22;  author jwh;  state Exp;
branches ;
next     38.2;

38.2
date     89.09.20.11.10.36;  author jwh;  state Exp;
branches ;
next     38.1;

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

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

37.1
date     89.05.12.11.36.56;  author dew;  state Exp;
branches ;
next     36.3;

36.3
date     89.05.11.11.45.29;  author quist;  state Exp;
branches ;
next     36.2;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

1.1
date     86.06.30.14.31.05;  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                         *)


$copyright 'COPYRIGHT (C) 1983 BY HEWLETT-PACKARD COMPANY'$
$range off$
$debug off$
$modcal$

module srmammodule;

$SEARCH 'SRM_DRV',
	'IOLIB:KERNEL'
{INTERNAL ONLY BEGIN}
,'LANSRM','IOLIB:LANDECS'
{INTERNAL ONLY END}
$
{
$SEARCH 'SRM_DRV',
	'LANSRM','LANDECS'$
}
import
  sysglobals,
  misc,
  iodeclarations,
{INTERNAL ONLY BEGIN}
  lansrm,
  landecs,
{INTERNAL ONLY END}
  srm;

export

procedure srmam(fp      : fibp;
		request : amrequesttype;
	 anyvar buffer  : window;
		bufsize : integer;
		position: integer);

implement
type
  pointer       = ^char;

(*****************************************************************************)
procedure srm_read(anyvar f     : fib;
		   startoffset  : integer;
		   bytecount    : integer;
		   ramaddress   : charptr);
var
  sent  : integer;
  access: integer;
  offset: integer;
begin
  if bytecount > 0 then
    with f, packet_ptr.rhead^
{INTERNAL ONLY BEGIN}
,packet_ptr.rread^
{INTERNAL ONLY END}
do
      begin
	access := random_access;
	offset := startoffset;
	sent  := 0;
	if bytecount > 512 then
	  begin
	    sendreadpack(funit,fileid,access,512,offset,ramaddress);
	    sent        := 512;
	    ramaddress  := addr(ramaddress^,512);
	    access      := sequential_access;
	    offset      := 0;

	    while  (bytecount - sent > 512) and (ioresult = ord(inoerror)) do
	      begin
		sendreadpack(funit,fileid,access,512,offset,ramaddress);
		sent            := sent + 512;
		ramaddress      := addr(ramaddress^,512);
		packetin(funit,req_read);
	      end;
	  end;

	if ioresult = ord(inoerror) then
	  begin
	    sendreadpack(funit,fileid,access,bytecount-sent,offset,ramaddress);
	    packetin(funit,req_read);
{INTERNAL ONLY BEGIN}
	    { conditionaly record actual number of bytes received }
	    if (fleof=maxint) and (fpeof=minint) then flastpos := actual;
{INTERNAL ONLY END}
	  end;

	if (bytecount > 512) and (ioresult = ord(inoerror)) then
	  packetin(funit,req_read);

	if ioresult <> ord(inoerror) then
	  resetcard(funit);
      end;
end; { srm_read }

(*****************************************************************************)
procedure srm_write(anyvar f    : fib;
		    startoffset : integer;
		    bytecount   : integer;
		    ramaddress  : charptr);
var
  sent  : integer;
  access: integer;
  offset: integer;
begin
  if bytecount > 0 then
    with f, packet_ptr.rhead^ , packet_ptr.rwrite^ do
      begin
	access := random_access;
	offset := startoffset;
	sent  := 0;
	if bytecount > 512 then
	  begin
	    sendwritepack(funit,fileid,access,512,offset,ramaddress);
	    sent        := 512;
	    ramaddress  := addr(ramaddress^,512);
	    access      := sequential_access;
	    offset      := 0;

	    while (bytecount - sent > 512) and (ioresult = ord(inoerror)) do
	      begin
		sendwritepack(funit,fileid,access,512,offset,ramaddress);
		sent            := sent + 512;
		ramaddress      := addr(ramaddress^,512);
		packetin(funit,req_write);
	      end;
	  end;

	if ioresult = ord(inoerror) then
	  begin
	    sendwritepack(funit,fileid,access,bytecount-sent,offset,ramaddress);
	    packetin(funit,req_write);
	  end;

	if (bytecount > 512) and (ioresult = ord(inoerror)) then
	  packetin(funit,req_write);

	if ioresult <> ord(inoerror) then
	  resetcard(funit);
      end;
end; { srm_write }

(*****************************************************************************)
procedure srm_clearunit(anyvar f    : fib);
var
  u             : unitnum;
  keepworkdirs  : boolean;
begin
  with f, unitable^[funit], isc_table[sc] do
    if (card_id <> hp98629)
{INTERNAL ONLY BEGIN}
	  and (card_id <> hp98643)
{INTERNAL ONLY END}
	     then  {this is not a theodore or LAN card }
      ioresult := ord(znodevice)
    else
      begin
{INTERNAL ONLY BEGIN}
	if card_id=hp98643 then { force driver to reset & restart the card }
	  call(io_drv_ptr^.iod_wtc,io_tmp_ptr,l_card_state, ord(cs_lance_ready))
	else
{INTERNAL ONLY END}
	  resetcard(funit);
	areyoualivepack(funit);
	if ioresult = ord(inoerror) then volpack(funit);
	if ioresult <> ord(inoerror) then ioresult := ord(znodevice)
	else
	  begin
	    keepworkdirs := false;
	    if strlen(uvid) > 0 then keepworkdirs := true
	    else
	      for u := 1 to maxunit do
		if sc = unitable^[u].sc then
		  if ba = unitable^[u].ba then
		    if strlen(unitable^[u].uvid) > 0 then
		      keepworkdirs := true;
	    gangcleanpack(funit, keepworkdirs);
	  end;
      end;
end;

(*****************************************************************************)
{INTERNAL ONLY BEGIN}
procedure srm_srmam(fp      : fibp;
		request : amrequesttype;
	 anyvar buffer  : window;
		bufsize : integer;
		position: integer);
begin
  ioresult  := ord(inoerror);
  srmsavesc := 0;
  lockup;
  try
    with fp^ do
      if (request <> clearunit) and (unitable^[funit].offline) then
	ioresult        := ord(znodevice)
      else
	case request of
	  readbytes   :begin
			 if flockable and (not flocked) then
			   ioresult := ord(ifileunlocked)
			 else
			   srm_read(fp^,position,bufsize,addr(buffer));
		       end;

	  writebytes  :begin
			 if flockable and (not flocked) then
			   ioresult := ord(ifileunlocked)
			 else
			   srm_write(fp^,position,bufsize,addr(buffer));
		       end;

	  clearunit   :begin
			 srm_clearunit(fp^);
		       end;

	  flush       : {do nothing, but no error};

	  otherwise   ioresult := ord(ibadrequest);
	end;
    if ioresult = ord(isrmcatchall) then
      if srmsavesc <> 0 then
	escape(srmsavesc);
  recover
    begin
      if escapecode = ioescapecode then
	ioresult  := ord(isrmcatchall)
      else
	begin
	  lockdown;
	  escape(escapecode);
	end;
    end;
  lockdown;
end; {srm_srmam}

procedure lan_srmam(fp:fibp; request:amrequesttype;
		    anyvar buffer:window; bufsize,position:integer);
    begin
      lastunit := fp^.funit;
      lastsc   := unitable^[lastunit].sc;
      lansrm_reset(lastsc);
      with lsrm_unit_table^[lastunit] do
      begin
	srm_srmam(fp,request,buffer,bufsize,position);
      end;
    end; { lan_srmam}

procedure srmam(fp:fibp; request:amrequesttype;
		anyvar buffer:window; bufsize,position:integer);
    begin
      with fp^ do
	if (request <> clearunit) and (unitable^[funit].offline) then
	  ioresult        := ord(znodevice)
	else
	  with unitable^[funit] do
	  begin
	    if iompx_info = nil then tm := srm_srmam
	    else
	    begin
	      if (isc_table[sc].card_id = hp98643) then
	      begin
		if iompx_info^.isc_iompx_table[sc].capable then
		begin
		  if pad=0 then lansrm_init_unit(funit);
		  pad := 1; { the shadow unit has been reset }
		  tm := lan_srmam;
		end
		else ioresult := ord(znodevice);
	      end
	      else tm := srm_srmam;
	    end;
	    call(tm,fp,request,buffer,bufsize,position);
	  end;
    end; {srmam}
{INTERNAL ONLY END}
end. {srmammodule}
@


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


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

 (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                         *)


$copyright 'COPYRIGHT (C) 1983 BY HEWLETT-PACKARD COMPANY'$
$range off$
$debug off$
$modcal$

module srmammodule;

$SEARCH 'SRM_DRV',
	'IOLIB:KERNEL'
{INTERNAL ONLY BEGIN}
,'LANSRM','IOLIB:LANDECS'
{INTERNAL ONLY END}
$
{
$SEARCH 'SRM_DRV',
	'LANSRM','LANDECS'$
}
import
  sysglobals,
  misc,
  iodeclarations,
{INTERNAL ONLY BEGIN}
  lansrm,
  landecs,
{INTERNAL ONLY END}
  srm;

export

procedure srmam(fp      : fibp;
		request : amrequesttype;
	 anyvar buffer  : window;
		bufsize : integer;
		position: integer);

implement
type
  pointer       = ^char;

(*****************************************************************************)
procedure srm_read(anyvar f     : fib;
		   startoffset  : integer;
		   bytecount    : integer;
		   ramaddress   : charptr);
var
  sent  : integer;
  access: integer;
  offset: integer;
begin
  if bytecount > 0 then
    with f, packet_ptr.rhead^
{INTERNAL ONLY BEGIN}
,packet_ptr.rread^
{INTERNAL ONLY END}
do
      begin
	access := random_access;
	offset := startoffset;
	sent  := 0;
	if bytecount > 512 then
	  begin
	    sendreadpack(funit,fileid,access,512,offset,ramaddress);
	    sent        := 512;
	    ramaddress  := addr(ramaddress^,512);
	    access      := sequential_access;
	    offset      := 0;

	    while  (bytecount - sent > 512) and (ioresult = ord(inoerror)) do
	      begin
		sendreadpack(funit,fileid,access,512,offset,ramaddress);
		sent            := sent + 512;
		ramaddress      := addr(ramaddress^,512);
		packetin(funit,req_read);
	      end;
	  end;

	if ioresult = ord(inoerror) then
	  begin
	    sendreadpack(funit,fileid,access,bytecount-sent,offset,ramaddress);
	    packetin(funit,req_read);
{INTERNAL ONLY BEGIN}
	    { conditionaly record actual number of bytes received }
	    if (fleof=maxint) and (fpeof=minint) then flastpos := actual;
{INTERNAL ONLY END}
	  end;

	if (bytecount > 512) and (ioresult = ord(inoerror)) then
	  packetin(funit,req_read);

	if ioresult <> ord(inoerror) then
	  resetcard(funit);
      end;
end; { srm_read }

(*****************************************************************************)
procedure srm_write(anyvar f    : fib;
		    startoffset : integer;
		    bytecount   : integer;
		    ramaddress  : charptr);
var
  sent  : integer;
  access: integer;
  offset: integer;
begin
  if bytecount > 0 then
    with f, packet_ptr.rhead^ , packet_ptr.rwrite^ do
      begin
	access := random_access;
	offset := startoffset;
	sent  := 0;
	if bytecount > 512 then
	  begin
	    sendwritepack(funit,fileid,access,512,offset,ramaddress);
	    sent        := 512;
	    ramaddress  := addr(ramaddress^,512);
	    access      := sequential_access;
	    offset      := 0;

	    while (bytecount - sent > 512) and (ioresult = ord(inoerror)) do
	      begin
		sendwritepack(funit,fileid,access,512,offset,ramaddress);
		sent            := sent + 512;
		ramaddress      := addr(ramaddress^,512);
		packetin(funit,req_write);
	      end;
	  end;

	if ioresult = ord(inoerror) then
	  begin
	    sendwritepack(funit,fileid,access,bytecount-sent,offset,ramaddress);
	    packetin(funit,req_write);
	  end;

	if (bytecount > 512) and (ioresult = ord(inoerror)) then
	  packetin(funit,req_write);

	if ioresult <> ord(inoerror) then
	  resetcard(funit);
      end;
end; { srm_write }

(*****************************************************************************)
procedure srm_clearunit(anyvar f    : fib);
var
  u             : unitnum;
  keepworkdirs  : boolean;
begin
  with f, unitable^[funit], isc_table[sc] do
    if (card_id <> hp98629)
{INTERNAL ONLY BEGIN}
	  and (card_id <> hp98643)
{INTERNAL ONLY END}
	     then  {this is not a theodore or LAN card }
      ioresult := ord(znodevice)
    else
      begin
{INTERNAL ONLY BEGIN}
	if card_id=hp98643 then { force driver to reset & restart the card }
	  call(io_drv_ptr^.iod_wtc,io_tmp_ptr,l_card_state, ord(cs_lance_ready))
	else
{INTERNAL ONLY END}
	  resetcard(funit);
	areyoualivepack(funit);
	if ioresult = ord(inoerror) then volpack(funit);
	if ioresult <> ord(inoerror) then ioresult := ord(znodevice)
	else
	  begin
	    keepworkdirs := false;
	    if strlen(uvid) > 0 then keepworkdirs := true
	    else
	      for u := 1 to maxunit do
		if sc = unitable^[u].sc then
		  if ba = unitable^[u].ba then
		    if strlen(unitable^[u].uvid) > 0 then
		      keepworkdirs := true;
	    gangcleanpack(funit, keepworkdirs);
	  end;
      end;
end;

(*****************************************************************************)
{INTERNAL ONLY BEGIN}
procedure srm_srmam(fp      : fibp;
		request : amrequesttype;
	 anyvar buffer  : window;
		bufsize : integer;
		position: integer);
begin
  ioresult  := ord(inoerror);
  srmsavesc := 0;
  lockup;
  try
    with fp^ do
      if (request <> clearunit) and (unitable^[funit].offline) then
	ioresult        := ord(znodevice)
      else
	case request of
	  readbytes   :begin
			 if flockable and (not flocked) then
			   ioresult := ord(ifileunlocked)
			 else
			   srm_read(fp^,position,bufsize,addr(buffer));
		       end;

	  writebytes  :begin
			 if flockable and (not flocked) then
			   ioresult := ord(ifileunlocked)
			 else
			   srm_write(fp^,position,bufsize,addr(buffer));
		       end;

	  clearunit   :begin
			 srm_clearunit(fp^);
		       end;

	  flush       : {do nothing, but no error};

	  otherwise   ioresult := ord(ibadrequest);
	end;
    if ioresult = ord(isrmcatchall) then
      if srmsavesc <> 0 then
	escape(srmsavesc);
  recover
    begin
      if escapecode = ioescapecode then
	ioresult  := ord(isrmcatchall)
      else
	begin
	  lockdown;
	  escape(escapecode);
	end;
    end;
  lockdown;
end; {srm_srmam}

procedure lan_srmam(fp:fibp; request:amrequesttype;
		    anyvar buffer:window; bufsize,position:integer);
    begin
      lastunit := fp^.funit;
      lastsc   := unitable^[lastunit].sc;
      lansrm_reset(lastsc);
      with lsrm_unit_table^[lastunit] do
      begin
	srm_srmam(fp,request,buffer,bufsize,position);
      end;
    end; { lan_srmam}

procedure srmam(fp:fibp; request:amrequesttype;
		anyvar buffer:window; bufsize,position:integer);
    begin
      with fp^ do
	if (request <> clearunit) and (unitable^[funit].offline) then
	  ioresult        := ord(znodevice)
	else
	  with unitable^[funit] do
	  begin
	    if iompx_info = nil then tm := srm_srmam
	    else
	    begin
	      if (isc_table[sc].card_id = hp98643) then
	      begin
		if iompx_info^.isc_iompx_table[sc].capable then
		begin
		  if pad=0 then lansrm_init_unit(funit);
		  pad := 1; { the shadow unit has been reset }
		  tm := lan_srmam;
		end
		else ioresult := ord(znodevice);
	      end
	      else tm := srm_srmam;
	    end;
	    call(tm,fp,request,buffer,bufsize,position);
	  end;
    end; {srmam}
{INTERNAL ONLY END}
end. {srmammodule}
@


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


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

 (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                         *)


$copyright 'COPYRIGHT (C) 1983 BY HEWLETT-PACKARD COMPANY'$
$range off$
$debug off$
$modcal$

module srmammodule;

$SEARCH 'SRM_DRV',
	'IOLIB:KERNEL'
{INTERNAL ONLY BEGIN}
,'LANSRM','IOLIB:LANDECS'
{INTERNAL ONLY END}
$
{
$SEARCH 'SRM_DRV',
	'LANSRM','LANDECS'$
}
import
  sysglobals,
  misc,
  iodeclarations,
{INTERNAL ONLY BEGIN}
  lansrm,
  landecs,
{INTERNAL ONLY END}
  srm;

export

procedure srmam(fp      : fibp;
		request : amrequesttype;
	 anyvar buffer  : window;
		bufsize : integer;
		position: integer);

implement
type
  pointer       = ^char;

(*****************************************************************************)
procedure srm_read(anyvar f     : fib;
		   startoffset  : integer;
		   bytecount    : integer;
		   ramaddress   : charptr);
var
  sent  : integer;
  access: integer;
  offset: integer;
begin
  if bytecount > 0 then
    with f, packet_ptr.rhead^
{INTERNAL ONLY BEGIN}
,packet_ptr.rread^
{INTERNAL ONLY END}
do
      begin
	access := random_access;
	offset := startoffset;
	sent  := 0;
	if bytecount > 512 then
	  begin
	    sendreadpack(funit,fileid,access,512,offset,ramaddress);
	    sent        := 512;
	    ramaddress  := addr(ramaddress^,512);
	    access      := sequential_access;
	    offset      := 0;

	    while  (bytecount - sent > 512) and (ioresult = ord(inoerror)) do
	      begin
		sendreadpack(funit,fileid,access,512,offset,ramaddress);
		sent            := sent + 512;
		ramaddress      := addr(ramaddress^,512);
		packetin(funit,req_read);
	      end;
	  end;

	if ioresult = ord(inoerror) then
	  begin
	    sendreadpack(funit,fileid,access,bytecount-sent,offset,ramaddress);
	    packetin(funit,req_read);
{INTERNAL ONLY BEGIN}
	    { conditionaly record actual number of bytes received }
	    if (fleof=maxint) and (fpeof=minint) then flastpos := actual;
{INTERNAL ONLY END}
	  end;

	if (bytecount > 512) and (ioresult = ord(inoerror)) then
	  packetin(funit,req_read);

	if ioresult <> ord(inoerror) then
	  resetcard(funit);
      end;
end; { srm_read }

(*****************************************************************************)
procedure srm_write(anyvar f    : fib;
		    startoffset : integer;
		    bytecount   : integer;
		    ramaddress  : charptr);
var
  sent  : integer;
  access: integer;
  offset: integer;
begin
  if bytecount > 0 then
    with f, packet_ptr.rhead^ , packet_ptr.rwrite^ do
      begin
	access := random_access;
	offset := startoffset;
	sent  := 0;
	if bytecount > 512 then
	  begin
	    sendwritepack(funit,fileid,access,512,offset,ramaddress);
	    sent        := 512;
	    ramaddress  := addr(ramaddress^,512);
	    access      := sequential_access;
	    offset      := 0;

	    while (bytecount - sent > 512) and (ioresult = ord(inoerror)) do
	      begin
		sendwritepack(funit,fileid,access,512,offset,ramaddress);
		sent            := sent + 512;
		ramaddress      := addr(ramaddress^,512);
		packetin(funit,req_write);
	      end;
	  end;

	if ioresult = ord(inoerror) then
	  begin
	    sendwritepack(funit,fileid,access,bytecount-sent,offset,ramaddress);
	    packetin(funit,req_write);
	  end;

	if (bytecount > 512) and (ioresult = ord(inoerror)) then
	  packetin(funit,req_write);

	if ioresult <> ord(inoerror) then
	  resetcard(funit);
      end;
end; { srm_write }

(*****************************************************************************)
procedure srm_clearunit(anyvar f    : fib);
var
  u             : unitnum;
  keepworkdirs  : boolean;
begin
  with f, unitable^[funit], isc_table[sc] do
    if (card_id <> hp98629)
{INTERNAL ONLY BEGIN}
	  and (card_id <> hp98643)
{INTERNAL ONLY END}
	     then  {this is not a theodore or LAN card }
      ioresult := ord(znodevice)
    else
      begin
{INTERNAL ONLY BEGIN}
	if card_id=hp98643 then { force driver to reset & restart the card }
	  call(io_drv_ptr^.iod_wtc,io_tmp_ptr,l_card_state, ord(cs_lance_ready))
	else
{INTERNAL ONLY END}
	  resetcard(funit);
	areyoualivepack(funit);
	if ioresult = ord(inoerror) then volpack(funit);
	if ioresult <> ord(inoerror) then ioresult := ord(znodevice)
	else
	  begin
	    keepworkdirs := false;
	    if strlen(uvid) > 0 then keepworkdirs := true
	    else
	      for u := 1 to maxunit do
		if sc = unitable^[u].sc then
		  if ba = unitable^[u].ba then
		    if strlen(unitable^[u].uvid) > 0 then
		      keepworkdirs := true;
	    gangcleanpack(funit, keepworkdirs);
	  end;
      end;
end;

(*****************************************************************************)
{INTERNAL ONLY BEGIN}
procedure srm_srmam(fp      : fibp;
		request : amrequesttype;
	 anyvar buffer  : window;
		bufsize : integer;
		position: integer);
begin
  ioresult  := ord(inoerror);
  srmsavesc := 0;
  lockup;
  try
    with fp^ do
      if (request <> clearunit) and (unitable^[funit].offline) then
	ioresult        := ord(znodevice)
      else
	case request of
	  readbytes   :begin
			 if flockable and (not flocked) then
			   ioresult := ord(ifileunlocked)
			 else
			   srm_read(fp^,position,bufsize,addr(buffer));
		       end;

	  writebytes  :begin
			 if flockable and (not flocked) then
			   ioresult := ord(ifileunlocked)
			 else
			   srm_write(fp^,position,bufsize,addr(buffer));
		       end;

	  clearunit   :begin
			 srm_clearunit(fp^);
		       end;

	  flush       : {do nothing, but no error};

	  otherwise   ioresult := ord(ibadrequest);
	end;
    if ioresult = ord(isrmcatchall) then
      if srmsavesc <> 0 then
	escape(srmsavesc);
  recover
    begin
      if escapecode = ioescapecode then
	ioresult  := ord(isrmcatchall)
      else
	begin
	  lockdown;
	  escape(escapecode);
	end;
    end;
  lockdown;
end; {srm_srmam}

procedure lan_srmam(fp:fibp; request:amrequesttype;
		    anyvar buffer:window; bufsize,position:integer);
    begin
      lastunit := fp^.funit;
      lastsc   := unitable^[lastunit].sc;
      lansrm_reset(lastsc);
      with lsrm_unit_table^[lastunit] do
      begin
	srm_srmam(fp,request,buffer,bufsize,position);
      end;
    end; { lan_srmam}

procedure srmam(fp:fibp; request:amrequesttype;
		anyvar buffer:window; bufsize,position:integer);
    begin
      with fp^ do
	if (request <> clearunit) and (unitable^[funit].offline) then
	  ioresult        := ord(znodevice)
	else
	  with unitable^[funit] do
	  begin
	    if iompx_info = nil then tm := srm_srmam
	    else
	    begin
	      if (isc_table[sc].card_id = hp98643) then
	      begin
		if iompx_info^.isc_iompx_table[sc].capable then
		begin
		  if pad=0 then lansrm_init_unit(funit);
		  pad := 1; { the shadow unit has been reset }
		  tm := lan_srmam;
		end
		else ioresult := ord(znodevice);
	      end
	      else tm := srm_srmam;
	    end;
	    call(tm,fp,request,buffer,bufsize,position);
	  end;
    end; {srmam}
{INTERNAL ONLY END}
end. {srmammodule}
@


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.2
log
@Removed external only version code. From now on all versions will have
SRM/UX capability.
@
text
@@


50.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@a296 54
{EXTERNAL ONLY BEGIN}
procedure srmam(fp      : fibp;
		request : amrequesttype;
	 anyvar buffer  : window;
		bufsize : integer;
		position: integer);
begin
  ioresult  := ord(inoerror);
  srmsavesc := 0;
  lockup;
  try
    with fp^ do
      if (request <> clearunit) and (unitable^[funit].offline) then
	ioresult        := ord(znodevice)
      else
	case request of
	  readbytes   :begin
			 if flockable and (not flocked) then
			   ioresult := ord(ifileunlocked)
			 else
			   srm_read(fp^,position,bufsize,addr(buffer));
		       end;

	  writebytes  :begin
			 if flockable and (not flocked) then
			   ioresult := ord(ifileunlocked)
			 else
			   srm_write(fp^,position,bufsize,addr(buffer));
		       end;

	  clearunit   :begin
			 srm_clearunit(fp^);
		       end;

	  flush       : {do nothing, but no error};

	  otherwise   ioresult := ord(ibadrequest);
	end;
    if ioresult = ord(isrmcatchall) then
      if srmsavesc <> 0 then
	escape(srmsavesc);
  recover
    begin
      if escapecode = ioescapecode then
	ioresult  := ord(isrmcatchall)
      else
	begin
	  lockdown;
	  escape(escapecode);
	end;
    end;
  lockdown;
end; {srmam}
{EXTERNAL ONLY END}
@


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.4
log
@

        SRM-UX source control hacking.
@
text
@@


38.3
log
@

      SRM-UX source control hacking.
@
text
@d30 5
a34 1
	'IOLIB:KERNEL'$IF SRMUX_ON$,'LANSRM','IOLIB:LANDECS'$END$$
d72 5
a76 1
    with f, packet_ptr.rhead^ $IF SRMUX_ON$,packet_ptr.rread^ $END$ do
d170 5
a174 2
    if (card_id <> hp98629) $IF SRMUX_ON$ and
       (card_id <> hp98643) $END$ then  {this is not a theodore or LAN card }
@


38.2
log
@

         SRM-UX source control.
@
text
@d39 1
a39 1
$IF SRMUX_ON$
d42 1
a42 1
$END$
d94 1
a94 1
$IF SRMUX_ON$
d97 1
a97 1
$END$
d167 1
a167 1
$IF SRMUX_ON$
d171 1
a171 1
$END$
d192 1
a192 1
$IF SRMUX_ON$
d285 2
a286 3
$END$

$IF NOT SRMUX_ON$
d339 1
a339 1
$END$
@


38.1
log
@Automatic bump of revision number for PWS version 3.23a
@
text
@d30 1
a30 2
	'IOLIB:KERNEL',
	'LANSRM','IOLIB:LANDECS'$
d39 1
d42 1
d68 1
a68 1
    with f, packet_ptr.rhead^ , packet_ptr.rread^ do
d94 1
d97 1
d162 2
a163 2
    if (card_id <> hp98629) and
       (card_id <> hp98643) then  {this is not a theodore or LAN card }
d167 1
d171 1
d192 1
d285 1
d287 54
@


37.2
log
@

    Changes for SRM-UX.
@
text
@@


37.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@d29 1
a29 1
$search 'SRM_DRV',
d32 4
d267 5
a271 1
		  tm := lan_srmam
@


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


36.2
log
@Changes/additions made to support SRM-UX
RDQ 9 may 89

@
text
@d63 1
a63 1
    with f, packet_ptr.rhead^ {, packet_ptr.rread^} do
@


36.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@d30 2
a31 1
	'IOLIB:KERNEL'$
d36 2
d89 2
d99 1
a99 1
end;
d146 1
a146 1
end;
d155 2
a156 1
    if (card_id <> hp98629) then  {this is not a theodore card}
d160 4
a163 1
	resetcard(funit);
d165 2
a166 4
	if ioresult = ord(inoerror) then
	  volpack(funit);
	if ioresult <> ord(inoerror) then
	  ioresult := ord(znodevice)
d170 1
a170 2
	    if strlen(uvid) > 0 then
	      keepworkdirs := true
d183 1
a183 1
procedure srmam(fp      : fibp;
d234 1
a234 1
end; {srmammodule}
d236 37
a272 1
end.
@


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