!**BEWARE** a blocksize of 512 bytes is often ASSUMED.

! I/O module for local/remote file system, with redirection interpretation.
! This version constructed by merging local and remote client modules.

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

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

%constinteger redirect lives = 32
%constinteger fsys limit = 8

%constinteger separator = ':'
%constinteger device marker = ':'

%constinteger interactive redirect character = '>'

%constinteger internal textual equivalent = 2

%externalinteger F external redirect level = 16_7FFFFFFF
! Set to the upper level at which redirector processing is
! done locally.  By default everything is, but protocol interperters
! will set a lower level.

%externalinteger F old style handling = 0
! Set to non-zero to enable "Directory", etc

%externalinteger F no explicit device = 0
! Set to non-zero to inhibit explicit device-name stripping

%externalinteger F validate pathnames = 0
! Set to non-zero to inhibit pathname component checking

%externalinteger F enable dot dot = 0
! Set to non-zero to enable ".." in pathnames

%externalinteger F default request flags = 0
! Applied to all requests, in addition to any specifically asked for.


%constinteger block shift = 9
%constinteger block size = 512
%constinteger read buffer size = 8 * block size
%constinteger write buffer size = block size

%include "Moose:Mouse.Inc"
%include "GDMR_H:NFac.Inc"

%systemintegerfnspec global heap get(%integer amount)

%systemroutinespec phex(%integer i)
%externalstring(127)%fnspec itos(%integer i, j)

%constinteger directory flag = 16_40000000

%constinteger leave path = 16_80000000

%constinteger NUL = 0

%ownrecord(mailbox fm)%name request mailbox == nil
%externalpredicatespec FS lookup(%string(31) name, %integername value)

!! %routine xprintstring(%string(255) s)
!!    %integer i, ch
!!       print symbol('"')
!!       %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
!!       print symbol('"')
!! %end

%recordformat path fm(%record(path fm)%name next, 
                      %integer version, %string(*)%name key,
                      %string(255) text)
%constinteger path size = 12 + 256

%ownrecord(semaphore fm) path lookaside semaphore = 0
%owninteger path lookaside initialised = 0

%ownrecord(path fm)%name path lookaside == nil

%externalrecord(path fm)%map FIO new path element
   %record(path fm)%name x
      %if path lookaside initialised = 0 %start
         !! printstring("Path new element: initialising...");  newline
         ! There's a small window here where things might go wrong.
         ! It could be that two processes test the initialisation flag at
         ! "the same time".  It's unlikely, so we'll just have to keep our
         ! fingers crossed......
         setup semaphore(path lookaside semaphore)
         path lookaside initialised = 1
      %else
         !! printstring("Path new element: initialised");  newline
         semaphore wait(path lookaside semaphore)
      %finish
      %if path lookaside == nil %start
         !! printstring("Empty: from heap");  newline
         x == record(global heap get(path size))
      %else
         !! printstring("From lookaside list");  newline
         x == path lookaside
         path lookaside == x_next
      %finish
      signal semaphore(path lookaside semaphore)
      %result == x
%end

%externalroutine FIO dispose path element(%record(path fm)%name x)
   semaphore wait(path lookaside semaphore)
   x_key == nil;  x_text = "";  x_version = 0
   x_next == path lookaside
   path lookaside == x
   signal semaphore(path lookaside semaphore)
%end

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

%externalroutine FIO dispose path(%record(path fm)%name p)
   %record(path fm)%name n
      %while p ## nil %cycle
         !! printstring("Disposing (path) ");  phex(addr(p));  newline
         n == p_next
         FIO dispose path element(p)
         p == n
      %repeat
%end

%predicate valid version(%record(path fm)%name p, %integername v)
   %integer i, ch, x
      %false %if length(p_key) < 2 %or charno(p_key, 1) # '-'
      x = 0
      %for i = 2, 1, length(p_key) %cycle
         ch = charno(p_key, i)
         %false %unless '0' <= ch <= '9'
         x = 10 * x - ch + '0'
      %repeat
      v = x
      %true
%end

%routine supply metacharacters(%integer start, finish)
   %bytename ch
      %while start < finish %cycle
         ch == byteinteger(start)
         %if ch = NUL %start
            ch = separator
         %else %if ch = 1
            ch = interactive redirect character
         %else %if ch = 2
            ch = '?'
         %finish
         start = start + 1
      %repeat
%end

%predicate equal(%string(255) a, b)
   %integer i, aa, bb
      %false %unless length(a) = length(b)
      %true %if a = ""
      %for i = 1, 1, length(a) %cycle
         aa = charno(a, i);  bb = charno(b, i)
         aa = aa - 'a' + 'A' %if 'a' <= aa <= 'z'
         bb = bb - 'a' + 'A' %if 'a' <= bb <= 'z'
         %false %unless aa = bb
      %repeat
      %true
%end

%externalrecord(path fm)%map FIO split path(%string(255) path,
                                            %integer separator,
                                            %record(path fm)%name append)
   %record(path fm)%name head == nil, last, current
   %integer ch, n, first = 1
   %string(255) s = "", xx
      !! printstring("Split path: """);  printstring(path)
      !! print symbol('"');  newline
      %if path = "" %start
root:    head == FIO new path element
         head_text = ""
         head_key == head_text
         head_version = 0
         head_next == append
         %result == head
      %finish
      %if separator = NUL %or F no explicit device # 0 %start
         first = 1
      %else
         %if charno(path, 1) = device marker %start
            ! Device specified explicitly.  Junk it.
            first = 3
            %cycle
               -> root %if first > length(path)
               %exit %if charno(path, first) = device marker
               first = first + 1
            %repeat
            -> root %if first = length(path)
            first = first + 1
         %finish
      %finish
      %for n = first, 1, length(path) %cycle
         ch = charno(path, n)
         ch = ch & 127 %if F validate pathnames = 0
         %if ch = separator %start
            %if s = "" %start
               FIO dispose path(head)
               %result == nil
            %finish
            ! End of component
            current == FIO new path element
            !! printstring("Component ");  printstring(s)
            !! printstring(" at ");  phex(addr(current));  newline
            current_text = s
            current_key == current_text
            current_version = 0
            current_next == nil
            %if head == nil %start
               head == current
               last == current
            %else
               last_next == current
               last == current
            %finish
            s = ""
         %else
            %if separator = NUL %or F validate pathnames # 0 %c
                  %or ' ' <= ch <= '~' %start
               ! Allow "silly" characters only in redirections
               s = s . to string(ch) %if ch # ' '
            %else
               FIO dispose path(head)
               %result == nil
            %finish
         %finish
      %repeat
      ! End of last component
      %if F old style handling # 0 %start
         !! printstring("Old-style handling for ")
         !! xprintstring(s);  newline
         %if equal(s, "DIRECTORY") %or equal(s, ".") %start
            s = ""
         %else %if s # "" %and charno(s, length(s)) = interactive redirect character
            length(s) = length(s) - 1
         %finish
      %finish
      current == FIO new path element
      !! printstring("Component ");  printstring(s)
      !! printstring(" at ");  phex(addr(current));  newline
      current_text = s
      current_key == current_text
      current_version = 0
      current_next == append
      %if head == nil %start
         head == current
      %else
         last_next == current
         %if valid version(current, last_version) %start
            FIO dispose path element(current)
            last_next == nil
         %finish
      %finish
      %result == head
%end


! File system selection & redirection.

%recordformat redirect fm(%string(15) fsys, %record(mailbox fm)%name box)
%ownrecord(redirect fm)%array redirects(1 : fsys limit) = 0(*)
%ownrecord(semaphore fm) redirect sem = 0
%owninteger redirect limit = 0
%owninteger redirect initialised = 0

%ownrecord(mailbox fm)%name default mailbox == nil
%ownrecord(mailbox fm)%name H2 mailbox == nil

%routine initialise boxes
   %integer x
      setup semaphore(redirect sem)
      redirect initialised = 1
      %if FS lookup(local filesystem mailbox, x) %start
         !! printstring(local filesystem mailbox)
         !! printstring(" at ");  phex(x);  newline
         redirects(1)_fsys = "LOCAL";  redirects(1)_box == record(x)
         default mailbox == record(x)
         redirect limit = 1
      %finish
      %if FS lookup(H2 filesystem mailbox, x) %start
         !! printstring(H2 filesystem mailbox)
         !! printstring(" at ");  phex(x);  newline
         redirect limit = redirect limit + 1
         redirects(redirect limit)_fsys = "H2"
         redirects(redirect limit)_box == record(x)
         H2 mailbox == record(x)
         default mailbox == record(x) %if default mailbox == nil
      %finish
      %if default mailbox == nil %start
         printstring("No filesystem??");  newline
      %finish
      signal semaphore(redirect sem)
%end

%record(mailbox fm)%map target mailbox(%record(fs message fm)%name m)
   ! In this version we're only called for external redirects.  Internal
   ! redirects are handled in FIO transact by using the last-tried
   ! filesystem (or the default one, the first time through).
   %record(path fm)%name p
   %record(redirect fm)%name r
   %integer i
      p == m_filename 
      !! printstring("Determine mailbox: ");  xprintstring(p_key)
      !! printstring(" in ");  write(redirect limit, 0)
      !! newline
      semaphore wait(redirect sem)
      %for i = 1, 1, redirect limit %cycle
         r == redirects(i)
         !! printstring("Trying ");  xprintstring(r_fsys);  newline
         %if r_fsys = p_key %start
            signal semaphore(redirect sem)
            !! printstring("Hit: ");  phex(addr(r_box));  newline
            m_filename == p_next;  FIO dispose path element(p)
            %result == r_box
         %finish
         !! xprintstring(r_fsys);  printstring(" # ")
         !! xprintstring(p_key);  newline
      %repeat
      ! Not found if we get here
      %if FS lookup("FILESYSTEM:" . p_key, i) %start
         ! Filesystem exists
         redirect limit = redirect limit + 1
         r == redirects(redirect limit)
         r_fsys = p_key;  r_box == record(i)
         signal semaphore(redirect sem)
         !! printstring(p_key);  printstring(" found at ")
         !! phex(i);  newline
         m_filename == p_next;  FIO dispose path element(p)
         %result == r_box
      %else
         signal semaphore(redirect sem)
         !! printstring(p_key);  printstring(" not found");  newline
         %result == nil
      %finish
%end

%externalroutine FIO transact(%record(fs message fm)%name m,
                              %record(mailbox fm)%name target)
   %record(mailbox fm) our reply mailbox = 0
   %record(semaphore fm) our reply semaphore = 0
   %record(path fm)%name p
   %record(fs message fm)%name r
   %integer lives = redirect lives, i
      initialise boxes %if redirect initialised = 0
      setup semaphore(our reply semaphore)
      setup mailbox(our reply mailbox, our reply semaphore)
      target == default mailbox %if target == nil
      %signal 3,,, "No filesystems" %if target == nil
      %cycle
         !! printstring("Transacting: code ");  write(m_code, 0)
         !! printstring(", subcode ");  write(m_subcode, 0)
         !! printstring(", reply ");  phex(addr(our reply mailbox))
         !! printstring(", sema ");  phex(addr(our reply semaphore))
         !! printstring(", path:");  newline
         !! show path(m_filename)
         %if target_queue_tag # 'MB' %or target_queue_size # size of(target) %start
            m_status = -1;  m_error code = -1
            m_textual response = "Dubious mailbox token"
            %return
         %finish
         send message(m, target, our reply mailbox)
         r == receive message(our reply mailbox)
         %signal 3,,, "Unexpected filesystem reply" %if r ## m
         !! printstring("Response: ");  write(m_status, 0)
         !! space;  write(m_error code, 0);  space
         !! printstring(m_textual response);  newline
         ! Remove those path components which were successfully translated
         ! (but not if the operation was "successful" and we've been asked
         ! to leave them alone).
         %if m_status # 0 %or m_request flags & leave path = 0 %start
            %while m_components translated > 0 %cycle
               p == m_filename;  m_filename == p_next
               !! printstring("Removing ");  printstring(p_key)
               !! printstring(" leaving ");  phex(addr(m_filename));  newline
               FIO dispose path element(p)
               m_components translated = m_components translated - 1
            %repeat
         %finish
         %return %if m_status <= 0;  ! Standard-OK or error
         ! +ve status, so it was an external textual equivalent.
         ! Split it apart and prepend it to the already-existing
         ! path (the part we didn't deal with last time).
         ! First we have to remove the path component which translated
         ! to the redirection, as the file system hasn't counted it as
         ! successfully translated.
         p == m_filename;  m_filename == p_next
         FIO dispose path element(p)
         !! printstring("Redirector: ");  xprintstring(m_textual response)
         !! newline
         %if m_status > F external redirect level %start
            ! Redirect level too high, so reassemble the full filename and
            ! return it to our caller
            %while m_filename ## nil %cycle
               p == m_filename;  m_filename == p_next
               m_textual response = m_textual response . to string(separator) . p_key
               FIO dispose path element(p)
            %repeat
            %if m_textual response # "" %start
               %for i = 1, 1, length(m_textual response) %cycle
                  charno(m_textual response, i) = separator %c
                     %if charno(m_textual response, i) = NUL
               %repeat
            %finish
            !! printstring("External redirect -> ")
            !! printstring(m_textual response);  newline
            %return
         %finish
         m_filename == FIO split path(m_textual response, NUL, m_filename)
         ! And round again with the new path.....
         lives = lives - 1
         %if lives = 0 %start
            m_textual response = "Too many redirections"
            m_error code = -1;  m_status = -1
            %return
         %finish
         %if m_status > internal textual equivalent %start
            target == target mailbox(m)
            %if target == nil %start
               ! Specified file system is missing
               p == m_filename
               m_textual response = p_key . " file system not present"
               m_error code = -1;  m_status = -1
               %return
            %finish
      !! %else
      !!    ! Use the last filesystem
      !!    printstring("Reuse filesystem at ");  phex(addr(target))
      !!    newline
         %finish
      %repeat
%end


%routine convert metacharacters(%string(*)%name s)
   %bytename ch
   %integer i
      %return %if s = ""
      %for i = 1, 1, length(s) %cycle
         ch == charno(s, i)
         ch = ':' %if ch = 0
      %repeat
%end


! External procedural interface.  This consists of a collection of %functions
! which return status values, and a collection of %routines which merely call
! the corresponding %functions and %signal if the status is non-zero.

%externalintegerfn F open file(%record(*)%name access,
                               %string(255) filename,
                               %integer mode, compatible,
                               %integer request flags,
                               %integername token1, token2, size, flags,
                               %string(*)%name textual response)
   %record(path fm)%name p
   %record(fs message fm) m = 0
      p == FIO split path(filename, separator, nil)
      textual response = "Bad filename" %and %result = -1 %if p == nil
      setup message(m, size of(m))
      m_access token = addr(access)
      m_textual response == textual response
      m_tag = 0
      m_request = open file request
      m_mode = mode
      m_compatible mode = compatible
      m_filename == p
      m_request flags = request flags ! F default request flags
      m_followup mailbox == nil
      FIO transact(m, nil)
      FIO dispose path(m_filename)
      %if m_status # 0 %start
         !! printstring("Open status ");  write(m_status, 0);  newline
         convert metacharacters(textual response)
         %result = m_status
      %finish
      textual response = "Dud followup mailbox" %and %result = -1 %c
         %if m_followup mailbox == nil
      token1 = m_file token
      token2 = addr(m_followup mailbox)
      size = m_byte count
      flags = m_response flags
      !! printstring("Opened: size ");  write(size, 0)
      !! printstring(", flags ");  phex(flags)
      !! printstring(", token 1 ");  phex(token 1)
      !! printstring(", token 2 ");  phex(token 2)
      !! newline
      %result = 0
%end

%externalroutine L open file(%record(*)%name access,
                             %string(255) filename,
                             %integer mode, compatible,
                             %integer request flags,
                             %integername token1, token2, size, flags)
   %string(255) text = ""
   %integer status
      status = F open file(access, filename, mode, compatible,
                           request flags, token1, token2, size, flags, text)
      %signal 3, 1, status, text %if status # 0
%end


%externalintegerfn F close file(%record(*)%name access,
                                %integer token1, token2, flags,
                                %string(*)%name textual response)
   %record(fs message fm) m = 0
      setup message(m, size of(m))
      m_access token = addr(access)
      m_textual response == textual response
      m_tag = 0
      m_request = close file request
      m_file token = token1
      m_request flags = flags ! F default request flags
      m_filename == nil
      FIO transact(m, record(token2))
      convert metacharacters(textual response) %if m_status # 0
      %result = m_status
%end

%externalroutine L close file(%record(*)%name access,
                              %integer token1, token2, flags)
   %string(255) text = ""
   %integer status
      status = F close file(access, token1, token2, flags, text)
      %signal 3, 1, status, text %if status # 0
%end


%externalintegerfn F truncate file(%record(*)%name access,
                                   %integer token1, token2, bytes,
                                   %string(*)%name textual response)
   %record(fs message fm) m = 0
      setup message(m, size of(m))
      m_access token = addr(access)
      m_textual response == textual response
      m_tag = 0
      m_request = truncate file request
      m_request flags = F default request flags
      m_file token = token1
      m_byte count = bytes
      m_filename == nil
      FIO transact(m, record(token2))
      convert metacharacters(textual response) %if m_status # 0
      %result = m_status
%end

%externalroutine L truncate file(%record(*)%name access,
                                 %integer token1, token2, bytes)
   %string(255) text = ""
   %integer status
      status = F truncate file(access, token1, token2, bytes, text)
      %signal 3, 1, status, text %if status # 0
%end


%externalintegerfn F read block(%record(*)%name access,
                                %integer token1, token2, byte offset,
                                %integername bytes,
                                %bytename buffer,
                                %string(*)%name textual response)
   %record(fs message fm) m = 0
      !! printstring("Read 512 from ");  write(byte offset, 0);  newline
      %if byte offset & 511 # 0 %start
         textual response = "Unaligned transfer"
         %result = -4
      %finish
      setup message(m, size of(m))
      m_access token = addr(access)
      m_textual response == textual response
      m_tag = 0
      m_request = read data request
      m_request flags = F default request flags
      m_file token = token1
      m_byte offset = byte offset
      m_data buffer == buffer
      m_byte count = 512
      m_filename == nil
      FIO transact(m, record(token2))
      %if m_status # 0 %start
         convert metacharacters(textual response)
         %result = m_status
      %finish
      bytes = m_byte count
      %result = 0
%end

%externalroutine L read block(%record(*)%name access,
                              %integer token1, token2, byte offset,
                              %integername bytes,
                              %bytename buffer)
   %string(255) text = ""
   %integer status
      status = F read block(access, token1, token2,
                            byte offset, bytes, buffer, text)
      %signal 3, 1, status, text %if status # 0
%end

%externalintegerfn F read N(%record(*)%name access,
                            %integer token1, token2, byte offset, N,
                            %integername bytes,
                            %bytename buffer,
                            %string(*)%name textual response)
   %record(fs message fm) m = 0
      !! printstring("Read ");  write(N, 0)
      !! printstring(" from ");  write(byte offset, 0);  newline
      %if byte offset & 511 # 0 %start
         textual response = "Unaligned transfer"
         %result = -4
      %finish
      setup message(m, size of(m))
      m_access token = addr(access)
      m_textual response == textual response
      m_tag = 0
      m_request = read data request
      m_request flags = F default request flags
      m_file token = token1
      m_byte offset = byte offset
      m_data buffer == buffer
      m_byte count = n
      m_filename == nil
      FIO transact(m, record(token2))
      %if m_status # 0 %start
         convert metacharacters(textual response)
         %result = m_status
      %finish
      bytes = m_byte count
      %result = 0
%end

%externalroutine L read N(%record(*)%name access,
                          %integer token1, token2, byte offset, N,
                          %integername bytes,
                          %bytename buffer)
   %string(255) text = ""
   %integer status
      status = F read N(access, token1, token2,
                        byte offset, N, bytes, buffer, text)
      %signal 3, 1, status, text %if status # 0
%end

%routine L read short block(%record(*)%name access,
                            %integer token1, token2, byte offset,
                            %integer buffer size,
                            %integername bytes,
                            %bytename buffer)
   %recordformat x fm(%bytearray x(0 : 511))
   %record(x fm) x
      L read block(access, token1, token2, byte offset, bytes, x_x(0))
      %signal 3, 9,, "Buffer overrun" %if bytes > buffer size
      A0 = addr(x)
      A1 = addr(buffer)
      D0 = buffer size - 1
   L: *move.b (A0)+, (A1)+
      *dbra D0, L
%end


%externalintegerfn F write block(%record(*)%name access,
                                 %integer token1, token2, byte offset, bytes,
                                 %bytename buffer,
                                 %string(*)%name textual response)
   %record(fs message fm) m = 0
      %if byte offset & 511 # 0 %start
         textual response = "Unaligned transfer"
         %result = -4
      %finish
      setup message(m, size of(m))
      m_access token = addr(access)
      m_textual response == textual response
      m_tag = 0
      m_request = write data request
      m_request flags = F default request flags
      m_file token = token1
      m_byte offset = byte offset
      m_data buffer == buffer
      m_byte count = bytes
      m_filename == nil
      FIO transact(m, record(token2))
      convert metacharacters(textual response) %if m_status # 0
      %result = m_status
%end

%externalroutine L write block(%record(*)%name access,
                               %integer token1, token2, byte offset, bytes,
                               %bytename buffer)
   %string(255) text = ""
   %integer status
      status = F write block(access, token1, token2,
                              byte offset, bytes, buffer, text)
      %signal 3, 1, status, text %if status # 0
%end


! Directory manipulation stuff

%externalintegerfn F create directory P(%record(*)%name access,
                                        %string(255) filename,
                                        %integer partition, flags,
                                        %string(*)%name textual response)
   %record(path fm)%name p
   %record(fs message fm) m = 0
      p == FIO split path(filename, separator, nil)
      textual response = "Bad filename" %and %result = -1 %if p == nil
      setup message(m, size of(m))
      m_access token = addr(access)
      m_textual response == textual response
      m_tag = 0
      %if partition > 0 %then m_request = local create directory request %c
                        %else m_request = create directory request
      m_filename == p
      m_request specific = partition
      m_request flags = flags ! F default request flags
      FIO transact(m, nil)
      FIO dispose path(m_filename)
      convert metacharacters(textual response) %if m_status # 0
      %result = m_status
%end

%externalroutine L create directory P(%record(*)%name access,
                                      %string(255) filename,
                                      %integer partition)
   %string(255) text = ""
   %integer status
      status = F create directory P(access, filename, partition, 0, text)
      %signal 3, 1, status, text %if status # 0
%end

%externalintegerfn F create directory(%record(*)%name access,
                                      %string(255) filename,
                                      %integer flags,
                                      %string(*)%name textual response)
   %record(path fm)%name p
   %record(fs message fm) m = 0
      p == FIO split path(filename, separator, nil)
      textual response = "Bad filename" %and %result = -1 %if p == nil
      setup message(m, size of(m))
      m_access token = addr(access)
      m_textual response == textual response
      m_tag = 0
      m_request = create directory request
      m_filename == p
      m_request flags = flags ! F default request flags
      FIO transact(m, nil)
      FIO dispose path(m_filename)
      convert metacharacters(textual response) %if m_status # 0
      %result = m_status
%end

%externalroutine L create directory(%record(*)%name access,
                                    %string(255) filename)
   %string(255) text = ""
   %integer status
      status = F create directory(access, filename, 0, text)
      %signal 3, 1, status, text %if status # 0
%end


%externalintegerfn F rename file(%record(*)%name access,
                                 %string(255) from, to,
                                 %string(*)%name textual response)
   %record(path fm)%name pf, pt
   %record(fs message fm) m = 0
   %record(mailbox fm)%name from box, to box
      !! printstring("Rename: ");  printstring(from)
      !! space;  printstring(to);  newline
      pf == FIO split path(from, separator, nil)
      textual response = "Bad (source) filename" %and %result = -1 %if pf == nil
      pt == FIO split path(to, separator, nil)
      %if pt == nil %start
         FIO dispose path(pf)
         textual response = "Bad (target) filename"
         %result = -1
      %finish
      setup message(m, size of(m))
      m_access token = addr(access)
      m_textual response == textual response
      m_tag = 0
      m_request = interpret filename request
      m_request flags = stop at penultimate ! leave path ! F default request flags
      m_filename == pf
      FIO transact(m, nil)
      %if m_status # 0 %start
         FIO dispose path(m_filename)
         FIO dispose path(pt)
         convert metacharacters(textual response)
         %result = m_status
      %finish
      pf == m_filename
      from box == m_followup mailbox
      m_filename == pt
      ! Same request code and flags
      FIO transact(m, nil)
      %if m_status # 0 %start
         FIO dispose path(m_filename)
         FIO dispose path(pf)
         convert metacharacters(textual response)
         %result = m_status
      %finish
      to box == m_followup mailbox
      m_request = rename file request
      m_request flags = F default request flags
      m_filename2 == m_filename
      m_filename == pf
      %if from box ## to box %start
         FIO dispose path(m_filename)
         FIO dispose path(m_filename2)
         textual response = "Rename between servers not allowed"
         %result = -1
      %finish
      !! printstring("Paths are:");  newline
      !! show path(m_filename);  show path(m_filename2)
      FIO transact(m, from box)
      FIO dispose path(m_filename)
      FIO dispose path(m_filename2)
      convert metacharacters(textual response) %if m_status # 0
      %result = m_status
%end

%externalroutine L rename file(%record(*)%name access,
                               %string(255) from, to)
   %string(255) text = ""
   %integer status
      status = F rename file(access, from, to, text)
      %signal 3, 1, status, text %if status # 0
%end


%recordformat copy token fm(%record(*)%name access,
                            %record(mailbox fm)%name f mailbox,
                            %integer f token, f size, f flags,
                            %record(mailbox fm)%name t mailbox,
                            %integer t token)


%externalintegerfn F initiate copy(%record(*)%name access,
                                   %string(255) from, to,
                                   %integername copy token,
                                   %string(*)%name textual response)
   %record(copy token fm)%name c
   %record(path fm)%name pf, pt
   %record(fs message fm) m = 0
   %record(mailbox fm)%name from box, to box
   %integer status
      !! printstring("Copy: ");  printstring(from)
      !! space;  printstring(to);  newline
      pf == FIO split path(from, separator, nil)
      textual response = "Bad (source) filename" %and %result = -1 %if pf == nil
      pt == FIO split path(to, separator, nil)
      %if pt == nil %start
         FIO dispose path(pf)
         textual response = "Bad (target) filename"
         %result = -1
      %finish
      setup message(m, size of(m))
      m_access token = addr(access)
      m_textual response == textual response
      m_tag = 0
      m_request = interpret filename request
      m_request flags = F default request flags
      m_filename == pf
      FIO transact(m, nil)
      %if m_status # 0 %start
         FIO dispose path(m_filename)
         FIO dispose path(pt)
         convert metacharacters(textual response)
         %result = m_status
      %finish
      pf == m_filename
      from box == m_followup mailbox
      m_filename == pt
      m_request flags = stop at penultimate ! F default request flags
      FIO transact(m, nil)
      %if m_status # 0 %start
         FIO dispose path(m_filename)
         FIO dispose path(pf)
         convert metacharacters(textual response)
         %result = m_status
      %finish
      pt == m_filename
      to box == m_followup mailbox
      m_filename == pf
      !! printstring("From box at ");  phex(addr(from box))
      !! printstring(", to box at ");  phex(addr(to box));  newline
      %if from box == H2 mailbox %and from box == to box %c
            %and pf_key = pt_key %start
         ! Remote copy if both are the same (remote) filestore
         !! printstring("Remote copy at same filestore");  newline
         copy token = 0
         m_request = old copy file request
         m_filename2 == pt
         FIO transact(m, from box)
         FIO dispose path(m_filename)
         FIO dispose path(m_filename2)
         convert metacharacters(textual response) %if m_status # 0
         %result = m_status
      %finish
      ! Otherwise we'll have to do the copy ourselves
      !! printstring("Different or local file systems");  newline
      c == new(c);  c_access == access
      c_f mailbox == from box;  c_t mailbox == to box
      ! First, open the source file
      m_request = open file request
      m_filename == pf
      m_mode = read file mode
      m_compatible mode = read file mode
      m_request flags = F default request flags
      FIO transact(m, from box)
      FIO dispose path(m_filename)
      %if m_status # 0 %start
         !! printstring("Open source failed: ");  write(m_status, 0);  newline
         dispose(c)
         FIO dispose path(pt)
         convert metacharacters(textual response)
         %result = m_status
      %finish
      c_f token = m_file token
      c_f size = m_byte count
      c_f flags= m_response flags
      !! printstring("Source opened as ");  phex(c_f token)
      !! printstring(", size ");  write(c_f size, 0);  newline
      ! Source was OK, open the destination file
      m_filename == pt
      m_mode = modify file mode
      m_compatible mode = 0
      m_request flags = create flag ! F default request flags
      FIO transact(m, to box)
      FIO dispose path(m_filename)
      %if m_status # 0 %start
         ! Error, preserve status and close the source file
         convert metacharacters(textual response)
         status = m_status
         !! printstring("Open destination failed: ")
         !! write(status, 0);  newline
         m_request = close file request
         m_request flags = F default request flags ! improper close flag
         m_access token = 0
         m_file token = c_f token
         FIO transact(m, from box)
         !! printstring("Close source status: ")
         !! write(m_status, 0);  newline
         dispose(c)
         %result = status
      %finish
      c_t token = m_file token
      !! printstring("Destination opened as ");  phex(c_t token);  newline
      copy token = addr(c)
      !! printstring("Copy token is ");  phex(copy token);  newline
      %result = 0
%end

%externalintegerfn F complete copy(%integer copy token,
                                   %string(*)%name textual response)
   %bytearray buffer(0 : 511)
   %record(copy token fm)%name c
   %record(fs message fm) m = 0
   %integer offset = 0
      !! printstring("Complete copy, token ");  phex(copy token);  newline
      %result = -1 %if copy token <= 0
      c == record(copy token)
      setup message(m, size of(m))
      m_access token = addr(c_access)
      m_tag = 0
      m_textual response == textual response
      m_filename == nil
      ! Copy block by block, while there's something to do
      %while c_f size > 0 %cycle
         !! printstring("Reading block ");  write(block, 0);  newline
         m_request = read data request
         m_file token = c_f token
         m_byte offset = offset
         m_data buffer == buffer(0)
         m_byte count = 512
         FIO transact(m, c_f mailbox)
         %if m_status # 0 %start
            printstring("Copy: read status ");  write(m_status, 0)
            newline
            %exit
         %finish
         !! printstring("Writing block ");  write(block, 0);  newline
         m_request = write data request
         m_file token = c_t token
         FIO transact(m, c_t mailbox)
         %if m_status # 0 %start
            printstring("Copy: write status ");  write(m_status, 0)
            newline
            %exit
         %finish
         offset = offset + 512
         c_f size = c_f size - 512;  ! Even for the short block
      %repeat
      ! Now close the source and destination files
      m_request = close file request
      m_file token = c_f token
      m_request flags = F default request flags
      FIO transact(m, c_f mailbox)
      %if m_status # 0 %start
         printstring("Copy: close source status ");  write(m_status, 0)
         newline
      %finish
      m_file token = c_t token
      m_request flags = 1 ! F default request flags;  ! Auto-truncate
      FIO transact(m, c_t mailbox)
      %if m_status # 0 %start
         printstring("Copy: close destination status ");  write(m_status, 0)
         newline
      %finish
      dispose(c)
      %result = 0
%end

%externalintegerfn F copy file(%record(*)%name access,
                               %string(255) from, to,
                               %string(*)%name textual response)
   %integer status, copy token
      status = F initiate copy(access, from, to, copy token, textual response)
      status = F complete copy(copy token, textual response) %c
         %if status = 0 %and copy token # 0
      %result = status
%end

%externalroutine L copy file(%record(*)%name access,
                             %string(255) from, to)
   %string(255) text = ""
   %integer status
      status = F copy file(access, from, to, text)
      %signal 3, 1, status, text %if status # 0
%end


%externalintegerfn F delete file(%record(*)%name access,
                                 %string(255) filename,
                                 %string(*)%name textual response)
   %record(path fm)%name p
   %record(fs message fm) m = 0
      p == FIO split path(filename, separator, nil)
      textual response = "Bad filename" %and %result = -1 %if p == nil
      setup message(m, size of(m))
      m_access token = addr(access)
      m_textual response == textual response
      m_tag = 0
      m_request = remove file request
      m_request flags = F default request flags
      m_filename == p
      FIO transact(m, nil)
      FIO dispose path(m_filename)
      convert metacharacters(textual response) %if m_status # 0
      %result = m_status
%end

%externalroutine L delete file(%record(*)%name access,
                               %string(255) filename)
   %string(255) text = ""
   %integer status
      status = F delete file(access, filename, text)
      %signal 3, 1, status, text %if status # 0
%end


%externalintegerfn F permit file(%record(*)%name access,
                                 %string(255) filename, mode,
                                 %string(*)%name textual response)
   %record(path fm)%name p
   %record(fs message fm) m = 0
      p == FIO split path(filename, separator, nil)
      textual response = "Bad filename" %and %result = -1 %if p == nil
      setup message(m, size of(m))
      m_access token = addr(access)
      m_textual response == textual response
      m_tag = 0
      m_request = textual permit file request
      m_request flags = F default request flags
      m_filename == p
      m_textual data == mode
      FIO transact(m, nil)
      FIO dispose path(m_filename)
      convert metacharacters(textual response) %if m_status # 0
      %result = m_status
%end

%externalroutine L permit file(%record(*)%name access,
                               %string(255) filename, mode)
   %string(255) text = ""
   %integer status
      status = F permit file(access, filename, mode, text)
      %signal 3, 1, status, text %if status # 0
%end


%externalintegerfn F insert textual translation(%record(*)%name access,
                                                %string(255) filename,
                                                %string(255) translation,
                                                %integer level,
                                                %string(*)%name textual response)
   %record(path fm)%name p
   %record(fs message fm) m = 0
      !! printstring("F Insert textual translation: filename ")
      !! xprintstring(filename);  printstring(", translation ")
      !! xprintstring(translation);  newline
      p == FIO split path(filename, separator, nil)
      textual response = "Bad filename" %and %result = -1 %if p == nil
      setup message(m, size of(m))
      m_access token = addr(access)
      m_textual response == textual response
      m_tag = 0
      m_request = local insert textual translation request 
      m_mode = level
      m_request flags = F default request flags
      m_filename == p
      m_textual data == translation
      FIO transact(m, nil)
      FIO dispose path(m_filename)
      convert metacharacters(textual response) %if m_status # 0
      %result = m_status
%end

%externalroutine L insert textual translation(%record(*)%name access,
                                              %string(255) filename,
                                              %string(255) translation,
                                              %integer level)
   %string(255) text = ""
   %integer status
      !! printstring("L Insert textual translation: filename ")
      !! xprintstring(filename);  printstring(", translation ")
      !! xprintstring(translation);  newline
      status = F insert textual translation(access, filename, translation,
                                            level, text)
      %signal 3, 1, status, text %if status # 0
%end

%externalintegerfn F insert ID(%record(*)%name access,
                               %string(255) filename,
                               %integer ID,
                               %string(*)%name textual response)
   %record(path fm)%name p
   %record(fs message fm) m = 0
      !! printstring("F Insert textual translation: filename ")
      !! xprintstring(filename);  printstring(", translation ")
      !! xprintstring(translation);  newline
      p == FIO split path(filename, separator, nil)
      textual response = "Bad filename" %and %result = -1 %if p == nil
      setup message(m, size of(m))
      m_access token = addr(access)
      m_textual response == textual response
      m_tag = 0
      m_request = local insert ID request 
      m_request specific = ID
      m_request flags = F default request flags
      m_filename == p
      FIO transact(m, nil)
      FIO dispose path(m_filename)
      convert metacharacters(textual response) %if m_status # 0
      %result = m_status
%end


%externalintegerfn F get header(%record(*)%name access,
                                %string(255) filename,
                                %record(*)%name header,
                                %string(*)%name textual response)
   %record(path fm)%name p
   %record(fs message fm) m = 0
      p == FIO split path(filename, separator, nil)
      textual response = "Bad filename" %and %result = -1 %if p == nil
      setup message(m, size of(m))
      m_access token = addr(access)
      m_textual response == textual response
      m_tag = 0
      m_request = local get file header request
      m_request flags = F default request flags
      m_filename == p
      m_data buffer == byteinteger(addr(header))
      FIO transact(m, nil)
      FIO dispose path(m_filename)
      convert metacharacters(textual response) %if m_status # 0
      %result = m_status
%end

%externalroutine L get header(%record(*)%name access, %string(255) filename,
                              %record(*)%name header)
   %string(255) text = ""
   %integer status
      status = F get header(access, filename, header, text)
      %signal 3, 1, status, text %if status # 0
%end


! The name of these next two is not well chosen....

%externalintegerfn F short form attributes(%record(*)%name access,
                                           %string(255) filename,
                                           %string(*)%name information,
                                           %string(*)%name textual response)
   %record(path fm)%name p
   %record(fs message fm) m = 0
      p == FIO split path(filename, separator, nil)
      textual response = "Bad filename" %and %result = -1 %if p == nil
      setup message(m, size of(m))
      m_access token = addr(access)
      m_textual response == textual response
      m_tag = 0
      m_request = textual file attributes request
      m_request flags = F default request flags
      m_filename == p
      m_textual data == information
      FIO transact(m, nil)
      FIO dispose path(m_filename)
      convert metacharacters(textual response) %if m_status # 0
      %result = m_status
%end

%externalroutine L short form attributes(%record(*)%name access,
                                         %string(255) filename,
                                         %string(*)%name information)
   %string(255) text = ""
   %integer status
      status = F short form attributes(access, filename, information, text)
      %signal 3, 1, status, text %if status # 0
%end

%externalintegerfn F obtain attributes(%record(*)%name access,
                                       %string(255) filename,
                                       %record(*)%name attributes,
                                       %string(*)%name textual response)
   %record(path fm)%name p
   %record(fs message fm) m = 0
      p == FIO split path(filename, separator, nil)
      textual response = "Bad filename" %and %result = -1 %if p == nil
      setup message(m, size of(m))
      m_access token = addr(access)
      m_textual response == textual response
      m_tag = 0
      m_request = local obtain attributes request
      m_request flags = F default request flags
      m_filename == p
      m_file attributes == attributes
      FIO transact(m, nil)
      FIO dispose path(m_filename)
      convert metacharacters(textual response) %if m_status # 0
      %result = m_status
%end

%externalroutine L obtain attributes(%record(*)%name access,
                                     %string(255) filename,
                                     %record(*)%name attributes)
   %string(255) text = ""
   %integer status
      status = F obtain attributes(access, filename, attributes, text)
      %signal 3, 1, status, text %if status # 0
%end

%externalintegerfn F modify attributes(%record(*)%name access,
                                       %string(255) filename,
                                       %record(*)%name attributes,
                                       %string(*)%name textual response)
   %record(path fm)%name p
   %record(fs message fm) m = 0
      p == FIO split path(filename, separator, nil)
      textual response = "Bad filename" %and %result = -1 %if p == nil
      setup message(m, size of(m))
      m_access token = addr(access)
      m_textual response == textual response
      m_tag = 0
      m_request = local modify attributes request
      m_request flags = F default request flags
      m_filename == p
      m_file attributes == attributes
      FIO transact(m, nil)
      FIO dispose path(m_filename)
      convert metacharacters(textual response) %if m_status # 0
      %result = m_status
%end

%externalroutine L modify attributes(%record(*)%name access,
                                     %string(255) filename,
                                     %record(*)%name attributes)
   %string(255) text = ""
   %integer status
      status = F modify attributes(access, filename, attributes, text)
      %signal 3, 1, status, text %if status # 0
%end

%externalintegerfn F enquire nth directory entry(%record(*)%name access,
                                                 %string(255) filename,
                                                 %integer which,
                                                 %string(*)%name information,
                                                 %string(*)%name textual response)
   %record(path fm)%name p
   %record(fs message fm) m = 0
      p == FIO split path(filename, separator, nil)
      textual response = "Bad filename" %and %result = -1 %if p == nil
      setup message(m, size of(m))
      m_access token = addr(access)
      m_textual response == textual response
      m_tag = 0
      m_request = local enquire nth entry request
      m_request flags = F default request flags
      m_filename == p
      m_request specific = which
      m_textual data == information
      FIO transact(m, nil)
      FIO dispose path(m_filename)
      convert metacharacters(textual response) %if m_status # 0
      %result = m_status
%end

! No %routine form for the above -- it's only in for the benefit of the
! H2 protocol interpreter.


%externalintegerfn F translate path(%record(*)%name access,
                                    %string(255) filename,
                                    %integername translation,
                                    %string(*)%name textual response)
   %record(path fm)%name p
   %record(fs message fm) m = 0
      !! printstring("F translate path: ");  printstring(filename);  newline
      p == FIO split path(filename, separator, nil)
      textual response = "Bad filename" %and %result = -1 %if p == nil
      setup message(m, size of(m))
      m_access token = addr(access)
      m_textual response == textual response
      m_tag = 0
      m_request = interpret filename request
      m_request flags = F default request flags
      m_filename == p
      !! printstring("About to transact");  newline
      FIO transact(m, nil)
      !! printstring("Done, disposing");  newline
      FIO dispose path(m_filename)
      translation = m_file token
      !! printstring("Resulting translation is ");  phex(translation);  newline
      convert metacharacters(textual response) %if m_status # 0
      %result = m_status
%end

%externalroutine L translate path(%record(*)%name access,
                                  %string(255) filename,
                                  %integername translation)
   %string(255) text = ""
   %integer status
      status = F translate path(access, filename, translation, text)
      %signal 3, 1, status, text %if status # 0
%end


! Special I/O module for H2 file system

%externalroutine X logon(%integer filestore, %string(255) user, pass)
   %record(path fm) p user
   %record(fs message fm) m = 0
   %record(fs message fm)%name x
   %record(semaphore fm) s
   %record(mailbox fm) r
   %string(255) text = ""
      !! printstring("Logon ");  printstring(user)
      !! printstring(" to ");  print symbol(filestore);  newline
      setup semaphore(s)
      setup mailbox(r, s)
      setup message(m, size of(m))
      p user_text = user
      p user_key == p user_text
      m_access token = 0
      m_textual response == text
      m_tag = 0
      m_request = old logon request
      m_request flags = F default request flags
      m_filename == p user
      m_textual data == pass
      m_request specific = filestore
      FIO transact(m, H2 mailbox)
      %signal 3, 8, 0, text %if m_status # 0
%end

%externalroutine X logoff(%integer filestore)
   %record(fs message fm) m = 0
   %record(fs message fm)%name x
   %record(semaphore fm) s
   %record(mailbox fm) r
   %string(255) text = ""
      !! printstring("Logoff from ");  print symbol(filestore);  newline
      setup semaphore(s)
      setup mailbox(r, s)
      setup message(m, size of(m))
      m_access token = 0
      m_textual response == text
      m_tag = 0
      m_request = old logoff request
      m_request flags = F default request flags
      m_request specific = filestore
      FIO transact(m, H2 mailbox)
      %signal 3, 8, 0, text %if m_status # 0
%end

%externalroutine X quote(%integer filestore, %string(255) pass)
   %record(path fm) p user
   %record(fs message fm) m = 0
   %record(fs message fm)%name x
   %record(semaphore fm) s
   %record(mailbox fm) r
   %string(255) text = ""
      setup semaphore(s)
      setup mailbox(r, s)
      setup message(m, size of(m))
      p user_text = pass
      p user_key == p user_text
      m_access token = 0
      m_textual response == text
      m_tag = 0
      m_request = old quote request
      m_request flags = F default request flags
      m_filename == p user
      m_request specific = filestore
      FIO transact(m, H2 mailbox)
      %signal 3, 8, 0, text %if m_status # 0
%end

%externalroutine X set pass(%integer filestore, %string(255) pass, validator)
   %record(path fm) p user
   %record(fs message fm) m = 0
   %record(fs message fm)%name x
   %record(semaphore fm) s
   %record(mailbox fm) r
   %string(255) text = ""
      setup semaphore(s)
      setup mailbox(r, s)
      setup message(m, size of(m))
      m_access token = 0
      m_tag = 0
      m_textual response == text
      m_textual data == pass
      m_textual data2 == validator
      m_request = old set pass request
      m_request flags = F default request flags
      m_request specific = filestore
      FIO transact(m, H2 mailbox)
      %signal 3, 8, 0, text %if m_status # 0
%end


! SCB interface.  File access token 1 is held in SCB_A, flags in SCB_B
! file token 2 in SCB_C

%externalrecord(scb fm)%map scb open %alias "x_open" %c
                                     (%integer mode, %string(255) filename)
   %record(scb fm)%name scb
   %integer x

   %routine refresh(%record(scb fm)%name scb)
      ! Beware RWT & connect file -- we may have had our buffer
      ! pointers fiddled with.
      %integer block, bytes, offset, blocks, i, j, n, b, expecting
         %signal 9,,, "End of file" %if scb_p >= scb_fl
         %signal 3, 9,, "Corrupt buffer (misaligned)" %c
            %unless (scb_fs - scb_bs) & (block size - 1) = 0
         blocks = (scb_bl - scb_bs) >> block shift
         offset = scb_p - scb_fs;  block = offset >> block shift
         b = scb_bs
         i = blocks;  j = block;  blocks = 0
         !! printstring("Refresh: ");  write(blocks + 1, 1);  write(i, 1)
         !! write(j, 1);  space;  phex(addr(scb));  newline
         %while i > 0 %cycle
            !! printstring("Getting remaining ");  write(i, 0);  newline
            L read N(nil, scb_a, scb_c, j << 9, i << 9, bytes, byteinteger(b))
            -> set pointers %if bytes = 0 %or bytes & (block size - 1) # 0;  ! EOF, presumably
            n = bytes >> block shift;  i = i - n;  j = j + n;  b = b + bytes
            !! printstring("Got ");  write(bytes, 0);  printstring(", ")
            !! write(i, 0);  printstring(" remaining at ")
            !! write(j, 0);  newline
            blocks = blocks + n;  bytes = 0
         %repeat
         expecting = (scb_bl - scb_bs) & (block size - 1)
         %if expecting # 0 %start
            ! Read the remaining short block
            !! printstring("Get remaining (short) ");  write(expecting, 0)
            !! printstring(" from ");  write(block + blocks, 0);  newline
            L read short block(nil, scb_a, scb_c, (block + blocks) << 9,
                               expecting, bytes, byteinteger(b))
         %finish
set pointers:
         !! printstring("Set pointers: ");  write(blocks, 0)
         !! printstring(" + ");  write(bytes, 0);  newline
         scb_fl = scb_bs - block << block shift + scb_fl - scb_fs
         scb_fs = scb_bs - block << block shift
         scb_p = scb_fs + offset
         scb_l = scb_bs + blocks << block shift + bytes
         supply metacharacters(scb_bs, scb_bl) %if scb_b & directory flag # 0
   %end

   %routine flush(%record(scb fm)%name scb, %integer sym)
      %integer block, bytes
         %signal 3, 9,, "Corrupt buffer (misaligned)" %c
            %unless (scb_fs - scb_bs) & (block size - 1) = 0
         %signal 3, 9,, "Corrupt buffer (size)" %c
            %unless scb_bl = scb_bs + write buffer size
         scb_fl = scb_p %if scb_fl < scb_p;  ! Extended file
         block = (scb_bs - scb_fs) >> block shift
         bytes = scb_fl - scb_bs;  bytes = block size %if bytes > block size
         L write block(nil, scb_a, scb_c, block << 9, bytes, byteinteger(scb_bs))
         %if bytes = block size %start
            ! Written the whole block
            scb_fs = scb_fs - block size
            scb_fl = scb_fl - block size
            scb_p = scb_bs
         %finish
         ! Else only a part block, so don't move the window            
         %if sym >= 0 %start
            byteinteger(scb_p) = sym
            scb_p = scb_p + 1
         %finish
   %end

   %routine access file(%string(*)%name file,
                        %record(scb fm)%name scb,
                        %integer mode)
      %integer access mode, compatible mode, flags
         %if mode = input mode %start
            access mode = read file mode
            compatible mode = read file mode
            flags = 0
         %else
            access mode = read file mode ! modify file mode
            compatible mode = 0
            flags = create flag
         %finish
         L open file(nil, file, access mode, compatible mode, flags,
                     scb_a, scb_c, scb_fl, scb_b)
         !! printstring("Accessed ");  printstring(file)
         !! printstring(" using ");  phex(addr(scb))
         !! printstring(", size ");  write(scb_fl, 0);  newline
   %end

   %routine close(%record(scb fm)%name scb, %integer mode)
      flush(scb, -1) %if scb_mode # input mode
      L close file(nil, scb_a, scb_c, auto truncate flag)
      heap put(scb_bs)
   %end

   %routine set in(%record(scb fm)%name scb, %integer pos)
      %signal 2,,, "Seeking off end of file" %unless 0 <= pos <= scb_fl - scb_fs
      scb_p = scb_fs + pos
      scb_l = scb_p %unless scb_bs <= scb_p <= scb_l
   %end

   %routine set out(%record(scb fm)%name scb, %integer pos)
      flush(scb, -1) %unless scb_p = scb_bs
      %signal 2,,, "Seeking off end of file" %unless 0 <= pos <= scb_fl - scb_fs
      scb_p = scb_fs + pos
      refresh(scb)
      scb_p = scb_fs + pos
      !? scb_l = scb_bl
      scb_l = scb_bl {AJS}
   %end

   %routine service(%record(scb fm)%name scb, %integer op, param)
      %switch do(ser closin : ser flush)
         %signal 3, 4, op, "Dud service code" %c
            %unless ser closin <= op <= ser flush
         -> do(op)

do(ser closin):   close(scb, 0);       %return
do(ser closout):  close(scb, 0);       %return
do(ser setin):    set in(scb, param);  %return
do(ser setout):   set out(scb, param); %return
do(ser prompt):                        %return
do(ser dropout):  close(scb, 1);       %return
do(ser refresh):  refresh(scb);        %return
do(ser flush):    flush(scb, param);   %return

   %end

      !! printstring("SCB open ");  printstring(filename)
      !! printstring(", mode ");  write(mode, 0);  newline
      scb == new scb(filename)
      scb_mode = mode
      scb_gla = A4
      *lea service, A0;  *move.l A0, x
      scb_serPC = x
      %if mode = input mode %start
         *lea refresh, A0;  *move.l A0, x
         scb_fastPC = x
         access file(filename, scb, mode)
         scb_bs = heap get(read buffer size)
         scb_bl = scb_bs + read buffer size
         scb_fs = scb_bs
         scb_fl = scb_bs + scb_fl
         scb_p = scb_bs
         scb_l = scb_bs
      %else
         *lea flush, A0;  *move.l A0, x
         scb_fastPC = x
         access file(filename, scb, mode)
         scb_bs = heap get(write buffer size)
         scb_bl = scb_bs + write buffer size
         scb_fs = scb_bs
         scb_fl = scb_bs
         scb_p = scb_bs
         scb_l = scb_bl
      %finish
      %result == scb
%end

%externalrecord(scb fm)%map scb F open %alias "f_open" %c
                                       (%integer mode, %string(255) filename)
   %result == scb open(mode, filename)
%end

%externalrecord(scb fm)%map scb L open %alias "l_open" %c
                                       (%integer mode, %string(255) filename)
   %result == scb open(mode, filename)
%end

%end %of %file