! H2 file system proccesses.  These processes interpret requests in standard
! internal message form, whether from an external-service manager or from a
! local process.  The processes make requests to a remote server using the
! 1976 H2 protocol.

%externalstring(47) copyright %alias "GDMR_(C)_F_H2" = %c
   "Copyright (C) 1987 George D.M. Ross"

! To do: implement redirection


%option "-nonstandard-low-nocheck-nodiag-noline"

%constinteger processes = 2
%constinteger priority = 6
%constinteger default initial allocation = 32
%constinteger file tokens = 32

%constinteger filestore specifier = 1

%include "Moose:Mouse.Inc"
%include "Sys:Ether.Inc"
%include "GDMR_H:FSysAcc.Inc"
%include "GDMR_H:FacMess.Inc"

%constinteger change file = modify file mode ! append to file mode

%conststring(1) SNL = "
"

%recordformat path fm(%record(path fm)%name next,
                      %integer version, %string(*)%name key,
                      %string(255) text)

%systemroutinespec phex(%integer i)
%systemroutinespec phex2(%integer i)
%systemstring(31)%fnspec itos(%integer i, j)
%systemintegerfnspec free store

%externalroutinespec FS insert(%string(31) name, %integer value)

%externalroutinespec dump(%integer n, %bytename b)

%ownrecord(semaphore fm) request semaphore = 0
%ownrecord(mailbox fm) request mailbox = 0


! Diagnostic

!! %routine show path(%record(path fm)%name p)
!!    %while p ## nil %cycle
!!       print symbol('@');  phex(addr(p))
!!       printstring(" -> ");  phex(addr(p_next))
!!       printstring(" v ");  write(p_version, 0)
!!       printstring(" c ");  printstring(p_key)
!!       newline
!!       p == p_next
!!    %repeat
!! %end

!! %routine xprintstring(%string(255) s)
!!    %integer i, ch
!!       %return %if s = ""
!!       %for i = 1, 1, length(s) %cycle
!!          ch = charno(s, i)
!!          %if ' ' <= ch <= '~' %start
!!             print symbol(ch)
!!          %else
!!             print symbol('<')
!!             write(ch, 0)
!!             print symbol('>')
!!          %finish
!!       %repeat
!! %end


! Filestore connection tables

%constinteger first filestore = 'A'
%constinteger last filestore  = 'Z'
%recordformat filestore fm(%record(semaphore fm) semaphore,
                           %integer port, Uno)
%ownrecord(filestore fm)%array filestore(first filestore : last filestore) = 0(*)

%constintegerarray filestore addresses(first filestore : last filestore) =
      16_14 { A },  16_15 { B },  16_1B { C },  16_00 { D },
      16_00 { E },  16_00 { F },  16_34 { G },  16_00 { H },
      16_00 { I },  16_00 { J },  16_00 { K },  16_00 { L },
      16_44 { M },  16_00 { N },  16_00 { O },  16_00 { P },
      16_00 { Q },  16_00 { R },  16_48 { S },  16_00 { T },
      16_00 { U },  16_72 { V },  16_00 { W },  16_00 { X },
      16_00 { Y },  16_00 { Z }


! Filestore communications

! reserved                   '@'       { Can't be used for some reason!
%constinteger FC openmod   = 'A'       { Uno: filename                : Xno
%constinteger FC rename    = 'B'       { Uno: filename, filename      :
%constinteger FC dchange   = 'C'       { Uno: filename, date          :
%constinteger FC delete    = 'D'       { Uno: filename                :
%constinteger FC permit    = 'E'       { Uno: filename, permissions   :
%constinteger FC finfo     = 'F'       { Uno: ownername, file-number  : packet
%constinteger FC general   = 'G'       { Uno:                         : packet
%constinteger FC uclose    = 'H'       { Xno:                         :
%constinteger FC readback  = 'I'       { Xno:                         : packet
%constinteger FC setdir    = 'J'       { Uno: ownername               :
%constinteger FC close     = 'K'       { Xno:                         :
%constinteger FC logon     = 'L'       { 0  : ownername, password     : Uno
%constinteger FC logoff    = 'M'       { Uno:                         :
%constinteger FC ninfo     = 'N'       { Uno: filename                : packet
%constinteger FC copyfile  = 'O'       { Uno: filename, filename      :
%constinteger FC pass      = 'P'       { Uno: password, username      :
%constinteger FC quote     = 'Q'       { Uno: password                :
%constinteger FC readda    = 'R'       { Xno: block-number, blocks    : packet
%constinteger FC openr     = 'S'       { Uno: filename                : Xno
%constinteger FC openw     = 'T'       { Uno: filename                : Xno
%constinteger FC reset     = 'U'       { Xno: block-number            :
%constinteger FC credir    = 'V'       { Uno: new-diectory-name       :
%constinteger FC writeda   = 'W'       { Xno: block-number, ...packet :
%constinteger FC readsq    = 'X'       { Xno: blocks                  : packet
%constinteger FC writesq   = 'Y'       { Xno: ...packet               :
%constinteger FC readfile  = 'Z'       { Uno: filename                : ...file
%constinteger FC new owner = '['       { Uno: <p>ownername, quota     :
%constinteger FC owners    = '\'       { Uno: partition number        : packet
%constinteger FC fcomm     = ']'       { Uno: system command          : packet
%constinteger FC new quota = '^'       { Uno: ownername, delta        :
! unused                     '_'       {

%constinteger first FC = '@';  ! This one is reserved.
%constinteger last  FC = '_'

%integerfn H to I(%string(127) h)
   %integer i, j, k
      %result = 0 %if h = ""
      %result = -1 %if charno(h, 1) = '-'
      i = 0
      %for j = 1, 1, length(h) %cycle
         k = charno(h, j) - '0'
         %exit %if k < 0
         i = 16 * i + k
      %repeat
      %result = i
%end

%string(7)%fn I to H(%integer i)
   %string(31) h
   %integer j
      h = ""
      h = h . to string((i >> j) & 15 + '0') %for j = 12, -4, 0
      %result = h
%end

%integerfn establish connection(%integer target)
   %record(filestore fm)%name f
   %string(127) response = "Dummy"
   %integer remote port, n
   %byte two = 2
      %on 3, 15 %start
         printstring("F_H2 (establish): ");  printstring(event_message)
         newline
         %result = -1
      %finish
      f == filestore(target)
      f_port = ether allocate port
      f_port = 0 %and %result = -1 %if f_port < 0;  !?
      ether open port(f_port, filestore addresses(target), 0)
      ether transmit block(f_port, 1, two)
      ether receive block(f_port, 127, n, charno(response, 1))
      length(response) = n
      remote port = H to I(response)
      %if remote port < 0 %start
         ether free port(f_port)
         f_port = 0
         !! printstring("Filestore ");  print symbol(target)
         !! printstring(": ");  printstring(response)
         %result = -1
      %finish
      ether close port(f_port)
      ether open port(f_port, filestore addresses(target), remote port)
      !! printstring("Local port ");  write(f_port, 0)
      !! printstring(" connected to filestore ");  print symbol(target)
      !! printstring(" (");  phex2(filestore addresses(target))
      !! printstring(") port ");  write(remote port, 0);  newline
      %result = 0
%end

%routine break connection(%integer target)
   %record(filestore fm)%name f
   %byte twelve = 12
      %on 15 %start
         printstring("F_H2 (break): ");  printstring(event_message)
         newline
         %return
      %finish
      !! printstring("Break connection to filestore ")
      !! print symbol(target);  newline
      f == filestore(target)
      semaphore wait(f_semaphore)
      signal semaphore(f_semaphore) %and %return %if f_port = 0
      ether transmit block(f_port, 1, twelve)
      ether close port(f_port)
      ether free port(f_port)
      f_port = 0
      signal semaphore(f_semaphore)
%end

%string(255)%fn send command(%integer target, UXno, command,
                             %string(255) parameters)
   %record(filestore fm)%name f
   %string(255) sending, response
   %integer status = 0, n
      %on 15 %start
         %result = "-- Ether error (send command): " . event_message
      %finish
      !! printstring("Send command to ");  print symbol(target);  newline
      %result = "-- Bad target filestore " . to string(target) %c
         %unless first filestore <= target <= last filestore
      %result = "-- Bad target filestore " . to string(target) %c
         %if filestore addresses(target) = 0
      f == filestore(target)
      semaphore wait(f_semaphore)
      %if f_port = 0 %start
         status = establish connection(target)
         %if status < 0 %start
            signal semaphore(f_semaphore)
            %result = "-- Connect to filestore " . %c
                      to string(target) . " rejected"
         %finish
      %finish
      %if command = FC logon %and f_Uno # 0 %start   
         signal semaphore(f_semaphore)
         %result = "-- Already logged on to " . to string(target)
      %else %if command = FC logoff %and f_Uno = 0
         ! Not logged on, so do nothing
         signal semaphore(f_semaphore)
         %result = ""
      %finish
      UXno = f_Uno %if UXno < 0
      response = "-- Dummy"
      sending = to string(command) . to string(UXno + '0') . parameters . SNL
      !! printstring(">>> ");  xprintstring(sending);  newline
      ether transmit block(f_port, length(sending), charno(sending, 1))
      ether receive block(f_port, 255, n, charno(response, 1))
      %if n > 0 %and charno(response, n) = NL %start
         ! Non-packet response -- drop the trailing NewLine
         length(response) = n - 1
      %else
         ! No trailing NewLine.  Must be a packet response, so we'll let
         ! our caller worry about decoding it all....
         length(response) = n
      %finish
      !! printstring("<<< ");  xprintstring(response);  newline
      %if response # "" %and charno(response, 1) = '-' %start
         signal semaphore(f_semaphore)
         %result = response
      %finish
      %if command = FC logon %start
         n = H to I(response)
         f_Uno = n
      %else %if command = FC logoff
         f_uno = 0
      %finish
      signal semaphore(f_semaphore)
      %result = response
%end

%routine copy block(%bytename from, to)
   D0 = 511
L: *move.b (A0)+, (A1)+
   *dbra D0, L
%end

%string(255)%fn make read request(%integer target, Xno, block,
                                  %record(*)%name buffer,
                                  %integername bytes)
   %bytearray b(0 : 532)
   %record(filestore fm)%name f
   %string(255) sending
   %string(*)%name response
   %integer status = 0, n, newline pos, i
      %on 15 %start
         %result = "-- Ether error (make read request): " . event_message
      %finish
      %result = "-- Bad target filestore " . to string(target) %c
         %unless first filestore <= target <= last filestore
      %result = "-- Bad target filestore " . to string(target) %c
         %if filestore addresses(target) = 0
      f == filestore(target)
      semaphore wait(f_semaphore)
      %if f_port = 0 %start
         status = establish connection(target)
         %if status < 0 %start
            signal semaphore(f_semaphore)
            %result = "-- Connect to filestore " . %c
                      to string(target) . " rejected"
         %finish
      %finish
      sending = to string(FC readDA) . to string(Xno + '0') . %c
                I to H(block) . SNL
      !! printstring("R > ");  printstring(sending);  ! No newline needed
      ether transmit block(f_port, length(sending), charno(sending, 1))
      ether receive block(f_port, 532, n, b(1))
      newline pos = 531
      %for i = 1, 1, n %cycle
         newline pos = i %and %exit %if b(i) = NL
      %repeat
      b(0) = newline pos - 1;  ! Drop the NewLine
      response == string(addr(b(0)))
      !! printstring("R < ");  printstring(response);  newline
      signal semaphore(f_semaphore)
      %result = response %if response # "" %and charno(response, 1) = '-'
      copy block(b(newline pos + 1), byteinteger(addr(buffer)))
      bytes = n - newline pos
      %result = response
%end

%string(255)%fn make write request(%integer target, Xno, block, bytes,
                                   %record(*)%name buffer)
   %bytearray b(0 : 532)
   %record(filestore fm)%name f
   %string(255) sending, response = "Dummy"
   %integer status, n
      %on 15 %start
         %result = "-- Ether error (make write request): " . event_message
      %finish
      %result = "-- Bad target filestore " . to string(target) %c
         %unless first filestore <= target <= last filestore
      %result = "-- Bad target filestore " . to string(target) %c
         %if filestore addresses(target) = 0
      f == filestore(target)
      semaphore wait(f_semaphore)
      %if f_port = 0 %start
         status = establish connection(target)
         %if status < 0 %start
            signal semaphore(f_semaphore)
            %result = "-- Connect to filestore " . %c
                      to string(target) . " rejected"
         %finish
      %finish
      sending = to string(FC writeDA) . to string(Xno + '0') . %c
                I to H(block) . "," . I to H(bytes) . SNL
      string(addr(b(0))) = sending
      copy block(byteinteger(addr(buffer)), b(length(sending) + 1))
      !! printstring("W > ");  printstring(sending)
      ether transmit block(f_port, length(sending) + bytes, b(1))
      ether receive block(f_port, 255, n, byteinteger(addr(response)))
      length(response) = n - 1
      !! printstring("W < ");  printstring(response);  newline
      signal semaphore(f_semaphore)
      %result = response
%end


! File tokens (issued by us, incorporating lower-level ones)

%recordformat file token fm(%record(mailbox fm)%name followup mailbox,
                            %integer filestore, Xno)
%ownrecord(file token fm)%array our file tokens(1 : file tokens) = 0(*)
%ownrecord(semaphore fm) file token semaphore = 0

%record(file token fm)%map get new file token
   %record(file token fm)%name t
   %integer i
      semaphore wait(file token semaphore)
      %for i = 1, 1, file tokens %cycle
         t == our file tokens(i)
         %if t_followup mailbox == nil %start
            ! Found a free one
            t_followup mailbox == request mailbox
            signal semaphore(file token semaphore)
            %result == t
         %finish
      %repeat
      signal semaphore(file token semaphore)
      %result == nil
%end

%routine validate file token(%record(fs message fm)%name m)
   %record(file token fm)%name t
   %integer i
      %for i = 1, 1, file tokens %cycle
         %if m_file token = addr(our file tokens(i)) %start
            t == record(m_file token)
            %exit %if t_followup mailbox == nil;  ! Invalid
            m_error code = 0
            %return
         %finish
      %repeat
      m_error code = -302;  m_status = -3
      m_error text = "Invalid file token"
%end


! Error code interpretation

%routine set status(%record(fs message fm)%name m)
   %if m_error code = 0 %start
      m_status = 0
   %else
      m_status = -2;  ! Meantime
      m_error text = "Unknown error " . itos(m_error code, 0)
   %finish
%end


! Filename munging.  Maybe fill in the target filestore from the first
! component of the filename

%routine determine filename(%record(fs message fm)%name m,
                            %string(255)%name filename)
   %record(path fm)%name p, last p
      p == m_filename
      %if length(p_key) = 2 %and charno(p_key, 1) = filestore specifier %start
         m_partition = charno(p_key, 2)
         p == p_next
      %finish
      filename = ""
      last p == p
      %while p ## nil %cycle
         filename = filename . ":" %if filename # ""
         filename = filename . p_key
         last p == p
         p == p_next
      %repeat
      filename = filename . ":" . itos(last p_version, 0) %c
         %if last p ## nil %and last p_version # 0
      %if m_partition <= 0 %start
         m_partition = 'B'
      %else %if 'a' <= m_partition <= 'z'
         m_partition = m_partition - 'a' + 'A'
      %finish
      !! printstring("Filename is ");  printstring(filename)
      !! printstring(" at ");  print symbol(m_partition);  newline
%end

%routine determine second filename(%record(fs message fm)%name m,
                                   %string(255)%name filename,
                                   %integername target filestore)
   %record(path fm)%name p, last p
      p == m_filename2
      target filestore = m_partition;  ! i.e. from first filename
      %if length(p_key) = 2 %and charno(p_key, 1) = filestore specifier %start
         target filestore = charno(p_key, 2)
         p == p_next
      %finish
      filename = ""
      last p == p
      %while p ## nil %cycle
         filename = filename . ":" %if filename # ""
         filename = filename . p_key
         last p == p
         p == p_next
      %repeat
      filename = filename . ":" . itos(last p_version, 0) %c
         %if last p ## nil %and last p_version # 0
      target filestore = target filestore - 'a' + 'A' %c
         %if 'a' <= target filestore <= 'z'
      !! printstring("Filename is ");  printstring(filename)
      !! printstring(" at ");  print symbol(m_partition);  newline
%end

%routine split at newline(%string(*)%name s, d1, d2)
   %bytename ch
   %integer i
      d1 = "";  d2 = ""
      %return %if s = ""
      ch == charno(s, 1);  i = length(s)
      %while i > 0 %and ch # NL %cycle
         d1 = d1 . to string(ch)
         ch == ch [1];  i = i - 1
      %repeat
      ch == ch [1];  i = i - 1
      %while i > 0 %cycle
         d2 = d2 . to string(ch)
         ch == ch [1];  i = i -1
      %repeat
%end


! One action routine for each of the request (sub)types.

%routine do open file(%record(fs message fm)%name m)
   %record(file token fm)%name file token
   %string(255) filename, response, size, pad
   %integer command
      !! printstring("Do open file: mode ");  phex2(m_access mode)
      !! printstring(", compatible ");  phex2(m_compatible mode)
      !! printstring(", flags ");  phex(m_request flags);  newline
      !! show path(m_filename)
      m_response flags = 0;  m_bytes = 0;  m_file token = 0;  ! Provisionally
      %if m_access mode & change file = 0 %start
         ! Open for reading only
         command = FC openR
      %else
         ! Open for writing.  Should we create a new one (unconditionally)?
         %if m_request flags & create flag = 0 %then command = FC openMod %c
                                               %else command = FC openW
      %finish
      ! Translate the name from list form
      determine filename(m, filename)
      ! Get a file token for the file
      file token == get new file token
      !! printstring("New file token is at ")
      !! phex(addr(file token));  newline
      %if file token == nil %start
         m_error code = -303;  m_status = -3
         m_error text = "(F_H2) No free file token"
         %return
      %finish
      ! Open file file
      response = send command(m_partition, -1, command, filename)
      %if response # "" %and charno(response, 1) = '-' %start
         ! Open failed.  Drop the token & return error
         file token_followup mailbox == nil
         m_error code = H to I(response);  m_status = -1
         m_error text = response
         %return
      %finish
      file token_Xno = charno(response, 1) - '0'
      file token_filestore = m_partition
      %if command = FC openW %start
         m_bytes = 0
      %else
         %if length(response) < 5 %start
            ! Dud response
            file token_followup mailbox == nil
            m_error code = -304;  m_status = -1
            m_error text = "Dud (short) response from filestore"
            %return
         %finish
         response = sub string(response, 3, length(response))
         %unless response -> size . (",") . pad %start
            ! Dud response
            file token_followup mailbox == nil
            m_error code = -304;  m_status = -1
            m_error text = "Dud (missing fields) response from filestore"
            %return
         %finish
         m_bytes = 512 * H to I(size) - H to I(pad)
      %finish
      m_file token = addr(file token)
      m_response flags = 0
      m_error code = 0;   m_status = 0
%end

%routine do read data(%record(fs message fm)%name m)
   %record(file token fm)%name t
      validate file token(m);  %return %if m_error code < 0
      t == record(m_file token)
      m_error text = make read request(t_filestore, t_Xno,
                                       m_block, m_buffer, m_bytes)
      %if m_error text # "" %and charno(m_error text, 1) = '-' %start
         m_error code = -1;  m_status = -1
      %else
         m_error code = 0;  m_status = 0
      %finish
%end

%routine do write data(%record(fs message fm)%name m)
   %record(file token fm)%name t
      validate file token(m);  %return %if m_error code < 0
      t == record(m_file token)
      m_error text = make write request(t_filestore, t_Xno,
                                        m_block, m_bytes, m_buffer)
      %if m_error text # "" %and charno(m_error text, 1) = '-' %start
         m_error code = -1;  m_status = -1
      %else
         m_error code = 0;  m_status = 0
      %finish
%end

%routine do close file(%record(fs message fm)%name m)
   %record(file token fm)%name t
      validate file token(m);  %return %if m_error code < 0
      t == record(m_file token)
      m_error text = send command(t_filestore, t_Xno, FC close, "")
      %if m_error text # "" %and charno(m_error text, 1) = '-' %start
         m_error code = -1;  m_status = -1
      %else
         m_error code = 0;  m_status = 0
      %finish
      t = 0
%end

%routine do truncate file(%record(fs message fm)%name m)
   m_error code = -1;  m_status = -3
   m_error text = "Subrequest (truncate file) not implemented yet"
%end

%routine do make accessible(%record(fs message fm)%name m)
   m_error code = -1;  m_status = -3
   m_error text = "Subrequest (make accessible) not implemented yet"
%end

%routine do obtain attributes(%record(fs message fm)%name m, %integer type)
   m_error code = -1;  m_status = -3
   m_error text = "Subrequest (obtain attributes) not implemented yet"
%end

%routine do short form attributes(%record(fs message fm)%name m)
   %string(255) filename
      determine filename(m, filename)
      !! printstring("Short form attributes: ");  printstring(filename);  newline
      m_error text = send command(m_partition, -1, FC ninfo, filename)
      !! printstring("response: ");  xprintstring(m_error text);  newline
      %if m_error text = "" %or charno(m_error text, 1) = '-' %start
         m_error code = -1;  m_status = -1
         %return
      %finish
      split at newline(m_error text, filename, m_textual info)
      !! printstring("Split text -> ");  printstring(m_textual info);  newline
      m_status = 0;  m_error code = 0
%end

%routine do modify attributes(%record(fs message fm)%name m, %integer type)
   m_error code = -1;  m_status = -3
   m_error text = "Subrequest (modify attributes) not implemented yet"
%end

%routine do list directory contents(%record(fs message fm)%name m)
   m_error code = -1;  m_status = -3
   m_error text = "Subrequest (list directory contents) not implemented yet"
%end

%routine do insert directory entry(%record(fs message fm)%name m)
   m_error code = -1;  m_status = -3
   m_error text = "Subrequest (insert directory entry) not implemented yet"
%end

%routine do remove directory entry(%record(fs message fm)%name m)
   %string(255) filename
      determine filename(m, filename)
      m_error text = send command(m_partition, -1, FC delete, filename)
      %if m_error text # "" %start
         m_error code = -1;  m_status = -1
      %else
         m_error code = 0;  m_status = 0
      %finish
%end

%routine do create new directory(%record(fs message fm)%name m)
   %string(255) filename
      determine filename(m, filename)
      m_error text = send command(m_partition, -1, FC credir, filename)
      %if m_error text # "" %start
         m_error code = -1;  m_status = -1
      %else
         m_error code = 0;  m_status = 0
      %finish
%end

%routine do rename file(%record(fs message fm)%name m)
   ! We have to make sure here that we aren't being asked to rename
   ! from one filestore to another....
   %string(255) from, to
   %integer second filestore
      determine filename(m, from)
      determine second filename(m, to, second filestore)
      %if m_partition # second filestore %start
         m_error code = -1;  m_status = -1
         m_error text = "-- Inter-filestore rename not allowed"
         %return
      %finish
      m_error text = send command(m_partition, -1, FC rename,
                                 from . "," . to)
      %if m_error text # "" %start
         m_error code = -1;  m_status = -1
      %else
         m_error code = 0;  m_status = 0
      %finish
%end

%routine do copy file(%record(fs message fm)%name m)
   ! We have to make sure here that we aren't being asked to copy
   ! from one filestore to another (that should be done by our caller)....
   %string(255) from, to
   %integer second filestore
      determine filename(m, from)
      determine second filename(m, to, second filestore)
      %if m_partition # second filestore %start
         m_error code = -1;  m_status = -1
         m_error text = "-- Inter-filestore copy not allowed"
         %return
      %finish
      m_error text = send command(m_partition, -1, FC copyfile,
                                 from . "," . to)
      %if m_error text # "" %start
         m_error code = -1;  m_status = -1
      %else
         m_error code = 0;  m_status = 0
      %finish
%end

%routine do exchange files(%record(fs message fm)%name m)
   m_error code = -1;  m_status = -3
   m_error text = "Subrequest (exchange files) not implemented yet"
%end

%routine do delete file(%record(fs message fm)%name m)
   do remove directory entry(m)
%end

%routine do generate unique name(%record(fs message fm)%name m)
   m_error code = -1;  m_status = -3
   m_error text = "Subrequest (unique name) not implemented yet"
%end

%routine do timestamp enquiry(%record(fs message fm)%name m)
   m_error code = -1;  m_status = -3
   m_error text = "Subrequest (timestamp enquiry) not implemented yet"
%end

%routine do filestore logon(%record(fs message fm)%name m)
   %record(path fm)%name p
      p == m_filename
      m_error text = send command(m_partition, -1, FC logon,
                                  p_key . "," . m_translation string)
      %if m_error text # "" %and charno(m_error text, 1) = '-' %start
         m_error code = -1;  m_status = -1
      %else
         m_error code = 0;  m_status = 0
      %finish
%end

%routine do filestore logoff(%record(fs message fm)%name m)
   m_error text = send command(m_partition, -1, FC logoff, "")
   break connection(m_partition)
   %if m_error text # "" %and charno(m_error text, 1) = '-' %start
      m_error code = -1;  m_status = -1
   %else
      m_error code = 0;  m_status = 0
   %finish
%end


! Request code demultiplexing routines, one for each of the major request
! codes.  These just switch on the subcodes....

%routine data access(%record(fs message fm)%name m)
   %if m_subcode = open file subcode %start
      do open file(m)
   %else %if m_subcode = read data subcode
      do read data(m)
   %else %if m_subcode = write data subcode
      do write data(m)
   %else %if m_subcode = close file subcode
      do close file(m)
   %else %if m_subcode = truncate file subcode
      do truncate file(m)
   %else %if m_subcode = make accessible subcode
      do make accessible(m)
   %else
      m_error code = -1;  m_status = -1
      m_error text = "Subrequest not recognised"
   %finish
%end

%routine file attributes access(%record(fs message fm)%name m)
   %if m_subcode = obtain attributes subcode %start
      do obtain attributes(m, 0)
   %else %if m_subcode = obtain attributes token subcode
      do obtain attributes(m, 1)
   %else %if m_subcode = short form attributes subcode
      do short form attributes(m)
   %else %if m_subcode = modify attributes subcode
      do modify attributes(m, 0)
   %else %if m_subcode = modify attributes token subcode
      do modify attributes(m, 1)
   %else
      m_error code = -1;  m_status = -1
      m_error text = "Subrequest not recognised"
   %finish
%end

%routine directory access(%record(fs message fm)%name m)
   %if m_subcode = list directory contents subcode %start
      do list directory contents(m)
   %else %if m_subcode = insert directory entry subcode
      do insert directory entry(m)
   %else %if m_subcode = remove directory entry subcode
      do remove directory entry(m)
   %else %if m_subcode = create new directory subcode
      do create new directory(m)
   %else
      m_error code = -1;  m_status = -1
      m_error text = "Subrequest not recognised"
   %finish
%end

%routine miscellaneous file operation(%record(fs message fm)%name m)
   %if m_subcode = rename file subcode %start
      do rename file(m)
   %else %if m_subcode = copy file subcode
      do copy file(m)
   %else %if m_subcode = exchange files subcode
      do exchange files(m)
   %else %if m_subcode = delete file subcode
      do delete file(m)
   %else %if m_subcode = translate redirections subcode
      ! Null operation, since we don't know about redirections.
      ! Just return success, and nothing translated.
      m_status = 0;  m_error code = 0
      m_components translated = 0
   %else
      m_error code = -1;  m_status = -1
      m_error text = "Subrequest not recognised"
   %finish
%end

%routine miscellaneous other operation(%record(fs message fm)%name m)
   %if m_subcode = generate unique name subcode %start
      do generate unique name(m)
   %else %if m_subcode = timestamp enquiry subcode
      do timestamp enquiry(m)
   %else
      m_error code = -1;  m_status = -1
      m_error text = "Subrequest not recognised"
   %finish
%end

%routine nonstandard operation(%record(fs message fm)%name m)
   %if m_subcode = 0 %start
      do filestore logon(m)
   %else %if m_subcode = 1
      do filestore logoff(m)
   %else
      m_error code = -1;  m_status = -1
      m_error text = "Subrequest (nonstandard) not recognised"
   %finish
%end


! Main code of local file system process.  Loop, reading the mailbox and
! calling a code-demultiplexing routine to interpret the subcodes as
! appropriate.

%routine local filesystem process
   %record(fs message fm)%name m
      open input(0, ":T");  select input(0)
      open output(0, ":T");  select output(0)
      %cycle
         !! printstring("Waiting for message to ");  phex(addr(request mailbox))
         !! newline
         m == receive message(request mailbox)
         !! printstring("Code is ");  write(m_code, 0);  newline
         %if m_code = data access code %start
            data access(m)
         %else %if m_code = file attributes access code
            file attributes access(m)
         %else %if m_code = directory access code
            directory access(m)
         %else %if m_code = miscellaneous file operation code
            miscellaneous file operation(m)
         %else %if m_code = miscellaneous other operation code
            miscellaneous other operation(m)
         %else %if m_code = 128
            nonstandard operation(m)
         %else
            m_error code= -1;  m_status = -1
            m_error text = "Unknown request code"
         %finish
         !! printstring("Replying, status ");  write(m_status, 0)
         !! printstring(", error code ");  write(m_error code, 0)
         !! printstring(", text """);  printstring(m_error text)
         !! print symbol('"');  newline
         send message(m, m_system part_reply, nil)
      %repeat
%end

%begin
   %record(process fm)%name p
   %integer i
   %label x
      open input(0, ":T");  select input(0)
      open output(0, ":T");  select output(0)
      setup semaphore(request semaphore)
      setup mailbox(request mailbox, request semaphore)
      setup semaphore(file token semaphore)
      signal semaphore(file token semaphore)
      %for i = first filestore, 1, last filestore %cycle
         setup semaphore(filestore(i)_semaphore)
         signal semaphore(filestore(i)_semaphore)
      %repeat
      FS insert(H2 file system mailbox, addr(request mailbox))
      !! printstring("Starting ");  write(processes, 0)
      !! printstring(" remote (H2) file system processes");  newline
      p == create process(10240, addr(x), priority, nil) %for i = 1, 1, processes - 1
      set priority(nil, priority)
      {} printstring("F_H2: ");  write(free store, 0)
      {} printstring(" free");  newline
      ! Fall through to form one of the processes....
x:    local filesystem process
      ! Never returns...
%end %of %program
