{ Routines to allow access to files on another filestore }

{ Genealogy:       RWT begat eftp,                                       }
{              and RDW ripped off bits for the first version of sethost, }
{              and FDC expanded it somewhat                              }
{              and RWT some more                                         }

%owninteger used ports = 1<<0 + 1<<1  {reserve those two}

%routine deallocate port(%integer p)
  p = 1<<p
  used ports = used ports & (\p)
%end

%integerfn allocate port
%integer bit,n
{hack 23/01/87}%result = 1
  bit = 1
  %for n = 0,1,31 %cycle
    usedports = usedports!bit %andresult = n %if usedports&bit=0
    bit = bit<<1
  %repeat
  %signal 10,0,1,"No free local ports"
%end

%predicate gotack(%integer port)
! Wait for ACK. 
! Return FALSE if NAK received or fed up waiting.
! Otherwise return TRUE.
%integer bit,deadline
  bit = 1<<port
  deadline = cputime+15000
  %cycle
    %if ack&bit#0 %start
      %trueif nak&bit=0
      nak = nak!!bit
      %false
    %finish
  %repeatuntil cputime>deadline
  %false
%end

%predicate gotdtx(%integer port)
! Wait for DTX and return TRUE,  FALSE when fed up.
%integer bit,deadline
  bit = 1<<port
  deadline = cputime+15000
  %cycle
    %trueif dtx&bit#0
  %repeatuntil cputime>deadline
  %false
%end

%constant %integer Max Fs = 5
%constant %string (16) %array FNames(1:Max Fs) =
   "Alpha", "Bravo", "Charlie", "Met", "Vax"
%constant %integer %array FNumbers(1:Max Fs) =
   16_14, 16_15, 16_1B, 16_44, 16_72


{---------- FILESTORE NAME ----------}
{ Convert a filestore's ether address into its textual name.
{ If that address does not appear in the above table,
{ then just return a 2-digit hex string.

 %string (255) %function Filestore Name (%integer n)
   %integer i
   %string (3) s

   %integerfn h (%integer n)
     n = n&15; n = n+7 %if n>9; %result = n+'0'
   %end

   %for i = 1, 1, Max Fs %cycle
      %result = FNames(i) %if FNumbers(i) = n
   %repeat
   s = tostring(h(n>>4))
   s = s.tostring(h(n))
   %result = s
%end {Filestore Name}

{---------- FILESTORE NUMBER ----------}
{ Convert a filestore name into its ether address.
{ If the name does not appear in the table, try to
{ interpret it as a hex string.

 %integer %function Filestore Number (%string (*) %name Fs)
   %integer i,k,n

   %predicate Prefix Match(%string (*) %name s1, s2)
   { Does s1 match a prefix of s2 ? }
      %integer i

      %false %if Length(s1) > Length(s2)
      %for i = 1, 1, Length(s1) %cycle
         %false %if (charno(s1, i) ! 32) # (charno(s2, i) ! 32)
      %repeat
      %true
   %end { Prefix Match }

   %for i = 1, 1, Max Fs %cycle
      %result = FNumbers(i) %if Prefix Match(Fs, FNames(i))
   %repeat
   n = 0
   %for i = 1,1,length(fs) %cycle
     k = charno(fs,i)!32
     %if '0'<=k<='9' %then n = n<<4+k-'0' -
     %elseif 'a'<=k<='f' %then n = n<<4+k-'a'+10 -
     %else n = 0
   %repeat
   %result = n %unless n=0
   %signal 10, 0, 1, "Filestore ".Fs." unknown"
%end {Filestore Number}


{---------- CURRENT HOST ----------}
{ Returns a token which identifies the current host. } 
{  LSAP . RDTE . RSAP . USERNO                       }

 %integer %function Current Host
   userno = userno&255
   %result = ((lsap<<8+rdte)<<8+rsap)<<8+userno
%end


{---------- SELECT HOST ----------}
{ Switches to the filestore identified by 'token'.                      }
{ 'token' must have been returned by Current Host or Connect to Host.   }

 %routine Select Host(%integer token)
   userno = token & 255
   rsap = token>>8 & 255
   rdte = token>>16 & 255
   lsap = token>>24
   fsport = lsap
%end

{---------- CONNECT TO HOST ----------}
{ Given a generalised directory name, this function logs on to it  }
{ and returns a token which can be used in calls to Select Host,   }
{ and which must be used in a call to Disconnect Host before the   }
{ caller terminates.  It is the caller's responsibility to save    }
{ Current Host before calling this function and reselect it before }
{ terminating.                                                     }

{ <Generalised Directory> = <Filestore Name>::<Directory Name>,<Password> /
{                           ::<Filestore Name>:<Directory Name>,<Password>
{ <Filestore Name>        = Alpha / Bravo / Charlie / Portable / Vax
{ <Directory Name>        = Up to 6 alphanumerics
{ <Password>              = Any string

{ Filestore Name default to Bravo,  Directory Name defaults to PUB }
{ and Password defaults to "".                                     }

{ Events: 10 0 1 - Unknown filestore                               }
{ Events: 10 0 2 - No response from filestore                      }
{         10 0 3 - Illegal connect attempted                       }

 %integer %function Connect to Host(%string (255) GDir)

   %string (255) Name, Dir Pass, message
   %integer Number, i, free port
   %byte facil = 2
   %byte %array buff(0:63)
   %label dunparsin

   Name = ""
   Dir Pass = ""
   -> dunparsin %if GDir = ""
   %if GDir -> Name.("::").Dir Pass %start
      -> dunparsin %if Length(Dir Pass) = 0                 { e.g. B:: }
      -> dunparsin %if Dir Pass -> Name.(":").Dir Pass      { ::B:D }
      -> dunparsin                                          { B::D or ::B }
   %else
      Dir Pass = GDir
   %finish
   dunparsin:
   Name = "Bravo" %if Length(Name) = 0
   Number = Filestore Number(Name)

   %if Number # RDTE %or Dir Pass # "" %start
      Dir Pass = "PUB" %if Length(Dir Pass) = 0
      free port = allocate port
      etheropen(free port, Number << 8)
      etherwrite(free port, facil, 1)
      %if %not gotack(free port) %and gotdtx(free port) %then %c
         %signal 10, 0, 2, "No response from ".Name."::"
      i = etherread(free port, buff(0), 64)
      %if i # 2 %or buff(1) # 10 %or buff(0) < '0' %start
         %if buff(0)='-' %and i>2 %start
           buff(0) = i-2
           message = string(addr(buff(0)))
           message = "Error (".message
           message = message.")"
         %else
           message = "Error"
         %finish
         message = message." while connnecting to ::"
         message = message.Name
         %signal 10, 0, 3, message
      %finish
      buff(0) = buff(0) - '0'
      etheropen(free port, (Number << 8) ! buff(0))
      rdte = number
      rsap = buff(0)
      lsap = free port
      fsport = lsap
      userno = fcomm('L0', Dir Pass)
   %finish

   %result = Current Host 
   
%end

{---------- DISCONNECT HOST ----------}
{ Disconnect from the host identified by 'token' }

 %routine Disconnect Host(%integer Token)
   %byte eot = 12
   %integer curtok

   curtok = current host
   select host(token)
   etherwrite(lsap, eot, 1)
   %if gotack(lsap) %start
     etherclose(lsap)
     deallocate port(lsap)
   %finish
   selecthost(curtok)
%end