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


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

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

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

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

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

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

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

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

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

51.1
date     91.01.30.16.09.02;  author jwh;  state Exp;
branches ;
next     50.5;

50.5
date     91.01.28.13.35.46;  author jwh;  state Exp;
branches ;
next     50.4;

50.4
date     90.11.12.15.30.47;  author jwh;  state Exp;
branches ;
next     50.3;

50.3
date     90.11.01.10.05.04;  author jwh;  state Exp;
branches ;
next     50.2;

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

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

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

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

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

48.1
date     90.07.26.11.14.24;  author jwh;  state Exp;
branches ;
next     47.3;

47.3
date     90.07.10.11.32.18;  author jwh;  state Exp;
branches ;
next     47.2;

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

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

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

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

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

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

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

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

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

39.1
date     89.09.26.16.33.06;  author dew;  state Exp;
branches ;
next     38.5;

38.5
date     89.09.21.10.36.15;  author jwh;  state Exp;
branches ;
next     38.4;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

1.1
date     86.06.30.14.34.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, 1985.
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$
$sysprog$
$ucsd$
module srm;
$SEARCH 'IOLIB:KERNEL'$
{INTERNAL ONLY BEGIN}
$SEARCH 'LANSRM','IOLIB:LANDECS'$
{ $SEARCH 'LANSRM','LANDECS'$ }
{INTERNAL ONLY END}

import iodeclarations,
       sysglobals,
       loader
{INTERNAL ONLY BEGIN}
	,lansrm, landecs
{INTERNAL ONLY END}
	;
export

$include 'INIT:SRM_TYPES'$
$include 'INIT:SRM_ERRS'$
{
$include 'SRM_TYPES'$
$include 'SRM_ERRS'$
}
var
  packet_ptr            : pk_ptr;
  defaulttimeout        : integer;      {timeout values in milliseconds}
  waitforlocktimeout    : integer;
  copytimeout           : integer;
  srmsavesc             : shortint;
{INTERNAL ONLY BEGIN}
  { srmux_on              : srmux_array; } { Moved to MISC 8/10/90 JWH }
  srmux_on              : srmux_array;  { Moved back 10/31/90 JWH }
{ TESTING ONLY !!!! }
{  usage_array          : array[damrequesttype] of integer; }
{INTERNAL ONLY END}

procedure srm_init;
procedure resetcard(unum : unitnum);
procedure packetout(unum        : unitnum);
procedure packetin(unum         : unitnum;
		   sendreq      : integer);
procedure areyoualivepack(unum          : unitnum);
procedure catpack(unum          : unitnum;
		  nfns          : integer;
		  nsaptr        : pnsa;
		  path          : path_start_type;
		  wd            : file_id_type;
		  rtpass        : name_type;
		  max           : integer;
		  indx          : integer);
procedure catpasspack(unum      : unitnum;
		      nfns      : integer;
		      nsaptr    : pnsa;
		      path      : path_start_type;
		      wd        : file_id_type;
		      rtpass    : name_type;
		      max       : integer;
		      indx      : integer);
procedure changeprotectpack(unum       : unitnum;
			    nfns       : integer;
			    nsaptr     : pnsa;
			    path       : path_start_type;
			    wd         : file_id_type;
			    rtpass     : name_type;
			    nps        : integer;
			    psaptr     : ppsa);
procedure changevolpack(unum            : unitnum;
			vpass           : name_type;
			newname         : name_type;
			newpass         : name_type);
procedure closepack(unum        : unitnum;
		    fid         : file_id_type);
procedure copypack(unum         : unitnum;
		   srcfid       : file_id_type;
		   srcoff       : integer;
		   destfid      : file_id_type;
		   destoff      : integer;
		   req          : integer);
procedure createpack(unum       : unitnum;
		     nfns       : integer;
		     nsaptr     : pnsa;
		     path       : path_start_type;
		     wd         : file_id_type;
		     rtpass     : name_type;
		     nps        : integer;
		     psaptr     : ppsa;
		     ftype      : gang_file_codes;
		     mode       : integer;
		     maxrec     : integer;
		     ext1       : integer;
		     ext2       : integer;
		     xaddr      : integer);
procedure createlinkpack(unum           : unitnum;
			 oldnfns        : integer;
			 oldnsaptr      : pnsa;
			 oldpath        : path_start_type;
			 oldwd          : file_id_type;
			 oldrtpass      : name_type;
			 newnfns        : integer;
			 newnsaptr      : pnsa;
			 newpath        : path_start_type;
			 newwd          : file_id_type;
			 newrtpass      : name_type;
			 purgeold       : boolean);
procedure exchangepack(unum             : unitnum;
		       fid1             : file_id_type;
		       fid2             : file_id_type);
procedure fileinfopack(unum             : unitnum;
		       fid              : file_id_type);
procedure gangcleanpack(unum            : unitnum;
			savewd          : boolean);
procedure lockpack(unum         : unitnum;
		   fid          : file_id_type;
		   wait         : boolean);
procedure openpack(unum         : unitnum;
		   nfns         : integer;
		   nsaptr       : pnsa;
		   path         : path_start_type;
		   wd           : file_id_type;
		   rtpass       : name_type;
		   share        : integer;
		   opn          : gang_open_type);
procedure pospack(unum          : unitnum;
		  fid           : file_id_type;
		  typepos       : position_type;
		  boffset       : integer);
procedure purgepack(unum        : unitnum;
		    nfns        : integer;
		    nsaptr      : pnsa;
		    path        : path_start_type;
		    wd          : file_id_type;
		    rtpass      : name_type);
procedure sendreadpack(unum     : unitnum;
		       fid      : file_id_type;
		       access   : integer;
		       req      : integer;
		       off      : integer;
		       dat      : anyptr);
procedure seteofpack(unum       : unitnum;
		     fid        : file_id_type;
		     usecurptr  : boolean;
		     boffset    : integer);
procedure unlockpack(unum       : unitnum;
		     fid        : file_id_type);
procedure volpack(unum  : unitnum);
procedure sendwritepack(unum    : unitnum;
			fid     : file_id_type;
			access  : integer;
			req     : integer;
			off     : integer;
			dat     : anyptr);
procedure setdefaulttimeout(time        : integer);
procedure setcopytimeout(time           : integer);
procedure setwaitforlocktimeout(time    : integer);
{INTERNAL ONLY BEGIN}
{ Added for SRM-UX }
procedure chmodpack(unum       : unitnum;
		    nfns       : integer;
		    nsaptr       : pnsa;
		    path       : path_start_type;
		    wd         : file_id_type;
		    fid        : file_id_type;
		    rtpass     : name_type;
		    nmode      : integer);
procedure chownpack(unum       : unitnum;
		    nfns       : integer;
		    nsaptr       : pnsa;
		    path       : path_start_type;
		    wd         : file_id_type;
		    fid        : file_id_type;
		    rtpass     : name_type;
		    nmode      : integer);
procedure chgrppack(unum       : unitnum;
		    nfns       : integer;
		    nsaptr       : pnsa;
		    path       : path_start_type;
		    wd         : file_id_type;
		    fid        : file_id_type;
		    rtpass     : name_type;
		    nmode      : integer);
procedure rmtexecpack(unum         : unitnum;
		      path         : path_start_type;
		      wd           : file_id_type;     { working directory }
		      rtpass       : name_type;
		      cmdstring    : anyptr;
		      cmdstringlen : integer);
{ function is_srmux_unit(unum : unitnum) : boolean; } { Moved to MISC JWH }
function is_srmux_unit(unum : unitnum) : boolean; { back 10/31/90 JWH }
{INTERNAL ONLY END}
var
  dumbuf        : ^buf_info_type;

implement

const
  packetouttimeout      = 1000;         {timeout values in milliseconds}
  ayatimeout            = 1000;

var
  srm_inited    : boolean;
  waitingforlock: boolean;

(****************************************************************************)

procedure maptoioresult(status : integer);
begin
  if ioresult = ord(inoerror) then
    if status <> 0 then
      case status of
	ios_bad_select_code                 : ioresult := ord(ibadunit);
	ios_attach_table_full               : ioresult := ord(itoomanyopen);
	ios_invalid_file_size               : ioresult := ord(inotvalidsize);
	ios_invalid_file_id                 : ioresult := ord(ilostfile);

	ios_bad_file_name,
	ios_file_pathname_missing           : ioresult := ord(ibadtitle);

	ios_illegal_byte_number             : ioresult := ord(ibadvalue);

	ios_successful_completion,
	ios_no_reply                        : ioresult := ord(inoerror);

	ios_system_down,
	ios_volume_offline,
	ios_volume_not_found,
	ios_volume_down                     : ioresult := ord(znodevice);

	ios_file_unopened                   : ioresult := ord(inotopen);

	ios_password_not_allowed,
	ios_no_capability_for_file,
	ios_invalid_protect_code,
	ios_password_not_found,
	ios_duplicate_passwords             : ioresult := ord(ibadpass);

	ios_access_to_file_not_allowed      : ioresult := ord(inoaccess);

	ios_unsupported_directory_operation,
	ios_link_to_directory_not_allowed   : ioresult := ord(inotondir);

	ios_deadlock_detected,
	ios_conflicting_share_modes,
	ios_file_locked_please_retry        : ioresult := ord(ifilelocked);

	ios_file_in_use,
	ios_purge_on_open                   : ioresult := ord(inotclosed);

	ios_insufficient_disk_space         : ioresult := ord(inoroom);
	ios_duplicate_filenames             : ioresult := ord(idupfile);

	ios_phys_eof_encountered,
	ios_eof_encountered                 : ioresult := ord(ieof);

	ios_file_not_found                  : ioresult := ord(inofile);
	ios_volume_in_use                   : ioresult := ord(znotready);
	ios_file_not_directory              : ioresult := ord(ifilenotdir);
	ios_directory_not_empty             : ioresult := ord(idirnotempty);
	ios_invalid_file_code               : ioresult := ord(ibadfiletype);

	ios_rename_across_volumes           : ioresult := 57; { For now }

	otherwise                             ioresult := ord(isrmcatchall);
      end;
end;
(****************************************************************************)

procedure initdumbuf;
begin
  with dumbuf^ do
    begin
      buf_ptr           := nil;
      act_tfr           := no_tfr;
      active_isc        := no_isc;
      buf_size          := 0;
      buf_empty         := nil;
      buf_fill          := nil;
      drv_tmp_ptr       := nil;
      eot_proc.dummy_sl := nil;
      eot_proc.dummy_pr := nil;
      eot_parm          := nil;
      dma_priority      := false;
    end;
end;
(****************************************************************************)

(****************************************************************************)

procedure srm_init;
begin
  if not srm_inited then
    begin
      new(packet_ptr.mp);
      new(dumbuf);
{INTERNAL ONLY BEGIN}
      lansrm_init(dumbuf^); { RDQ }
{INTERNAL ONLY END}
      markuser;
      srm_inited := true;
    end;
  initdumbuf;
  defaulttimeout        := 240000;   {3.1}{timeout values in milliseconds}
  waitforlocktimeout    := 0;
  copytimeout           := 240000;       { modified for 3.1 6/11/85 jws }
end;
(****************************************************************************)

procedure resetcard(unum : unitnum);
begin
  with isc_table[unitable^[unum].sc] do
    call(io_drv_ptr^.iod_init, io_tmp_ptr);
end;
(****************************************************************************)

procedure setdefaulttimeout(time: integer);
begin
  defaulttimeout := time;                        {time is in milliseconds}
end;
(****************************************************************************)

procedure setwaitforlocktimeout(time: integer);
begin
  waitforlocktimeout := time;                    {time is in milliseconds}
end;
(****************************************************************************)

procedure setcopytimeout(time: integer);
begin
  copytimeout := time;                           {time is in milliseconds}
end;
(****************************************************************************)

procedure setintegertimeout(sc  : type_isc;
			    time: integer);
begin
  with isc_table[sc] do
    begin
      user_time := time;                        {time is in milliseconds}
      if io_tmp_ptr <> nil then
	io_tmp_ptr^.timeout := time;
    end;
end;
(****************************************************************************)

function do_buffer_data(var b_info : buf_info_type) : integer;
begin
  with b_info do
    do_buffer_data := integer(buf_fill) - integer(buf_empty);
end;
(****************************************************************************)

procedure do_buffer_reset(var b_info : buf_info_type);
begin
  with b_info do
    if active_isc <> no_isc then
      io_escape(ioe_buf_busy,no_isc)
    else
      begin
	buf_fill        := buf_ptr;
	buf_empty       := buf_ptr;
      end;
end;
(****************************************************************************)

function do_buffer_space(var b_info : buf_info_type) : integer;
begin
  with b_info do
    begin
      if  (do_buffer_data(b_info) = 0)
      and (active_isc = no_isc) then
	do_buffer_reset(b_info);
      do_buffer_space := buf_size + integer(buf_ptr) - integer(buf_fill);
    end;
end;
(****************************************************************************)
{INTERNAL ONLY BEGIN}
procedure do_transfer(sc        : type_isc;
		      dir       : dir_of_tfr;
		      count     : integer;
		      tfr_end   : boolean);
var
  lcount        : integer;
  utfr          : user_tfr_type;
begin
  with isc_table[sc], dumbuf^ do
    begin
      utfr := serial_fastest;
      if not tfr_end then lcount := count
      else
	if dir = from_memory then
	  lcount := do_buffer_data(dumbuf^)
	else
	  lcount := do_buffer_space(dumbuf^);

      if io_tmp_ptr = nil then io_escape(ioe_no_driver,sc);
      if lcount = 0 then io_escape(ioe_bad_cnt,no_isc);
      { if iompx capable then use registered transfer }
      { otherwise use normal transfer}
      if iompx_info<>nil then
	with iompx_info^ do
	if isc_iompx_table[sc].capable then utfr := dummy_tfr_1;

      if active_isc <> no_isc then io_escape(ioe_buf_busy,no_isc);

      if do_buffer_data(dumbuf^) = 0 then do_buffer_reset(dumbuf^);

      with io_tmp_ptr^ do
	if dir = to_memory then
	  begin
	    if do_buffer_space(dumbuf^) < lcount then
	      io_escape(ioe_no_space,sc);
	    if utfr<>dummy_tfr_1 then
	      if in_bufptr <> nil then io_escape(ioe_isc_busy,sc)
				  else in_bufptr := dumbuf;
	  end
	else
	  begin
	    if do_buffer_data(dumbuf^) < lcount then
	      io_escape(ioe_no_data,sc);
	    if out_bufptr <> nil then io_escape(ioe_isc_busy,sc)
				 else out_bufptr := dumbuf;
	  end;

      drv_tmp_ptr       := io_tmp_ptr;
      act_tfr           := no_tfr;
      usr_tfr           := utfr;
      b_w_mode          := false;               {byte mode}
      direction         := dir;
      term_char         := -1;                  {no term char}
      term_count        := lcount;
      end_mode          := tfr_end;

      call(io_drv_ptr^.iod_tfr,io_tmp_ptr,dumbuf);
    end;
end;
{INTERNAL ONLY END}
(****************************************************************************)
procedure dorecover(unum        : unitnum);
begin
  ioresult := ord(isrmcatchall);
  if (escapecode <> ioescapecode) then
    begin
      if srmsavesc = 0 then
	srmsavesc     := escapecode
    end
  else
    if (ioe_result = ioe_timeout) then
      ioresult := ord(ztimeout);
  resetcard(unum);
end;
(****************************************************************************)

procedure packetout(unum        : unitnum);
var
  ip    : ^integer;
begin
  with unitable^[unum] do
    try
      initdumbuf;
      setintegertimeout(sc,packetouttimeout);
      packet_ptr.mp^[8]  := chr(unitable^[unum].ba);
      packet_ptr.mp^[9]  := chr(0);
      packet_ptr.mp^[10] := chr(0);
      packet_ptr.mp^[11] := chr(0);
      ip := addr(packet_ptr.mp^[17]);  {request type}
      if ip^ = req_are_you_alive then
	packet_ptr.mp^[12] := chr(2)
      else
	packet_ptr.mp^[12] := chr(7);
      dumbuf^.buf_ptr   := anyptr(packet_ptr.mp);
      dumbuf^.buf_size  := sizeof(msg_packet_type);
      dumbuf^.buf_empty := addr(packet_ptr.mp^[8]);
      ip := addr(packet_ptr.mp^[13]);  {packet length}
      dumbuf^.buf_fill  := addr(packet_ptr.mp^[12+1+ip^]);
      do_transfer(sc,from_memory,0,true);
    recover
      dorecover(unum);
end;
(****************************************************************************)

procedure packetin(unum         : unitnum;
		   sendreq      : integer);
type
  ayastatustype = packed record
		    srmnode     : byte;
		    linkerrs    : byte;
		    computerid  : shortint;
		  end;
  ayastatusptr  = ^ayastatustype;
var
  count : integer;
begin
  with unitable^[unum] do
    try
      initdumbuf;
      if sendreq = req_are_you_alive then
	setintegertimeout(sc,ayatimeout)
      else
      if (sendreq = req_flock) and (waitingforlock) then
	setintegertimeout(sc,waitforlocktimeout)
      else
      if (sendreq = req_copy) or
	 (sendreq = req_create) then        { 3.0 BUG FIX 3/16/84 }
	setintegertimeout(sc,copytimeout)
      else
	setintegertimeout(sc,defaulttimeout);
      with packet_ptr.rhead^, packet_ptr.rread^ do
	begin
	  repeat
	    fillchar(linkfiller, 28, chr(0));

	    dumbuf^.buf_ptr   := anyptr(packet_ptr.mp);
	    dumbuf^.buf_size  := sizeof(msg_packet_type);
	    dumbuf^.buf_empty := anyptr(packet_ptr.mp);
	    dumbuf^.buf_fill  := addr(packet_ptr.mp^[9]);

	    if sendreq <> req_read then
	      begin
		do_transfer(sc,to_memory,0,true);
	      end
	    else
	      begin
		count := size_from_gang_error + 4;
		do_transfer(sc,to_memory,count,false);

		if message_length > size_from_gang_error then
		  if  return_request_type <> -req_read then
		    begin
		      do_transfer(sc,to_memory,0,true);
		    end
		  else
		    begin
		      count := size_from_read - size_from_gang_error;
		      do_transfer(sc,to_memory,count,false);

		      count := actual;

		      if count > 0 then
			begin
			  dumbuf^.buf_ptr   := anyptr(user_sequencing_field);
			  dumbuf^.buf_size  := 512;
			  dumbuf^.buf_empty := anyptr(user_sequencing_field);
			  dumbuf^.buf_fill  := anyptr(user_sequencing_field);
			  do_transfer(sc,to_memory,count,false);
			end;
		    end;
	      end;
	  until return_request_type = -sendreq;

	  if sendreq <> req_are_you_alive then
	    maptoioresult(status)
	  else
	    if ayastatusptr(addr(status))^.srmnode <> 1 then
	      ioresult := ord(znodevice);
	end;
    recover
      dorecover(unum);
end;
(****************************************************************************)

procedure setup_smh(var smh     : send_header_type;
		    ml,
		    srt,
		    usf         : integer);
begin
  with smh do
    begin
      message_length    := ml;
      send_request_type := srt;
      user_sequencing_field := usf;
    end;
end;
(****************************************************************************)

procedure setup_vnh(var vnh     : volume_header_type;
			unum    : unitnum);
begin
  with vnh do
    begin
      filler1                   := 0;
      driver_name               := ' ';
      catalogue_organization    := ' ';
      device_address_present.i  := 1;
      with device_address do
	begin
	  address1              := unitable^[unum].du;  {unit number}
	  haddress              := 0;
	  unit_num              := 0;
	  volume_num            := 0;
	end;
      volume_name := ' ';
    end;
end;
(****************************************************************************)

procedure setup_fnh(var fnh     : file_header_type;
		    num         : integer;
		    wd          : file_id_type;
		    pt          : path_start_type;
		    rp          : name_type);
begin
  with fnh do
    begin
      num_file_name_sets := num;
      working_directory  := wd;
      filler1            := 0;
      path_type          := pt;
      root_password      := rp;
    end;
end;
(****************************************************************************)

procedure areyoualivepack(unum          : unitnum);
begin
  with packet_ptr.sareyoualive^ do
    begin
      setup_smh(send_mess_header,
		size_to_are_you_alive,
		req_are_you_alive,
		0);
    end;

  packetout(unum);
  if ioresult = ord(inoerror) then
    packetin(unum,req_are_you_alive);
  if ioresult <> ord(inoerror) then
    packet_ptr.rareyoualive^.return_mess_header.status := 0;
end;
(****************************************************************************)

procedure catpack(unum          : unitnum;
		  nfns          : integer;
		  nsaptr        : pnsa;
		  path          : path_start_type;
		  wd            : file_id_type;
		  rtpass        : name_type;
		  max           : integer;
		  indx          : integer);
begin
  with packet_ptr.scat^ do
    begin
      pnsa(addr(start_name_sets))^ := nsaptr^;

      setup_smh(send_mess_header,
		size_to_cat+nfns*36,
		req_catalog,
		0);

      max_num_files := max;
      file_index    := indx;
      filler1       := 0;

      setup_vnh(volume_name_header,unum);

      filler2 := 0;

      setup_fnh(file_name_header,
		nfns,
		wd,      {working directory}
		path,
		rtpass);{root password}

    end;
  packetout(unum);
  packetin(unum,req_catalog);
end;
(****************************************************************************)

procedure catpasspack(unum      : unitnum;
		      nfns      : integer;
		      nsaptr    : pnsa;
		      path      : path_start_type;
		      wd        : file_id_type;
		      rtpass    : name_type;
		      max       : integer;
		      indx      : integer);
begin
  with packet_ptr.scatpass^ do
    begin
      pnsa(addr(start_name_sets))^ := nsaptr^;

      setup_smh(send_mess_header,
		size_to_catprotect+nfns*36,
		req_catprotect,
		0);

      max_num_passwords := max;
      filler1           := 0;
      password_index    := indx;

      setup_vnh(volume_name_header,unum);

      filler2 := 0;

      setup_fnh(file_name_header,
		nfns,
		wd,      {working directory}
		path,
		rtpass);{root password}

    end;
  packetout(unum);
  packetin(unum,req_catprotect);
end;
(****************************************************************************)

procedure changeprotectpack(unum       : unitnum;
			    nfns       : integer;
			    nsaptr     : pnsa;
			    path       : path_start_type;
			    wd         : file_id_type;
			    rtpass     : name_type;
			    nps        : integer;
			    psaptr     : ppsa);
begin
  with packet_ptr.schangeprotect^ do
    begin
      pnsa(addr(start_name_sets))^ := nsaptr^;
      ppsa(addr(pnsa(addr(start_name_sets))^[nfns+1]))^ := psaptr^;

      setup_smh(send_mess_header,
		size_to_changeprotect+nfns*36+nps*24,
		req_changeprotect,
		0);

      setup_vnh(volume_name_header,unum);

      setup_fnh(file_name_header,
		nfns,
		wd,      {working directory}
		path,
		rtpass);{root password}

      num_protect_code_sets     := nps;
    end;

  packetout(unum);
  packetin(unum,req_changeprotect);
end;
(****************************************************************************)

procedure changevolpack(unum            : unitnum;
			vpass           : name_type;
			newname         : name_type;
			newpass         : name_type);
begin
  with packet_ptr.schangevolume^ do
    begin
      setup_smh(send_mess_header,
		size_to_change_vol_label,
		req_label,
		0);

      setup_vnh(volume_name_header,unum);
      password              := vpass;
      new_volume_name       := newname;
      new_vol_password      := newpass;
    end;

  packetout(unum);
  packetin(unum,req_label);
end;
(****************************************************************************)

procedure closepack(unum        : unitnum;
		    fid         : file_id_type);
begin
  with packet_ptr.sclose^ do
    begin
      setup_smh(send_mess_header,
		size_to_close,
		req_close,
		0);
      file_id           := fid;
      directory_password:= ' ';
      file_password     := ' ';
      filler5.i         := 0;
      nodeallocate.i    := 0;
    end;

  packetout(unum);
  packetin(unum,req_close);
end;
(****************************************************************************)

procedure copypack(unum         : unitnum;
		   srcfid       : file_id_type;
		   srcoff       : integer;
		   destfid      : file_id_type;
		   destoff      : integer;
		   req          : integer);
begin
  with packet_ptr.scopy^ do
    begin
      setup_smh(send_mess_header,
		size_to_copy,
		req_copy,
		0);

      source_file_id            := srcfid;
      source_offset             := srcoff;
      destination_file_id       := destfid;
      destination_offset        := destoff;
      requested                 := req;
    end;

  packetout(unum);
  packetin(unum,req_copy);
end;
(****************************************************************************)

procedure createpack(unum       : unitnum;
		     nfns       : integer;
		     nsaptr     : pnsa;
		     path       : path_start_type;
		     wd         : file_id_type;
		     rtpass     : name_type;
		     nps        : integer;
		     psaptr     : ppsa;
		     ftype      : gang_file_codes;
		     mode       : integer;
		     maxrec     : integer;
		     ext1       : integer;
		     ext2       : integer;
		     xaddr      : integer);
begin
  with packet_ptr.screatefile^ do
    begin
      pnsa(addr(start_name_sets))^ := nsaptr^;
      if nps > 0 then
	ppsa(addr(pnsa(addr(start_name_sets))^[nfns+1]))^ := psaptr^;

      setup_smh(send_mess_header,
		size_to_create+nfns*36+nps*24,
		req_create,
		0);

      setup_vnh(volume_name_header,unum);

      setup_fnh(file_name_header,
		nfns,
		wd,      {working directory}
		path,
		rtpass);{root password}

      file_code                 := ftype;
      record_mode               := mode;

      max_record_size           := maxrec;
      first_extent              := ext1;
      contiguous_first_extent.i := 0;           {false}
      secondary_extent          := ext2;
      max_file_size             := maxint;
      boot_start_address        := xaddr;
      num_protect_code_sets     := nps;
      label_included_flag.i     := 0;           {false}
    end;

  packetout(unum);
  packetin(unum,req_create);
end;
(****************************************************************************)

procedure createlinkpack(unum           : unitnum;
			 oldnfns        : integer;
			 oldnsaptr      : pnsa;
			 oldpath        : path_start_type;
			 oldwd          : file_id_type;
			 oldrtpass      : name_type;
			 newnfns        : integer;
			 newnsaptr      : pnsa;
			 newpath        : path_start_type;
			 newwd          : file_id_type;
			 newrtpass      : name_type;
			 purgeold       : boolean);
begin
  with packet_ptr.screatelink^ do
    begin
      pnsa(addr(start_name_sets))^ := oldnsaptr^;
      pnsa(addr(pnsa(addr(start_name_sets))^[oldnfns+1]))^ := newnsaptr^;

      setup_smh(send_mess_header,
		size_to_createlink+oldnfns*36+newnfns*36,
		req_createlink,
		0);

      setup_vnh(volume_name_header,unum);

      setup_fnh(old_file_name_header,
		oldnfns,
		oldwd,      {working directory}
		oldpath,
		oldrtpass);{root password}

      setup_fnh(new_file_name_header,
		newnfns,
		newwd,      {working directory}
		newpath,
		newrtpass);{root password}

      purge_old_link.i  := ord(purgeold);
    end;

  packetout(unum);
  packetin(unum,req_createlink);
end;
(****************************************************************************)

procedure exchangepack(unum             : unitnum;
		       fid1             : file_id_type;
		       fid2             : file_id_type);
begin
  with packet_ptr.sexchange^ do
    begin
      setup_smh(send_mess_header,
		size_to_xchg_open,
		req_xchg_open,
		0);

      file_id_1 := fid1;
      file_id_2 := fid2;
    end;

  packetout(unum);
  packetin(unum,req_xchg_open);
end;
(****************************************************************************)

procedure fileinfopack(unum             : unitnum;
		       fid              : file_id_type);
begin
  with packet_ptr.sfileinfo^ do
    begin
      setup_smh(send_mess_header,
		size_to_info,
		req_info,
		0);

      implicit_unlock.i := 1;
      file_id := fid;
    end;

  packetout(unum);
  packetin(unum,req_info);
end;
(****************************************************************************)

procedure gangcleanpack(unum            : unitnum;
			savewd          : boolean);
begin
  with packet_ptr.sgangclean^ do
    begin
      setup_smh(send_mess_header,
		size_to_gang_cleanup,
		req_gang_cleanup,
		0);

      keep_protected_directories.i := ord(savewd);
    end;

  packetout(unum);
end;
(****************************************************************************)

procedure lockpack(unum         : unitnum;
		   fid          : file_id_type;
		   wait         : boolean);
begin
  waitingforlock := wait;
  with packet_ptr.slock^ do
    begin
      setup_smh(send_mess_header,
		size_to_flock,
		req_flock,
		0);

      file_id           := fid;
      wait_for_lock.i   := ord(wait);
    end;

  packetout(unum);
  packetin(unum,req_flock);
end;
(****************************************************************************)

procedure openpack(unum         : unitnum;
		   nfns         : integer;
		   nsaptr       : pnsa;
		   path         : path_start_type;
		   wd           : file_id_type;
		   rtpass       : name_type;
		   share        : integer;
		   opn          : gang_open_type);
begin
  with packet_ptr.sopen^ do
    begin
      pnsa(addr(start_name_sets))^ := nsaptr^;

      setup_smh(send_mess_header,
		size_to_open+nfns*36,
		req_open,
		0);

      setup_vnh(volume_name_header,unum);

      setup_fnh(file_name_header,
		nfns,
		wd,     {working directory}
		path,
		rtpass);{root password}

      filler2           := 0;
      filler3           := 0;
      share_code        := share;
      filler4.id        := 0;
      filler1           := 0;
      open_type         := opn;
    end;

  packetout(unum);
  packetin(unum,req_open);
end;
(****************************************************************************)

procedure pospack(unum          : unitnum;
		  fid           : file_id_type;
		  typepos       : position_type;
		  boffset       : integer);
begin
  with packet_ptr.spos^ do
    begin
      setup_smh(send_mess_header,
		size_to_position,
		req_position,
		0);

      implicit_unlock.i := 1;
      file_id := fid;
      filler3     := 0;
      type_of_position := typepos;
      byte_offset := boffset;
    end;

  packetout(unum);
  packetin(unum,req_position);
end;
(****************************************************************************)

procedure purgepack(unum        : unitnum;
		    nfns        : integer;
		    nsaptr      : pnsa;
		    path        : path_start_type;
		    wd          : file_id_type;
		    rtpass      : name_type);
begin
  with packet_ptr.spurge^ do
    begin
      pnsa(addr(start_name_sets))^ := nsaptr^;

      setup_smh(send_mess_header,
		size_to_purge+nfns*36,
		req_purgelink,
		0);

      setup_vnh(volume_name_header,unum);

      setup_fnh(file_name_header,
		nfns,
		wd,      {working directory}
		path,
		rtpass);{root password}
    end;

  packetout(unum);
  packetin(unum,req_purgelink);
end;
(****************************************************************************)

procedure sendreadpack(unum     : unitnum;
		       fid      : file_id_type;
		       access   : integer;
		       req      : integer;
		       off      : integer;
		       dat      : anyptr);
begin
  with packet_ptr.sread^ do
    begin
      setup_smh(send_mess_header,
		size_to_read,
		req_read,
		integer(dat));

      implicit_unlock.i := 1;
      file_id           := fid;
      access_code       := access;
      filler3[1]        := 0;
      filler3[2]        := 0;
      requested         := req;
      offset            := off;
    end;

  packetout(unum);
end;
(****************************************************************************)

procedure seteofpack(unum       : unitnum;
		     fid        : file_id_type;
		     usecurptr  : boolean;
		     boffset    : integer);
begin
  with packet_ptr.sseteof^ do
    begin
      setup_smh(send_mess_header,
		size_to_set_eof,
		req_set_eof,
		0);

      implicit_unlock.i := 1;
      file_id           := fid;
      use_current_ptr.i := ord(usecurptr);
      byte_offset       := boffset;
    end;

  packetout(unum);
  packetin(unum,req_set_eof);
end;
(****************************************************************************)

procedure unlockpack(unum       : unitnum;
		     fid        : file_id_type);
begin
  with packet_ptr.sunlock^ do
    begin
      setup_smh(send_mess_header,
		size_to_funlock,
		req_funlock,
		0);

      file_id           := fid;
      explicit_unlock.i := ord(true);
    end;

  packetout(unum);
  packetin(unum,req_funlock);
end;
(****************************************************************************)

procedure volpack(unum  : unitnum);
begin
  with packet_ptr.svol^ do
    begin
      setup_smh(send_mess_header,
		size_to_volstatus,
		req_volstatus,
		0);

      setup_vnh(volume_name_header,unum);
    end;

  packetout(unum);
  packetin(unum,req_volstatus);
end;
(****************************************************************************)

procedure sendwritepack(unum    : unitnum;
			fid     : file_id_type;
			access  : integer;
			req     : integer;
			off     : integer;
			dat     : anyptr);
begin
  with packet_ptr.swrite^ do
    begin
      setup_smh(send_mess_header,
		size_to_write + req,
		req_write,
		integer(dat));

      implicit_unlock.i := 1;
      file_id           := fid;
      access_code       := access;
      filler3[1]        := 0;
      filler3[2]        := 0;
      requested         := req;
      offset            := off;
      filler8.i         := 0;
      flush_buffer.i    := 1;
      moveleft(charptr(dat)^,data,req);
    end;

  packetout(unum);
end;
(****************************************************************************)
{INTERNAL ONLY BEGIN}
{ Added for SRM-UX : }
procedure chmodpack(unum       : unitnum;
		    nfns       : integer;
		    nsaptr       : pnsa;
		    path       : path_start_type;
		    wd         : file_id_type;
		    fid        : file_id_type;
		    rtpass     : name_type;
		    nmode      : integer);
var nsap : pnsa;
var nsa  : name_set_array;
var i : integer;
begin
  { Set up the packet, and send it : }

  with packet_ptr.schmod^ do
   begin
     pnsa(addr(start_name_sets))^ := nsaptr^;
     setup_smh(send_mess_header,
	    size_to_hfs_chmod + 36*nfns,
	    req_hfs_chmod, 0);
     setup_vnh(volume_name_header.old_header,unum);
     setup_fnh(file_name_header,nfns,wd,path,rtpass);

     volume_name_header.delta_mask := hex('fffffe00'); { ???????????? }
     volume_name_header.ordinary_perm := nmode;  { ?????????? }
     volume_name_header.dir_perm := nmode;  { ?????????? }
   end;

  packetout(unum);
  packetin(unum,req_hfs_chmod);

end;

procedure chownpack(unum       : unitnum;
		    nfns       : integer;
		    nsaptr       : pnsa;
		    path       : path_start_type;
		    wd         : file_id_type;
		    fid        : file_id_type;
		    rtpass     : name_type;
		    nmode      : integer);
begin
  { Set up the packet, and send it : }

  with packet_ptr.schown^ do
   begin
     pnsa(addr(start_name_sets))^ := nsaptr^;
     setup_smh(send_mess_header,
	    size_to_hfs_chown + 36*nfns,
	    req_hfs_chown, 0);
     setup_vnh(volume_name_header.old_header,unum);
     setup_fnh(file_name_header,nfns,wd,path,rtpass);
     volume_name_header.new_owner := nmode;
   end;
  packetout(unum);
  packetin(unum,req_hfs_chown);
end;

procedure chgrppack(unum       : unitnum;
		    nfns       : integer;
		    nsaptr       : pnsa;
		    path       : path_start_type;
		    wd         : file_id_type;
		    fid        : file_id_type;
		    rtpass     : name_type;
		    nmode      : integer);
begin
  { Set up the packet, and send it : }

  with packet_ptr.schgrp^ do
   begin
     pnsa(addr(start_name_sets))^ := nsaptr^;
     setup_smh(send_mess_header,
	    size_to_hfs_chgrp + 36*nfns,
	    req_hfs_chgrp, 0);
     setup_vnh(volume_name_header.old_header,unum);
     setup_fnh(file_name_header,nfns,wd,path,rtpass);
     volume_name_header.new_owner := nmode;
   end;

  packetout(unum);
  packetin(unum,req_hfs_chgrp);
end;

procedure rmtexecpack(unum         : unitnum;
		      path         : path_start_type;
		      wd           : file_id_type;     { working directory }
		      rtpass       : name_type;
		      cmdstring    : anyptr;
		      cmdstringlen : integer);
  type
     cp = ^char;
  var
     i : integer;
  begin
    with packet_ptr.srmtexec^ do
      begin
	setup_smh(send_mess_header,
		  size_to_rmt_exec + cmdstringlen,
		  req_rmt_exec,
		  0);
	setup_vnh(volume_name_header,unum);
	cmd_size           := cmdstringlen;
	directory_id       := wd;
	filler1            := 0;
	path_type          := path;
	volume_pword       := rtpass;
	spare1 := 0;
	spare2 := 0;
	moveleft(cp(cmdstring)^,cmd,cmdstringlen);
      end;
    packetout(unum);
    packetin(unum,req_rmt_exec);
  end;

function is_srmux_unit(unum : unitnum) : boolean;
begin
  is_srmux_unit := srmux_on[unum];
end;
{INTERNAL ONLY END}
(****************************************************************************)

end{module srm}.


@


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


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

 (c) Copyright Hewlett-Packard Company, 1985.
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$
$sysprog$
$ucsd$
module srm;
$SEARCH 'IOLIB:KERNEL'$
{INTERNAL ONLY BEGIN}
$SEARCH 'LANSRM','IOLIB:LANDECS'$
{ $SEARCH 'LANSRM','LANDECS'$ }
{INTERNAL ONLY END}

import iodeclarations,
       sysglobals,
       loader
{INTERNAL ONLY BEGIN}
	,lansrm, landecs
{INTERNAL ONLY END}
	;
export

$include 'INIT:SRM_TYPES'$
$include 'INIT:SRM_ERRS'$
{
$include 'SRM_TYPES'$
$include 'SRM_ERRS'$
}
var
  packet_ptr            : pk_ptr;
  defaulttimeout        : integer;      {timeout values in milliseconds}
  waitforlocktimeout    : integer;
  copytimeout           : integer;
  srmsavesc             : shortint;
{INTERNAL ONLY BEGIN}
  { srmux_on              : srmux_array; } { Moved to MISC 8/10/90 JWH }
  srmux_on              : srmux_array;  { Moved back 10/31/90 JWH }
{ TESTING ONLY !!!! }
{  usage_array          : array[damrequesttype] of integer; }
{INTERNAL ONLY END}

procedure srm_init;
procedure resetcard(unum : unitnum);
procedure packetout(unum        : unitnum);
procedure packetin(unum         : unitnum;
		   sendreq      : integer);
procedure areyoualivepack(unum          : unitnum);
procedure catpack(unum          : unitnum;
		  nfns          : integer;
		  nsaptr        : pnsa;
		  path          : path_start_type;
		  wd            : file_id_type;
		  rtpass        : name_type;
		  max           : integer;
		  indx          : integer);
procedure catpasspack(unum      : unitnum;
		      nfns      : integer;
		      nsaptr    : pnsa;
		      path      : path_start_type;
		      wd        : file_id_type;
		      rtpass    : name_type;
		      max       : integer;
		      indx      : integer);
procedure changeprotectpack(unum       : unitnum;
			    nfns       : integer;
			    nsaptr     : pnsa;
			    path       : path_start_type;
			    wd         : file_id_type;
			    rtpass     : name_type;
			    nps        : integer;
			    psaptr     : ppsa);
procedure changevolpack(unum            : unitnum;
			vpass           : name_type;
			newname         : name_type;
			newpass         : name_type);
procedure closepack(unum        : unitnum;
		    fid         : file_id_type);
procedure copypack(unum         : unitnum;
		   srcfid       : file_id_type;
		   srcoff       : integer;
		   destfid      : file_id_type;
		   destoff      : integer;
		   req          : integer);
procedure createpack(unum       : unitnum;
		     nfns       : integer;
		     nsaptr     : pnsa;
		     path       : path_start_type;
		     wd         : file_id_type;
		     rtpass     : name_type;
		     nps        : integer;
		     psaptr     : ppsa;
		     ftype      : gang_file_codes;
		     mode       : integer;
		     maxrec     : integer;
		     ext1       : integer;
		     ext2       : integer;
		     xaddr      : integer);
procedure createlinkpack(unum           : unitnum;
			 oldnfns        : integer;
			 oldnsaptr      : pnsa;
			 oldpath        : path_start_type;
			 oldwd          : file_id_type;
			 oldrtpass      : name_type;
			 newnfns        : integer;
			 newnsaptr      : pnsa;
			 newpath        : path_start_type;
			 newwd          : file_id_type;
			 newrtpass      : name_type;
			 purgeold       : boolean);
procedure exchangepack(unum             : unitnum;
		       fid1             : file_id_type;
		       fid2             : file_id_type);
procedure fileinfopack(unum             : unitnum;
		       fid              : file_id_type);
procedure gangcleanpack(unum            : unitnum;
			savewd          : boolean);
procedure lockpack(unum         : unitnum;
		   fid          : file_id_type;
		   wait         : boolean);
procedure openpack(unum         : unitnum;
		   nfns         : integer;
		   nsaptr       : pnsa;
		   path         : path_start_type;
		   wd           : file_id_type;
		   rtpass       : name_type;
		   share        : integer;
		   opn          : gang_open_type);
procedure pospack(unum          : unitnum;
		  fid           : file_id_type;
		  typepos       : position_type;
		  boffset       : integer);
procedure purgepack(unum        : unitnum;
		    nfns        : integer;
		    nsaptr      : pnsa;
		    path        : path_start_type;
		    wd          : file_id_type;
		    rtpass      : name_type);
procedure sendreadpack(unum     : unitnum;
		       fid      : file_id_type;
		       access   : integer;
		       req      : integer;
		       off      : integer;
		       dat      : anyptr);
procedure seteofpack(unum       : unitnum;
		     fid        : file_id_type;
		     usecurptr  : boolean;
		     boffset    : integer);
procedure unlockpack(unum       : unitnum;
		     fid        : file_id_type);
procedure volpack(unum  : unitnum);
procedure sendwritepack(unum    : unitnum;
			fid     : file_id_type;
			access  : integer;
			req     : integer;
			off     : integer;
			dat     : anyptr);
procedure setdefaulttimeout(time        : integer);
procedure setcopytimeout(time           : integer);
procedure setwaitforlocktimeout(time    : integer);
{INTERNAL ONLY BEGIN}
{ Added for SRM-UX }
procedure chmodpack(unum       : unitnum;
		    nfns       : integer;
		    nsaptr       : pnsa;
		    path       : path_start_type;
		    wd         : file_id_type;
		    fid        : file_id_type;
		    rtpass     : name_type;
		    nmode      : integer);
procedure chownpack(unum       : unitnum;
		    nfns       : integer;
		    nsaptr       : pnsa;
		    path       : path_start_type;
		    wd         : file_id_type;
		    fid        : file_id_type;
		    rtpass     : name_type;
		    nmode      : integer);
procedure chgrppack(unum       : unitnum;
		    nfns       : integer;
		    nsaptr       : pnsa;
		    path       : path_start_type;
		    wd         : file_id_type;
		    fid        : file_id_type;
		    rtpass     : name_type;
		    nmode      : integer);
procedure rmtexecpack(unum         : unitnum;
		      path         : path_start_type;
		      wd           : file_id_type;     { working directory }
		      rtpass       : name_type;
		      cmdstring    : anyptr;
		      cmdstringlen : integer);
{ function is_srmux_unit(unum : unitnum) : boolean; } { Moved to MISC JWH }
function is_srmux_unit(unum : unitnum) : boolean; { back 10/31/90 JWH }
{INTERNAL ONLY END}
var
  dumbuf        : ^buf_info_type;

implement

const
  packetouttimeout      = 1000;         {timeout values in milliseconds}
  ayatimeout            = 1000;

var
  srm_inited    : boolean;
  waitingforlock: boolean;

(****************************************************************************)

procedure maptoioresult(status : integer);
begin
  if ioresult = ord(inoerror) then
    if status <> 0 then
      case status of
	ios_bad_select_code                 : ioresult := ord(ibadunit);
	ios_attach_table_full               : ioresult := ord(itoomanyopen);
	ios_invalid_file_size               : ioresult := ord(inotvalidsize);
	ios_invalid_file_id                 : ioresult := ord(ilostfile);

	ios_bad_file_name,
	ios_file_pathname_missing           : ioresult := ord(ibadtitle);

	ios_illegal_byte_number             : ioresult := ord(ibadvalue);

	ios_successful_completion,
	ios_no_reply                        : ioresult := ord(inoerror);

	ios_system_down,
	ios_volume_offline,
	ios_volume_not_found,
	ios_volume_down                     : ioresult := ord(znodevice);

	ios_file_unopened                   : ioresult := ord(inotopen);

	ios_password_not_allowed,
	ios_no_capability_for_file,
	ios_invalid_protect_code,
	ios_password_not_found,
	ios_duplicate_passwords             : ioresult := ord(ibadpass);

	ios_access_to_file_not_allowed      : ioresult := ord(inoaccess);

	ios_unsupported_directory_operation,
	ios_link_to_directory_not_allowed   : ioresult := ord(inotondir);

	ios_deadlock_detected,
	ios_conflicting_share_modes,
	ios_file_locked_please_retry        : ioresult := ord(ifilelocked);

	ios_file_in_use,
	ios_purge_on_open                   : ioresult := ord(inotclosed);

	ios_insufficient_disk_space         : ioresult := ord(inoroom);
	ios_duplicate_filenames             : ioresult := ord(idupfile);

	ios_phys_eof_encountered,
	ios_eof_encountered                 : ioresult := ord(ieof);

	ios_file_not_found                  : ioresult := ord(inofile);
	ios_volume_in_use                   : ioresult := ord(znotready);
	ios_file_not_directory              : ioresult := ord(ifilenotdir);
	ios_directory_not_empty             : ioresult := ord(idirnotempty);
	ios_invalid_file_code               : ioresult := ord(ibadfiletype);

	ios_rename_across_volumes           : ioresult := 57; { For now }

	otherwise                             ioresult := ord(isrmcatchall);
      end;
end;
(****************************************************************************)

procedure initdumbuf;
begin
  with dumbuf^ do
    begin
      buf_ptr           := nil;
      act_tfr           := no_tfr;
      active_isc        := no_isc;
      buf_size          := 0;
      buf_empty         := nil;
      buf_fill          := nil;
      drv_tmp_ptr       := nil;
      eot_proc.dummy_sl := nil;
      eot_proc.dummy_pr := nil;
      eot_parm          := nil;
      dma_priority      := false;
    end;
end;
(****************************************************************************)

(****************************************************************************)

procedure srm_init;
begin
  if not srm_inited then
    begin
      new(packet_ptr.mp);
      new(dumbuf);
{INTERNAL ONLY BEGIN}
      lansrm_init(dumbuf^); { RDQ }
{INTERNAL ONLY END}
      markuser;
      srm_inited := true;
    end;
  initdumbuf;
  defaulttimeout        := 240000;   {3.1}{timeout values in milliseconds}
  waitforlocktimeout    := 0;
  copytimeout           := 240000;       { modified for 3.1 6/11/85 jws }
end;
(****************************************************************************)

procedure resetcard(unum : unitnum);
begin
  with isc_table[unitable^[unum].sc] do
    call(io_drv_ptr^.iod_init, io_tmp_ptr);
end;
(****************************************************************************)

procedure setdefaulttimeout(time: integer);
begin
  defaulttimeout := time;                        {time is in milliseconds}
end;
(****************************************************************************)

procedure setwaitforlocktimeout(time: integer);
begin
  waitforlocktimeout := time;                    {time is in milliseconds}
end;
(****************************************************************************)

procedure setcopytimeout(time: integer);
begin
  copytimeout := time;                           {time is in milliseconds}
end;
(****************************************************************************)

procedure setintegertimeout(sc  : type_isc;
			    time: integer);
begin
  with isc_table[sc] do
    begin
      user_time := time;                        {time is in milliseconds}
      if io_tmp_ptr <> nil then
	io_tmp_ptr^.timeout := time;
    end;
end;
(****************************************************************************)

function do_buffer_data(var b_info : buf_info_type) : integer;
begin
  with b_info do
    do_buffer_data := integer(buf_fill) - integer(buf_empty);
end;
(****************************************************************************)

procedure do_buffer_reset(var b_info : buf_info_type);
begin
  with b_info do
    if active_isc <> no_isc then
      io_escape(ioe_buf_busy,no_isc)
    else
      begin
	buf_fill        := buf_ptr;
	buf_empty       := buf_ptr;
      end;
end;
(****************************************************************************)

function do_buffer_space(var b_info : buf_info_type) : integer;
begin
  with b_info do
    begin
      if  (do_buffer_data(b_info) = 0)
      and (active_isc = no_isc) then
	do_buffer_reset(b_info);
      do_buffer_space := buf_size + integer(buf_ptr) - integer(buf_fill);
    end;
end;
(****************************************************************************)
{INTERNAL ONLY BEGIN}
procedure do_transfer(sc        : type_isc;
		      dir       : dir_of_tfr;
		      count     : integer;
		      tfr_end   : boolean);
var
  lcount        : integer;
  utfr          : user_tfr_type;
begin
  with isc_table[sc], dumbuf^ do
    begin
      utfr := serial_fastest;
      if not tfr_end then lcount := count
      else
	if dir = from_memory then
	  lcount := do_buffer_data(dumbuf^)
	else
	  lcount := do_buffer_space(dumbuf^);

      if io_tmp_ptr = nil then io_escape(ioe_no_driver,sc);
      if lcount = 0 then io_escape(ioe_bad_cnt,no_isc);
      { if iompx capable then use registered transfer }
      { otherwise use normal transfer}
      if iompx_info<>nil then
	with iompx_info^ do
	if isc_iompx_table[sc].capable then utfr := dummy_tfr_1;

      if active_isc <> no_isc then io_escape(ioe_buf_busy,no_isc);

      if do_buffer_data(dumbuf^) = 0 then do_buffer_reset(dumbuf^);

      with io_tmp_ptr^ do
	if dir = to_memory then
	  begin
	    if do_buffer_space(dumbuf^) < lcount then
	      io_escape(ioe_no_space,sc);
	    if utfr<>dummy_tfr_1 then
	      if in_bufptr <> nil then io_escape(ioe_isc_busy,sc)
				  else in_bufptr := dumbuf;
	  end
	else
	  begin
	    if do_buffer_data(dumbuf^) < lcount then
	      io_escape(ioe_no_data,sc);
	    if out_bufptr <> nil then io_escape(ioe_isc_busy,sc)
				 else out_bufptr := dumbuf;
	  end;

      drv_tmp_ptr       := io_tmp_ptr;
      act_tfr           := no_tfr;
      usr_tfr           := utfr;
      b_w_mode          := false;               {byte mode}
      direction         := dir;
      term_char         := -1;                  {no term char}
      term_count        := lcount;
      end_mode          := tfr_end;

      call(io_drv_ptr^.iod_tfr,io_tmp_ptr,dumbuf);
    end;
end;
{INTERNAL ONLY END}
(****************************************************************************)
procedure dorecover(unum        : unitnum);
begin
  ioresult := ord(isrmcatchall);
  if (escapecode <> ioescapecode) then
    begin
      if srmsavesc = 0 then
	srmsavesc     := escapecode
    end
  else
    if (ioe_result = ioe_timeout) then
      ioresult := ord(ztimeout);
  resetcard(unum);
end;
(****************************************************************************)

procedure packetout(unum        : unitnum);
var
  ip    : ^integer;
begin
  with unitable^[unum] do
    try
      initdumbuf;
      setintegertimeout(sc,packetouttimeout);
      packet_ptr.mp^[8]  := chr(unitable^[unum].ba);
      packet_ptr.mp^[9]  := chr(0);
      packet_ptr.mp^[10] := chr(0);
      packet_ptr.mp^[11] := chr(0);
      ip := addr(packet_ptr.mp^[17]);  {request type}
      if ip^ = req_are_you_alive then
	packet_ptr.mp^[12] := chr(2)
      else
	packet_ptr.mp^[12] := chr(7);
      dumbuf^.buf_ptr   := anyptr(packet_ptr.mp);
      dumbuf^.buf_size  := sizeof(msg_packet_type);
      dumbuf^.buf_empty := addr(packet_ptr.mp^[8]);
      ip := addr(packet_ptr.mp^[13]);  {packet length}
      dumbuf^.buf_fill  := addr(packet_ptr.mp^[12+1+ip^]);
      do_transfer(sc,from_memory,0,true);
    recover
      dorecover(unum);
end;
(****************************************************************************)

procedure packetin(unum         : unitnum;
		   sendreq      : integer);
type
  ayastatustype = packed record
		    srmnode     : byte;
		    linkerrs    : byte;
		    computerid  : shortint;
		  end;
  ayastatusptr  = ^ayastatustype;
var
  count : integer;
begin
  with unitable^[unum] do
    try
      initdumbuf;
      if sendreq = req_are_you_alive then
	setintegertimeout(sc,ayatimeout)
      else
      if (sendreq = req_flock) and (waitingforlock) then
	setintegertimeout(sc,waitforlocktimeout)
      else
      if (sendreq = req_copy) or
	 (sendreq = req_create) then        { 3.0 BUG FIX 3/16/84 }
	setintegertimeout(sc,copytimeout)
      else
	setintegertimeout(sc,defaulttimeout);
      with packet_ptr.rhead^, packet_ptr.rread^ do
	begin
	  repeat
	    fillchar(linkfiller, 28, chr(0));

	    dumbuf^.buf_ptr   := anyptr(packet_ptr.mp);
	    dumbuf^.buf_size  := sizeof(msg_packet_type);
	    dumbuf^.buf_empty := anyptr(packet_ptr.mp);
	    dumbuf^.buf_fill  := addr(packet_ptr.mp^[9]);

	    if sendreq <> req_read then
	      begin
		do_transfer(sc,to_memory,0,true);
	      end
	    else
	      begin
		count := size_from_gang_error + 4;
		do_transfer(sc,to_memory,count,false);

		if message_length > size_from_gang_error then
		  if  return_request_type <> -req_read then
		    begin
		      do_transfer(sc,to_memory,0,true);
		    end
		  else
		    begin
		      count := size_from_read - size_from_gang_error;
		      do_transfer(sc,to_memory,count,false);

		      count := actual;

		      if count > 0 then
			begin
			  dumbuf^.buf_ptr   := anyptr(user_sequencing_field);
			  dumbuf^.buf_size  := 512;
			  dumbuf^.buf_empty := anyptr(user_sequencing_field);
			  dumbuf^.buf_fill  := anyptr(user_sequencing_field);
			  do_transfer(sc,to_memory,count,false);
			end;
		    end;
	      end;
	  until return_request_type = -sendreq;

	  if sendreq <> req_are_you_alive then
	    maptoioresult(status)
	  else
	    if ayastatusptr(addr(status))^.srmnode <> 1 then
	      ioresult := ord(znodevice);
	end;
    recover
      dorecover(unum);
end;
(****************************************************************************)

procedure setup_smh(var smh     : send_header_type;
		    ml,
		    srt,
		    usf         : integer);
begin
  with smh do
    begin
      message_length    := ml;
      send_request_type := srt;
      user_sequencing_field := usf;
    end;
end;
(****************************************************************************)

procedure setup_vnh(var vnh     : volume_header_type;
			unum    : unitnum);
begin
  with vnh do
    begin
      filler1                   := 0;
      driver_name               := ' ';
      catalogue_organization    := ' ';
      device_address_present.i  := 1;
      with device_address do
	begin
	  address1              := unitable^[unum].du;  {unit number}
	  haddress              := 0;
	  unit_num              := 0;
	  volume_num            := 0;
	end;
      volume_name := ' ';
    end;
end;
(****************************************************************************)

procedure setup_fnh(var fnh     : file_header_type;
		    num         : integer;
		    wd          : file_id_type;
		    pt          : path_start_type;
		    rp          : name_type);
begin
  with fnh do
    begin
      num_file_name_sets := num;
      working_directory  := wd;
      filler1            := 0;
      path_type          := pt;
      root_password      := rp;
    end;
end;
(****************************************************************************)

procedure areyoualivepack(unum          : unitnum);
begin
  with packet_ptr.sareyoualive^ do
    begin
      setup_smh(send_mess_header,
		size_to_are_you_alive,
		req_are_you_alive,
		0);
    end;

  packetout(unum);
  if ioresult = ord(inoerror) then
    packetin(unum,req_are_you_alive);
  if ioresult <> ord(inoerror) then
    packet_ptr.rareyoualive^.return_mess_header.status := 0;
end;
(****************************************************************************)

procedure catpack(unum          : unitnum;
		  nfns          : integer;
		  nsaptr        : pnsa;
		  path          : path_start_type;
		  wd            : file_id_type;
		  rtpass        : name_type;
		  max           : integer;
		  indx          : integer);
begin
  with packet_ptr.scat^ do
    begin
      pnsa(addr(start_name_sets))^ := nsaptr^;

      setup_smh(send_mess_header,
		size_to_cat+nfns*36,
		req_catalog,
		0);

      max_num_files := max;
      file_index    := indx;
      filler1       := 0;

      setup_vnh(volume_name_header,unum);

      filler2 := 0;

      setup_fnh(file_name_header,
		nfns,
		wd,      {working directory}
		path,
		rtpass);{root password}

    end;
  packetout(unum);
  packetin(unum,req_catalog);
end;
(****************************************************************************)

procedure catpasspack(unum      : unitnum;
		      nfns      : integer;
		      nsaptr    : pnsa;
		      path      : path_start_type;
		      wd        : file_id_type;
		      rtpass    : name_type;
		      max       : integer;
		      indx      : integer);
begin
  with packet_ptr.scatpass^ do
    begin
      pnsa(addr(start_name_sets))^ := nsaptr^;

      setup_smh(send_mess_header,
		size_to_catprotect+nfns*36,
		req_catprotect,
		0);

      max_num_passwords := max;
      filler1           := 0;
      password_index    := indx;

      setup_vnh(volume_name_header,unum);

      filler2 := 0;

      setup_fnh(file_name_header,
		nfns,
		wd,      {working directory}
		path,
		rtpass);{root password}

    end;
  packetout(unum);
  packetin(unum,req_catprotect);
end;
(****************************************************************************)

procedure changeprotectpack(unum       : unitnum;
			    nfns       : integer;
			    nsaptr     : pnsa;
			    path       : path_start_type;
			    wd         : file_id_type;
			    rtpass     : name_type;
			    nps        : integer;
			    psaptr     : ppsa);
begin
  with packet_ptr.schangeprotect^ do
    begin
      pnsa(addr(start_name_sets))^ := nsaptr^;
      ppsa(addr(pnsa(addr(start_name_sets))^[nfns+1]))^ := psaptr^;

      setup_smh(send_mess_header,
		size_to_changeprotect+nfns*36+nps*24,
		req_changeprotect,
		0);

      setup_vnh(volume_name_header,unum);

      setup_fnh(file_name_header,
		nfns,
		wd,      {working directory}
		path,
		rtpass);{root password}

      num_protect_code_sets     := nps;
    end;

  packetout(unum);
  packetin(unum,req_changeprotect);
end;
(****************************************************************************)

procedure changevolpack(unum            : unitnum;
			vpass           : name_type;
			newname         : name_type;
			newpass         : name_type);
begin
  with packet_ptr.schangevolume^ do
    begin
      setup_smh(send_mess_header,
		size_to_change_vol_label,
		req_label,
		0);

      setup_vnh(volume_name_header,unum);
      password              := vpass;
      new_volume_name       := newname;
      new_vol_password      := newpass;
    end;

  packetout(unum);
  packetin(unum,req_label);
end;
(****************************************************************************)

procedure closepack(unum        : unitnum;
		    fid         : file_id_type);
begin
  with packet_ptr.sclose^ do
    begin
      setup_smh(send_mess_header,
		size_to_close,
		req_close,
		0);
      file_id           := fid;
      directory_password:= ' ';
      file_password     := ' ';
      filler5.i         := 0;
      nodeallocate.i    := 0;
    end;

  packetout(unum);
  packetin(unum,req_close);
end;
(****************************************************************************)

procedure copypack(unum         : unitnum;
		   srcfid       : file_id_type;
		   srcoff       : integer;
		   destfid      : file_id_type;
		   destoff      : integer;
		   req          : integer);
begin
  with packet_ptr.scopy^ do
    begin
      setup_smh(send_mess_header,
		size_to_copy,
		req_copy,
		0);

      source_file_id            := srcfid;
      source_offset             := srcoff;
      destination_file_id       := destfid;
      destination_offset        := destoff;
      requested                 := req;
    end;

  packetout(unum);
  packetin(unum,req_copy);
end;
(****************************************************************************)

procedure createpack(unum       : unitnum;
		     nfns       : integer;
		     nsaptr     : pnsa;
		     path       : path_start_type;
		     wd         : file_id_type;
		     rtpass     : name_type;
		     nps        : integer;
		     psaptr     : ppsa;
		     ftype      : gang_file_codes;
		     mode       : integer;
		     maxrec     : integer;
		     ext1       : integer;
		     ext2       : integer;
		     xaddr      : integer);
begin
  with packet_ptr.screatefile^ do
    begin
      pnsa(addr(start_name_sets))^ := nsaptr^;
      if nps > 0 then
	ppsa(addr(pnsa(addr(start_name_sets))^[nfns+1]))^ := psaptr^;

      setup_smh(send_mess_header,
		size_to_create+nfns*36+nps*24,
		req_create,
		0);

      setup_vnh(volume_name_header,unum);

      setup_fnh(file_name_header,
		nfns,
		wd,      {working directory}
		path,
		rtpass);{root password}

      file_code                 := ftype;
      record_mode               := mode;

      max_record_size           := maxrec;
      first_extent              := ext1;
      contiguous_first_extent.i := 0;           {false}
      secondary_extent          := ext2;
      max_file_size             := maxint;
      boot_start_address        := xaddr;
      num_protect_code_sets     := nps;
      label_included_flag.i     := 0;           {false}
    end;

  packetout(unum);
  packetin(unum,req_create);
end;
(****************************************************************************)

procedure createlinkpack(unum           : unitnum;
			 oldnfns        : integer;
			 oldnsaptr      : pnsa;
			 oldpath        : path_start_type;
			 oldwd          : file_id_type;
			 oldrtpass      : name_type;
			 newnfns        : integer;
			 newnsaptr      : pnsa;
			 newpath        : path_start_type;
			 newwd          : file_id_type;
			 newrtpass      : name_type;
			 purgeold       : boolean);
begin
  with packet_ptr.screatelink^ do
    begin
      pnsa(addr(start_name_sets))^ := oldnsaptr^;
      pnsa(addr(pnsa(addr(start_name_sets))^[oldnfns+1]))^ := newnsaptr^;

      setup_smh(send_mess_header,
		size_to_createlink+oldnfns*36+newnfns*36,
		req_createlink,
		0);

      setup_vnh(volume_name_header,unum);

      setup_fnh(old_file_name_header,
		oldnfns,
		oldwd,      {working directory}
		oldpath,
		oldrtpass);{root password}

      setup_fnh(new_file_name_header,
		newnfns,
		newwd,      {working directory}
		newpath,
		newrtpass);{root password}

      purge_old_link.i  := ord(purgeold);
    end;

  packetout(unum);
  packetin(unum,req_createlink);
end;
(****************************************************************************)

procedure exchangepack(unum             : unitnum;
		       fid1             : file_id_type;
		       fid2             : file_id_type);
begin
  with packet_ptr.sexchange^ do
    begin
      setup_smh(send_mess_header,
		size_to_xchg_open,
		req_xchg_open,
		0);

      file_id_1 := fid1;
      file_id_2 := fid2;
    end;

  packetout(unum);
  packetin(unum,req_xchg_open);
end;
(****************************************************************************)

procedure fileinfopack(unum             : unitnum;
		       fid              : file_id_type);
begin
  with packet_ptr.sfileinfo^ do
    begin
      setup_smh(send_mess_header,
		size_to_info,
		req_info,
		0);

      implicit_unlock.i := 1;
      file_id := fid;
    end;

  packetout(unum);
  packetin(unum,req_info);
end;
(****************************************************************************)

procedure gangcleanpack(unum            : unitnum;
			savewd          : boolean);
begin
  with packet_ptr.sgangclean^ do
    begin
      setup_smh(send_mess_header,
		size_to_gang_cleanup,
		req_gang_cleanup,
		0);

      keep_protected_directories.i := ord(savewd);
    end;

  packetout(unum);
end;
(****************************************************************************)

procedure lockpack(unum         : unitnum;
		   fid          : file_id_type;
		   wait         : boolean);
begin
  waitingforlock := wait;
  with packet_ptr.slock^ do
    begin
      setup_smh(send_mess_header,
		size_to_flock,
		req_flock,
		0);

      file_id           := fid;
      wait_for_lock.i   := ord(wait);
    end;

  packetout(unum);
  packetin(unum,req_flock);
end;
(****************************************************************************)

procedure openpack(unum         : unitnum;
		   nfns         : integer;
		   nsaptr       : pnsa;
		   path         : path_start_type;
		   wd           : file_id_type;
		   rtpass       : name_type;
		   share        : integer;
		   opn          : gang_open_type);
begin
  with packet_ptr.sopen^ do
    begin
      pnsa(addr(start_name_sets))^ := nsaptr^;

      setup_smh(send_mess_header,
		size_to_open+nfns*36,
		req_open,
		0);

      setup_vnh(volume_name_header,unum);

      setup_fnh(file_name_header,
		nfns,
		wd,     {working directory}
		path,
		rtpass);{root password}

      filler2           := 0;
      filler3           := 0;
      share_code        := share;
      filler4.id        := 0;
      filler1           := 0;
      open_type         := opn;
    end;

  packetout(unum);
  packetin(unum,req_open);
end;
(****************************************************************************)

procedure pospack(unum          : unitnum;
		  fid           : file_id_type;
		  typepos       : position_type;
		  boffset       : integer);
begin
  with packet_ptr.spos^ do
    begin
      setup_smh(send_mess_header,
		size_to_position,
		req_position,
		0);

      implicit_unlock.i := 1;
      file_id := fid;
      filler3     := 0;
      type_of_position := typepos;
      byte_offset := boffset;
    end;

  packetout(unum);
  packetin(unum,req_position);
end;
(****************************************************************************)

procedure purgepack(unum        : unitnum;
		    nfns        : integer;
		    nsaptr      : pnsa;
		    path        : path_start_type;
		    wd          : file_id_type;
		    rtpass      : name_type);
begin
  with packet_ptr.spurge^ do
    begin
      pnsa(addr(start_name_sets))^ := nsaptr^;

      setup_smh(send_mess_header,
		size_to_purge+nfns*36,
		req_purgelink,
		0);

      setup_vnh(volume_name_header,unum);

      setup_fnh(file_name_header,
		nfns,
		wd,      {working directory}
		path,
		rtpass);{root password}
    end;

  packetout(unum);
  packetin(unum,req_purgelink);
end;
(****************************************************************************)

procedure sendreadpack(unum     : unitnum;
		       fid      : file_id_type;
		       access   : integer;
		       req      : integer;
		       off      : integer;
		       dat      : anyptr);
begin
  with packet_ptr.sread^ do
    begin
      setup_smh(send_mess_header,
		size_to_read,
		req_read,
		integer(dat));

      implicit_unlock.i := 1;
      file_id           := fid;
      access_code       := access;
      filler3[1]        := 0;
      filler3[2]        := 0;
      requested         := req;
      offset            := off;
    end;

  packetout(unum);
end;
(****************************************************************************)

procedure seteofpack(unum       : unitnum;
		     fid        : file_id_type;
		     usecurptr  : boolean;
		     boffset    : integer);
begin
  with packet_ptr.sseteof^ do
    begin
      setup_smh(send_mess_header,
		size_to_set_eof,
		req_set_eof,
		0);

      implicit_unlock.i := 1;
      file_id           := fid;
      use_current_ptr.i := ord(usecurptr);
      byte_offset       := boffset;
    end;

  packetout(unum);
  packetin(unum,req_set_eof);
end;
(****************************************************************************)

procedure unlockpack(unum       : unitnum;
		     fid        : file_id_type);
begin
  with packet_ptr.sunlock^ do
    begin
      setup_smh(send_mess_header,
		size_to_funlock,
		req_funlock,
		0);

      file_id           := fid;
      explicit_unlock.i := ord(true);
    end;

  packetout(unum);
  packetin(unum,req_funlock);
end;
(****************************************************************************)

procedure volpack(unum  : unitnum);
begin
  with packet_ptr.svol^ do
    begin
      setup_smh(send_mess_header,
		size_to_volstatus,
		req_volstatus,
		0);

      setup_vnh(volume_name_header,unum);
    end;

  packetout(unum);
  packetin(unum,req_volstatus);
end;
(****************************************************************************)

procedure sendwritepack(unum    : unitnum;
			fid     : file_id_type;
			access  : integer;
			req     : integer;
			off     : integer;
			dat     : anyptr);
begin
  with packet_ptr.swrite^ do
    begin
      setup_smh(send_mess_header,
		size_to_write + req,
		req_write,
		integer(dat));

      implicit_unlock.i := 1;
      file_id           := fid;
      access_code       := access;
      filler3[1]        := 0;
      filler3[2]        := 0;
      requested         := req;
      offset            := off;
      filler8.i         := 0;
      flush_buffer.i    := 1;
      moveleft(charptr(dat)^,data,req);
    end;

  packetout(unum);
end;
(****************************************************************************)
{INTERNAL ONLY BEGIN}
{ Added for SRM-UX : }
procedure chmodpack(unum       : unitnum;
		    nfns       : integer;
		    nsaptr       : pnsa;
		    path       : path_start_type;
		    wd         : file_id_type;
		    fid        : file_id_type;
		    rtpass     : name_type;
		    nmode      : integer);
var nsap : pnsa;
var nsa  : name_set_array;
var i : integer;
begin
  { Set up the packet, and send it : }

  with packet_ptr.schmod^ do
   begin
     pnsa(addr(start_name_sets))^ := nsaptr^;
     setup_smh(send_mess_header,
	    size_to_hfs_chmod + 36*nfns,
	    req_hfs_chmod, 0);
     setup_vnh(volume_name_header.old_header,unum);
     setup_fnh(file_name_header,nfns,wd,path,rtpass);

     volume_name_header.delta_mask := hex('fffffe00'); { ???????????? }
     volume_name_header.ordinary_perm := nmode;  { ?????????? }
     volume_name_header.dir_perm := nmode;  { ?????????? }
   end;

  packetout(unum);
  packetin(unum,req_hfs_chmod);

end;

procedure chownpack(unum       : unitnum;
		    nfns       : integer;
		    nsaptr       : pnsa;
		    path       : path_start_type;
		    wd         : file_id_type;
		    fid        : file_id_type;
		    rtpass     : name_type;
		    nmode      : integer);
begin
  { Set up the packet, and send it : }

  with packet_ptr.schown^ do
   begin
     pnsa(addr(start_name_sets))^ := nsaptr^;
     setup_smh(send_mess_header,
	    size_to_hfs_chown + 36*nfns,
	    req_hfs_chown, 0);
     setup_vnh(volume_name_header.old_header,unum);
     setup_fnh(file_name_header,nfns,wd,path,rtpass);
     volume_name_header.new_owner := nmode;
   end;
  packetout(unum);
  packetin(unum,req_hfs_chown);
end;

procedure chgrppack(unum       : unitnum;
		    nfns       : integer;
		    nsaptr       : pnsa;
		    path       : path_start_type;
		    wd         : file_id_type;
		    fid        : file_id_type;
		    rtpass     : name_type;
		    nmode      : integer);
begin
  { Set up the packet, and send it : }

  with packet_ptr.schgrp^ do
   begin
     pnsa(addr(start_name_sets))^ := nsaptr^;
     setup_smh(send_mess_header,
	    size_to_hfs_chgrp + 36*nfns,
	    req_hfs_chgrp, 0);
     setup_vnh(volume_name_header.old_header,unum);
     setup_fnh(file_name_header,nfns,wd,path,rtpass);
     volume_name_header.new_owner := nmode;
   end;

  packetout(unum);
  packetin(unum,req_hfs_chgrp);
end;

procedure rmtexecpack(unum         : unitnum;
		      path         : path_start_type;
		      wd           : file_id_type;     { working directory }
		      rtpass       : name_type;
		      cmdstring    : anyptr;
		      cmdstringlen : integer);
  type
     cp = ^char;
  var
     i : integer;
  begin
    with packet_ptr.srmtexec^ do
      begin
	setup_smh(send_mess_header,
		  size_to_rmt_exec + cmdstringlen,
		  req_rmt_exec,
		  0);
	setup_vnh(volume_name_header,unum);
	cmd_size           := cmdstringlen;
	directory_id       := wd;
	filler1            := 0;
	path_type          := path;
	volume_pword       := rtpass;
	spare1 := 0;
	spare2 := 0;
	moveleft(cp(cmdstring)^,cmd,cmdstringlen);
      end;
    packetout(unum);
    packetin(unum,req_rmt_exec);
  end;

function is_srmux_unit(unum : unitnum) : boolean;
begin
  is_srmux_unit := srmux_on[unum];
end;
{INTERNAL ONLY END}
(****************************************************************************)

end{module srm}.


@


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


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

 (c) Copyright Hewlett-Packard Company, 1985.
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$
$sysprog$
$ucsd$
module srm;
$SEARCH 'IOLIB:KERNEL'$
{INTERNAL ONLY BEGIN}
$SEARCH 'LANSRM','IOLIB:LANDECS'$
{ $SEARCH 'LANSRM','LANDECS'$ }
{INTERNAL ONLY END}

import iodeclarations,
       sysglobals,
       loader
{INTERNAL ONLY BEGIN}
	,lansrm, landecs
{INTERNAL ONLY END}
	;
export

$include 'INIT:SRM_TYPES'$
$include 'INIT:SRM_ERRS'$
{
$include 'SRM_TYPES'$
$include 'SRM_ERRS'$
}
var
  packet_ptr            : pk_ptr;
  defaulttimeout        : integer;      {timeout values in milliseconds}
  waitforlocktimeout    : integer;
  copytimeout           : integer;
  srmsavesc             : shortint;
{INTERNAL ONLY BEGIN}
  { srmux_on              : srmux_array; } { Moved to MISC 8/10/90 JWH }
  srmux_on              : srmux_array;  { Moved back 10/31/90 JWH }
{ TESTING ONLY !!!! }
{  usage_array          : array[damrequesttype] of integer; }
{INTERNAL ONLY END}

procedure srm_init;
procedure resetcard(unum : unitnum);
procedure packetout(unum        : unitnum);
procedure packetin(unum         : unitnum;
		   sendreq      : integer);
procedure areyoualivepack(unum          : unitnum);
procedure catpack(unum          : unitnum;
		  nfns          : integer;
		  nsaptr        : pnsa;
		  path          : path_start_type;
		  wd            : file_id_type;
		  rtpass        : name_type;
		  max           : integer;
		  indx          : integer);
procedure catpasspack(unum      : unitnum;
		      nfns      : integer;
		      nsaptr    : pnsa;
		      path      : path_start_type;
		      wd        : file_id_type;
		      rtpass    : name_type;
		      max       : integer;
		      indx      : integer);
procedure changeprotectpack(unum       : unitnum;
			    nfns       : integer;
			    nsaptr     : pnsa;
			    path       : path_start_type;
			    wd         : file_id_type;
			    rtpass     : name_type;
			    nps        : integer;
			    psaptr     : ppsa);
procedure changevolpack(unum            : unitnum;
			vpass           : name_type;
			newname         : name_type;
			newpass         : name_type);
procedure closepack(unum        : unitnum;
		    fid         : file_id_type);
procedure copypack(unum         : unitnum;
		   srcfid       : file_id_type;
		   srcoff       : integer;
		   destfid      : file_id_type;
		   destoff      : integer;
		   req          : integer);
procedure createpack(unum       : unitnum;
		     nfns       : integer;
		     nsaptr     : pnsa;
		     path       : path_start_type;
		     wd         : file_id_type;
		     rtpass     : name_type;
		     nps        : integer;
		     psaptr     : ppsa;
		     ftype      : gang_file_codes;
		     mode       : integer;
		     maxrec     : integer;
		     ext1       : integer;
		     ext2       : integer;
		     xaddr      : integer);
procedure createlinkpack(unum           : unitnum;
			 oldnfns        : integer;
			 oldnsaptr      : pnsa;
			 oldpath        : path_start_type;
			 oldwd          : file_id_type;
			 oldrtpass      : name_type;
			 newnfns        : integer;
			 newnsaptr      : pnsa;
			 newpath        : path_start_type;
			 newwd          : file_id_type;
			 newrtpass      : name_type;
			 purgeold       : boolean);
procedure exchangepack(unum             : unitnum;
		       fid1             : file_id_type;
		       fid2             : file_id_type);
procedure fileinfopack(unum             : unitnum;
		       fid              : file_id_type);
procedure gangcleanpack(unum            : unitnum;
			savewd          : boolean);
procedure lockpack(unum         : unitnum;
		   fid          : file_id_type;
		   wait         : boolean);
procedure openpack(unum         : unitnum;
		   nfns         : integer;
		   nsaptr       : pnsa;
		   path         : path_start_type;
		   wd           : file_id_type;
		   rtpass       : name_type;
		   share        : integer;
		   opn          : gang_open_type);
procedure pospack(unum          : unitnum;
		  fid           : file_id_type;
		  typepos       : position_type;
		  boffset       : integer);
procedure purgepack(unum        : unitnum;
		    nfns        : integer;
		    nsaptr      : pnsa;
		    path        : path_start_type;
		    wd          : file_id_type;
		    rtpass      : name_type);
procedure sendreadpack(unum     : unitnum;
		       fid      : file_id_type;
		       access   : integer;
		       req      : integer;
		       off      : integer;
		       dat      : anyptr);
procedure seteofpack(unum       : unitnum;
		     fid        : file_id_type;
		     usecurptr  : boolean;
		     boffset    : integer);
procedure unlockpack(unum       : unitnum;
		     fid        : file_id_type);
procedure volpack(unum  : unitnum);
procedure sendwritepack(unum    : unitnum;
			fid     : file_id_type;
			access  : integer;
			req     : integer;
			off     : integer;
			dat     : anyptr);
procedure setdefaulttimeout(time        : integer);
procedure setcopytimeout(time           : integer);
procedure setwaitforlocktimeout(time    : integer);
{INTERNAL ONLY BEGIN}
{ Added for SRM-UX }
procedure chmodpack(unum       : unitnum;
		    nfns       : integer;
		    nsaptr       : pnsa;
		    path       : path_start_type;
		    wd         : file_id_type;
		    fid        : file_id_type;
		    rtpass     : name_type;
		    nmode      : integer);
procedure chownpack(unum       : unitnum;
		    nfns       : integer;
		    nsaptr       : pnsa;
		    path       : path_start_type;
		    wd         : file_id_type;
		    fid        : file_id_type;
		    rtpass     : name_type;
		    nmode      : integer);
procedure chgrppack(unum       : unitnum;
		    nfns       : integer;
		    nsaptr       : pnsa;
		    path       : path_start_type;
		    wd         : file_id_type;
		    fid        : file_id_type;
		    rtpass     : name_type;
		    nmode      : integer);
procedure rmtexecpack(unum         : unitnum;
		      path         : path_start_type;
		      wd           : file_id_type;     { working directory }
		      rtpass       : name_type;
		      cmdstring    : anyptr;
		      cmdstringlen : integer);
{ function is_srmux_unit(unum : unitnum) : boolean; } { Moved to MISC JWH }
function is_srmux_unit(unum : unitnum) : boolean; { back 10/31/90 JWH }
{INTERNAL ONLY END}
var
  dumbuf        : ^buf_info_type;

implement

const
  packetouttimeout      = 1000;         {timeout values in milliseconds}
  ayatimeout            = 1000;

var
  srm_inited    : boolean;
  waitingforlock: boolean;

(****************************************************************************)

procedure maptoioresult(status : integer);
begin
  if ioresult = ord(inoerror) then
    if status <> 0 then
      case status of
	ios_bad_select_code                 : ioresult := ord(ibadunit);
	ios_attach_table_full               : ioresult := ord(itoomanyopen);
	ios_invalid_file_size               : ioresult := ord(inotvalidsize);
	ios_invalid_file_id                 : ioresult := ord(ilostfile);

	ios_bad_file_name,
	ios_file_pathname_missing           : ioresult := ord(ibadtitle);

	ios_illegal_byte_number             : ioresult := ord(ibadvalue);

	ios_successful_completion,
	ios_no_reply                        : ioresult := ord(inoerror);

	ios_system_down,
	ios_volume_offline,
	ios_volume_not_found,
	ios_volume_down                     : ioresult := ord(znodevice);

	ios_file_unopened                   : ioresult := ord(inotopen);

	ios_password_not_allowed,
	ios_no_capability_for_file,
	ios_invalid_protect_code,
	ios_password_not_found,
	ios_duplicate_passwords             : ioresult := ord(ibadpass);

	ios_access_to_file_not_allowed      : ioresult := ord(inoaccess);

	ios_unsupported_directory_operation,
	ios_link_to_directory_not_allowed   : ioresult := ord(inotondir);

	ios_deadlock_detected,
	ios_conflicting_share_modes,
	ios_file_locked_please_retry        : ioresult := ord(ifilelocked);

	ios_file_in_use,
	ios_purge_on_open                   : ioresult := ord(inotclosed);

	ios_insufficient_disk_space         : ioresult := ord(inoroom);
	ios_duplicate_filenames             : ioresult := ord(idupfile);

	ios_phys_eof_encountered,
	ios_eof_encountered                 : ioresult := ord(ieof);

	ios_file_not_found                  : ioresult := ord(inofile);
	ios_volume_in_use                   : ioresult := ord(znotready);
	ios_file_not_directory              : ioresult := ord(ifilenotdir);
	ios_directory_not_empty             : ioresult := ord(idirnotempty);
	ios_invalid_file_code               : ioresult := ord(ibadfiletype);

	ios_rename_across_volumes           : ioresult := 57; { For now }

	otherwise                             ioresult := ord(isrmcatchall);
      end;
end;
(****************************************************************************)

procedure initdumbuf;
begin
  with dumbuf^ do
    begin
      buf_ptr           := nil;
      act_tfr           := no_tfr;
      active_isc        := no_isc;
      buf_size          := 0;
      buf_empty         := nil;
      buf_fill          := nil;
      drv_tmp_ptr       := nil;
      eot_proc.dummy_sl := nil;
      eot_proc.dummy_pr := nil;
      eot_parm          := nil;
      dma_priority      := false;
    end;
end;
(****************************************************************************)

(****************************************************************************)

procedure srm_init;
begin
  if not srm_inited then
    begin
      new(packet_ptr.mp);
      new(dumbuf);
{INTERNAL ONLY BEGIN}
      lansrm_init(dumbuf^); { RDQ }
{INTERNAL ONLY END}
      markuser;
      srm_inited := true;
    end;
  initdumbuf;
  defaulttimeout        := 240000;   {3.1}{timeout values in milliseconds}
  waitforlocktimeout    := 0;
  copytimeout           := 240000;       { modified for 3.1 6/11/85 jws }
end;
(****************************************************************************)

procedure resetcard(unum : unitnum);
begin
  with isc_table[unitable^[unum].sc] do
    call(io_drv_ptr^.iod_init, io_tmp_ptr);
end;
(****************************************************************************)

procedure setdefaulttimeout(time: integer);
begin
  defaulttimeout := time;                        {time is in milliseconds}
end;
(****************************************************************************)

procedure setwaitforlocktimeout(time: integer);
begin
  waitforlocktimeout := time;                    {time is in milliseconds}
end;
(****************************************************************************)

procedure setcopytimeout(time: integer);
begin
  copytimeout := time;                           {time is in milliseconds}
end;
(****************************************************************************)

procedure setintegertimeout(sc  : type_isc;
			    time: integer);
begin
  with isc_table[sc] do
    begin
      user_time := time;                        {time is in milliseconds}
      if io_tmp_ptr <> nil then
	io_tmp_ptr^.timeout := time;
    end;
end;
(****************************************************************************)

function do_buffer_data(var b_info : buf_info_type) : integer;
begin
  with b_info do
    do_buffer_data := integer(buf_fill) - integer(buf_empty);
end;
(****************************************************************************)

procedure do_buffer_reset(var b_info : buf_info_type);
begin
  with b_info do
    if active_isc <> no_isc then
      io_escape(ioe_buf_busy,no_isc)
    else
      begin
	buf_fill        := buf_ptr;
	buf_empty       := buf_ptr;
      end;
end;
(****************************************************************************)

function do_buffer_space(var b_info : buf_info_type) : integer;
begin
  with b_info do
    begin
      if  (do_buffer_data(b_info) = 0)
      and (active_isc = no_isc) then
	do_buffer_reset(b_info);
      do_buffer_space := buf_size + integer(buf_ptr) - integer(buf_fill);
    end;
end;
(****************************************************************************)
{INTERNAL ONLY BEGIN}
procedure do_transfer(sc        : type_isc;
		      dir       : dir_of_tfr;
		      count     : integer;
		      tfr_end   : boolean);
var
  lcount        : integer;
  utfr          : user_tfr_type;
begin
  with isc_table[sc], dumbuf^ do
    begin
      utfr := serial_fastest;
      if not tfr_end then lcount := count
      else
	if dir = from_memory then
	  lcount := do_buffer_data(dumbuf^)
	else
	  lcount := do_buffer_space(dumbuf^);

      if io_tmp_ptr = nil then io_escape(ioe_no_driver,sc);
      if lcount = 0 then io_escape(ioe_bad_cnt,no_isc);
      { if iompx capable then use registered transfer }
      { otherwise use normal transfer}
      if iompx_info<>nil then
	with iompx_info^ do
	if isc_iompx_table[sc].capable then utfr := dummy_tfr_1;

      if active_isc <> no_isc then io_escape(ioe_buf_busy,no_isc);

      if do_buffer_data(dumbuf^) = 0 then do_buffer_reset(dumbuf^);

      with io_tmp_ptr^ do
	if dir = to_memory then
	  begin
	    if do_buffer_space(dumbuf^) < lcount then
	      io_escape(ioe_no_space,sc);
	    if utfr<>dummy_tfr_1 then
	      if in_bufptr <> nil then io_escape(ioe_isc_busy,sc)
				  else in_bufptr := dumbuf;
	  end
	else
	  begin
	    if do_buffer_data(dumbuf^) < lcount then
	      io_escape(ioe_no_data,sc);
	    if out_bufptr <> nil then io_escape(ioe_isc_busy,sc)
				 else out_bufptr := dumbuf;
	  end;

      drv_tmp_ptr       := io_tmp_ptr;
      act_tfr           := no_tfr;
      usr_tfr           := utfr;
      b_w_mode          := false;               {byte mode}
      direction         := dir;
      term_char         := -1;                  {no term char}
      term_count        := lcount;
      end_mode          := tfr_end;

      call(io_drv_ptr^.iod_tfr,io_tmp_ptr,dumbuf);
    end;
end;
{INTERNAL ONLY END}
(****************************************************************************)
procedure dorecover(unum        : unitnum);
begin
  ioresult := ord(isrmcatchall);
  if (escapecode <> ioescapecode) then
    begin
      if srmsavesc = 0 then
	srmsavesc     := escapecode
    end
  else
    if (ioe_result = ioe_timeout) then
      ioresult := ord(ztimeout);
  resetcard(unum);
end;
(****************************************************************************)

procedure packetout(unum        : unitnum);
var
  ip    : ^integer;
begin
  with unitable^[unum] do
    try
      initdumbuf;
      setintegertimeout(sc,packetouttimeout);
      packet_ptr.mp^[8]  := chr(unitable^[unum].ba);
      packet_ptr.mp^[9]  := chr(0);
      packet_ptr.mp^[10] := chr(0);
      packet_ptr.mp^[11] := chr(0);
      ip := addr(packet_ptr.mp^[17]);  {request type}
      if ip^ = req_are_you_alive then
	packet_ptr.mp^[12] := chr(2)
      else
	packet_ptr.mp^[12] := chr(7);
      dumbuf^.buf_ptr   := anyptr(packet_ptr.mp);
      dumbuf^.buf_size  := sizeof(msg_packet_type);
      dumbuf^.buf_empty := addr(packet_ptr.mp^[8]);
      ip := addr(packet_ptr.mp^[13]);  {packet length}
      dumbuf^.buf_fill  := addr(packet_ptr.mp^[12+1+ip^]);
      do_transfer(sc,from_memory,0,true);
    recover
      dorecover(unum);
end;
(****************************************************************************)

procedure packetin(unum         : unitnum;
		   sendreq      : integer);
type
  ayastatustype = packed record
		    srmnode     : byte;
		    linkerrs    : byte;
		    computerid  : shortint;
		  end;
  ayastatusptr  = ^ayastatustype;
var
  count : integer;
begin
  with unitable^[unum] do
    try
      initdumbuf;
      if sendreq = req_are_you_alive then
	setintegertimeout(sc,ayatimeout)
      else
      if (sendreq = req_flock) and (waitingforlock) then
	setintegertimeout(sc,waitforlocktimeout)
      else
      if (sendreq = req_copy) or
	 (sendreq = req_create) then        { 3.0 BUG FIX 3/16/84 }
	setintegertimeout(sc,copytimeout)
      else
	setintegertimeout(sc,defaulttimeout);
      with packet_ptr.rhead^, packet_ptr.rread^ do
	begin
	  repeat
	    fillchar(linkfiller, 28, chr(0));

	    dumbuf^.buf_ptr   := anyptr(packet_ptr.mp);
	    dumbuf^.buf_size  := sizeof(msg_packet_type);
	    dumbuf^.buf_empty := anyptr(packet_ptr.mp);
	    dumbuf^.buf_fill  := addr(packet_ptr.mp^[9]);

	    if sendreq <> req_read then
	      begin
		do_transfer(sc,to_memory,0,true);
	      end
	    else
	      begin
		count := size_from_gang_error + 4;
		do_transfer(sc,to_memory,count,false);

		if message_length > size_from_gang_error then
		  if  return_request_type <> -req_read then
		    begin
		      do_transfer(sc,to_memory,0,true);
		    end
		  else
		    begin
		      count := size_from_read - size_from_gang_error;
		      do_transfer(sc,to_memory,count,false);

		      count := actual;

		      if count > 0 then
			begin
			  dumbuf^.buf_ptr   := anyptr(user_sequencing_field);
			  dumbuf^.buf_size  := 512;
			  dumbuf^.buf_empty := anyptr(user_sequencing_field);
			  dumbuf^.buf_fill  := anyptr(user_sequencing_field);
			  do_transfer(sc,to_memory,count,false);
			end;
		    end;
	      end;
	  until return_request_type = -sendreq;

	  if sendreq <> req_are_you_alive then
	    maptoioresult(status)
	  else
	    if ayastatusptr(addr(status))^.srmnode <> 1 then
	      ioresult := ord(znodevice);
	end;
    recover
      dorecover(unum);
end;
(****************************************************************************)

procedure setup_smh(var smh     : send_header_type;
		    ml,
		    srt,
		    usf         : integer);
begin
  with smh do
    begin
      message_length    := ml;
      send_request_type := srt;
      user_sequencing_field := usf;
    end;
end;
(****************************************************************************)

procedure setup_vnh(var vnh     : volume_header_type;
			unum    : unitnum);
begin
  with vnh do
    begin
      filler1                   := 0;
      driver_name               := ' ';
      catalogue_organization    := ' ';
      device_address_present.i  := 1;
      with device_address do
	begin
	  address1              := unitable^[unum].du;  {unit number}
	  haddress              := 0;
	  unit_num              := 0;
	  volume_num            := 0;
	end;
      volume_name := ' ';
    end;
end;
(****************************************************************************)

procedure setup_fnh(var fnh     : file_header_type;
		    num         : integer;
		    wd          : file_id_type;
		    pt          : path_start_type;
		    rp          : name_type);
begin
  with fnh do
    begin
      num_file_name_sets := num;
      working_directory  := wd;
      filler1            := 0;
      path_type          := pt;
      root_password      := rp;
    end;
end;
(****************************************************************************)

procedure areyoualivepack(unum          : unitnum);
begin
  with packet_ptr.sareyoualive^ do
    begin
      setup_smh(send_mess_header,
		size_to_are_you_alive,
		req_are_you_alive,
		0);
    end;

  packetout(unum);
  if ioresult = ord(inoerror) then
    packetin(unum,req_are_you_alive);
  if ioresult <> ord(inoerror) then
    packet_ptr.rareyoualive^.return_mess_header.status := 0;
end;
(****************************************************************************)

procedure catpack(unum          : unitnum;
		  nfns          : integer;
		  nsaptr        : pnsa;
		  path          : path_start_type;
		  wd            : file_id_type;
		  rtpass        : name_type;
		  max           : integer;
		  indx          : integer);
begin
  with packet_ptr.scat^ do
    begin
      pnsa(addr(start_name_sets))^ := nsaptr^;

      setup_smh(send_mess_header,
		size_to_cat+nfns*36,
		req_catalog,
		0);

      max_num_files := max;
      file_index    := indx;
      filler1       := 0;

      setup_vnh(volume_name_header,unum);

      filler2 := 0;

      setup_fnh(file_name_header,
		nfns,
		wd,      {working directory}
		path,
		rtpass);{root password}

    end;
  packetout(unum);
  packetin(unum,req_catalog);
end;
(****************************************************************************)

procedure catpasspack(unum      : unitnum;
		      nfns      : integer;
		      nsaptr    : pnsa;
		      path      : path_start_type;
		      wd        : file_id_type;
		      rtpass    : name_type;
		      max       : integer;
		      indx      : integer);
begin
  with packet_ptr.scatpass^ do
    begin
      pnsa(addr(start_name_sets))^ := nsaptr^;

      setup_smh(send_mess_header,
		size_to_catprotect+nfns*36,
		req_catprotect,
		0);

      max_num_passwords := max;
      filler1           := 0;
      password_index    := indx;

      setup_vnh(volume_name_header,unum);

      filler2 := 0;

      setup_fnh(file_name_header,
		nfns,
		wd,      {working directory}
		path,
		rtpass);{root password}

    end;
  packetout(unum);
  packetin(unum,req_catprotect);
end;
(****************************************************************************)

procedure changeprotectpack(unum       : unitnum;
			    nfns       : integer;
			    nsaptr     : pnsa;
			    path       : path_start_type;
			    wd         : file_id_type;
			    rtpass     : name_type;
			    nps        : integer;
			    psaptr     : ppsa);
begin
  with packet_ptr.schangeprotect^ do
    begin
      pnsa(addr(start_name_sets))^ := nsaptr^;
      ppsa(addr(pnsa(addr(start_name_sets))^[nfns+1]))^ := psaptr^;

      setup_smh(send_mess_header,
		size_to_changeprotect+nfns*36+nps*24,
		req_changeprotect,
		0);

      setup_vnh(volume_name_header,unum);

      setup_fnh(file_name_header,
		nfns,
		wd,      {working directory}
		path,
		rtpass);{root password}

      num_protect_code_sets     := nps;
    end;

  packetout(unum);
  packetin(unum,req_changeprotect);
end;
(****************************************************************************)

procedure changevolpack(unum            : unitnum;
			vpass           : name_type;
			newname         : name_type;
			newpass         : name_type);
begin
  with packet_ptr.schangevolume^ do
    begin
      setup_smh(send_mess_header,
		size_to_change_vol_label,
		req_label,
		0);

      setup_vnh(volume_name_header,unum);
      password              := vpass;
      new_volume_name       := newname;
      new_vol_password      := newpass;
    end;

  packetout(unum);
  packetin(unum,req_label);
end;
(****************************************************************************)

procedure closepack(unum        : unitnum;
		    fid         : file_id_type);
begin
  with packet_ptr.sclose^ do
    begin
      setup_smh(send_mess_header,
		size_to_close,
		req_close,
		0);
      file_id           := fid;
      directory_password:= ' ';
      file_password     := ' ';
      filler5.i         := 0;
      nodeallocate.i    := 0;
    end;

  packetout(unum);
  packetin(unum,req_close);
end;
(****************************************************************************)

procedure copypack(unum         : unitnum;
		   srcfid       : file_id_type;
		   srcoff       : integer;
		   destfid      : file_id_type;
		   destoff      : integer;
		   req          : integer);
begin
  with packet_ptr.scopy^ do
    begin
      setup_smh(send_mess_header,
		size_to_copy,
		req_copy,
		0);

      source_file_id            := srcfid;
      source_offset             := srcoff;
      destination_file_id       := destfid;
      destination_offset        := destoff;
      requested                 := req;
    end;

  packetout(unum);
  packetin(unum,req_copy);
end;
(****************************************************************************)

procedure createpack(unum       : unitnum;
		     nfns       : integer;
		     nsaptr     : pnsa;
		     path       : path_start_type;
		     wd         : file_id_type;
		     rtpass     : name_type;
		     nps        : integer;
		     psaptr     : ppsa;
		     ftype      : gang_file_codes;
		     mode       : integer;
		     maxrec     : integer;
		     ext1       : integer;
		     ext2       : integer;
		     xaddr      : integer);
begin
  with packet_ptr.screatefile^ do
    begin
      pnsa(addr(start_name_sets))^ := nsaptr^;
      if nps > 0 then
	ppsa(addr(pnsa(addr(start_name_sets))^[nfns+1]))^ := psaptr^;

      setup_smh(send_mess_header,
		size_to_create+nfns*36+nps*24,
		req_create,
		0);

      setup_vnh(volume_name_header,unum);

      setup_fnh(file_name_header,
		nfns,
		wd,      {working directory}
		path,
		rtpass);{root password}

      file_code                 := ftype;
      record_mode               := mode;

      max_record_size           := maxrec;
      first_extent              := ext1;
      contiguous_first_extent.i := 0;           {false}
      secondary_extent          := ext2;
      max_file_size             := maxint;
      boot_start_address        := xaddr;
      num_protect_code_sets     := nps;
      label_included_flag.i     := 0;           {false}
    end;

  packetout(unum);
  packetin(unum,req_create);
end;
(****************************************************************************)

procedure createlinkpack(unum           : unitnum;
			 oldnfns        : integer;
			 oldnsaptr      : pnsa;
			 oldpath        : path_start_type;
			 oldwd          : file_id_type;
			 oldrtpass      : name_type;
			 newnfns        : integer;
			 newnsaptr      : pnsa;
			 newpath        : path_start_type;
			 newwd          : file_id_type;
			 newrtpass      : name_type;
			 purgeold       : boolean);
begin
  with packet_ptr.screatelink^ do
    begin
      pnsa(addr(start_name_sets))^ := oldnsaptr^;
      pnsa(addr(pnsa(addr(start_name_sets))^[oldnfns+1]))^ := newnsaptr^;

      setup_smh(send_mess_header,
		size_to_createlink+oldnfns*36+newnfns*36,
		req_createlink,
		0);

      setup_vnh(volume_name_header,unum);

      setup_fnh(old_file_name_header,
		oldnfns,
		oldwd,      {working directory}
		oldpath,
		oldrtpass);{root password}

      setup_fnh(new_file_name_header,
		newnfns,
		newwd,      {working directory}
		newpath,
		newrtpass);{root password}

      purge_old_link.i  := ord(purgeold);
    end;

  packetout(unum);
  packetin(unum,req_createlink);
end;
(****************************************************************************)

procedure exchangepack(unum             : unitnum;
		       fid1             : file_id_type;
		       fid2             : file_id_type);
begin
  with packet_ptr.sexchange^ do
    begin
      setup_smh(send_mess_header,
		size_to_xchg_open,
		req_xchg_open,
		0);

      file_id_1 := fid1;
      file_id_2 := fid2;
    end;

  packetout(unum);
  packetin(unum,req_xchg_open);
end;
(****************************************************************************)

procedure fileinfopack(unum             : unitnum;
		       fid              : file_id_type);
begin
  with packet_ptr.sfileinfo^ do
    begin
      setup_smh(send_mess_header,
		size_to_info,
		req_info,
		0);

      implicit_unlock.i := 1;
      file_id := fid;
    end;

  packetout(unum);
  packetin(unum,req_info);
end;
(****************************************************************************)

procedure gangcleanpack(unum            : unitnum;
			savewd          : boolean);
begin
  with packet_ptr.sgangclean^ do
    begin
      setup_smh(send_mess_header,
		size_to_gang_cleanup,
		req_gang_cleanup,
		0);

      keep_protected_directories.i := ord(savewd);
    end;

  packetout(unum);
end;
(****************************************************************************)

procedure lockpack(unum         : unitnum;
		   fid          : file_id_type;
		   wait         : boolean);
begin
  waitingforlock := wait;
  with packet_ptr.slock^ do
    begin
      setup_smh(send_mess_header,
		size_to_flock,
		req_flock,
		0);

      file_id           := fid;
      wait_for_lock.i   := ord(wait);
    end;

  packetout(unum);
  packetin(unum,req_flock);
end;
(****************************************************************************)

procedure openpack(unum         : unitnum;
		   nfns         : integer;
		   nsaptr       : pnsa;
		   path         : path_start_type;
		   wd           : file_id_type;
		   rtpass       : name_type;
		   share        : integer;
		   opn          : gang_open_type);
begin
  with packet_ptr.sopen^ do
    begin
      pnsa(addr(start_name_sets))^ := nsaptr^;

      setup_smh(send_mess_header,
		size_to_open+nfns*36,
		req_open,
		0);

      setup_vnh(volume_name_header,unum);

      setup_fnh(file_name_header,
		nfns,
		wd,     {working directory}
		path,
		rtpass);{root password}

      filler2           := 0;
      filler3           := 0;
      share_code        := share;
      filler4.id        := 0;
      filler1           := 0;
      open_type         := opn;
    end;

  packetout(unum);
  packetin(unum,req_open);
end;
(****************************************************************************)

procedure pospack(unum          : unitnum;
		  fid           : file_id_type;
		  typepos       : position_type;
		  boffset       : integer);
begin
  with packet_ptr.spos^ do
    begin
      setup_smh(send_mess_header,
		size_to_position,
		req_position,
		0);

      implicit_unlock.i := 1;
      file_id := fid;
      filler3     := 0;
      type_of_position := typepos;
      byte_offset := boffset;
    end;

  packetout(unum);
  packetin(unum,req_position);
end;
(****************************************************************************)

procedure purgepack(unum        : unitnum;
		    nfns        : integer;
		    nsaptr      : pnsa;
		    path        : path_start_type;
		    wd          : file_id_type;
		    rtpass      : name_type);
begin
  with packet_ptr.spurge^ do
    begin
      pnsa(addr(start_name_sets))^ := nsaptr^;

      setup_smh(send_mess_header,
		size_to_purge+nfns*36,
		req_purgelink,
		0);

      setup_vnh(volume_name_header,unum);

      setup_fnh(file_name_header,
		nfns,
		wd,      {working directory}
		path,
		rtpass);{root password}
    end;

  packetout(unum);
  packetin(unum,req_purgelink);
end;
(****************************************************************************)

procedure sendreadpack(unum     : unitnum;
		       fid      : file_id_type;
		       access   : integer;
		       req      : integer;
		       off      : integer;
		       dat      : anyptr);
begin
  with packet_ptr.sread^ do
    begin
      setup_smh(send_mess_header,
		size_to_read,
		req_read,
		integer(dat));

      implicit_unlock.i := 1;
      file_id           := fid;
      access_code       := access;
      filler3[1]        := 0;
      filler3[2]        := 0;
      requested         := req;
      offset            := off;
    end;

  packetout(unum);
end;
(****************************************************************************)

procedure seteofpack(unum       : unitnum;
		     fid        : file_id_type;
		     usecurptr  : boolean;
		     boffset    : integer);
begin
  with packet_ptr.sseteof^ do
    begin
      setup_smh(send_mess_header,
		size_to_set_eof,
		req_set_eof,
		0);

      implicit_unlock.i := 1;
      file_id           := fid;
      use_current_ptr.i := ord(usecurptr);
      byte_offset       := boffset;
    end;

  packetout(unum);
  packetin(unum,req_set_eof);
end;
(****************************************************************************)

procedure unlockpack(unum       : unitnum;
		     fid        : file_id_type);
begin
  with packet_ptr.sunlock^ do
    begin
      setup_smh(send_mess_header,
		size_to_funlock,
		req_funlock,
		0);

      file_id           := fid;
      explicit_unlock.i := ord(true);
    end;

  packetout(unum);
  packetin(unum,req_funlock);
end;
(****************************************************************************)

procedure volpack(unum  : unitnum);
begin
  with packet_ptr.svol^ do
    begin
      setup_smh(send_mess_header,
		size_to_volstatus,
		req_volstatus,
		0);

      setup_vnh(volume_name_header,unum);
    end;

  packetout(unum);
  packetin(unum,req_volstatus);
end;
(****************************************************************************)

procedure sendwritepack(unum    : unitnum;
			fid     : file_id_type;
			access  : integer;
			req     : integer;
			off     : integer;
			dat     : anyptr);
begin
  with packet_ptr.swrite^ do
    begin
      setup_smh(send_mess_header,
		size_to_write + req,
		req_write,
		integer(dat));

      implicit_unlock.i := 1;
      file_id           := fid;
      access_code       := access;
      filler3[1]        := 0;
      filler3[2]        := 0;
      requested         := req;
      offset            := off;
      filler8.i         := 0;
      flush_buffer.i    := 1;
      moveleft(charptr(dat)^,data,req);
    end;

  packetout(unum);
end;
(****************************************************************************)
{INTERNAL ONLY BEGIN}
{ Added for SRM-UX : }
procedure chmodpack(unum       : unitnum;
		    nfns       : integer;
		    nsaptr       : pnsa;
		    path       : path_start_type;
		    wd         : file_id_type;
		    fid        : file_id_type;
		    rtpass     : name_type;
		    nmode      : integer);
var nsap : pnsa;
var nsa  : name_set_array;
var i : integer;
begin
  { Set up the packet, and send it : }

  with packet_ptr.schmod^ do
   begin
     pnsa(addr(start_name_sets))^ := nsaptr^;
     setup_smh(send_mess_header,
	    size_to_hfs_chmod + 36*nfns,
	    req_hfs_chmod, 0);
     setup_vnh(volume_name_header.old_header,unum);
     setup_fnh(file_name_header,nfns,wd,path,rtpass);

     volume_name_header.delta_mask := hex('fffffe00'); { ???????????? }
     volume_name_header.ordinary_perm := nmode;  { ?????????? }
     volume_name_header.dir_perm := nmode;  { ?????????? }
   end;

  packetout(unum);
  packetin(unum,req_hfs_chmod);

end;

procedure chownpack(unum       : unitnum;
		    nfns       : integer;
		    nsaptr       : pnsa;
		    path       : path_start_type;
		    wd         : file_id_type;
		    fid        : file_id_type;
		    rtpass     : name_type;
		    nmode      : integer);
begin
  { Set up the packet, and send it : }

  with packet_ptr.schown^ do
   begin
     pnsa(addr(start_name_sets))^ := nsaptr^;
     setup_smh(send_mess_header,
	    size_to_hfs_chown + 36*nfns,
	    req_hfs_chown, 0);
     setup_vnh(volume_name_header.old_header,unum);
     setup_fnh(file_name_header,nfns,wd,path,rtpass);
     volume_name_header.new_owner := nmode;
   end;
  packetout(unum);
  packetin(unum,req_hfs_chown);
end;

procedure chgrppack(unum       : unitnum;
		    nfns       : integer;
		    nsaptr       : pnsa;
		    path       : path_start_type;
		    wd         : file_id_type;
		    fid        : file_id_type;
		    rtpass     : name_type;
		    nmode      : integer);
begin
  { Set up the packet, and send it : }

  with packet_ptr.schgrp^ do
   begin
     pnsa(addr(start_name_sets))^ := nsaptr^;
     setup_smh(send_mess_header,
	    size_to_hfs_chgrp + 36*nfns,
	    req_hfs_chgrp, 0);
     setup_vnh(volume_name_header.old_header,unum);
     setup_fnh(file_name_header,nfns,wd,path,rtpass);
     volume_name_header.new_owner := nmode;
   end;

  packetout(unum);
  packetin(unum,req_hfs_chgrp);
end;

procedure rmtexecpack(unum         : unitnum;
		      path         : path_start_type;
		      wd           : file_id_type;     { working directory }
		      rtpass       : name_type;
		      cmdstring    : anyptr;
		      cmdstringlen : integer);
  type
     cp = ^char;
  var
     i : integer;
  begin
    with packet_ptr.srmtexec^ do
      begin
	setup_smh(send_mess_header,
		  size_to_rmt_exec + cmdstringlen,
		  req_rmt_exec,
		  0);
	setup_vnh(volume_name_header,unum);
	cmd_size           := cmdstringlen;
	directory_id       := wd;
	filler1            := 0;
	path_type          := path;
	volume_pword       := rtpass;
	spare1 := 0;
	spare2 := 0;
	moveleft(cp(cmdstring)^,cmd,cmdstringlen);
      end;
    packetout(unum);
    packetin(unum,req_rmt_exec);
  end;

function is_srmux_unit(unum : unitnum) : boolean;
begin
  is_srmux_unit := srmux_on[unum];
end;
{INTERNAL ONLY END}
(****************************************************************************)

end{module srm}.


@


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


50.4
log
@Added "usage_array" for use in logging testing activity.
@
text
@a460 59
{EXTERNAL ONLY BEGIN}
procedure do_transfer(sc        : type_isc;
		      dir       : dir_of_tfr;
		      count     : integer;
		      tfr_end   : boolean);
var
  lcount        : integer;
begin
  with isc_table[sc], dumbuf^ do
    begin
      if not tfr_end then
	lcount := count
      else
	if dir = from_memory then
	  lcount := do_buffer_data(dumbuf^)
	else
	  lcount := do_buffer_space(dumbuf^);

      if io_tmp_ptr = nil then
	io_escape(ioe_no_driver,sc);
      if lcount = 0 then
	io_escape(ioe_bad_cnt,no_isc);
      if active_isc <> no_isc then
	io_escape(ioe_buf_busy,no_isc);

      if do_buffer_data(dumbuf^) = 0 then
	do_buffer_reset(dumbuf^);

      with io_tmp_ptr^ do
	if dir = to_memory then
	  begin
	    if in_bufptr <> nil then
	      io_escape(ioe_isc_busy,sc);
	    if do_buffer_space(dumbuf^) < lcount then
	      io_escape(ioe_no_space,sc);
	    in_bufptr := dumbuf;
	  end
	else
	  begin
	    if out_bufptr <> nil then
	      io_escape(ioe_isc_busy,sc);
	    if do_buffer_data(dumbuf^) < lcount then
	      io_escape(ioe_no_data,sc);
	    out_bufptr := dumbuf;
	  end;

      drv_tmp_ptr       := io_tmp_ptr;
      act_tfr           := no_tfr;
      usr_tfr           := serial_fastest;
      b_w_mode          := false;               {byte mode}
      direction         := dir;
      term_char         := -1;                  {no term char}
      term_count        := lcount;
      end_mode          := tfr_end;

      call(io_drv_ptr^.iod_tfr,io_tmp_ptr,dumbuf);
    end;
end;
{EXTERNAL ONLY END}
@


50.3
log
@Changed the maptoioresult procedure to map the rename_across_volumes
error to 57.
@
text
@d58 2
@


50.2
log
@Re-enabled the function is_srmux_unit. This will no longer be
exported from misc.
@
text
@d283 1
a283 1
	ios_rename_across_volumes           : ioresult := 58; { For now }
@


50.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@d57 1
d211 1
d1392 1
a1392 1
{ function is_srmux_unit(unum : unitnum) : boolean;
d1395 1
a1395 1
end; } { Moved to MISC 8/10/90 }
@


49.2
log
@Enhanced maptoioresult to map the SRM and SRM/UX error 31043
"ios_rename_across_volumes" to 58 instead of the srm catchall
value of 50. This might be temporary ...
@
text
@@


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


48.2
log
@Moved some SRM-UX stuff from here to module MISC. JWH.
@
text
@@


48.1
log
@Automatic bump of revision number for PWS version 3.24a
@
text
@d56 1
a56 1
  srmux_on              : srmux_array;
d209 1
a209 1
function is_srmux_unit(unum : unitnum) : boolean;
d1388 1
a1388 1
function is_srmux_unit(unum : unitnum) : boolean;
d1391 1
a1391 1
end;
@


47.3
log
@Added routines chmodpack, chownpack, and chgrppack.
@
text
@@


47.2
log
@RM-UX changes.
@
text
@d178 25
d1272 85
@


47.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@d55 3
d184 1
d1277 5
@


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.5
log
@
      SRM-UX source control changes.
@
text
@@


38.4
log
@

            Added the directives {INTERNAL ONLY BEGIN},
        {INTERNAL ONLY END}, and {EXTERNAL VERSION to the
        source for SRM-UX control purposes. See the first
        entry in the turnlog for an explanation of this. 
@
text
@d425 2
a426 1
{EXTERNAL VERSION
d484 1
a484 1
{INTERNAL ONLY END}
@


38.3
log
@

        SRM-UX source control in 3.23.
@
text
@d29 1
a29 1
$IF SRMUX_ON$
d32 1
a32 1
$END$
d36 5
a40 1
       loader $IF SRMUX_ON$ lansrm, landecs $END$ ;
d174 1
a174 1
$IF SRMUX_ON$
d181 1
a181 1
$END$
d284 1
a284 1
$IF SRMUX_ON$
d286 1
a286 1
$END$
d365 1
a365 2

$IF NOT SRMUX_ON$
d372 1
d376 2
a377 2
      if not tfr_end then
	lcount := count
d384 7
a390 6
      if io_tmp_ptr = nil then
	io_escape(ioe_no_driver,sc);
      if lcount = 0 then
	io_escape(ioe_bad_cnt,no_isc);
      if active_isc <> no_isc then
	io_escape(ioe_buf_busy,no_isc);
d392 1
a392 2
      if do_buffer_data(dumbuf^) = 0 then
	do_buffer_reset(dumbuf^);
d394 2
a398 2
	    if in_bufptr <> nil then
	      io_escape(ioe_isc_busy,sc);
d401 3
a403 1
	    in_bufptr := dumbuf;
a406 2
	    if out_bufptr <> nil then
	      io_escape(ioe_isc_busy,sc);
d409 2
a410 1
	    out_bufptr := dumbuf;
d415 1
a415 1
      usr_tfr           := serial_fastest;
d425 1
a425 2
$END$
$IF SRMUX_ON$
a431 1
  utfr          : user_tfr_type;
d435 2
a436 2
      utfr := serial_fastest;
      if not tfr_end then lcount := count
d443 6
a448 7
      if io_tmp_ptr = nil then io_escape(ioe_no_driver,sc);
      if lcount = 0 then io_escape(ioe_bad_cnt,no_isc);
      { if iompx capable then use registered transfer }
      { otherwise use normal transfer}
      if iompx_info<>nil then
	with iompx_info^ do
	if isc_iompx_table[sc].capable then utfr := dummy_tfr_1;
d450 2
a451 1
      if active_isc <> no_isc then io_escape(ioe_buf_busy,no_isc);
a452 2
      if do_buffer_data(dumbuf^) = 0 then do_buffer_reset(dumbuf^);

d456 2
d460 1
a460 3
	    if utfr<>dummy_tfr_1 then
	      if in_bufptr <> nil then io_escape(ioe_isc_busy,sc)
				  else in_bufptr := dumbuf;
d464 2
d468 1
a468 2
	    if out_bufptr <> nil then io_escape(ioe_isc_busy,sc)
				 else out_bufptr := dumbuf;
d473 1
a473 1
      usr_tfr           := utfr;
d483 1
a483 1
$END$
a484 1

d1241 1
a1241 1
$IF SRMUX_ON$
d1272 1
a1272 1
$END$
@


38.2
log
@

      SRM-UX source control in 3.23.

@
text
@d362 59
@


38.1
log
@Automatic bump of revision number for PWS version 3.23a
@
text
@d29 1
d32 1
d36 1
a36 3
       loader,
       lansrm,
       landecs;
d170 1
d177 1
d280 1
d282 1
d362 1
d422 1
d1181 1
d1212 1
@


37.2
log
@

         SRM-UX changes....
@
text
@@


37.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@d28 1
a28 1
$search 'IOLIB:KERNEL'$
d30 1
d41 4
a44 1

@


36.2
log
@Changes made to support SRM-UX and remote process execution/control
RDQ 9 may 89

@
text
@@


36.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@d29 2
d33 3
a35 1
       loader;
d166 8
a181 1
  dumbuf        : ^buf_info_type;
d274 1
d360 1
d364 2
a365 2
      if not tfr_end then
	lcount := count
d372 7
a378 6
      if io_tmp_ptr = nil then
	io_escape(ioe_no_driver,sc);
      if lcount = 0 then
	io_escape(ioe_bad_cnt,no_isc);
      if active_isc <> no_isc then
	io_escape(ioe_buf_busy,no_isc);
d380 1
a380 2
      if do_buffer_data(dumbuf^) = 0 then
	do_buffer_reset(dumbuf^);
d382 2
a386 2
	    if in_bufptr <> nil then
	      io_escape(ioe_isc_busy,sc);
d389 3
a391 1
	    in_bufptr := dumbuf;
a394 2
	    if out_bufptr <> nil then
	      io_escape(ioe_isc_busy,sc);
d397 2
a398 1
	    out_bufptr := dumbuf;
d403 1
a403 1
      usr_tfr           := serial_fastest;
d475 2
a476 1
      else if (sendreq = req_flock) and (waitingforlock) then
d478 3
a480 2
      else if (sendreq = req_copy) or
	      (sendreq = req_create) then        { 3.0 BUG FIX 3/16/84 }
d985 1
a985 1
		wd,      {working directory}
d1170 31
@


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