! Local 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 are responsible for performing directory and
! file system operations as necessary.  

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

! To do: implement append-mode

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

%constinteger processes = 4
%constinteger priority = 6
%constinteger process size = 20480

%constinteger default initial allocation = 32
%constinteger file tokens = 48

%constinteger directory buffer size = 4096
%constinteger directory buffers = 6

%constinteger directory token    = 16_40000000
! reserved: non-file-structured  = 16_80000000

%include "Moose:Mouse.Inc"
%include "GDMR_H:FSysAcc.Inc"
%include "GDMR_H:FSys.Inc"
%include "GDMR_H:Dir.Inc"
%include "GDMR_H:Tree.Inc";  ! **Meantime**
%include "GDMR_H:FacMess.Inc"

%constinteger NUL = 0

%constinteger infinity = 16_7FFFFFFF

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

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

%externalroutinespec fsys initialise
%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 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

!! %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 ");  xprintstring(p_key)
!!       newline
!!       p == p_next
!!    %repeat
!! %end


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

%recordformat file token fm(%record(mailbox fm)%name followup mailbox,
                            %integer fsys issued token, file ID)

%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
      !! printstring("Validate file token: message at ");  phex(addr(m))
      !! printstring(", quoted token is ");  phex(m_file token);  newline
      %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
            !! printstring("Validated (slot ");  write(i, 0)
            !! print symbol(')');  newline
            %return
         %finish
      %repeat
      !! printstring("Invalid token");  newline
      m_error code = -302;  m_status = -3
      m_error text = "Invalid file token"
%end


! Key list stuff

!! %routine print key list(%record(key list fm)%name list)
!!    %while list ## nil %cycle
!!       spaces(15 - length(list_key));  printstring(list_key)
!!       spaces(2);  phex(list_value);  newline
!!       list == list_next
!!    %repeat
!! %end

%routine dispose keylist(%record(key list fm)%name what)
   %record(key list fm)%name n
      %while what ## nil %cycle
         !! printstring("Disposing (key) ");  phex(addr(what));  newline
         n == what_next
         dispose(what)
         what == n
      %repeat
%end

%routine copy key list(%record(key list fm)%name key list,
                       %bytename to, %integer limit,
                       %integername copied)
   %integer i
      copied = 0
      %while key list ## nil %cycle
         !! printstring("Copy key list: """);  printstring(key list_key)
         !! print symbol('"');  newline
         %for i = 1, 1, length(key list_key) %cycle
            limit = limit - 1
            %return %if limit <= 0
            to = charno(key list_key, i)
            to == to [1]
            copied = copied + 1
         %repeat
         %if key list_value & directory flag # 0 %start
            limit = limit - 1
            %return %if limit <= 0
            to = NUL
            to == to [1]
            copied = copied + 1 
         %else %if key list_value & non ID flag # 0
            limit = limit - 1
            %return %if limit <= 0
            to = 1
            to == to [1]
            copied = copied + 1 
         %finish
         limit = limit - 1
         %return %if limit <= 0
         to = NL
         to == to [1]
         copied = copied + 1 
         key list == key list_next
      %repeat
      !! write(copied, 0);  printstring(" bytes copied");  newline
%end


! Directory buffers

%recordformat directory buffer fm(%integer size, stamp, refcount, ID,
                                  %bytearray x(1 : directory buffer size))
%ownrecord(directory buffer fm)%array directory buffer(0 : directory buffers) = 0(*)
%ownrecord(semaphore fm) directory buffer semaphore = 0

%integerfn find directory buffer(%integer ID)
   %owninteger directory stamp = 0
   %record(directory buffer fm)%name db
   %integer i, oldest stamp = infinity, oldest = -1
      !! printstring("Find directory buffer: ");  phex(ID);  newline
      semaphore wait(directory buffer semaphore)
      %for i = 0, 1, directory buffers %cycle
         db == directory buffer(i)
         %if db_ID = ID %start
            !! printstring("Already (still) in cache at ")
            !! write(i, 0);  newline
            directory stamp = directory stamp + 1
            db_stamp = directory stamp
            db_refcount = db_refcount + 1
            signal semaphore(directory buffer semaphore)
            %result = i
         %else %if db_refcount = 0 %and db_stamp < oldest stamp
            oldest = i;  oldest stamp = db_stamp
         %finish
      %repeat
      ! Not already there, so return a new buffer
      !! printstring("Not there, using ");  write(oldest, 0);  newline
      %if oldest < 0 %start
         signal semaphore(directory buffer semaphore)
         %result = -1
      %finish
      directory stamp = directory stamp + 1
      db == directory buffer(oldest)
      db_ID = -1;  db_refcount = 1
      db_stamp = directory stamp
      signal semaphore(directory buffer semaphore)
      %result = oldest
%end

%routine release directory buffer(%integer which)
   %record(directory buffer fm)%name db
      which = which & (\ directory token)
      !! printstring("Release directory buffer ")
      !! write(which, 0);  newline
      %if which > directory buffers %start
         printstring("F_Local: release dud directory buffer ")
         write(which, 0);  newline
         %return
      %finish
      semaphore wait(directory buffer semaphore)
      db == directory buffer(which)
      db_refcount = db_refcount - 1
      %if db_refcount < 0 %start
         printstring("F_Local: Reference count going negative for directory cache entry ")
         phex(db_ID);  newline
      %finish
      signal semaphore(directory buffer semaphore)
      !! printstring("Refcount -> ");  write(db_refcount, 0);  newline
%end

%routine invalidate directory buffers(%integer ID)
   %record(directory buffer fm)%name db
   %integer i
      !! printstring("Invalidate for directory ");  phex(ID);  newline
      semaphore wait(directory buffer semaphore)
      %for i = 0, 1, directory buffers %cycle
         db == directory buffer(i)
         db_ID = -1 %if db_ID = ID
      %repeat
      signal semaphore(directory buffer semaphore)
%end

%record(directory buffer fm)%map map directory buffer(%integer token)
   token = token & (\ directory token)
   %result == nil %unless token <= directory buffers
   %result == directory buffer(token)
%end

%integerfn get directory contents(%record(fsys access fm)%name access,
                                  %integer ID, %integername buffer token)
   %record(directory buffer fm)%name db
   %integer status, buffer
   %record(key list fm)%name key list
      !! printstring("Get directory contents: ID ")
      !! phex(ID);  newline
      buffer = find directory buffer(ID)
      %result = -200 %if buffer < 0
      db == directory buffer(buffer)
      %if db_ID # ID %start
         ! Not in the cache, so we'll have to obtain it
         key list == directory contents(access, ID, status)
         release directory buffer(buffer) %and %result = status %if status # 0
         copy key list(key list, db_x(1), directory buffer size, db_size)
         dispose key list(key list)
         db_ID = ID
      %finish
      buffer token = buffer ! directory token
      %result = 0
%end


! Error code interpretation.  Many of these should never be seen by users:
! if they do it indicates a filestore bug somewhere....

%conststring(31)%array fsys errors(100 : 121) =
      "FSys bugcheck",              { -100 }
      "End of file",                { -101 }
      "File header checksum error", { -102 }
      "Index file full",            { -103 }
      "File table full",            { -104 }
      "No such file",               { -105 }
      "No authority",               { -106 }
      "Bad token",                  { -107 }
      "Invalid size",               { -108 }
      "Bad operation",              { -109 }
      "File header full",           { -110 }
      "Not file structured",        { -111 }
      "Partition ID error",         { -112 }
      "Not implemented",            { -113 }
      "Incompatible mode",          { -114 }
      "Invalid block",              { -115 }
      "No privilege",               { -116 }
      "Partition full",             { -117 }
      "Bad refcount increment",     { -118 }
      "Non-zero refcount",          { -119 }
      "Dud file index",             { -120 }
      "Improperly closed file"      { -121 }
%conststring(31)%array partition errors(51 : 56) =
      "Partition ID error",         {  -51 }
      "Partition validity error",   {  -52 }
      "Partition block ID error",   {  -53 }
      "Partition protection trap",  {  -54 }
      "Partition readin error",     {  -55 }
      "Buffer alignment error"      {  -56 }
%conststring(31)%array directory errors(200 : 206) =
      "No directory buffers",       { -200, locally generated }
      "Dud path",                   { -201 }
      "Not a directory",            { -202 }
      "Dud component",              { -203 }
      "Non-empty directory",        { -204 }
      "Versions not allowed",       { -205 }
      "Version not found"           { -206 }
%conststring(31)%array tree tree errors(500 : 504) =
      "B-Tree checksum error",      { -500 }
      "File or directory not found",{ -501, really "Key not found" }
      "Duplicate file name",        { -502, really "Key..."        }
      "Null file name",             { -503, really "Key..."        }
      "Filename size error"         { -504, really "key..."        }
%conststring(31)%array tree data errors(550 : 554) =
      "Too many data blocks",       { -550 }
      "Data size error",            { -551 }
      "Data block corrupt",         { -552 }
      "Data site error",            { -553 }
      "Deleted data"                { -554 }

%routine set status(%record(fs message fm)%name m)
   %if m_error code >= 0 %start
      m_status = m_error code
   %else %if -121 <= m_error code <= -100
      m_status = -1;  ! Meantime
      m_error text = fsys errors(-m_error code)
   %else %if -56 <= m_error code <= -51
      m_status = -1;  ! Meantime
      m_error text = partition errors(-m_error code)
   %else %if -206 <= m_error code <= -200
      m_status = -1;  ! Meantime
      m_error text = directory errors(-m_error code)
   %else %if -504 <= m_error code <= -500
      m_status = -1;  ! Meantime
      m_error text = tree tree errors(-m_error code)
   %else %if -554 <= m_error code <= -550
      m_status = -1;  ! Meantime
      m_error text = tree data errors(-m_error code)
   %else
      m_status = -2;  ! Meantime
      m_error text = "Unknown error " . itos(m_error code, 0)
   %finish
%end


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

%routine do open file(%record(fs message fm)%name m)
   %integer ID, previous ID = 0, parent ID, partition, n
   %record(file token fm)%name file token
   %record(directory buffer fm)%name db
   %record(path fm)%name last
      !! 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
      m_error code = directory lookup(m_access_local, m_filename,
                                      m_components translated,
                                      previous ID, parent ID,
                                      m_error text)
      %if m_error code = 0 %start
         ! File (or previous version) exists
         %if m_access mode & change file # 0 %start
            ! Open for writing.  Should we create a new one (unconditionally)?
            %if previous ID & directory flag # 0 %start
               ! Directories can't be written to in any case...
               !! printstring("Attempt to modify directory ")
               !! phex(previous ID);  printstring(", access mode ")
               !! phex(m_access mode);  printstring(", flags ")
               !! phex(m_request flags);  newline
               !! printstring("Change file flags: ");  phex(change file)
               !! newline
               m_error code = -301;  m_status = -1
               m_error text = "Invalid (open modify) operation on a directory"
               %return
            %finish
            -> do file create %if m_request flags & create flag # 0
         %finish
         %if previous ID & directory flag # 0 %start
            !! printstring("Open directory ");  phex(previous ID)
            !! printstring(" for reading");  newline
            file token == get new file token
            %if file token == nil %start
               m_error code = -303;  m_status = -3
               m_error text = "(F_Local) No free file token"
               %return
            %finish
            m_error code = get directory contents(m_access_local, previous ID,
                                                  file token_fsys issued token)
            %if m_error code # 0 %start
               set status(m)
               file token_followup mailbox == nil
               %return
            %finish         
            db == map directory buffer(file token_fsys issued token)
            %if db == nil %start
               m_error code = -200
            %else
               m_bytes = db_size
               m_response flags = directory token
               m_file token = addr(file token)
            %finish
            set status(m)
            %return
         %finish

         ! Open an existing file (non-directory)
         ID = previous ID
do file open:
         file token == get new file token
         %if file token == nil %start
            m_error code = -303;  m_status = -3
            m_error text = "(F_Local) No free file token"
            %return
         %finish
         m_error code = fsys open file(m_access_local, ID,
                                       m_access mode, m_compatible mode,
                                       file token_fsys issued token, m_bytes,
                                       m_response flags)
         %if m_error code # 0 %start
            file token_followup mailbox == nil
            set status(m)
            %return
         %finish
         !! printstring("FSys issued token is ")
         !! write(file token_fsys issued token, 0);  newline
         file token_file ID = ID
         m_status = 0
         m_file token = addr(file token)
         %return
      %finish

      ! Lookup error / didn't exist / external translation
      %if m_error code > 0 %start
         ! External translation, dispose of it quickly
         ! (Nothing to do except set the status code.)
         m_status = m_error code
         %return
      %finish

      ! If we're only reading the file, or we haven't been asked to create
      ! it if it doesn't exist, then there's nothing more we can do.
      %if m_access mode & change file = 0 %c
            %or m_request flags & create if flag # 0 %start
         set status(m)
         %return
      %finish

      ! If we get here we must have been asked to create a file which either
      ! doesn't already exist, should be replaced by a new version, or had some
      ! problem with the path.  We'll deal with the last case first since we
      ! have to look down the path component list to find the final component
      ! anyway.  If the "components translated" count doesn't cover the whole
      ! path (less the final component), then we assume that it was a lookup
      ! error elsewhere.
      previous ID = parent ID;  ! Inherit from parent directory
do file create:
      n = m_components translated;  last == m_filename
      %while last_next ## nil %cycle
         n = n - 1
         set status(m) %and %return %if n < 0;  ! Must have failed somewhere
         last == last_next
      %repeat
      previous ID = 0 %if m_request flags & no inherit flag # 0
      !! printstring("About to do create: parent = ");  phex(parent ID)
      !! printstring(", previous = ");  phex(previous ID);  newline
      m_error code = fsys create file(m_access_local, last_key,
                                      (parent ID & partition mask) %c
                                          >> partition shift,
                                      previous ID,
                                      default initial allocation, ID)
      set status(m) %and %return %if m_error code # 0
      invalidate directory buffers(parent ID)
      m_error code = directory insert ID(m_access_local, parent ID,
                                         last_key, ID)
      %if m_error code # 0 %start
         ! Insert failed, so we'll have to delete the file again
         n = fsys delete file(nil, ID)
         set status(m)
         %return
      %finish
      ! All OK, so do the open
      -> do file open
%end

%routine copy block(%integer bytes, %bytename from, to)
   ! Unaligned, hence bytewise, copy
   *subq.l #1, D0
L: *move.b (A0)+, (A1)+
   *dbra D0, L
%end

%routine do read data(%record(fs message fm)%name m)
   %record(file token fm)%name t
   %record(directory buffer fm)%name db
   %integer start pos, size
      !! printstring("Do read data: block ");  write(m_block, 0)
      !! printstring(", bytes: ");  write(m_bytes, 0)
      !! printstring(", buffer: ");  phex(addr(m_buffer));  newline
      validate file token(m);  %return %if m_error code < 0
      t == record(m_file token)
      !! printstring("FSys issued token is ");  write(t_fsys issued token, 0)
      !! newline
      %if t_fsys issued token & directory token = 0 %start
         m_error code = fsys read file block(m_access_local, t_fsys issued token,
                                             m_block, m_bytes, m_buffer)
         !! printstring("FSys read status: ");  write(m_error code, 0);  newline
         set status(m)
      %else
         !! printstring("Read directory: block ");  write(m_block, 0)
         !! newline
         db == directory buffer(t_fsys issued token & (\ directory token))
         start pos = m_block * 512 + 1
         size = db_size - start pos + 1;  size = 512 %if size > 512
         %if 0 < start pos <= db_size %start
            copy block(size, db_x(start pos), byteinteger(addr(m_buffer)))
            m_bytes = size
            m_error code = 0;  m_status = 0
         %else
            m_error code = 0;  m_status = 0
            m_bytes = 0
         %finish
      %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)
      %if t_fsys issued token & directory token = 0 %start
         m_error code= fsys write file block(m_access_local, t_fsys issued token,
                                             m_block, m_bytes, m_buffer)
         set status(m)
      %else
         m_status = -1;  m_error code = -301
         m_error text = "Invalid (write) operation on a directory"
      %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)
      %if t_fsys issued token & directory token = 0 %start
         m_error code = fsys close file(m_access_local, t_fsys issued token,
                                        m_request flags)
         t_followup mailbox == nil
         set status(m)
      %else
         !! printstring("Close a ""directory"" file ")
         !! phex(t_fsys issued token);  newline
         release directory buffer(t_fsys issued token)
         t_followup mailbox == nil
         m_error code = 0;  m_status = 0
      %finish
%end

%routine do truncate 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)
      %if t_fsys issued token & directory token = 0 %start
         m_error code= fsys truncate open file(m_access_local,
                                               t_fsys issued token,
                                               m_bytes)
         set status(m)
      %else
         m_status = -1;  m_error code = -301
         m_error text = "Invalid (truncate) operation on a directory"
      %finish
%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 header(%record(fs message fm)%name m, %record(*)%name header)
   ! (Assumes that buffer is at least header-sized)
   %integer file ID, penultimate ID
      m_error code = directory lookup(m_access_local, m_filename,
                                      m_components translated,
                                      file ID, penultimate ID, m_error text)
      set status(m) %and %return %if m_error code # 0
      m_error code = fsys read file header(m_access_local, file ID, header)
      set status(m)
%end

%routine do short form attributes(%record(fs message fm)%name m)
   %integer ID translation, parent ID
      m_error code = directory lookup(m_access_local, m_filename,
                                      m_components translated,
                                      ID translation, parent ID,
                                      m_error text)
      %if m_error code # 0 %start
         !! printstring("Lookup failed for path: ")
         !! write(m_error code, 0);  newline
         !! show path(m_filename)
         set status(m)
         %return
      %finish
      m_error code = fsys short form info(m_access_local, ID translation,
                                          m_textual info)
      set status(m)
%end

%routine do obtain attributes(%record(fs message fm)%name m, %integer type)
   %integer ID translation, parent ID
      %if type # 0 %start
         m_error code = -1;  m_status = -3
         m_error text = "Subrequest (obtain attributes by token) not implemented yet"
         %return
      %finish
      m_error code = directory lookup(m_access_local, m_filename,
                                      m_components translated,
                                      ID translation, parent ID,
                                      m_error text)
      %if m_error code # 0 %start
         set status(m)
         %return
      %finish
      m_error code = fsys obtain attributes(m_access_local, ID translation,
                                            m_attributes)
      set status(m)
%end

%routine do modify attributes(%record(fs message fm)%name m, %integer type)
   %integer ID translation, parent ID
      %if type # 0 %start
         m_error code = -1;  m_status = -3
         m_error text = "Subrequest (modify attributes by token) not implemented yet"
         %return
      %finish
      m_error code = directory lookup(m_access_local, m_filename,
                                      m_components translated,
                                      ID translation, parent ID,
                                      m_error text)
      %if m_error code # 0 %start
         set status(m)
         %return
      %finish
      m_error code = fsys modify attributes(m_access_local, ID translation,
                                            m_attributes)
      set status(m)
%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)
   %record(path fm)%name final
   %integer directory ID, file ID
      final == directory penultimate(m_access_local, m_filename,
                                     m_components translated,
                                     directory ID, m_error text, m_error code)
      set status(m) %and %return %if m_error code # 0
      m_error code = directory lookup one(m_access_local, directory ID,
                                          final_key, final_version,
                                          file ID, m_error text)
      set status(m) %and %return %if m_error code < 0
      %if file ID & directory flag # 0 %start
         m_error code = directory check empty(m_access_local, file ID)
         set status(m) %and %return %if m_error code < 0
      %finish
      invalidate directory buffers(directory ID)
      m_error code = directory delete entry(m_access_local, directory ID,
                                            final_key, final_version)
      ! Delete is implied by refcount being decremented
      set status(m)
%end

%routine do create new directory(%record(fs message fm)%name m)
   %integer parent ID
      m_error code = create directory(m_access_local, m_filename, m_partition,
                                      m_request flags & no inherit flag,
                                      m_components translated, parent ID,
                                      m_error text)
      invalidate directory buffers(parent ID)
      set status(m)   
%end

%routine do enquire nth directory entry(%record(fs message fm)%name m)
   %record(directory buffer fm)%name db
   %integer d, ID, parent ID, i, n
      m_error code = directory lookup(m_access_local, m_filename,
                                      m_components translated,
                                      ID, parent ID, m_error text)
      set status(m) %and %return %if m_error code # 0
      m_error code = get directory contents(m_access_local, ID, d)
      set status(m) %and %return %if m_error code # 0
      db == directory buffer(d)
      ! Got the directory, now find the m_blockth entry
      n = m_block - 1; i = 1
      m_textual info = ""
      %while n > 0 %cycle
         %if i > db_size %start
            release directory buffer(d)
            m_status = 0;  m_error code = 0
            %return
         %finish
         n = n - 1 %if db_x(i) = NL
         i = i + 1
      %repeat
      i = i + 1 %if db_x(i) = NL
      ! We're now pointing at the start of the entry
      ! (or off the end of the directory)
      %while i <= db_size %and db_x(i) # NL %cycle
         m_textual info = m_textual info . to string(db_x(i))
         i = i + 1
      %repeat
      release directory buffer(d)            
      m_status = 0;  m_error code = 0
%end

%routine do insert local translation(%record(fs message fm)%name m)
   %record(path fm)%name final
   %integer directory ID
      final == directory penultimate(m_access_local, m_filename,
                                     m_components translated,
                                     directory ID, m_error text, m_error code)
      set status(m) %and %return %if m_error code # 0
      invalidate directory buffers(directory ID)
      m_error code = directory insert local(m_access_local, directory ID,
                                            final_key,
                                            m_translation string)
      set status(m)
%end

%routine do insert external translation(%record(fs message fm)%name m)
   %record(path fm)%name final
   %integer directory ID
      final == directory penultimate(m_access_local, m_filename,
                                     m_components translated,
                                     directory ID, m_error text, m_error code)
      set status(m) %and %return %if m_error code # 0
      invalidate directory buffers(directory ID)
      m_error code = directory insert external(m_access_local, directory ID,
                                               final_key,
                                               m_translation string)
      set status(m)
%end

%routine do translate path(%record(fs message fm)%name m)
   %integer parent ID
      !! printstring("Do translate path");  newline
      m_error code = directory lookup(m_access_local, m_filename,
                                      m_components translated,
                                      m_file token, parent ID,
                                      m_error text)
      !! printstring("Done, status ");  write(m_error code, 0)
      !! printstring(", ID ");  phex(m_file token);  newline
      set status(m)
%end

%routine do rename file(%record(fs message fm)%name m)
   %record(path fm)%name last f, last t
   %integer directory ID f, directory ID t, ID translation
   %string(255) textual translation
      last f == directory penultimate(m_access_local, m_filename,
                                      m_components translated,
                                      directory ID f,
                                      m_error text, m_error code)
      %if m_error code # 0 %start
         m_error code = -302 %if m_error code > 0;  ! Dud component (translation)
         set status(m)
         %return
      %finish
      last t == directory penultimate(m_access_local, m_filename2,
                                      m_components translated 2,
                                      directory ID t,
                                      m_error text, m_error code)
      %if m_error code # 0 %start
         m_error code = -302 %if m_error code > 0;  ! Dud component (translation)
         set status(m)
         %return
      %finish
      ! Both have translated successfully to a non-external directory
      %if last t_version # 0 %start
         m_error code = -206;  ! No versions allowed <<<<<<<
         set status(m)
         %return
      %finish
      m_error code = directory lookup one(m_access_local, directory ID f,
                                          last f_key, last f_version,
                                          ID translation, textual translation)
      %if m_error code # 0 %start
         m_error code = -302 %if m_error code > 0;  ! Dud component (translation)
         set status(m)
         %return
      %finish
      invalidate directory buffers(directory ID t)
      m_error code = directory insert ID(m_access_local, directory ID t,
                                         last t_key, ID translation)
      %if m_error code # 0 %start
         set status(m)
         %return
      %finish
      invalidate directory buffers(directory ID f)
      m_error code = directory delete entry(m_access_local, directory ID f,
                                            last f_key, last f_version)
      set status(m)
%end

%routine do copy file(%record(fs message fm)%name m)
   m_error code = -1;  m_status = -3
   m_error text = "Subrequest (copy file) not implemented yet"
%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 translate redirections(%record(fs message fm)%name m)
   %record(path fm)%name final
   %integer directory ID, file ID
      final == directory penultimate(m_access_local, m_filename,
                                     m_components translated,
                                     directory ID, m_error text, m_error code)
      %if m_request flags = 0 %start
         ! We've to translate the whole path, so look up the final
         ! component (non-zero means only translate to penultimate).
         set status(m) %and %return %if m_error code # 0
         m_error code = directory lookup one(m_access_local, directory ID,
                                             final_key, final_version,
                                             file ID, m_error text)
      %finish
      %if m_error code = 0 %start
         ! Success.  Set m_components translated to zero to
         ! prevent the path being disposed of by IO_F -- we want
         ! it to be passed back intact for subsequent reuse.
         m_components translated = 0
         m_status = 0
      %else
         set status(m)
      %finish
%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


! 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 %if m_subcode = file header subcode
      do header(m, m_buffer)
   %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 %if m_subcode = enquire nth directory entry subcode
      do enquire nth directory entry(m)
   %else %if m_subcode = insert local translation subcode
      do insert localtranslation(m)
   %else %if m_subcode = insert external translation subcode
      do insert external translation(m)
   %else %if m_subcode = translate path subcode
      do translate path(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
      do translate redirections(m)
   %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


! 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("Local filesystem request: code ");  write(m_code, 0)
         !! printstring(", subcode ");  write(m_subcode, 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
            m_error code= -1;  m_status = -1
            m_error text = "Unknown request code"
         %finish
         !! printstring("Replying to ");  phex(addr(m_system part_reply))
         !! printstring(", 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(directory buffer semaphore)
      signal semaphore(directory buffer semaphore)
      setup semaphore(file token semaphore)
      signal semaphore(file token semaphore)
      FS insert(local file system mailbox, addr(request mailbox))
      fsys initialise
      !! printstring("Starting ");  write(processes, 0)
      !! printstring(" local file system processes");  newline
      p == create process(process size, addr(x), priority, nil) %for i = 1, 1, processes - 1
      set priority(nil, priority)
      {} printstring("F_Local: ");  write(free store, 0)
      {} printstring(" free");  newline
      ! Fall through to form one of the processes....
x:    local filesystem process
      ! Never returns...
%end %of %program
