! 1976-spec Filestore filing system

! Provides a collection of procedures performing file operations
! corresponding to the filestore remote commands.  Each operation
! has a corresponding %integerfn, which performs the required filestore
! action and then returns a completion status to its caller.  These
! %fns are prefixed with "FS ".  A number of other procedures are
! also provided which perform miscellaneous operations which are not
! exported as external commands.  These are prefixed with "FSx ".
! All other procedures are intended for internal consumption only.

%option "-nocheck-nostack-low"

%include "Config.Inc"

%include "System:COMMON"
%include "System:Utility.Inc"
%include "System:Schedule.Inc"
%include "System:Errors.Inc"

! Packed culprits
%externalintegerspec err d
%externalintegerspec err n1
%externalintegerspec err n2
%externalintegerspec err pling

%include "Inc:Util.Imp"
!include "I:UTIL.INC"

%ownrecord(common fm)%name common
%externalrecord(common fm)%mapspec common area

%externalroutinespec print client address(%integer context)

! Global parameter -- indicates which (local) port has received the
! file system request (-ve for internal).
%externalinteger ether context = 0

! Write lock on file system:
!     = 0   :  disallow operations which would write to disc
!     # 0   :  allow all operations
! Initially allows all operations.  Cleared down in FSx initialise if
! a disc transfer fails or a directory is corrupt.
%externalinteger file system writeable = 1


! Bitmap manipulation.  Procedures for allocating, deallocating and
! checking disc extents.  Byte operations are performed, where possible,
! with individual bit operations being performed only when this is not
! possible.  Bitmaps are scanned sequentially from the start.....

%routine free extent(%integer start, free size, %bytename bitmap)
   ! Deallocate the blocks specified by <start> and <size>
   %integer i, bit, byte, size
   %bytename b
   %byte x
   %label error
      start = start & h;  free size = free size & h
      size = free size
   !D %if common_diags & fsys diags # 0 %start
   !D    pdate
   !D    printstring("Free ");  write(size, 0)
   !D    printstring(" block");  print symbol('s') %if size # 1
   !D    printstring(" starting at ");  write(start, 0)
   !D    newline
   !D %finish
      %unless 0 <= start < fp size %and size > 0 %c
            %and 0 < start + size <= fp size %start
         pdate
         printstring("*** Free extent -- illegal extent: ")
         write(start, 0);  space;  write(size, 0)
         newline
         %return
      %finish

      ! First the non-byte-aligned part at the start
      bit = start & 7;  byte = start >> 3
      b == bitmap[byte]
      %if bit = 0 %start
         b == b[-1]
      %else
         %while size # 0 %and bit # 0 %cycle
            x = 1 << bit
            -> error %if b & x = 0
            b = b & (\ x)
            bit = (bit + 1) & 7
            size = size - 1
         %repeat
      %finish

      ! Then the byte-aligned part in the middle, taking
      ! it a full byte at a time.
      %while size >> 3 # 0 %cycle
         b == b[1]
         -> error %if b # 255
         b = 0
         size = size - 8
      %repeat

      ! Finally the non-full-byte part at the end.
      ! 0 <= size <= 7 by now.
      bit = 0;  b == b[1]
      %while size > 0 %cycle
         x = 1 << bit
         -> error %if b & x = 0
         b = b !! x
         bit = bit + 1
         size = size - 1
      %repeat
      %return

error:
      ! Come here if any of the blocks weren't allocated
      %for i = 0, 1, last partition %cycle
         ! Decide which partition we were dealing with
         %if bitmap == common_partition(i)_bitmap_b(0) %start
            pdate
            printstring("Extent not claimed: ")
            write(i,                0);  print symbol(':')
            write(start,            0);  print string(" (")
            write(free size,        0);  print string("):")
            write(free size - size, 0)
            newline
            %return
         %finish
      %repeat
      ! Fall through here if we couldn't find which partition
      ! the bitmap corresponded to.
      pdate
      printstring("*** Unknown bitmap -- extent not claimed: ")
      write(start, 0);  printstring(" (")
      write(size,  0);  print symbol(')')
      newline
%end

%predicate check and allocate(%integer start, size, %bytename bitmap)
   ! Check if the any of the extent specified by <start> and
   ! <size> has been allocated.  Mark it as allocated, regardless.
   ! NB should only be called during file system initialisation.
   %integer set = 0, bit, byte
   %bytename b
   %byte x
      start = start & h;  size = size & h
      %unless 0 <= start < fp size %and size > 0 %c
            %and 0 < start + size <= fp size %start
         pdate
         printstring("*** Check and allocate -- illegal extent: ")
         write(start, 0);  space;  write(size, 0)
         newline
         %false
      %finish

      ! First the non-byte-aligned part at the start
      bit = start & 7;  byte = start >> 3
      b == bitmap[byte]
      %if bit = 0 %start
         b == b[-1]
      %else
         %while size > 0 %and bit # 0 %cycle
            x = 1 << bit
            set = 1 %if b & x # 0
            b = b ! x
            bit = (bit + 1) & 7
            size = size - 1
         %repeat
      %finish

      ! Then the byte-aligned part in the middle, taking
      ! it a full byte at a time.
      %while size >> 3 # 0 %cycle
         b == b[1]
         set = 1 %if b # 0
         b = 255
         size = size - 8
      %repeat

      ! Finally the non-full-byte part at the end
      ! 0 <= size <= 7 by now
      bit = 0;  b == b[1]
      %while size > 0 %cycle
         x = 1 << bit
         set = 1 %if b & x # 0
         b = b ! x
         bit = bit + 1
         size = size - 1
      %repeat
      %if set = 0 %then %false %else %true
%end

%routine allocate extent(%integer desired, %bytename bitmap,
                         %integername actual, start)
   ! Try to allocate <desired> contiguous blocks in <bitmap>
   ! returning <actual> and <start> to indicate result.
   ! Allocate largest possible if no extent would be enough.
   ! <start> < 0 indicates that the disc is full.
   %integer pos, biggest, biggest pos, found, size, bit, byte
   %bytename b
   %byte x
   %label try again, got one, done, the lot, no more

   !D %if common_diags & fsys diags # 0 %start
   !D    pdate
   !D    printstring("Allocate ");  write(desired, 0)
   !D    newline
   !D %finish

      desired = 8192 %if desired > 8192
      pos = 0;  biggest = 0

try again:
      ! Find the first unallocated block in the bitmap.
      ! First look at the non-byte-aligned part, starting
      ! at the current position.
      -> no more %if pos > fp size
      byte = pos >> 3;  bit = pos & 7
      b == bitmap[byte]
      %if bit = 0 %start
         b == b[-1]
      %else
         %while size # 0 %and bit # 0 %cycle
            -> got one %if b & (1 << bit) = 0
            bit = (bit + 1) & 7
            pos = pos + 1
            -> no more %if pos > fp size
         %repeat
      %finish

      ! Then the byte-aligned part in the middle, taking
      ! it a full byte at a time.
      %cycle
         b == b[1]
         %exit %if b # 255
         pos = pos + 8
         -> no more %if pos > fp size
      %repeat

      ! A block was unallocated somewhere in the last byte
      ! checked.  Find it.
      bit = 0
      %cycle
         -> got one %if b & (1 << bit) = 0
         ! Must be true somewhere, since b # 255
         bit = bit + 1
         pos = pos + 1
      %repeat

got one:
      ! Found an unallocated block.  Now find out how many
      ! contiguous blocks there are.
      found = pos
      size = 0

      ! First the non-byte-aligned part at the start
      bit = pos & 7;  byte = pos >> 3
      b == bitmap[byte]
      %if bit = 0 %start
         b == b[-1]
      %else
         %while bit # 0 %cycle
            %if b & (1 << bit) = 0 %then size = size + 1 %c
                                   %else -> the lot
            bit = (bit + 1) & 7
         %repeat
      %finish

      ! Then the byte-aligned part in the middle, taking it
      ! a full byte at a time
      %cycle
         b == b[1]
         %exit %if b # 0
         size = size + 8
         -> the lot %if size >= desired
      %repeat

      ! One of the blocks in the last byte was allocated.  Find
      ! out how many were unallocated.
      bit = 0
      %cycle
         x = 1 << bit
         %if b & (1 << bit) = 0 %then size = size + 1 %c
                                %else -> the lot
         ! %else part holds somewhere, since b # 0
         bit = bit + 1
      %repeat

the lot:
      ! We now know how large the unallocated hole was.
      ! Determine if it is big enough.  If not, was it bigger than
      ! the largest we already know about?
      %if size >= desired %start
         ! Big enough
         actual = size
         start = found
         -> done
      %finish
      %if size > biggest %start
         ! Larger than the ones we already know about
         biggest = size
         biggest pos = found
      %finish
      ! Now set a new starting position and go looking for another
      ! unallocated hole.
      pos = found + size
      -> try again

no more:
      ! We've searched the entire bitmap for a large enough
      ! hole.  We'll just have to return the largest we know about,
      ! since there weren't any sufficiently large.
      %if biggest = 0 %start
         ! No holes found!?  The partition must be full
         start = -1
         actual = -1
         %return
      %else
         ! The largest we know about
         start = biggest pos
         actual = biggest
      %finish

done:
      ! We've found our hole.  Now mark it all as allocated.
      ! First the non-byte-aligned part at the start.
      size = actual
      pos = start
      bit = pos & 7;  byte = pos >> 3
      b == bitmap[byte]
      %if bit = 0 %start
         b == b[-1]
      %else
         %while size # 0 %and bit # 0 %cycle
            x = 1 << bit
            b = b ! x
            bit = (bit + 1) & 7
            size = size - 1
         %repeat
      %finish

      ! Then the byte-aligned part in the middle, taking
      ! it a full byte at a time.
      %while size >> 3 # 0 %cycle
         b == b[1]
         b = 255
         size = size - 8
      %repeat

      ! Finally the non-full-byte part at the end.
      ! 0 <= size <= 7 by now.
      bit = 0;  b == b[1]
      %while size > 0 %cycle
         x = 1 << bit
         b = b ! x
         bit = bit + 1
         size = size - 1
      %repeat
%end


! Special buffer allocation/deallocation.  Special buffers are used
! to implement pseudo-files, such as DIRECTORY and all the ones
! "owned" by user $.

%owninteger special mask = 0

%integerfn allocate special
   ! Find a free special buffer
   %integer i, x
      %for i = 1, 1, specials %cycle
         ! Scan the allocation map, looking for a free one.
         x = 1 << i
         %if special mask & x = 0 %start
            ! Found one.  Allocate it, zap it and
            ! return its index.
            special mask = special mask ! x
            common_specials(i) = 0
            %result = i
         %finish
      %repeat
      %result = no buffer
%end

%routine free special(%integer which)
   ! Mark a special buffer as free.
   special mask = special mask & (\ (1 << which))
%end

%routine add special(%record(special fm)%name b, %string(255) text)
   ! Add text to special buffer b, character at a time until either
   ! the text is exhausted or we have run out of buffer.
   %integer i, j
      j = b_bytes
      %if text # "" %start
         %for i = 1, 1, length(text) %cycle
            j = j + 1
            b_b(j) = charno(text, i)
            %exit %if j = 4096
         %repeat
      %finish
      b_bytes = j
%end

%routine spaces special(%record(special fm)%name b, %integer n)
   ! Add n spaces to special buffer b.
   %integer j
      j = b_bytes
      %while n > 0 %cycle
         j = j + 1
         b_b(j) = ' '
         %exit %if j = 4096
         n = n - 1
      %repeat
      b_bytes = j
%end


! Disc I/O requests

%include "SYSTEM:CACHE.INC"

%integerfn read block(%integer partition, %integer block,
                      %record(buffer fm)%name buffer)
   ! Read the specified block from the specified partition into
   ! the buffer provided.  Note that the block address is given
   ! within the partition, not absolutely -- this allows an extra
   ! consistency check.
   block = block & h
!D %if common_diags & disc diags # 0 %start
!D    pdate
!D    printstring("Read block ");  write(block, 0)
!D    printstring(" from partition ");  write(partition, 0)
!D    newline
!D %finish
   ! Check that the specified block lies within the specified
   ! partition's boundaries.
   %result = data address error %unless 0 <= block < fp size
   ! Bump the monitor count and do the transfer
   common_monitor_file reads = common_monitor_file reads + 1
   %result = make disc request(1, p start(partition) + block,
                               addr(buffer_b(0)), D read, 0)
%end

%integerfn write block(%integer partition, %integer block,
                       %record(buffer fm)%name buffer)
   ! Write and verify the specified block.  Much the same as
   ! read block.
   block = block & h
!D %if common_diags & disc diags # 0 %start
!D    pdate
!D    printstring("Write block ");  write(block, 0)
!D    printstring(" to partition ");  write(partition, 0)
!D    newline
!D %finish
   %result = data address error %unless 0 <= block < fp size
   common_monitor_file writes = common_monitor_file writes + 1
   %result = make disc request(1, p start(partition) + block,
                               addr(buffer_b(0)), D write ! D verify, 0)
%end

%integerfn read directory(%record(dir info fm)%name dir)
   ! Read and verify the reqired directory.  Much the same as
   ! read block, above.
!D %if common_diags & disc diags # 0 %start
!D    pdate
!D    printstring("Read directory ")
!D    write(dir_partition, 0);  print symbol('.')
!D    write(dir_user no, 0)
!D    newline
!D %finish
   %result = directory address error %unless 0 < dir_user no <= u per p %c
      %and 0 <= dir_partition <= last partition
   common_monitor_dir reads = common_monitor_dir reads + 1
   %result = make disc request(4, pd start(dir_partition) + 4 * dir_user no - 4,
                               addr(dir_d), D read ! D verify, 1)
%end

%integerfn write directory(%record(dir info fm)%name dir)
   ! Write and verify the specified directory.  Again, much the
   ! same as read block.
!D %if common_diags & disc diags # 0 %start
!D    pdate
!D    printstring("Write directory ")
!D    write(dir_partition, 0);  print symbol('.')
!D    write(dir_user no, 0)
!D    newline
!D %finish
   %result = directory address error %unless 0 < dir_user no <= u per p %c
      %and 0 <= dir_partition <= last partition
   common_monitor_dir writes = common_monitor_dir writes + 1
   %result = make disc request(4, pd start(dir_partition) + 4 * dir_user no - 4,
                               addr(dir_d), D write ! D verify, 1)
%end

%integerfn read system block(%integer block, count, %record(*)%name buffer)
   ! Read and verify blocks from the system area at the end of the
   ! disc (currently only the bad block lists and system password live there).
   %if common_diags & disc diags # 0 %start
      pdate
      printstring("Read system block ");  write(block, 0)
      printstring(" (");  write(count, 0);  print symbol(')')
      newline
   %finish
   %result = size error %if count <= 0
   %result = data address error %if block < 0 %c
                                %or block + count > head size
   %result = make disc request(count, sy2 start + block, addr(buffer), %c
                               D read ! D verify, 0)
%end

%integerfn write system block(%integer block, count, %record(*)%name buffer)
   ! Write and verify blocks to the system area.
   %if common_diags & disc diags # 0 %start
      pdate
      printstring("Write system block ");  write(block, 0)
      printstring(" (");  write(count, 0);  print symbol(')')
      newline
   %finish
   %result = size error %if count <= 0
   %result = data address error %if block < 0 %c
                                %or block + count > head size
   %result = make disc request(count, sy2 start + block, addr(buffer), %c
                               D write ! D verify, 0)
%end


%integerfn read boot area(%integer block, %bytename buffer)
   ! Read and verify blocks from the system area at the start of the
   ! disc (the boot area).
   %if common_diags & disc diags # 0 %start
      pdate
      printstring("Read boot block ");  write(block, 0)
      newline
   %finish
   %result = data address error %unless 0 <= block < head size
   %result = make disc request(1, sy1 start + block, addr(buffer), %c
                               D read ! D verify, 0)
%end

%integerfn write boot area(%integer block, %bytename buffer)
   ! Write and verify blocks to the boot area.
   %if common_diags & disc diags # 0 %start
      pdate
      printstring("Write boot block ");  write(block, 0)
      newline
   %finish
   %result = data address error %unless 0 <= block < head size
   %result = make disc request(1, sy1 start + block, addr(buffer), %c
                               D write ! D verify, 0)
%end


! Bad block list handling.  Four copies of the bad block lists are
! maintained in the system area on the disc.  They are all read in
! and the one with the highest stamp value us used.

%constinteger bad limit = 512 - 3
%recordformat bad fm((%integer stamp, %integerarray bad(1 : bad limit),
                      %integer last bad, checksum) %c
                 %or %integerarray x(1 : 512))

%%ownrecord(bad fm)%array bad blocks(1 : 4) = 0(*)
%ownrecord(bad fm)%name bad block list

%owninteger newest bad block list = -1

%externalrecord(bad fm)%spec dc bad list

%integerfn bad checksum(%record(bad fm)%name b)
   ! Calculate the checksum for the bad block lists
   %integer i, c
      c = 0
      c = c + b_x(i) %for i = 1, 1, 512
      %result = c
%end

%routine read bad block list
   ! Read the bad block lists, verify their checksums, and note
   ! the one with the highest stamp.
   %integer i, x, stamp, check
      %for i = 1, 1, 4 %cycle
         ! First get all the lists
         x = read system block(bad area(i), 4, bad blocks(i))
         %if x # success %start
            ! Failed to read this one.  Zap the store copy.
            pdate
            printstring("*** Failed to read bad block area ");  write(i, 0)
            newline
            bad blocks(i) = 0
         %finish
      %repeat
      stamp = -1
      %for i = 1, 1, 4 %cycle
         ! Now validate the checksums (should be zero) and
         ! find which list has the highest stamp.
         bad block list == bad blocks(i)
         check = bad checksum(bad block list)
         %if check # 0 %start
            pdate
            printstring("*** Bad block area ");  write(i, 0)
            printstring(" checksum error")
            newline
         %else %if bad block list_stamp > stamp
            stamp = bad block list_stamp
            newest bad block list = i
         %finish
      %repeat
      %if stamp < 0 %start
         ! Disaster.  Log it, then protect the file system.
         pdate
         printstring("*** No readable bad block list")
         newline
         bad block list == nil
         file system writeable = 0
      %else
         ! Found one useable one.
         bad block list == bad blocks(newest bad block list)
         pdate
         printstring("Bad block list ");  write(newest bad block list, 0)
         printstring(" shows ");  write(bad block list_last bad, 0)
         printstring(" error")
         print symbol('s') %if bad block list_last bad # 1
         print symbol(':');  newline
         %for i = 1, 1, bad block list_last bad %cycle
            write(bad block list_bad(i), 7)
            newline %if i & 15 = 0
         %repeat
         newline %if bad block list_last bad & 15 # 0
         dc bad list = bad block list
      %finish
%end

%routine add to bad block list(%integer block)
   ! Dynamically add a block to a one of the bad block
   ! lists, bumping its stamp.
   %integer i, x, oldest, oldest stamp
      %if bad blocks(newest bad block list)_last bad = bad limit %start
         pdate
         printstring("*** Bad block list is full -- failed to add ")
         write(block, 0)
         newline
         %return
      %finish
      oldest stamp = infinity
      %for i = 1, 1, 4 %cycle
         %if i # newest bad block list %c
               %and bad blocks(i)_stamp < oldest stamp %start
            oldest = i
            oldest stamp = bad blocks(i)_stamp
         %finish
      %repeat
      bad blocks(oldest) = bad blocks(newest bad block list)
      bad block list == bad blocks(oldest)
      %for i = bad block list_last bad, -1, 1 %cycle
         %if bad block list_bad(i) > block %start
            bad block list_bad(i + 1) = bad block list_bad(i)
         %else %if bad block list_bad(i) = block
            pdate
            printstring("*** Block ");  write(block, 0)
            printstring(" already in bad block list ")
            write(oldest, 0);  newline
            bad block list_stamp = 0;  ! Reuse this one -- it's corrupted
            bad block list == bad blocks(newest bad block list)
            %return
         %else
            bad block list_bad(i + 1) = block
            -> inserted
         %finish
      %repeat
      bad block list_bad(1) = block
inserted:
      bad block list_last bad = bad block list_last bad + 1
      bad block list_stamp = bad block list_stamp + 1
      bad block list_checksum = 0
      bad block list_checksum = -bad checksum(bad block list)
      dc bad list = bad block list
      newest bad block list = oldest
      x = write system block(bad area(oldest), 4, bad block list)
      %if x # success %start
         pdate
         printstring("*** Failed to write bad block list (")
         write(oldest, 0);  print symbol(')')
         newline
         %return
      %finish
      pdate
      printstring("*** Bad block ");  write(block, 0)
      printstring(" inserted in bad block list ");  write(oldest, 0)
      newline
%end

%routine P reach add to bad block list(%integer partition, block)
   ! Required because the compiler can't reach otherwise....
   add to bad block list(p start(partition) + block)
%end

%recordformat pass fm((%integer pass1, pass2) %c
                  %or %integerarray x(1 : 128))

%integerfn set system pass(%integer new pass)
   %record(pass fm) p = 0
   %integer x, OK = 0
      p_pass1 = new pass
      p_pass2 = -new pass
      x = write system block(pass area(1), 1, p)
      %if x # success %start
         pdate
         printstring("***Failed to write pass area 1");  newline
         OK = x
      %finish
      x = write system block(pass area(2), 1, p)
      %if x # success %start
         pdate
         printstring("***Failed to write pass area 2");  newline
         OK = x
      %finish
      %result = x %if x # success
      common_system pass = new pass
      %result = success
%end

%routine get system pass(%integername pass)
   %record(pass fm) p = 0
   %integer x, p1, p2, i, j
      x = read system block(pass area(1), 1, p)
      %if x # success %start
         pdate
         printstring("***Failed to read pass area 1");  newline
         p1 = 0
      %else
         j = 0
         j = j + p_x(i) %for i = 1, 1, 128
         %if j = 0 %start
            p1 = p_pass1
         %else
            pdate
            printstring("*** Checksum error for pass area 1")
            newline
            p1 = 0
         %finish
      %finish
      x = read system block(pass area(2), 1, p)
      %if x # success %start
         pdate
         printstring("***Failed to read pass area 2");  newline
         p2 = 0
      %else
         j = 0
         j = j + p_x(i) %for i = 1, 1, 128
         %if j = 0 %start
            p2 = p_pass1
         %else
            pdate
            printstring("*** Checksum error for pass area 2")
            newline
            p2 = 0
         %finish
      %finish
      %if 0 # p1 = p2 %start
         pass = p1
      %else
         pdate
         printstring("*** Password areas disagree")
         newline
         %if p1 # 0 %start
            pass = p1
         %else %if p2 # 0
            pass = p2
         %else
            pdate
            printstring("*** Password not set")
            newline
         %finish
      %finish
%end


! Miscellaneous file system constants

%constinteger dollars      = 16_F9FF;                 ! $$$ packed
%constinteger dots         = 16_F396;                 ! ... packed

%constinteger subliminal 1 = dollars << 16 ! dots;    ! $$$...
%constinteger subliminal 2 = dots    << 16 ! dots;    ! ......

%constinteger ANON         = 16_087F5780;             ! ANON packed
%constinteger GDMR         = 16_2C6D7080;             ! Ditto GDMR
%constinteger RWT          = 16_742C0000;             ! ... RWT
%constinteger SYSTEM       = 16_7ABB7DD5;             ! ... SYSTEM

%constinteger temporary    = 62400;                   ! $ packed

%constinteger F permission = 3
%constinteger R permission = 2
%constinteger O permission = 1
%constinteger N permission = 0

%constinteger owner  permission shift = 14
%constinteger public permission shift = 12
%constinteger archive bit       shift = 11
%constinteger log     bit       shift = 10

%constinteger log bit = 1 << log bit shift

! Fields are: owner access; public access; archive; log; pseudo-user; size
!                                  OO PP A L P ---size----
%constinteger files       mask = 2_00 00 0 0 0 0 1111 1111
%constinteger bytes       mask = 2_00 00 0 0 0 1 1111 1111
%constinteger permissions mask = 2_11 11 1 1 0 0 0000 0000 ! 16_FFFF0000
%constinteger FRA              = 2_11 10 1 0 0 0 0000 0000 ! 16_FFFF0000
%constinteger FNA              = 2_11 00 1 0 0 0 0000 0000 ! 16_FFFF0000
                                                             {** FRIG **}
%constinteger pseudo user      = 2_00 00 0 0 1 0 0000 0000

%constinteger time        mask = 2_0000 0 111 1111 1111

%constinteger transient file   = 16_8000 ! 16_FFFF0000       {** FRIG **}
%constinteger dud       file   = 16_4000


! Miscellaneous utility stuff

%routine stamp(%record(stamp fm)%name s)
   ! Fill a time stamp record with the current date/time
   time stamp(s_date, s_time)
%end

%string(31)%fn show stamp(%record(stamp fm)%name s)
   ! Unpack the contents of a time stamp record
   %result = unpack date(s_date) . " " . unpack time(s_time)
%end

%string(3)%fn unpack perms(%short mask)
   ! Unpack the permissions fields from a proterction mask
   %conststring(1)%array p(0 : 3) = "N", "O", "R", "F"
   %conststring(1)%array a(0 : 1) = "V", "A"
      %result = p(mask >> owner  permission shift & 3) . %c
                p(mask >> public permission shift & 3) . %c
                a(mask >> archive bit       shift & 1)
%end

%routine pad(%integer desired, %record(buffer fm)%name b)
   ! Pad a buffer to the desired size by adding trailing spaces
   %integername bytes
      bytes == b_bytes
      b_b(bytes) = ' ' %and bytes = bytes + 1 %while bytes < desired
%end

%routine add text(%string(255) s, %record(buffer fm)%name b)
   ! Add text to a buffer
   %integer i, j
      j = b_bytes
      %if s # "" %start
         %for i = 1, 1, length(s) %cycle
            b_b(j) = charno(s, i)
            j = j + 1
         %repeat
      %finish
      b_bytes = j
%end


! File system procedures start here.....

%integerfn file size(%integer which, %record(directory fm)%name dir,
                     %integername blocks, extents)
   ! Find the number of blocks and extents in the specified file.
   %record(entry fm)%name f
   %integer p extents, files, i
      files = dir_header_files & files mask
      %unless 0 <= files <= file limit %start
         ! Directory claims to have too many files in it.
         pdate
         printstring("*** Directory ")
         printstring(unpack(dir_header_owner, 0))
         printstring(" corrupt (file size): bad file limit ")
         write(files, 0)
         printstring(" (");  write(file limit, 0)
         print symbol(')')
         newline
         err d = dir_header_owner
         err n1 = 0;  err n2 = 0;  err pling = 0
         %result = directory corrupt & xs error
      %finish
      %if files * 4 >= dir_file(files)_extents %start
         ! Files and extents overlap.
         pdate
         printstring("*** Directory ")
         printstring(unpack(dir_header_owner, 0))
         printstring(" corrupt (file size): overlap ")
         write(files, 0)
         write(dir_file(files)_extents, 1)
         newline
         err d = dir_header_owner
         err n1 = 0;  err n2 = 0;  err pling = 0
         %result = directory corrupt & xs error
      %finish
      %result = file not found %unless 0 < which <= files
      ! We know the file slot is valid, so find the extents and
      ! count them up....
      f == dir_file(which)
      %if which = 1 %start
         p extents = extent limit + 1
      %else
         p extents = dir_file(which - 1)_extents
      %finish
      blocks = 0
      i = f_extents
      %while i < p extents %cycle
         blocks = blocks + (dir_extent(i)_size & h)
         i = i + 1
      %repeat
      extents = p extents - f_extents
      %result = success
%end

%integerfn delete file(%integer slot, %record(dir info fm)%name dir info)
   ! Delete the file in the specified slot of the directory supplied.
   ! Free the allocated extents then shuffle those belonging to the other
   ! files in the directory so as to obliterate them.  Note that it is OK
   ! to do things in this order, since if we crash before the directory has
   ! been written out then when we are rebooted the file will exist in its
   ! pre-deletion state.  We assume that the user has the requisite
   ! authority to delete files from the directory.
   %record(Xno info fm)%name Xno info
   %record(extent fm)%name e
   %record(header fm)%name h
   %record(entry fm)%name f
   %integer files, extents, p extents, t extents, i, q restore, x
   %bytename bitmap
      %result = not writeable %if file system writeable = 0
   !D %if common_diags & fsys diags # 0 %start
   !D    pdate
   !D    printstring("Delete file ");  write(slot, 0)
   !D    newline
   !D %finish
      h == dir info_d_header
      files = h_files & files mask
      %unless 0 < slot <= files %start
         ! Specified file slot is outwith the range of those
         ! which would be legal in this directory
         pdate
         printstring("*** Directory ")
         printstring(unpack(dir info_d_header_owner, 0))
         printstring(" corrupt (delete): bad file slot ")
         write(slot, 0)
         printstring(" (");  write(files, 0)
         print symbol(')')
         newline
         err d = dir info_d_header_owner
         err n1 = 0;  err n2 = 0;  err pling = 0
         %result = directory corrupt & xs error
      %finish
      %if files * 4 >= dir info_d_file(files)_extents %start
         ! Files and extents overlap in directory
         pdate
         printstring("*** Directory ")
         printstring(unpack(dir info_d_header_owner, 0))
         printstring(" corrupt (delete): overlap ")
         write(files, 0)
         write(dir info_d_file(files)_extents, 1)
         newline
         err d = dir info_d_header_owner
         err n1 = 0;  err n2 = 0;  err pling = 0
         %result = directory corrupt & xs error
      %finish
      f == dir info_d_file(slot)
      ! Check that user has full owner authority
      %result = no authority %c
         %unless f_perms >> owner permission shift & 3 = F permission
      %for i = 1, 1, Xnos %cycle
         ! If the file is currently open somewhere then we must
         ! leave it around until the transaction is closed.  We
         ! transform it into a special temporary ($$$.........)
         ! whence it will be deleted at some future date.  Note that
         ! this is the only case where files with duplicate names
         ! can come to exist in a directory.
         Xno info == common_Xno(i)
         %if Xno info_Uno >= 0 %and Xno info_dir info == dir info %c
               %and Xno info_file slot = slot %start
            ! Found it owned by some Xno, so merely change its name.
            ! Note that this may involve a quota adjustment.
         !D %if common_diags & fsys diags # 0 %start
         !D    pdate
         !D    printstring("Open as Xno ");  write(i, 0)
         !D    printstring(", -> Subliminal")
         !D    newline
         !D %finish
            %if f_name1 >> 16 < temporary %c
                  %and f_status & transient file = 0 %start
               ! Must restore quota
               x = file size(slot, dir info_d, t extents, q restore)
               %result = x %if x # success
               dir info_d_header_quota left = dir info_d_header_quota left %c
                                              + q restore
            %finish
            f_name1 = subliminal 1
            f_name2 = subliminal 2
            dir info_written = 1
            %result = 1  {** Special for Logoff **}
         %finish
      %repeat
      ! Find extent limit for file
      %if slot = 1 %then p extents = extent limit + 1 %c
                   %else p extents = dir info_d_file(slot - 1)_extents
      f == dir info_d_file(slot)
      bitmap == common_partition(dir info_partition)_bitmap_b(0)
      q restore = 0
      %for i = f_extents, 1, p extents - 1 %cycle
         ! Cycle round freeing file's extents, counting up the
         ! blocks used in case the user's quota requires adjustment
         e == dir info_d_extent(i)
         q restore = q restore + e_size
         %if e_size = 0 %start
            ! Found an extent with no blocks allocated
         !! %if f_extents # p extents - 1 %start
               ! More than one extent to the file.  Complain.
               pdate
               printstring("*** Delete file ")
               printstring(unpack(dir info_d_header_owner, 0))
               print symbol(':')
               printstring(unpack(f_name1, f_name2))
               printstring(" -- illegal null extent")
               newline
         !! %finish
            ! Else must be null file -- treat it as OK, since we may
            ! have decided that null files are allowable (see close).
         %else
            ! Free the extent if the file didn't overlap another
            ! somewhere (shouldn't happen, of course.....)
            free extent(e_start, e_size, bitmap) %if f_status & dud file = 0
            e_start = 0;  e_size = 0;  ! Just in case....
         %finish
      %repeat
      ! Restore user's quota if this wasn't a temporary file
      h_quota left = h_quota left + q restore %c
         %if f_name1 >> 16 < temporary %and f_status & transient file = 0
      %if slot = files %start
         ! File occupies most recent slot in directory.  Easy case, 
         ! do it as a special.
         h_files = h_files - 1
         dir info_written = 1
         %result = success
      %finish
      ! Not the last in the directory, so we must shuffle....
      t extents = dir info_d_file(files)_extents
      extents = p extents - f_extents
      %if extents # 0 %start
         dir info_d_extent(i + extents) = dir info_d_extent(i) %c
            %for i = f_extents - 1, -1, t extents
      %finish
      %for i = slot + 1, 1, files %cycle
         f == dir info_d_file(i - 1)
         f = dir info_d_file(i)
         f_extents = f_extents + extents
      %repeat
      ! One fewer files now, of course.
      h_files = h_files - 1
      dir info_written = 1
      ! Since we've moved some files in the directory we have to check
      ! all the Xno records, since they refer to files by directory slot.
      ! If we find any referring to a shuffled file then we must adjust it.
      %for i = 1, 1, Xnos %cycle
         Xno info == common_Xno(i)
         %if Xno info_dir info == dir info %start
            ! Xno refers to this directory.  Adjust the Xno.
            Xno info_file slot = Xno info_file slot - 1 %c
               %if Xno info_file slot > slot
         %finish
      %repeat
      %result = success
%end

%integerfn directory stamp
   ! LRU stamp for directory cache
   %owninteger stamp = 0
      stamp = stamp + 1
      %result = stamp
%end

%integerfn get directory(%integer owner, partition, user no)
   ! Find a directory in the cache.  Bring it in if it isn't
   ! already there.  <owner> is packed username.  <user no> is
   ! user's slot in the user register.
   %integer i, possible = -1, files
   %integer stamp = infinity
   %record(dir info fm)%name d
   %record(entry fm)%name file
      %result = directory address error %unless 0 < user no <= u per p %c
         %and 0 <= partition <= last partition
      ! First of all, have a look through the cache for the directory.
      ! If we find it bump its reference count and return its cache index.
      ! On the fly, note the least recently used directory with a zero
      ! reference count, in case we need one to throw out.....
      %for i = 1, 1, dirs %cycle
         d == common_dir info(i)
         %if d_owner = owner %start
            ! Found the directory in the cache
            d_ref count = d_ref count + 1
            d_stamp = directory stamp
            %result = i
         %else %if d_ref count = 0 %and d_stamp < stamp
            ! Not this one, but it does have a zero ref count
            possible = i
            stamp = d_stamp
         %finish
      %repeat
      %result = no buffer %if possible < 0
      ! We didn't find the directory, but we did find a candidate
      ! for replacement.  Note our interest in the slot, then get
      ! the directory in off the disc.
      d == common_dir info(possible)
      d_partition = partition
      d_user no   = user no
      d_ref count = 1
      d_owner     = owner
      d_written   = 0
      d_stamp     = directory stamp
      i = read directory(d)
      %result = i %if i < 0
      ! Now some consistency checks on the directory contents.
      %if 0 # d_d_header_directory size # directory size %start
         ! Directory size is wrong.  It should have been 0 or 2048.
         ! We really want to use this field for something more useful,
         ! such as a checksum....
         pdate
         printstring("*** Directory ")
         printstring(unpack(d_d_header_owner, 0))
         printstring(" corrupt (get directory): bad size ")
         write(d_d_header_directory size, 0);  newline
       ! err d = d_d_header_owner
       ! err n1 = 0;  err n2 = 0;  err pling = 0
       ! %result = directory corrupt & xs error
      %finish
      files = d_d_header_files & files mask
      %unless 0 <= files <= file limit %start
         ! Directory claims to have an unreasonable number of
         ! files in it.
         pdate
         printstring("*** Directory ")
         printstring(unpack(d_d_header_owner, 0))
         printstring(" corrupt (get directory): bad file limit ")
         write(files, 0)
         printstring(" (");  write(file limit, 0)
         print symbol(')')
         newline
         err d = d_d_header_owner
         err n1 = 0;  err n2 = 0;  err pling = 0
         %result = directory corrupt & xs error
      %finish
      %if files # 0 %start
         %if files * 4 >= d_d_file(files)_extents %start
            ! Files and extents overlap.
            pdate
            printstring("*** Directory ")
            printstring(unpack(d_d_header_owner, 0))
            printstring(" corrupt (get directory): overlap ")
            write(files, 0)
            write(d_d_file(files)_extents, 1)
            newline
            err d = d_d_header_owner
            err n1 = 0;  err n2 = 0;  err pling = 0
            %result = directory corrupt & xs error
         %finish
      %finish
      %result = possible
%end

%routine remember directory(%record(dir info fm)%name d)
   ! We have been handed a pointer to the directory record
   ! by somebody.  Note our interest in case it goes away
   ! while we are still interested in it.
   d_ref count = d_ref count + 1
   d_stamp = directory stamp
%end

%integerfn forget directory(%record(dir info fm)%name d)
   ! We are no longer interested in this directory.  Decrement the
   ! ref count.  Delete temporaries if it goes to zero.  Write
   ! out the directory if the written flag is set.
   %record(entry fm)%name file
   %record(header fm)%name header
   %integer i, k
   %integer x = success
      %if d_ref count <= 0 %start
         ! Reference count is just about to go negative?!
         pdate
         printstring("*** Refcount going negative for ")
         printstring(unpack(d_owner, 0))
         newline
         d_ref count = 2;  ! Lock it down forever more (we hope!)
         !? %result = refcount negative
      %finish
      %if d_ref count = 1 %start
         ! We are the last lot to have had an interest in
         ! the directory, so we now run around deleting
         ! temporaries and transients.
         header == d_d_header
         i = 1
         %while i <= header_files & files mask %cycle
            file == d_d_file(i)
            %if file_name1 >> 16 >= temporary %or %c
                  file_status & transient file # 0 %start
               k = delete file(i, d)
               %if common_diags & fsys diags # 0 %start
                  pdate
                  printstring("Delete file: ")
                  write(k, 0)
                  newline
               %finish
               i = i + 1 %if k # success
               ! Note that the above condition will also hold
               ! if the file being "deleted" was successfully
               ! turned into $$$......... -- this shouldn't
               ! happen, of course, since it implies that
               ! someone else has an unregistered interest
               ! in the directory......
               d_written = 1
            %else
               i = i + 1
            %finish
         %repeat
      %finish
      ! Write the directory if the written flag is set.  Only clear
      ! it if the write succeeded.
      x = write directory(d) %if d_written # 0
      d_written = 0 %if x = success
      ! Finally, register that we are no longer interested in the
      ! directory by decrementing the reference count, and as a
      ! parting gesture set the LRU stamp.
zz:   d_ref count = d_ref count - 1
      d_stamp = directory stamp
      %result = x
%end

%externalroutine FSx display directory
   ! Dump a directory's contents onto the console.
   %record(dir info fm)%name dir info
   %record(directory fm)%name d
   %record(entry fm)%name file
   %record(header fm)%name header
   %record(extent fm)%name extent
   %string(127) s
   %integer x, i, j
      prompt("Directory: ");  read(x)
      %return %unless 0 < x <= dirs
      dir info == common_dir info(x)
      d == dir info_d
      header == d_header
      printstring("Directory ");  printstring(unpack(header_owner, 0))
      newline
      %if header_files & files mask = 0 %start
         printstring("No files");  newline
         %return
      %finish
      x = extent limit
      %for i = 1, 1, header_files & files mask %cycle
         file == d_file(i)
         printstring("File ");  write(i, 0);  printstring(": ")
         printstring(unpack(file_name1, file_name2))
         print symbol('?') %if file_status & dud       file # 0
         print symbol('!') %if file_status & transient file # 0
         newline
         %for j = file_extents, 1, x %cycle
            extent == d_extent(j)
            printstring("   Extent ");  write(j - file_extents, 2)
            printstring(" (");  write(j, 2);  printstring(")  ")
            write(extent_start & h, 5);  write(extent_size, 5)
            newline
         %repeat
         x = file_extents - 1
      %repeat
%end

%integerfn allocate Uno
   ! Allocate a Uno record for the user.  Unallocated ones are
   ! known by having a null (packed) logged-on owner.
   %record(Uno info fm)%name Uno info
   %integer i
      %for i = 1, 1, Unos %cycle
         ! Try them all....
         Uno info == common_Uno(i)
         %if Uno info_l owner = 0 %start
            ! Got one.  Mark it as in use (with an invalid owner
            ! name) and return the Uno slot to the caller
            Uno info_l owner = -1
            stamp(Uno info_logon stamp)
            Uno info_active stamp = Uno info_logon stamp
            Uno info_Xno active stamp = 0
            %result = i
         %finish
      %repeat
      %result = no Uno
%end

%integerfn validate Uno(%integer Uno, zero status)
   ! Check a Uno to see if it has been allocated to the user on
   ! the ether port specified by ether context.
   %record(Uno info fm)%name Uno info
      %if Uno = 0 %start
         ! ANON -- special case, since some actions are permitted
         ! (eg OpenR, ReadFile), while others aren't (eg Quote)
         %result = zero status %if zero status # success
         Uno info == common_Uno(0)
      %else
         ! Not ANON -- must be a valid Uno which has been allocated to
         ! the caller's ether context
         %result = illegal Uno %unless 0 < Uno <= Unos
         Uno info == common_Uno(Uno)
         %result = illegal Uno %if Uno info_l owner = 0  { Not in use }
         %result = illegal Uno %if Uno info_context # ether context
      %finish
      stamp(Uno info_active stamp)
      %result = success
%end

%externalintegerfn FSx clone Uno(%integer Uno, context)
   ! For some internal operations (eg internal copy) we want a
   ! Uno record which has all the caller's attributes (eg owner,
   ! default directory, password) EXCEPT for the ether context
   ! which we want not to be valid for the outside universe.
   ! This avoids internal operations being splatted by the
   ! user logging off....
   %record(Uno info fm)%name s Uno info, c Uno info
   %integer allocated, x
      x = validate Uno(Uno, success)
      %result = x %if x # success
      s Uno info == common_Uno(Uno)
      ! Caller's Uno is OK, so allocate a new one....
      allocated = allocate Uno
      %result = allocated %if allocated < success
      c Uno info == common_Uno(allocated)
      ! Clone the caller's Uno, and set the context
      ! to that supplied
      c Uno info = s Uno info
      c Uno info_context = context
      ! Note interest in logon and default directories
      remember directory(c Uno info_l directory)
      remember directory(c Uno info_d directory)
      %result = allocated
%end

%integerfn allocate Xno
   ! Allocate a Xno record for the user.  Unallocated ones are
   ! known by having a negative associated Uno.
   %record(Xno info fm)%name Xno info
   %integer i
      %for i = 1, 1, Xnos %cycle
         Xno info == common_Xno(i)
         %if Xno info_Uno < 0 %start
            ! Found a free one.  Claim it (NB can't use -ve Uno
            ! since that means unallocated (because we can't use
            ! zero to mean this since that is a valid Uno!)) by
            ! setting an invalid +ve Uno.
            Xno info_Uno = Unos + 1
            Xno info_context = ether context
            stamp(Xno info_opened stamp)
            Xno info_active stamp = Xno info_opened stamp
            %result = i
         %finish
      %repeat
      %result = -1
%end

%integerfn validate Xno(%integer Xno)
   ! Check a Xno to see if it has been allocated to the user on
   ! the ether port specified by ether context.
   %record(Xno info fm)%name Xno info
      %unless 0 < Xno <= Xnos %start
      !D pdate
      !D printstring("*** Invalid Xno (range) ")
      !D write(Xno, 0)
      !D newline
         %result = illegal Xno
      %finish
      Xno info == common_Xno(Xno)
      %if Xno info_Uno < 0 %start
      !D pdate
      !D printstring("*** Invalid Xno (not allocated) ")
      !D write(Xno, 0)
      !D newline
         %result = illegal Xno
      %finish
      %result = illegal Xno %if Xno info_context # ether context
      stamp(Xno info_active stamp)
      stamp(common_Uno(Xno info_Uno)_Xno active stamp)
      %result = success
%end

%integerfn check conflicts(%integer o, n1, n2, pling, flags)
   ! Check the Xno table to see if the file is already open
   ! in a conflicting mode.
   ! pling = 0 : ignore '!' files
   ! pling # 0 : consider '!' files
   %record(Xno info fm)%name Xno info
   %record(directory fm)%name d
   %record(entry fm)%name file
   %integer i
      %for i = 1, 1, Xnos %cycle
         Xno info == common_Xno(i)
         %if Xno info_Uno > 0 %start
            ! Xno allocated, check owner
            d == Xno info_dir info_d
            %if d_header_owner = o %start
               ! Correct owner, now check filename
               file == d_file(Xno info_file slot)
               %if file_name1 = n1 %and file_name2 = n2 %start
                  ! Check the pling state
                  %if pling # 0 %or file_status & transient file = 0 %start
                     ! Same file, check the access
                     %if Xno info_flags & flags # 0 %start
                        ! Conflicting mode of access
                        err d = o
                        err n1 = n1;  err n2 = n2
                        err pling = 0
                        %result = conflicting access & xs error
                     %finish
                  %finish
               %finish
            %finish
         %finish
      %repeat
      ! Got here, so there wasn't a conflict
      %result = success
%end

%integerfn check password(%integer password, %record(directory fm)%name dir)
   ! Check if supplied password matches either that in the directory
   ! or the system password.  Either is OK.  Null directory password
   ! matches everything.
   %result = success %if dir_header_password = 0 %c
                     %or dir_header_password = password %c
                     %or password = common_system pass
   %result = no authority
%end

%integerfn find owner(%integer owner, %integername part, entry)
   ! Search the user register for a (packed) username.  Return
   ! partition and slot therein if found.
   %record(register fm)%name r
      %for part = 0, 1, last partition %cycle
         r == common_partition(part)_register
         %for entry = 1, 1, u per p %cycle
            %result = success %if r_owner(entry) = owner
         %repeat
      %repeat
      err d = owner
      err n1 = 0;  err n2 = 0
      err pling = 0
      %result = owner not found & xs error
%end

%integerfn find file(%record(directory fm)%name dir, %integer n1, n2, mask)
   ! Find a file in a directory.  '!' files may be ignored by setting
   ! the appropriate bit in mask.
   %record(header fm)%name h
   %record(entry fm)%name e
   %integer i, files
      h == dir_header
      files = h_files & files mask
      %unless 0 <= files <= file limit %start
         ! Directory claims to have an unreasonable number
         ! of files.
         pdate
         printstring("*** Directory ")
         printstring(unpack(dir_header_owner, 0))
         printstring(" corrupt (find file): bad file limit ")
         write(files, 0)
         printstring(" (");  write(file limit, 0)
         print symbol(')')
         newline
         err d = dir_header_owner
         err n1 = 0;  err n2 = 0;  err pling = 0
         %result = directory corrupt & xs error
      %finish
      %if files = 0 %start
         err d = dir_header_owner
         err n1 = n1;  err n2 = n2
         %result = file not found
      %finish
      ! Directory has some files in it.  Search them, starting with
      ! the most recent -- this guarantees that '!' files will be
      ! found before their non-'!' namesakes (for, eg, deletion).
      %for i = files, -1, 1 %cycle
         e == dir_file(i)
         %result = i %if e_name1 = n1 %c
                    %and e_name2 = n2 %c
                    %and e_status & mask = 0
      %repeat
      err d = dir_header_owner
      err n1 = n1;  err n2 = n2
      %result = file not found
%end


! File access reporting

%routine log access(%record(Uno info fm)%name Uno info,
                    %integer directory name,
                    %record(entry fm)%name file,
                    %string(15) operation)
   %return %if file_perms & log bit = 0
   pdate
   printstring(unpack(Uno info_l owner, 0))
   print symbol('!') %if Uno info_q pass = common_system pass
   printstring(" at ");  print client address(ether context)
   printstring(" -- ");  printstring(unpack(directory name, 0))
   print symbol(':');    printstring(unpack(file_name1, file_name2))
   print symbol('?') %if file_status & dud       file # 0
   print symbol('!') %if file_status & transient file # 0
   printstring(" -- ");  printstring(operation)
   newline
%end


! Initialisation

%externalroutine FSx initialise file system
   ! Set it all going.  Read the bad block lists.  Scan
   ! all the user directories, building the bitmaps and
   ! checking for inconsistencies.
   %record(Uno info fm)%name Uno
   %record(dir info fm)%name d
   %record(partition fm)%name p
   %record(directory fm)%name dir
   %record(header fm)%name header
   %record(extent fm)%name extent
   %record(entry fm)%name file
   %record(register fm)%name register
   %integer i, j, k, x, f, e, dud, write flag, total files, extent barrier
   %integer owners, allocated, p extent, files, extents, total extents
   %integer bad owners, bad blocks, first bad, last bad
   %bytename bitmap
   %record(bitmap fm) multiple
   %label get next user, get next user x, no dud
      common == common area
      common_Xno(i)_Uno = -1 %for i = 1, 1, Xnos
      get system pass(common_system pass)
      read bad block list
      d == common_dir info(1)
      %for j = 0, 1, last partition %cycle
         p == common_partition(j);  p = 0
         bitmap == p_bitmap_b(0)
         register == p_register
         ! Having previously read in the bad block list, we now check
         ! the bounds of each partition's directory and data areas against
         ! it.  We allocate bad blocks and mark bad directories in the
         ! user register.
         bad blocks = 0;  bad owners = 0
         %if bad block list ## nil %and bad block list_last bad # 0 %start
            first bad = p start(j)
            last bad = first bad + fp size - 1
            %for k = 1, 1, bad block list_last bad %cycle
               %if first bad <= bad block list_bad(k) <= last bad %start
                  bad blocks = bad blocks + 1
                  %if check and allocate(bad block list_bad(k) - first bad,
                                         1, bitmap) %start
                     pdate
                     printstring("*** Bad block ")
                     write(bad block list_bad(k), 0)
                     printstring(" already allocated")
                     newline
                  %finish
               %finish
            %repeat
            first bad = pd start(j)
            last bad = first bad + dp size - 1
            %for k = 1, 1, bad block list_last bad %cycle
               %if first bad <= bad block list_bad(k) <= last bad %start
                  bad owners = bad owners + 1
                  register_owner((bad block list_bad(k) %c
                                  - first bad) // 4 + 1) = -1
               %finish
            %repeat
         %finish
         ! Now read each directory in turn, adding any users found to
         ! the register and allocating the blocks in their files.  If
         ! any are found to overlap a second pass will be required.
         pdate
         printstring("Initialising for partition ");  write(j, 0)
         printstring(" (max: ");  write(fp size - bad blocks, 0)
         printstring(" blocks, ")
         write(u per p - bad owners, 0);  printstring(" owners)")
         newline
         owners = 0;  allocated = 0
         dud = 0;  total extents = 0
         total files = 0
         multiple = 0
         p_bitmap_b(bitmap size) = 255;  ! last 0 .. 7 blocks are never used
         %for k = 1, 1, u per p %cycle
            %continue %if register_owner(k) < 0  { Bad }
            d_partition = j;  d_user no = k
            x = read directory(d)
            %if x # 0 %start
               pdate
               printstring("Read directory ")
               write(j, 0)
               print symbol('.')
               write(k, 0)
               printstring(" fails ")
               write(x, 0)
               newline
               file system writeable = 0
               %continue
            %finish
            dir == d_d
            header == dir_header
            write flag = 0
            %if header_owner # 0 %start
            !D pdate
            !D printstring("User ");  printstring(unpack(header_owner, 0))
            !D printstring(", quota ");  write(header_quota left & h, 0)
            !D newline
               owners = owners + 1
               register_owner(k) = header_owner
               files = header_files & files mask
               %if 0 < files <= file limit %start
                  ! Not an unreasonable number of files.  So far so good...
                  total files = total files + files
                  p extent = extent limit + 1
                  extent barrier = dir_file(files)_extents
                  %unless 0 < extent barrier <= extent limit %start
                     ! Files and extents overlap.
                     pdate
                     printstring("*** ")
                     printstring(unpack(header_owner, 0))
                     printstring(" -- corrupt directory (extents)")
                     newline
                     -> get next user
                  %finish
                  f = 1
                  ! Now, for each file in turn allocate its extents
                  %while f <= files %cycle
                     file == dir_file(f)
                     e = p extent - 1
                     extents = 0
                     %while e >= file_extents %cycle
                        %if e >= extent barrier %start
                           extent == dir_extent(e)
                           extents = extents + 1
                           %if extent_size = 0 %start
                           !! %if file_extents # p extent - 1 %start
                                 pdate
                                 printstring("*** ")
                                 printstring(unpack(header_owner, 0))
                                 print symbol(':')
                                 printstring(unpack(file_name1, file_name2))
                                 printstring(" -- illegal null extent ")
                                 write(extents, 0);  print symbol(':')
                                 write(extent_start & h, 0)
                                 newline
                                 file system writeable = 0
                           !! %finish
                              ! Else must be a null file -- allow it
                           %else
                              ! Allocate the extent.  Allocate it in the
                              ! duplicates bitmap if it has already been
                              ! allocated in the normal one.
                              %if check and allocate(extent_start, %c
                                                     extent_size, bitmap) %start
                                 dud = dud + 1
                                 %if check and allocate(extent_start,  %c
                                                        extent_size,   %c
                                                        multiple_b(0)) %start
                                    ! Dummy -- mark extent multiply allocated
                                 %finish
                              %finish
                              allocated = allocated + (extent_size & h)
                           %finish
                        %else
                           pdate
                           printstring("*** ")
                           printstring(unpack(header_owner, 0))
                           printstring(" -- corrupt directory (file)")
                           newline
                           file system writeable = 0
                           -> get next user
                        %finish
                        e = e - 1
                     %repeat
                     p extent = file_extents
                     f = f + 1
                     total extents = total extents + extents
                  %repeat
               %else %if files # 0
                  ! Non-zero, but unreasonable
                  pdate
                  printstring("*** Corrupt directory ")
                  write(j, 0)
                  print symbol('.')
                  write(k, 0)
                  newline
                  file system writeable = 0
               %finish
            %finish
get next user:
         %repeat
         ! If we haven't found any dud files, or the file system has
         ! been marked as protected anyway (due to a problem reading in
         ! a directory) then we skip the second pass.
         -> no dud %if dud = 0 %or file system writeable = 0
         pdate
         printstring("*** Partition has overlapping extents")
         newline
         dud = 0
         %for k = 1, 1, u per p %cycle
            %unless 1 <= k <= 128 %start
               pdate
               printstring("Compyler bug, k = "); write(k, 0)
               newline
               %exit
            %finish
            %continue %if register_owner(k) <= 0  { Bad or not in use }
            d_partition = j;  d_user no = k
            x = read directory(d)
            %if x # 0 %start
               pdate
               printstring("Read directory ")
               write(j, 0)
               print symbol('.')
               write(k, 0)
               printstring(" fails ")
               write(x, 0)
               newline
               file system writeable = 0
               %continue
            %finish
            dir == d_d
            header == dir_header
            write flag = 0
            files = header_files & files mask
            %if 0 < files <= file limit %start
               p extent = extent limit + 1
               extent barrier = dir_file(files)_extents
               -> get next user x %unless 0 < extent barrier <= extent limit
               f = 1
               %while f <= files %cycle
                  file == dir_file(f)
                  e = p extent - 1
                  extents = 0
                  %while e >= file_extents %cycle
                     %if e >= extent barrier %start
                        extent == dir_extent(e)
                        extents = extents + 1
                        %if extent_size > 0 %start
                           %if check and allocate(extent_start,  %c
                                                  extent_size,   %c
                                                  multiple_b(0)) %start
                              %if file_status & dud file = 0 %start
                                 ! File not already marked as dud
                                 pdate
                                 printstring("*** ")
                                 printstring(unpack(header_owner, 0))
                                 print symbol(':')
                                 printstring(unpack(file_name1, file_name2))
                                 printstring(" -- multiple allocation: extent ")
                                 write(extents, 0)
                                 printstring(", start ")
                                 write(extent_start, 0)
                                 printstring(", finish ")
                                 write(extent_start + extent_size - 1, 0)
                                 printstring(", size ")
                                 write(extent_size, 0)
                                 newline
                                 file_status = file_status ! dud file
                                 write flag = 1
                              %finish
                              dud = dud + 1
                           %finish
                        %finish
                     %else
                        ! Dubious directory
                        file system writeable = 0
                        -> get next user x
                     %finish
                     e = e - 1
                  %repeat
                  p extent = file_extents
                  f = f + 1
               %repeat
               x = write directory(d) %if write flag # 0
            %finish
            ! Else corrupt directory
get next user x:
         %repeat
no dud:  ! Directory scan passes complete for this partition
         pdate
         write(owners, 0);  printstring(" owner")
         print symbol('s') %if owners # 1;  printstring(", ")
         write(allocated, 0);  printstring(" block")
         print symbol('s') %if allocated # 1
         printstring(" (");  write(total files, 0)
         printstring(" file");  print symbol('s') %if total files # 1
         printstring(", ");  write(total extents, 0)
         printstring(" extent");  print symbol('s') %if total extents # 1
         printstring(") allocated")
         %if dud # 0 %start
            printstring(", ")
            write(dud, 0)
            printstring(" dud extent")
            print symbol('s') %if dud # 1
         %finish
         newline
      %repeat
      ! Directories checked, bitmaps and register built.
      ! Now log on ANON permanently, to avoid special cases elsewhere.
      x = find owner(anon, i, j)
      %if x = success %start
         x = get directory(anon, i, j)
         %if x < success %start
            pdate
            printstring("*** Failed to read ANON directory ***")
            newline
            file system writeable = 0
            %return
         %finish
         Uno == common_Uno(0)
         Uno_l owner = anon
         Uno_d owner = anon
         Uno_q pass  = 0
         Uno_l directory == common_dir info(x)
         Uno_d directory == Uno_l directory
         Uno_context = 0
         stamp(Uno_logon stamp)
         Uno_active stamp = Uno_logon stamp
         Uno_Xno active stamp = 0
      %else
         pdate
         printstring("*** No ANON ***")
         newline
         file system writeable = 0
      %finish
      common_monitor = 0
      pdate
      printstring("File system initialised")
      printstring(" read-only") %if file system writeable = 0
      newline
      ! Finally set system availability (if it has not been set already
      ! from the console during initialisation).
      common_system open = -1 %if common_system open = 0
%end

%externalintegerfn FS new owner(%integer Uno, %string(255) s owner,
                                %integer quota)
   ! Add a new user to the file system
   %integer x, i, j, dir, user no, partition
   %integer owner, blank
   %record(dir info fm)%name d
   %record(directory fm)%name directory
   %record(partition fm)%name p
   %record(header fm)%name header
   %record(register fm)%name register
   %record(Uno info fm)%name Uno info
   %label got one
      %result = not writeable %if file system writeable = 0
      x = validate Uno(Uno, not logged on)
      %result = x %if x # success
      Uno info == common_Uno(Uno)
      %result = no authority %if Uno info_q pass # common_system pass
      ! Creator must be privileged.  Now validate username and quota
      quota = default quota %if quota = 0
      ! Extract partition number and user name from first param
      %result = param error & p1 error %unless 2 <= length(s owner) <= 7
      partition = charno(s owner, 1) - '0'
      %result = param error & p1 error %unless 0 <= partition <= last partition
      x = pack(substring(s owner, 2, length(s owner)), owner, blank)
      %result = param error & p1 error %if x # success %or blank # 0
      p == common_partition(partition)
      ! Check to see if owner exists already.  We insist that
      ! owner names are unique.
      x = find owner(owner, i, j)
      %if x = success %start
         err d = owner
         err n1 = 0;  err n2 = 0;  err pling = 0
         %result = user exists & xs error
      %finish
      ! OK to create.  Find a free slot in the register.
      register == p_register
      %for user no = 1, 1, u per p %cycle
         -> got one %if register_owner(user no) = 0
      %repeat
      err d = owner
      err n1 = 0;  err n2 = 0;  err pling = 0
      %result = no slot & xs error
got one:
      ! Found a register slot.  Get a directory slot.
      dir = get directory(owner, partition, user no)
      %result = dir %if dir < 0
      d == common_dir info(dir)
      directory == d_d
      %if directory_header_owner # 0 %start
         ! Directory claims to be owned already?!
         x = forget directory(d)
         err d = owner
         err n1 = 0;  err n2 = 0;  err pling = 0
         %result = file exists & xs error
      %finish
      ! Initialise directory header
      directory = 0
      header == directory_header
      header_owner = owner
      header_password = 0
      header_quota left = quota
      header_perms = FNA;  ! Was FRA
      header_directory size = 2048
      d_written = 1
      register_owner(user no) = owner
      pdate
      printstring(unpack(Uno info_l owner, 0))
      printstring(" created new user: ");  printstring(unpack(header_owner, 0))
      printstring(" (")
      write(partition, 0)
      print symbol('.')
      write(user no, 0)
      printstring("), quota ");  write(header_quota left & h, 0)
      newline
      %result = forget directory(d)
%end

%externalintegerfn FS change quota(%integer Uno, %string(255) s owner,
                                   %integer delta)
   ! Modify a user's quota
   %integer x, dir, user no, partition
   %integer owner, blank
   %record(dir info fm)%name d
   %record(directory fm)%name directory
   %record(header fm)%name header
   %record(Uno info fm)%name Uno info
      %result = not writeable %if file system writeable = 0
      x = validate Uno(Uno, not logged on)
      %result = x %if x # success
      Uno info == common_Uno(Uno)
      %result = no authority %if Uno info_q pass # common_system pass
      ! Privileged callers only.  Now find the target.
      x = pack(s owner, owner, blank)
      %result = param error & p1 error %if x # success %or blank # 0
      x = find owner(owner, partition, user no)
      err d = owner %and %result = x & p1 error %if x # success
      dir = get directory(owner, partition, user no)
      %result = dir %if dir < 0
      d == common_dir info(dir)
      directory == d_d
      header == directory_header
      header_quota left <- header_quota left + delta
      d_written = 1
      pdate
      printstring(unpack(Uno info_l owner, 0))
      printstring(" setting new quota: ");  printstring(unpack(header_owner, 0))
      printstring(" (")
      write(partition, 0)
      print symbol('.')
      write(user no, 0)
      printstring("), quota ");  write(header_quota left & h, 0)
      newline
      %result = forget directory(d)
%end

%externalintegerfn FS partition(%integer Uno, partition,
                                %integername bytes, %record(buffer fm)%name b)
   ! Return a list of the users on the specified half-partition.
   %record(register fm)%name register
   %integer who
   %integer x, half, i
      x = validate Uno(Uno, success)
      %result = x %if x # success
      half = (partition & 1) * 64
      partition = partition >> 1
      %result = param error & p1 error %unless 0 <= partition <= last partition
      register == common_partition(partition)_register
      b_bytes = 0
      %for i = half + 1, 1, half + 64 %cycle
         %if i <= u per p %then who = register_owner(i) %c
                          %else who = 0
         %if who = 0 %then add text("---", b) %c
                     %else add text(unpack(who, 0), b)
         pad(8 * (i - half) - 1, b)
         %if i & 7 = 0 %then add text(snl, b) %c
                       %else add text(" ", b)
      %repeat
      bytes = b_bytes
      %result = success
%end

%externalintegerfn FS logon(%string(255) ownername,
                            %string(255) password, %integername Uno)
   ! Log on a user.  Check username and password, and if OK set
   ! up defaults.
   %record(dir info fm)%name dir info
   %record(directory fm)%name dir
   %record(header fm)%name header
   %record(Uno info fm)%name Uno info
   %integer x, part = -1, entry
   %integer owner, pass, blank
      x = pack(ownername, owner, blank)
      %result = param error & p1 error %if x # success %or blank # 0
      x = find owner(owner, part, entry)
      %if x # success %start
         err n1 = 0;  err n2 = 0;  err pling = 0
         err d = owner
         %result = x & xs error
      %finish
!!    password = endecrypt(ownername, password, 0)
      pass = encrypt(password)
      %result = logins disabled %if common_system open & allow logins = 0 %c
         %and pass # common_system pass
      ! Username exists.  Now get a Uno, check the password, and if OK
      ! set up the defaults.
      Uno = allocate Uno
      %result = no Uno %if Uno < 0
      Uno info == common_Uno(Uno)
      Uno info_context = ether context
      x = get directory(owner, part, entry)
      Uno info_l owner = 0 %and %result = x %if x < success
      dir info == common_dir info(x)
      dir == dir info_d
      header == dir_header
      ! Check to see whether the user is pseudo- or real
      %if header_perms & pseudo user # 0 %and ether context > 0 %c
            %and pass # common_system pass %start
         ! Not allowed, report it and dump everything
         pdate
         printstring("Logon pseudo-user ");  printstring(unpack(owner, 0))
         printstring(" at ");  print client address(ether context)
         printstring(" rejected");  newline
         x = forget directory(dir info)
         Uno info_l owner = 0
         %result = no authority
      %finish
      Uno info_l owner = 0
   !D %if common_diags & fsys diags # 0 %start
   !D    pdate
   !D    printstring("Logon ");  printstring(unpack(header_owner, 0))
   !D    printstring(", quota ");  write(header_quota left & h, 0)
   !D    printstring(", Uno ");  write(Uno, 0)
   !D    newline
   !D %finish
      %if check password(pass, dir) = success %start
         ! Password is acceptable.  Set up defaults.
         %if pass = common_system pass %start
            pdate
            printstring(unpack(owner, 0))
            printstring(" at ");  print client address(ether context)
            printstring(" using system pass")
            newline
         %else %if pass # 0 %and dir_header_password = 0
            ! Null directory password requires null quoted password
            Uno info_l owner = 0
            x = forget directory(dir info)
            %result = no authority
         %finish
         Uno info_l owner = owner
         Uno info_d owner = owner
         Uno info_q pass  = pass
         Uno info_l directory == dir info
         Uno info_d directory == dir info
         common_monitor_logons = common_monitor_logons + 1
         ! Note a second interest in the initial directory (once for
         ! the logon directory pointer and once more for the
         ! default directory pointer).
         remember directory(Uno info_d directory)
         %result = success
      %finish
      ! Bad password.  Dump the directory and bounce the request.
      x = forget directory(dir info)
      Uno info_l owner = 0
      %result = no authority
%end

%integerfnspec FS Uclose(%integer Xno)

%externalintegerfn FS logoff(%integer Uno)
   ! Log off a user.  UClose any open transactions.
   %record(Uno info fm)%name Uno info
   %record(Xno info fm)%name Xno info
   %integer x, i
   !D %if common_diags & fsys diags # 0 %start
   !D    pdate
   !D    printstring("Logoff ");  write(Uno, 0)
   !D    newline
   !D %finish
      x = validate Uno(Uno, not logged on)
      %result = x %if x # success
      Uno info == common_Uno(Uno)
      %for i = 1, 1, Xnos %cycle
         Xno info == common_Xno(i)
         x = FS Uclose(i) %if Xno info_Uno = Uno  { File in use }
      %repeat
      x = forget directory(Uno info_d directory)
      x = forget directory(Uno info_l directory)
      Uno info_l owner = 0
      %result = x
%end

%integerfn delete user(%integer Uno, %string(255) user)
   %record(Uno info fm)%name Uno info
   %record(dir info fm)%name dir info
   %integer n1, n2, x, part, entry
      Uno info == common_Uno(Uno)
      ! We must be privileged
      %result = no authority %unless Uno info_q pass = common_system pass
      ! Find out if the user exists.  If so, read in the directory.
      x = pack(user, n1, n2)
      %result = x & p1 error %if x < success
      %result = param error & p1 error %if n2 # 0
      x = find owner(n1, part, entry)
      %if x < success %start
         err n1 = 0;  err n2 = 0;  err pling = 0
         err d = n1
         %result = x & xs error
      %finish
      x = get directory(n1, part, entry)
      %result = x %if x < success
      dir info == common_dir info(x)
      ! Directory must not be in use by someone else
      %if dir info_ref count # 1 %start
         x = forget directory(dir info)
         err d = n1
         err n1 = 0;  err n2 = 0;  err pling = 0
         %result = directory in use & xs error
      %finish
      ! Directory must be empty
      %if dir info_d_header_files & files mask # 0 %start
         x = forget directory(dir info)
         err d = n1
         err n1 = 0;  err n2 = 0;  err pling = 0
         %result = directory not empty & xs error
      %finish
      ! All OK, so zap the directory and register
      dir info_d_header_owner = 0
      dir info_owner = 0
      dir info_written = 1
      common_partition(part)_register_owner(entry) = 0
      pdate
      printstring(unpack(Uno info_l owner, 0))
      printstring(" deleting user ")
      printstring(unpack(n1, 0))
      newline
      %result = forget directory(dir info)
%end

%externalintegerfn FS delete(%integer Uno, %string(255) filename)
   ! Delete a file.  Check user's authority, and if OK search
   ! for the file.  Delete it if all is OK.
   %record(Uno info fm)%name Uno info
   %record(dir info fm)%name dir info
   %integer n1, n2, user, blank
   %integer x, z, slot, part, entry
   %string(255) user name
      %result = not writeable %if file system writeable = 0
      x = validate Uno(Uno, success)
      %result = x %if x # success
      Uno info == common_Uno(Uno)
      %if filename -> user name . (":") . filename %start
         ! Username supplied as part of filename.  Use the
         ! corresponding directory (if it exists).  If the
         ! resulting filename is null then we delete the user.
         %result = delete user(Uno, username) %if filename = ""
         %result = param error %if username = ""
         x = pack(user name, user, blank)
         %result = x & p1 error %if x # success
         %result = param error %if blank # 0
         x = find owner(user, part, entry)
         %if x # success %start
            err n1 = 0;  err n2 = 0;  err pling = 0
            err d = user
            %result = x & xs error
         %finish
         x = get directory(user, part, entry)
         %result = x %if x < success
         dir info == common_dir info(x)
         %if dir info ## Uno info_l directory %start
            ! Not logon directory, so password must match before
            ! deletion is allowed.
            x = check password(Uno info_q pass, dir info_d)
            z = forget directory(dir info) %and %result = x %if x # success
         %finish
      %else
         ! No directory supplied, so use the current default.
         dir info == Uno info_d directory
         %if dir info ## Uno info_l directory %start
            ! Not logon directory, so password must match before
            ! deletion is allowed.
            x = check password(Uno info_q pass, dir info_d)
            %result = x %if x # success
         %finish
         ! Note our interest in the directory
         remember directory(dir info)
      %finish
      %if charno(filename, length(filename)) = '!' %start
         ! Remove the '!' from '!'-files.  Fail the request
         ! if this leaves a null name.
         length(filename) = length(filename) - 1
         x = forget directory(dir info) %and %result = param error & p1 error %c
            %if filename = ""
      %finish
      x = pack(filename, n1, n2)
      z = forget directory(dir info) %and %result = x & p1 error %if x # success
      ! Authority and filename are OK.  Try to find the file.
      slot = find file(dir info_d, n1, n2, 0)
      %if slot < success %start
         err d = dir info_d_header_owner
         err n1 = n1;  err n2 = n2
         x = forget directory(dir info) 
         %result = slot & xs error
      %finish
      log access(Uno info, dir info_d_header_owner,
                 dir info_d_file(slot), "Delete")
      x = delete file(slot, dir info)
      z = forget directory(dir info)
      %result = x %if x < success
      %result = z
%end

%integerfn rename user(%record(Uno info fm)%name Uno info,
                       %string(255) from, to)
   ! Change an owner's name.  This required modifying the
   ! directory (and the cache entry) and the register.
   %record(partition fm)%name p
   %record(dir info fm)%name dir info
   %integer f, t, x, part, entry, i
   %string(255) q
      %result = not writeable %if file system writeable = 0
      ! Privileged users only.
      %result = no authority %unless Uno info_q pass = common_system pass
      ! Resultant name must be of the form <name>: (ie ':' must
      ! be present and no filename is allowed).  Note that <from> has
      ! already been checked before we are called.
      %result = param error & p2 error %unless to -> to .(":"). q
      %result = param error & p2 error %if q # ""
      x = pack(from, f, i)
      %result = param error & p1 error %if x # success %or i # 0
      x = pack(to, t, i)
      %result = param error & p2 error %if x # success %or i # 0
      ! Both usernames are OK.  Check that the original username exists
      ! and that the new username doesn't.
      x = find owner(t, part, entry)
      %if x = success %start
         err n1 = 0;  err n2 = 0;  err pling = 0
         err d = t
         %result = user exists & xs error
      %finish
      x = find owner(f, part, entry)
      %if x # success %start
         err n1 = 0;  err n2 = 0;  err pling = 0
         err d = f
         %result = x & xs error
      %finish
      x = get directory(f, part, entry)
      %result = x %if x < success
      ! All OK, so make the changes.
      pdate
      printstring(unpack(Uno info_l owner, 0))
      printstring(" renaming ")
      printstring(unpack(f, 0))
      printstring(" to ")
      printstring(unpack(t, 0))
      newline
      dir info == common_dir info(x)
      dir info_d_header_owner = t
      dir info_owner = t
      p == common_partition(part)
      p_register_owner(entry) = t
      dir info_written = 1
      %result = forget directory(dir info)
%end

%externalintegerfn FS rename(%integer Uno, %string(255) from, to)
   ! Rename a file (or possibly a user).  Caller must have appropriate
   ! authority, the source filename must exist, and the destination
   ! filename must not.  Note special treatment of '!'-files.
   %record(Uno info fm)%name Uno info
   %record(dir info fm)%name dir info
   %record(entry fm)%name file
   %integer x, z, f1, f2, t1, t2, found from, part, entry, size, new q
   %integer user, blank
   %string(255) user name
      %result = not writeable %if file system writeable = 0
      x = validate Uno(Uno, success)
      %result = x %if x # success
      Uno info == common_Uno(Uno)
      %if from -> user name . (":") . from %start
         ! Username supplied.  If the filename is blank then we
         ! are renaming the user.
         %result = param error & p1 error %if username = ""
         %result = rename user(Uno info, user name, to) %if from = ""
         ! Renaming the file.  Is the username acceptable?
         x = pack(user name, user, blank)
         %result = param error & p1 error %if x # success %or blank # 0
         x = find owner(user, part, entry)
         %if x # success %start
            err n1 = 0;  err n2 = 0;  err pling = 0
            err d = user
            %result = x & xs error
         %finish
         x = get directory(user, part, entry)
         %result = x %if x < success
         dir info == common_dir info(x)
         ! Username exists.  Check the password if we didn't
         ! log in as that user.
         %if dir info ## Uno info_l directory %start
            x = check password(Uno info_q pass, dir info_d)
            z = forget directory(dir info) %and %result = x %if x # success
         %finish
      %else
         ! No username given, so use the default.
         dir info == Uno info_d directory
         %if dir info ## Uno info_l directory %start
            ! Not the owner we logged in as, so check the password.
            x = check password(Uno info_q pass, dir info_d)
            %result = x %if x # success
         %finish
         remember directory(dir info)
      %finish
      %if charno(from, length(from)) = '!' %start
         length(from) = length(from) - 1
         %if from = "" %start
            x = forget directory(dir info)
            %result = param error & p1 error
         %finish
      %finish
      ! Validate the source filename
      x = pack(from, f1, f2)
      z = forget directory(dir info) %and %result = x & p1 error %if x # success
      ! Source OK, how about the destination?  First try to split off an
      ! owner name.  If there is one, then it must be the same one as for the
      ! source (owner names are unique).
      %if to -> user name . (":") . to %start
         x = pack(user name, user, blank)
         %if x # success %or blank # 0 %or user # dir info_d_header_owner %start
            z = forget directory(dir info)
            %result = param error & p2 error
         %finish
      %finish
      x = pack(to, t1, t2)
      z = forget directory(dir info) %and %result = x & p2 error %if x # success
      ! Does the source exist?
      found from = find file(dir info_d, f1, f2, 0)
      %if found from < success %start
         err d = dir info_d_header_owner
         err n1 = f1;  err n2 = f2
         z = forget directory(dir info)
         %result = found from & xs error
      %finish
      ! Does the destination exist in its non-'!' form?
      x = find file(dir info_d, t1, t2, transient file)
      %if x >= success %start
      !D %if common_diags & fsys diags # 0 %start
      !D    pdate
      !D    printstring("File exists (non-'!') ")
      !D    write(x, 0)
      !D    newline
      !D %finish
         err d = dir info_d_header_owner
         err n1 = t1;  err n2 = t2
         err pling = dir info_d_file(x)_status & transient file
         z = forget directory(dir info)
         %result = file exists & xs error
      %finish
      ! Check again on the existence of the destination filename,
      ! this time including '!'-files among those searched.  The only
      ! case where the destination filename is allowed to exist is
      ! if we are renaming a '!'-file to its non-'!' verion, in which
      ! case the source and destination file slots will be the same.
      ! Renaming to the same name as an already-existing '!'-file is
      ! not allowed.
      x = find file(dir info_d, t1, t2, 0)
      %if success <= x # found from %start
      !D %if common_diags & fsys diags # 0 %start
      !D    pdate
      !D    printstring("File exists ('!') ")
      !D    write(x, 0)
      !D    newline
      !D %finish
         err d = dir info_d_header_owner
         err n1 = t1;  err n2 = t2
         err pling = dir info_d_file(x)_status & transient file
         z = forget directory(dir info)
         %result = file exists & xs error
      %finish
      ! The destination filename doesn't exist, so we can go ahead with
      ! the renaming.  Find out how big the file is, so that we can
      ! adjust the user's quota if the file's permanence changes.
      file == dir info_d_file(found from)
      x = file size(found from, dir info_d, size, z)
      %if x # success %start
         z = forget directory(dir info)
         %result = x
      %finish
      new q = dir info_d_header_quota left & h
      ! Restore quota if file was not temporary or transient
      new q = new q + size %c
         %if f1 >> 16 < temporary %and file_status & transient file = 0
      ! Deduct quota if file will not be temporary
      new q = new q - size %if t1 >> 16 < temporary
      ! If the user's quota is insufficient to permit the renaming then
      ! fail the request.  Otherwise finish the remaining processing.
      %if new q < 0 %start
         z = forget directory(dir info)
         err d = dir info_d_header_owner
         err n1 = t1;  err n2 = t2
         %result = no quota & xs error
      %finish
      dir info_d_header_quota left = new q
      log access(Uno info, dir info_d_header_owner, file, "Rename")
      file_name1  = t1
      file_name2  = t2
      file_status = file_status & (\transient file)
      dir info_written = 1
      %result = forget directory(dir info)
%end

%externalintegerfn FS dchange(%integer Uno, %string(255) filename,
                              %string(255) date and time)
   ! Change the timestamp associated with a file
   %record(Uno info fm)%name Uno info
   %record(dir info fm)%name dir info
   %record(entry fm)%name file
   %integer n1, n2, user, blank
   %integer x, z, slot, part, entry
   %short packed date, packed time
   %string(255) user name, date, time
      %result = not writeable %if file system writeable = 0
      x = validate Uno(Uno, success)
      %result = x %if x # success
      Uno info == common_Uno(Uno)
      ! First split the date and time into its component parts
      date and time = date . " " . time %c
         %while date and time -> date .("  "). time
      %result = param error & p2 error %c
         %unless date and time -> date .(" "). time
      ! Pack the date and time and then repack them.  If we get what we
      ! started with, then they were OK, otherwise there was an error.
      packed date = pack date(date)
      %result = param error & p2 error %unless date = unpack date(packed date)
      packed time = pack time(time)
      %result = param error & p2 error %unless time = unpack time(packed time)
      ! Date and time OK, now find the file
      %if filename -> user name . (":") . filename %start
         ! Username was supplied.  First check that a filename was supplied.
         %result = param error & p1 error %if filename = ""
         ! OK, so validate username and get its corresponding directory.
         %result = param error & p1 error %if username = ""
         x = pack(user name, user, blank)
         %result = param error & p1 error %if x # success %or blank # 0
         x = find owner(user, part, entry)
         %if x # success %start
            err n1 = 0;  err n2 = 0;  err pling = 0
            err d = user
            %result = x & xs error
         %finish
         x = get directory(user, part, entry)
         %result = x %if x < success
         dir info == common_dir info(x)
         ! If it isn't the directory we logged on to, then we must
         ! check the password.
         %if dir info ## Uno info_l directory %start
            x = check password(Uno info_q pass, dir info_d)
            z = forget directory(dir info) %and %result = x %if x # success
         %finish
      %else
         ! No directory given, so use the default.
         dir info == Uno info_d directory
         %if dir info ## Uno info_l directory %start
            ! Not our logon directory -- check the password
            x = check password(Uno info_q pass, dir info_d)
            %result = x %if x # success
         %finish
         remember directory(dir info)
      %finish
      ! Lose the '!' from the filename, if there is one, then see if
      ! it is valid.
      %if charno(filename, length(filename)) = '!' %start
         length(filename) = length(filename) - 1
         x = forget directory(dir info) %and %result = param error & p1 error %c
            %if filename = ""
      %finish
      x = pack(filename, n1, n2)
      z = forget directory(dir info) %and %result = x & p1 error %if x # success
      ! Filename is valid, but does it exist?
      slot = find file(dir info_d, n1, n2, 0)
      %if slot < success %start
         x = forget directory(dir info) 
         err d = dir info_d_header_owner
         err n1 = n1;  err n2 = n2
         %result = slot & xs error
      %finish
      ! File exists, so set its timestamp.
      file == dir info_d_file(slot)
      file_date = packed date
      file_time = file_time & (\ time mask) ! packed time
      log access(Uno info, dir info_d_header_owner, file, "DChange")
      %result = forget directory(dir info)
%end

%integerfn set perms(%string(255) permissions, %shortname mask)
   ! Convert permissions from textual form to a mask.  Either
   !        only the permissions are specified
   !  or    only the archive status is specified
   !  or    both are specified.
   ! Full access for owner allows read/write/delete
   ! Full access for world allows read/write but not delete
   ! Note that file creation required owner authority for the
   ! directory, and hence non-owners may (DA) modify files in
   ! a directory but not (SQ) overwrite them.
   %integer owner, public, archive, log, l, ch
      l = length(permissions)
      %result = param error %unless 0 < l <= 3
      ! Obtain current values from mask
      owner   = mask >> owner  permission shift & 3
      public  = mask >> public permission shift & 3
      archive = mask >> archive bit       shift & 1
      log     = mask >> log     bit       shift & 1
      %if l >= 2 %start
         ! Permissions must have been specified
         ch = charno(permissions, 1)
         %if ch = 'F' %or ch = 'f' %start
            owner = 3
         %else %if ch = 'R' %or ch = 'r'
            owner = 2
       ! %else %if ch = 'O' %or ch = 'o'
       !    owner = 1
         %else %if ch = 'N' %or ch = 'n'
            owner = 0
         %else
            %result = param error
         %finish
         ch = charno(permissions, 2)
         %if ch = 'F' %or ch = 'f' %start
            public = 3
         %else %if ch = 'R' %or ch = 'r'
            public = 2
       ! %else %if ch = 'O' %or ch = 'o'
       !    public = 1
         %else %if ch = 'N' %or ch = 'n'
            public = 0
         %else
            %result = param error
         %finish
         owner = public %if owner < public
         ! Get the archive status, if it has been specified
         ch = charno(permissions, 3) %if l = 3
      %else
         ! Only the archive status specified
         ch = charno(permissions, 1)
      %finish
      %if l & 1 # 0 %start
         ! Archive status has been specified
         %if ch = 'A' %or ch = 'a' %start
            archive = 1
         %else %if ch = 'V' %or ch = 'v'
            archive = 0
         %else %if ch = 'L' %or ch = 'l'
            log = 1
         %else %if ch = 'Q' %or ch = 'q'
            log = 0
         %else
            %result = param error
         %finish
      %finish
      ! All relevant information extracted, so set the new values
      mask <- mask & (\ permissions mask) %c
              ! owner   << owner  permission shift %c
              ! public  << public permission shift %c
              ! archive << archive bit       shift %c
              ! log     << log     bit       shift
      %result = success
%end

%externalintegerfn FS permit(%integer Uno, %string(255) filename, permissions)
   ! Set access on file, or set default access
   %string(255) owner name
   %record(Uno info fm)%name Uno info
   %record(dir info fm)%name dir info
   %record(entry fm)%name file
   %integer x, z, part, entry, slot
   %integer n1, n2, owner, blank
      %result = not writeable %if file system writeable = 0
      x = validate Uno(Uno, not logged on)
      %result = x %if x # success
      Uno info == common_Uno(Uno)
      ! Split off owner name from filename, if possible
      owner name = "" %unless filename -> owner name . (":") . filename
      %if owner name = "" %start
         ! No owner name given, so use default
         dir info == Uno info_d directory
         %if dir info ## Uno info_l directory %start
            ! Must check password, since not logon directory
            x = check password(Uno info_q pass, dir info_d)
            %result = x %if x # success
         %finish
         remember directory(dir info)
      %else
         ! Ownername supplied, so validate it and get its directory
         x = pack(owner name, owner, blank)
         %result = param error & p1 error %if x # success %or blank # 0
         x = find owner(owner, part, entry)
         %if x # success %start
            err n1 = 0;  err n2 = 0;  err pling = 0
            err d = owner
            %result = x & xs error
         %finish
         x = get directory(owner, part, entry)
         %result = x %if x < success
         dir info == common_dir info(x)
         ! Must check password if not logon directory
         %if dir info ## Uno info_l directory %start
            x = check password(Uno info_q pass, dir info_d)
            z = forget directory(dir info) %and %result = x %if x # success
         %finish
      %finish
      %if filename = "" %start
         ! Set default access (could be to make a pseudo-user)
         %if permissions = "P" %or permissions = "G" %start
            ! (Un)make a pseudo-user
            %result = no authority %unless Uno info_q pass = common_system pass
            pdate
            printstring(unpack(Uno info_l owner, 0));  printstring(" at ")
            print client address(ether context);  printstring(" setting ")
            printstring(unpack(dir info_d_header_owner, 0))
            printstring(" as a ")
            %if permissions = "P" %start
               dir info_d_header_perms = dir info_d_header_perms ! pseudo user
               printstring("pseudo-")
            %else
               dir info_d_header_perms = dir info_d_header_perms & (\ pseudo user)
               printstring("real ")
            %finish
            printstring("user");  newline
            dir info_written = 1
            x = forget directory(dir info)
            %result = success
         %finish
         x = set perms(permissions, dir info_d_header_perms)
         x = forget directory(dir info) %and %result = param error & p2 error %c
            %if x # success
      %else
         ! Set file access -- first find if the file exists.
         x = pack(filename, n1, n2)
         z = forget directory(dir info) %and %result = x & p1 error %c
            %if x # success
         slot = find file(dir info_d, n1, n2, transient file)
         %if slot < success %start
            x = forget directory(dir info)
            err d = dir info_d_header_owner
            err n1 = n1;  err n2 = n2
            %result = slot & xs error
         %finish
         file == dir info_d_file(slot)
         ! File exists, so change its protection.  We have already
         ! checked that we have the requisite owner authority.
         x = set perms(permissions, file_perms)
         x = forget directory(dir info) %and %result = param error & p2 error %c
            %if x # success
      %finish
      dir info_written = 1
      x = forget directory(dir info)
      %result = success
%end

%externalintegerfn FS finfo(%integer Uno, %string(255) ownername,
                            %integer file number,
                            %integername bytes,
                            %record(buffer fm)%name b)
   ! Information on a selected file in a directory.  Only files to which
   ! the caller has sufficient authority will be included in the list.
   %record(directory fm)%name directory
   %record(header fm)%name header
   %record(dir info fm)%name dir info
   %record(Uno info fm)%name Uno info
   %record(extent fm)%name e
   %record(entry fm)%name f
   %integer owner, blank
   %integer part, entry, x, d, i, extents, blocks, files, oa, which
   %short date, time
      x = validate Uno(Uno, success)
      %result = x %if x # success
      Uno info == common_Uno(Uno)
      %if ownername # "" %start
         ! Owner name supplied.  See if it exists.
         x = pack(ownername, owner, blank)
         %result = param error & p1 error %if x # success %or blank # 0
         x = find owner(owner, part, entry)
         %if x # success %start
            err n1 = 0;  err n2 = 0;  err pling = 0
            err d = owner
            %result = x & xs error
         %finish
         d = get directory(owner, part, entry)
         %result = d %if d < success
         dir info == common_dir info(d)
      %else
         ! No owner, so use current default
         owner = Uno info_d owner
         dir info == Uno info_d directory
         remember directory(dir info)
      %finish
      directory == dir info_d
      ! Determine ownership authority wrt directory
      %if dir info == Uno info_l directory %start
         ! Logon directory, so must be owner
         oa = success
      %else
         ! Not logon directory, so must check password
         oa = check password(Uno info_q pass, directory)
      %finish
      b_bytes = 0
      header == directory_header
      files = header_files & files mask
      %if file number = 0 %start
         ! Enquiring about general directory information, so assemble it
         time stamp(date, time)
         add text(unpack(header_owner, 0), b)
         add text(" (", b)
         add text(itos(dir info_partition, 0), b)
         add text(".", b)
         add text(itos(dir info_user no, 0), b)
         add text(") at ", b)
         add text(unpack time(time), b)
         add text(" on ", b)
         add text(unpack date(date), b)
         add text(" -- files: ", b)
         extents = 0;  blocks = 0
         %if files # 0 %start
            %for i = extent limit, -1, directory_file(files)_extents %cycle
               e == directory_extent(i)
               extents = extents + 1
               blocks = blocks + (e_size & h)
            %repeat
         %finish
         add text(itos(files, 0), b)
         add text(", extents: ", b)
         add text(itos(extents, 0), b)
         add text(", blocks: ", b)
         add text(itos(blocks, 0), b)
         add text("/", b)
         add text(itos(header_quota left & h + blocks, 0), b)
      %else %if 0 < file number <= files
         ! Enquiring about a specific file in the directory.  The slot
         ! number specifies which file is required.  Note that we only
         ! count accessible files for this purpose, and that the most
         ! recent file is deemeed to be in slot 1 -- this means that
         ! we have to start our scan at the bottom end if the directory's
         ! file list, since files are added to the %end of the list.
         which = files
         %while which > 0 %and file number > 0 %cycle
            ! Look for file in accessible slots
            f == directory_file(which)
            %if oa = success %start
               ! Owner of directory, so count all the files in it
               file number = file number - 1
               which = which - 1
            %else
               ! Not the owner, so count only those with public access
               file number = file number - 1 %c
                  %if f_perms >> public permission shift & 3 >= R permission
               which = which - 1
            %finish
         %repeat
         ! We've either found the file or run out of slots
         %if which = 0 %and file number # 0 %start
            ! Run out of slots.  Return an empty packet
            b_bytes = 0
         %else
            ! Found the file, so assemble the details
            add text(unpack(f_name1, f_name2), b)
            add text("?", b) %if f_status & dud file       # 0
            add text("!", b) %if f_status & transient file # 0
            pad(16, b)
            add text(unpack perms(f_perms), b)
            add text("   ", b)
            add text(unpack date(f_date), b)
            add text("  ", b)
            add text(unpack time(f_time & time mask), b)
            x = file size(which + 1, directory, blocks, extents)
            i = forget directory(dir info) %and %result = x %if x # success
            add text("  ", b)
            add text(itos(blocks, 0), b)
            add text("(", b)
            add text(itos(extents, 0), b)
            add text(")", b)
         %finish
      %else
         ! Requested slot is outwith the number of files in the directory,
         ! so we don't even need to bother looking.
         b_bytes = 0
      %finish
      i = forget directory(dir info)
      bytes = b_bytes
      %result = success
%end

%externalintegerfn FS ninfo(%integer Uno, %string(255) filename,
                            %integername bytes, %record(buffer fm)%name b)
   %record(Uno info fm)%name Uno info
   %record(dir info fm)%name dir info
   %record(directory fm)%name directory
   %record(entry fm)%name file
   %integer n1, n2, x, owner, part, entry, it, blocks, extents, pling
   %string(255) username
      x = validate Uno(Uno, success)
      %result = x %if x # success
      Uno info == common_Uno(Uno)
      %if filename -> username . (":") . filename %start
         x = pack(username, owner, n2)
         %result = param error & p1 error %if x # success %or n2 # 0
         x = find owner(owner, part, entry)
         %if x # success %start
            err n1 = 0;  err n2 = 0;  err pling = 0
            err d = owner
            %result = x & xs error
         %finish
         x = get directory(owner, part, entry)
         %result = x %if x < success
         dir info == common_dir info(x)
      %else
         %result = not logged on %if Uno = 0
         dir info == Uno info_d directory
         remember directory(dir info)
      %finish
      %if filename = "" %or filename = "!" %start
         x = forget directory(dir info)
         %result = param error & p1 error
      %finish
      %if charno(filename, length(filename)) = '!' %start
         length(filename) = length(filename) - 1
         pling = 0
      %else
         pling = transient file
      %finish
      x = pack(filename, n1, n2)
      %if x # success %start
         x = forget directory(dir info)
         %result = param error & p1 error
      %finish
      directory == dir info_d
      it = find file(directory, n1, n2, pling)
      %if it < success %start
         x = forget directory(dir info)
         %result = it & xs error
      %finish
      file == directory_file(it)
      b_bytes = 0
      add text(unpack(n1, n2), b)
      add text("?", b) %if file_status & dud file       # 0
      add text("!", b) %if file_status & transient file # 0
      pad(16, b)
      add text(unpack perms(file_perms), b)
      add text("   ", b)
      add text(unpack date(file_date), b)
      add text("  ", b)
      add text(unpack time(file_time & time mask), b)
      x = file size(it, directory, blocks, extents)
      it = forget directory(dir info) %and %result = x %if x # success
      add text("  ", b)
      add text(itos(blocks, 0), b)
      add text("(", b)
      add text(itos(extents, 0), b)
      add text(")", b)
      bytes = b_bytes
      x = forget directory(dir info)
      %result = success
%end

%externalintegerfn FS pass(%integer Uno, %string(255) password, username)
   ! Set a user's password.  Note that we change the password
   ! in the logon directory (hence guaranteeing that the
   ! caller has sufficient authority), %not the default directory.
   ! If the username is specified we change the password for that user.
   %record(Uno info fm)%name Uno info
   %record(dir info fm)%name dir info
   %record(directory fm)%name directory
   %record(header fm)%name header
   %integer x, user, blank, part, entry
      %result = not writeable %if file system writeable = 0
      x = validate Uno(Uno, not logged on)
      %result = x %if x # success
      Uno info == common_Uno(Uno)
      ! Uno OK, so encrypt the password and change it in the
      ! logon directory.
      %if username = "" %start
         ! Null username, change own password
         dir info == Uno info_l directory
         remember directory(dir info)
      %else
         ! Someone else's password
         %result = no authority %unless Uno info_q pass = common_system pass
         x = pack(username, user, blank)
         %result = param error & p2 error %if x # success
         x = find owner(user, part, entry)
         %if x # success %start
            err d = user
            err n1 = 0;  err n2 = 0
            err pling = 0
            %result = owner not found & xs error
         %finish
         x = get directory(user, part, entry)
         %result = x %if x < success
         dir info == common_dir info(x)
         pdate
         printstring(unpack(Uno info_l owner, 0))
         printstring(" changing ")
         printstring(unpack(user, 0))
         printstring("'s password")
         newline
      %finish
      directory == dir info_d
      header == directory_header
!!    password = endecrypt(unpack(Uno info_l owner, 0), password, 0)
      header_password = encrypt(password)
      dir info_written = 1
      %result = forget directory(dir info)
%end

%externalintegerfn FS quote(%integer Uno, %string(255) password)
   ! Quote a password.
   %record(Uno info fm)%name Uno info
   %integer x, pass
      x = validate Uno(Uno, not logged on)
      %result = x %if x # success
      Uno info == common_Uno(Uno)
!!    password = endecrypt(unpack(Uno info_l owner, 0), password, 0)
      pass = encrypt(password)
      Uno info_q pass = pass
      %if pass = common_system pass %start
         pdate
         printstring(unpack(Uno info_l owner, 0))
         printstring(" at ");  print client address(ether context)
         printstring(" quoting system pass")
         newline
      %finish
      %result = success
%end

%externalintegerfn FS setdir(%integer Uno, %string(255) ownername)
   ! Set a new default directory.  If none was specified then
   ! reset to the logon directory.
   %record(Uno info fm)%name Uno info
   %integer x, i, part = -1, entry
   %integer owner, blank
      x = validate Uno(Uno, not logged on)
      %result = x %if x # success
      Uno info == common_Uno(Uno)
      %if ownername = "" %start
         ! Resetting to logon directory
         x = forget directory(Uno info_d directory)
         Uno info_d directory == Uno info_l directory
         Uno info_d owner     =  Uno info_l owner
         remember directory(Uno info_l directory)
         %result = success
      %finish
      ! Setting to somewhere else.  First find out if it exists.
      x = pack(ownername, owner, blank)
      %result = param error & p1 error %if x # success %or blank # 0
      x = find owner(owner, part, entry)
      %if x # success %start
         err n1 = 0;  err n2 = 0;  err pling = 0
         err d = owner %and %result = x & xs error
      %finish
      Uno info == common_Uno(Uno)
      x = get directory(owner, part, entry)
      %result = x %if x < success
      ! Got the new default.  Forget the old one and set the new one.
      i = forget directory(Uno info_d directory)
      Uno info_d directory == common_dir info(x)
      Uno info_d owner = owner
      %result = success
%end

%integerfn special file(%integer Uno,
                        %string(255) which special,
                        %integername Xno, block count, pad count)
   ! Implements the pseudo-files "owned" by "user" $.
   %record(special fm)%name sb
   %record(port fm)%name port info
   %record(Uno info fm)%name Uno info, Uno X
   %record(Xno info fm)%name Xno info, Xno X
   %record(dir info fm)%name dir info
   %record(header fm)%name header
   %record(entry fm)%name file
   %string(255) s
   %integer i, x, bm
      upper case(which special)
      Uno info == common_Uno(Uno)
      Xno = allocate Xno
      %result = no Xno %if Xno < 0
      Xno info == common_Xno(Xno)
      ! The first few pseudo-files already exist in store, as they are
      ! merely the file system's internal tables.
      %if which special = "TRACE" %start
         ! Read the trace buffer
         Xno info_Uno = Uno
         Xno info_special buffer = -1
         Xno info_next to send == byteinteger(addr(common_trace))
         Xno info_file slot = -1
         Xno info_dir info == nil
         Xno info_forget == nil
         Xno info_flags = Xno read
         x = 64 * (tbuffs + 1) + 8
         block count = x >> 9 + 1
         Xno info_blocks to go = block count
         Xno info_bytes = rem(x, 512)
         pad count = 512 - Xno info_bytes
         %result = success
      %else %if which special = "BADLIST"
         ! Read the bad block list
         %result = disc error %if bad block list == nil
         Xno info_Uno = Uno
         Xno info_special buffer = -1
         Xno info_next to send == byteinteger(addr(bad block list))
         Xno info_file slot = -1
         Xno info_dir info == nil
         Xno info_forget == nil
         Xno info_flags = Xno read
         Xno info_blocks to go = 4;  block count = 4
         Xno info_bytes = 512;  pad count = 0
         %result = success
      %else %if which special -> ("BITMAP.") . which special
         ! Read a bitmap
         %result = param error %if length(which special) # 1
         bm = charno(which special, 1) - '0'
         %result = param error %unless 0 <= bm <= last partition
         Xno info_Uno = Uno
         Xno info_special buffer = -1
         Xno info_next to send == common_partition(bm)_bitmap_b(0)
         Xno info_file slot = -1
         Xno info_dir info == nil
         Xno info_forget == nil
         Xno info_flags = Xno read
         x = bitmap size
         block count = x >> 9 + 1
         Xno info_blocks to go = block count
         Xno info_bytes = rem(x, 512)
         pad count = 512 - Xno info_bytes
         %result = success
      %finish
      ! The remainder require that we allocate a special buffer into
      ! which we will write the contents of our pseudo-file.
      x = allocate special
      Xno info_Uno = -1 %and %result = x %if x < success
      ! Got a special buffer.  Set up the Xno to use it.
      sb == common_specials(x)
      Xno info_Uno = Uno
      Xno info_special buffer = x
      Xno info_next to send == common_specials(x)_b(1)
      Xno info_file slot = -1
      Xno info_dir info == nil
      Xno info_forget == nil
      Xno info_flags = Xno read
      ! Now decide which special file is required
      %if which special = "UNOS" %start
         ! Format the Uno table
         %for i = 0, 1, Unos %cycle
            Uno X == common_Uno(i)
            %if Uno X_l owner # 0 %start
               add special(sb, itos(i, 2))
               add special(sb, itos(Uno X_context, 3))
               %if 0 < Uno X_context <= ports %start
                  port info == common_port info(Uno X_context)
                  spaces special(sb, 2)
                  add special(sb, itox2(port info_remote))
                  add special(sb, itos(port info_port, 2))
               %else
                  spaces special(sb, 7)
               %finish
               s = unpack(Uno X_l owner, 0)
               spaces special(sb, 7 - length(s));  add special(sb, s)
               %if Uno X_q pass = common_system pass %start
                  add special(sb, "!")
               %else
                  spaces special(sb, 1)
               %finish
               s = unpack(Uno X_d owner, 0)
               spaces special(sb, 7 - length(s));  add special(sb, s)
               spaces special(sb, 2)
               add special(sb, show stamp(Uno X_logon stamp))
               spaces special(sb, 2)
               add special(sb, show stamp(Uno X_active stamp))
               spaces special(sb, 2)
               add special(sb, show stamp(Uno X_Xno active stamp))
               add special(sb, snl)
            %finish
         %repeat
      %else %if which special = "XNOS"
         ! Format the Xno table
         %for i = 1, 1, Xnos %cycle
            Xno X == common_Xno(i)
            %if Xno X_Uno >= 0 %start
               add special(sb, itos(i, 2))
               add special(sb, itos(Xno X_Uno, 2))
               add special(sb, itos(Xno X_context, 2))
               spaces special(sb, 1)
               %if Xno X_file slot <= 0 %start
                  add special(sb, "Special file")
                  spaces special(sb, 32)
               %else
                  x = 20
                  dir info == Xno X_dir info
                  s = unpack(dir info_owner, 0)
                  add special(sb, s);  x = x - length(s)
                  add special(sb, ":")
                  file == dir info_d_file(Xno X_file slot)
                  s = unpack(file_name1, file_name2)
                  add special(sb, s);  x = x - length(s)
                  add special(sb, "?") %and x = x - 1 %c
                     %if file_status & dud       file # 0
                  add special(sb, "!") %and x = x - 1 %c
                     %if file_status & transient file # 0
                  spaces special(sb, x)
                  add special(sb, itos(Xno X_next file block,   4))
                  %if Xno X_next extent block <= h %start
                     add special(sb, itos(Xno X_next extent block, 4))
                  %else
                     add special(sb, "  ...")
                  %finish
                  add special(sb, itos(Xno X_next disc block,   5))
                  add special(sb, itos(Xno X_extent no + 1,     2))
                  add special(sb, "/")
                  add special(sb, itos(Xno X_extents,           2))
               %finish
               add special(sb, itos(Xno X_blocks,  -6))
               spaces special(sb, 2)
               add special(sb, show stamp(Xno X_active stamp))
               spaces special(sb, 1)
               add special(sb, "R") %if Xno X_flags & Xno read  # 0
               add special(sb, "W") %if Xno X_flags & Xno write # 0
               add special(sb, "L") %if Xno X_flags & Xno last  # 0
               add special(sb, snl)
            %finish
         %repeat
      %else %if which special = "DIRECTORIES"
         ! Format the directory cache table
         %for i = 1, 1, dirs %cycle
            dir info == common_dir info(i)
            %if dir info_owner # 0 %start 
               add special(sb, itos(i, 3))
               spaces special(sb, 3)
               s = unpack(dir info_owner, 0)
               add special(sb, s);  spaces special(sb, 8 - length(s))
               add special(sb, "(")
               add special(sb, itos(dir info_partition, -1))
               add special(sb, ".")
               add special(sb, itos(dir info_user no, -3))
               add special(sb, ")")
               add special(sb, itos(dir info_ref count, 4))
               add special(sb, itos(dir info_stamp, 9))
               add special(sb, "   ** written **") %if dir info_written # 0
               add special(sb, snl)
            %finish
         %repeat
      %else %if which special = "PORTS"
         ! Format the ether port table
         %for i = 1, 1, ports %cycle
            port info == common_port info(i)
            %if port info_state # 0 %start
               add special(sb, itos(i, 2))
               spaces special(sb, 2)
               add special(sb, itox2(port info_remote))
               add special(sb, itos(port info_port, 2))
               spaces special(sb, 2)
               add special(sb, show stamp(port info_opened stamp))
               spaces special(sb, 2)
               add special(sb, show stamp(port info_active stamp))
               add special(sb, snl)
            %finish
         %repeat
      %else
         ! Unknown, so free the special buffer and the Xno
         free special(x)
         Xno info_Uno = -1
         %result = not implemented
      %finish
      ! Set block count and pad count for the resultant "file"
      block count = sb_bytes >> 9 + 1
      Xno info_blocks to go = block count
      Xno info_bytes = rem(sb_bytes, 512)
      pad count = 512 - Xno info_bytes
      %result = success
%end

%integerfn special directory(%integer Uno, %record(dir info fm)%name dir info,
                             %integer owner,
                             %integername Xno, block count, pad count)
   ! Implements the special file "directory", providing a list of the
   ! (accessible) files in the given directory, one file per line.
   %record(Uno info fm)%name Uno info
   %record(Xno info fm)%name Xno info
   %record(special fm)%name sb
   %record(entry fm)%name file
   %integer x, z, i
      Uno info == common_Uno(Uno)
      Xno = allocate Xno
      z = forget directory(dir info) %and %result = Xno %if Xno < success
      Xno info == common_Xno(Xno)
      ! Got an Xno.  Try for a special buffer.
      x = allocate special
      %if x < success %start
         z = forget directory(dir info)
         Xno info_Uno = -1
         %result = x
      %finish
      ! Set up the Xno to use our special buffer
      sb == common_specials(x)
      Xno info_Uno = Uno
      Xno info_special buffer = x
      Xno info_next to send == common_specials(x)_b(1)
      Xno info_file slot = -1
      Xno info_dir info == nil
      Xno info_forget == dir info
      Xno info_flags = Xno read
      ! Now cycle round all the files in the directory, adding them if
      ! the caller is the owner of the directory or if the files
      ! are not protected against the world.
      %for i = dir info_d_header_files & files mask, -1, 1 %cycle
         file == dir info_d_file(i)
         %if owner = success %c
               %or file_perms >> public permission shift & 3 %c
                   >= R permission %start
            add special(sb, unpack(file_name1, file_name2))
            add special(sb, "?") %if file_status & dud       file # 0
            add special(sb, "!") %if file_status & transient file # 0
            add special(sb, snl)
         %finish
      %repeat
      ! Finally, set the block and pad count for the "file"
      block count = sb_bytes >> 9 + 1
      Xno info_blocks to go = block count
      Xno info_bytes = rem(sb_bytes, 512)
      pad count = 512 - Xno info_bytes
      %result = success
%end

%externalintegerfn FS openr(%integer Uno, %string(255) filename,
                            %integername Xno, block count, pad count)
   ! Open file for reading (writing not allowed).
   %string(255) user name
   %record(Uno info fm)%name Uno info
   %record(Xno info fm)%name Xno info
   %record(dir info fm)%name dir info
   %record(directory fm)%name directory
   %record(header fm)%name header
   %record(entry fm)%name file
   %integer file index, x, z, part, entry, i, p extents, owner
   %integer p1, p2, d1, blank
   !D %if common_diags & fsys diags # 0 %start
   !D    pdate
   !D    printstring("OpenR ");  printstring(filename)
   !D    newline
   !D %finish
      !%result = param error & p1 error %if filename = ""
      x = validate Uno(Uno, success)
      %result = x %if x # success
      Uno info == common_Uno(Uno)
      %if filename -> user name . (":") . filename %start
         ! File is not in default directory
         !%result = param error & p1 error %if filename = ""
         %if user name = "$" %start
            ! Special file wanted
            %result = special file(Uno, filename, Xno,
                                   block count, pad count)
         %finish
         %result = param error & p1 error %if username = ""
         ! Find out if the specified owner exists
         x = pack(user name, d1, blank)
         %result = param error & p1 error %if x # success %or blank # 0
         x = find owner(d1, part, entry)
         %if x # success %start
            err n1 = 0;  err n2 = 0;  err pling = 0
            err d = d1
            %result = x & xs error
         %finish
         x = get directory(d1, part, entry)
         %result = x %if x < success
         dir info == common_dir info(x)
      %else
         ! Use the default directory.  Note that we don't allow
         ! ANON to read files from its default directory.
         %result = not logged on %if Uno = 0
         dir info == Uno info_d directory
         remember directory(dir info)
      %finish
      directory == dir info_d
      %if dir info == Uno info_l directory %start
         ! Logon directory, so must have owner authority
         owner = success
      %else
         ! Not logon directory, so check the password
         owner = check password(Uno info_q pass, directory)
      %finish
      upper case(filename)
      %result = special directory(Uno, dir info, owner,
                                  Xno, block count, pad count) %c
         %if filename = "" %or filename = "." %or filename = "DIRECTORY"
      ! Now have a look for the file in the directory
      x = pack(filename, p1, p2)
      z = forget directory(dir info) %and %result = x & p1 error %if x # success
      file index = find file(directory, p1, p2, transient file)
      %if file index < 0 %start
         ! Not there
         err d = directory_header_owner
         z = forget directory(dir info)
         err n1 = p1;  err n2 = p2
         %result = file not found & xs error
      %finish
      ! Found it.  Does the caller have read authority?  Quoting the
      ! system password will do too.
      file == directory_file(file index)
      %unless (owner = success %and %c
                (file_perms >> owner  permission shift) & 3 >= R permission) %c
          %or (owner # success %and %c
                (file_perms >> public permission shift) & 3 >= R permission) %c
          %or Uno info_q pass = common_system pass %c
      %start
         ! No.
         err d = directory_header_owner
         z = forget directory(dir info)
         err n1 = p1;  err n2 = p2
         %result = file not found & xs error
      %finish
      ! Authority OK, check for conflicts
      x = check conflicts(directory_header_owner, p1, p2, 0, Xno write)
      z = forget directory(dir info) %and %result = x %if x # success
      log access(Uno info, directory_header_owner, file, "OpenR")
      ! Set up the Xno
      Xno = allocate Xno
      %if Xno < 0 %start
         z = forget directory(dir info)
         %result = no Xno
      %finish
      Xno info == common_Xno(Xno)
      Xno info_next file block = 1;                ! Start at the beginning
      Xno info_next extent block = infinity - 1;   ! Force read of first extent
      Xno info_flags = Xno read;                   ! Read only
      Xno info_dir info == dir info
      Xno info_file slot = file index
      Xno info_bytes = file_bytes & bytes mask;    ! Extract bytes in last block
      Xno info_bytes = 512 %if Xno info_bytes = 0; ! 0 means a full block
      header == directory_header
      ! Now we have to find out how big the file is.  First find where
      ! its extents are in the directory.
      %if file index = 1 %start
         Xno info_extents = extent limit + 1 - file_extents
         p extents = extent limit + 1
      %else
         Xno info_extents = directory_file(file index - 1)_extents %c
                            - file_extents
         p extents = directory_file(file index - 1)_extents
      %finish
      Xno info_extent no = Xno info_extents;       ! Start at highest (first)
      Xno info_extent = 0;                         ! Zap the Xno extent record
      Xno info_next disc block = 0;                ! and the disc address
      Xno info_Uno = Uno;                          ! Attach Xno to its Uno
      ! Now find out how big the file is.
      block count = 0
      i = file_extents
      %while i < p extents %cycle
         block count = block count + (directory_extent(i)_size & h)
         i = i + 1
      %repeat
      ! Got all the information, so set the block and pad counts
      ! and then we're all done.
      pad count = 512 - Xno info_bytes
      Xno info_blocks = block count
      %result = success
%end

%integerfn uniquify(%string(255) filename, %record(directory fm)%name d,
                    %integername name1, name2)
   ! Create a filename which is guaranteed to be unique in the
   ! directory.  We do this by prepending (?) a special string whose
   ! first three characters are guaranteed not to appear as the first
   ! three characters in any other filename in the directory.  Note that
   ! we must preserve the tail of the supplied filename, since the
   ! laser printer despooler will want to know about the filename's
   ! extension so as to be able to handle it correctly.
   %string(255) it
   %integer i, files, x
   %label next one
   !D %if common_diags & fsys diags # 0 %start
   !D    pdate
   !D    printstring("Uniquify ");  printstring(filename)
   !D    newline
   !D %finish
      %result = param error %if length(filename) > 12
      ! If the given filename is too long then take only the tail end of it.
      filename = substring(filename, length(filename) - 8, length(filename)) %c
         %if length(filename) > 9
      ! Now construct a first guess at the uniquified filename
      it = "AAA........."
      length(it) = 12 - length(filename)
      it = it . filename
      x = pack(it, name1, name2)
      %result = x %if x # success
   !D %if common_diags & fsys diags # 0 %start
   !D    pdate
   !D    printstring(it);  printstring(" packed as ")
   !D    phex(name1);  space
   !D    phex(name2);  newline
   !D %finish
      ! First guess is a valid filename, so scan the directory looking
      ! for the initial three-letter sequence.  If we find it then we
      ! twiddle the guess and try again.
      files = d_header_files & files mask
next one:
      %for i = 1, 1, files %cycle
         %if d_file(i)_name1 = name1 %start
            ! Sequence already exists, so try another one.
            name1 = name1 + 16_10000
            -> next one
         %finish
      %repeat
      %result = success
%end

%externalintegerfn FS openw(%integer Uno, %string(255) filename,
                            %integer block count,
                            %integername Xno)
   ! Open a file for writing (reading not allowed).  The file is
   ! created in its '!' form (if it doesn't already exist as such).
   ! When the file is closed it will be truncated to the length
   ! it last had (resetting may shorten it).  Note that the caller
   ! must have owner authority wrt the directory into which the file
   ! is to be written.
   %record(directory fm)%name dir
   %record(header fm)%name header
   %record(entry fm)%name file
   %record(extent fm)%name extent
   %record(dir info fm)%name dir info
   %record(Uno info fm)%name Uno info
   %record(Xno info fm)%name Xno info
   %integer n1, n2, user, blank
   %integer x, z, files, last extent, part, entry, a start, a size, perms
   %integer blocks, extents
   %short date, time
   %string(255) user name
      %result = not writeable %if file system writeable = 0
   !D %if common_diags & fsys diags # 0 %start
   !D    pdate
   !D    printstring("OpenW ");  printstring(filename)
   !D    printstring(", ");  write(block count, 0)
   !D    newline
   !D %finish
      x = validate Uno(Uno, success)
      %result = x %if x # success
      Uno info == common_Uno(Uno)
      %if filename -> user name . (":") . filename %start
         ! Owner name explicitly given, so see if it exists.
         %result = param error & p1 error %if username = ""
         %result = not implemented %if username = "$";  ! Specials
         x = pack(user name, user, blank)
         %result = param error & p1 error %if x # success %or blank # 0
         x = find owner(user, part, entry)
         %if x # success %start
            err n1 = 0;  err n2 = 0;  err pling = 0
            err d = user
            %result = x & xs error
         %finish
         x = get directory(user, part, entry)
         %result = x %if x < success
         dir info == common_dir info(x)
         ! Owner exists, so check whether caller has owner authority
         ! wrt directory.  If it was the logon directory then that
         ! follows by definition, otherwise we must check the password.
         %if dir info ## Uno info_l directory %start
            x = check password(Uno info_q pass, dir info_d)
            z = forget directory(dir info) %and %result = x %if x # success
         %finish
      %else
         ! No owner supplied, so use default
         %result = not logged on %if Uno = 0
         dir info == Uno info_d directory
         %if dir info ## Uno info_l directory %start
            ! Not logon directory, so check password
            x = check password(Uno info_q pass, dir info_d)
            %result = x %if x # success
         %finish
         remember directory(dir info)
      %finish
      dir == dir info_d
      header == dir_header
      files = header_files & files mask
      ! Convert ASCII form of filename to internal packed form, at the
      ! same time performing any required uniquification.
      %if filename = "" %or filename = "!" %start
         x = uniquify("", dir, n1, n2)
      %else %if charno(filename, 1) = '!'
         x = uniquify(substring(filename, 2, length(filename)),
                      dir, n1, n2)
      %else
         x = pack(filename, n1, n2)
      %finish
      z = forget directory(dir info) %and %result = x & p1 error %if x # success
      ! Check that we aren't conflicting with someone else.
      x = check conflicts(header_owner, n1, n2, 1, Xno write)
      z = forget directory(dir info) %and %result = x %if x # success
      ! Find whether the file exists.  If it does, then it must be
      ! in its non-'!' form, and must have full access permission to
      ! the owner (thus it is possible to protect files against
      ! accidental overwriting.
      x = find file(dir info_d, n1, n2, 0)
      %if x > success %start
         ! File exists.  Make sure it isn't a '!'-file, and that there
         ! is full access to owner.
         file == dir info_d_file(x)
         %if file_status & transient file # 0 %start
            ! '!' form already exists
            z = forget directory(dir info)
            err d = dir info_d_header_owner
            err n1 = n1;  err n2 = n2
            err pling = 1
            %result = file exists
         %else %unless file_perms >> owner permission shift & 3 = F permission
            ! No authority to overwrite existing version
            z = forget directory(dir info)
            %result = no authority
         %finish
         ! File already exists, so inherit access mask and size
         perms = file_perms & permissions mask
         z = file size(x, dir info_d, blocks, extents)
         block count = blocks + default allocation %if block count = 0
      %else
         ! File is new, so use default access mask
         perms = header_perms & permissions mask
      %finish
   !D %if common_diags & fsys diags # 0 %start
   !D    pdate
   !D    printstring("Permissions will be ")
   !D    phex(perms)
   !D    newline
   !D %finish
      ! Default the initial allocation if none was supplied
      block count = default allocation %if block count <= 0
      ! Check user's quota before allowing initial allocation
      %if block count > dir info_d_header_quota left & h %start
         z = forget directory(dir info)
         err d = dir info_d_header_owner
         err n1 = n1;  err n2 = n2
         %result = no quota & xs error
      %finish
      Xno = allocate Xno
      z = forget directory(dir info) %and %result = no Xno %if Xno < 0
      Xno info == common_Xno(Xno)
      %if files = 0 %start
         ! Directory is currently empty
         files = 1
         last extent = extent limit + 1
      %else
         ! Directory has file in it, so make sure there is a free
         ! slot for the file and at least one extent.  Each file header
         ! requires space equivalent to 4 extents in the directory.  We
         ! must allow 4 for each file which exists already, 4 for the file
         ! we are about to create, 4 for the directory header and 1 for the
         ! first extent of the new file.
         file == dir_file(files)
         last extent = file_extents
         %if files * 4 + 4 + 4 + 1 >= last extent %start
            ! Files and extents would overlap.
            Xno info_Uno = -1;  ! Free the Xno
            err d = dir info_d_header_owner
            err n1 = n1;  err n2 = n2
            err pling = file_status & transient file
            z = forget directory(dir info)
            %result = no slot & xs error
         %finish
         ! Space for the file, so bump the count for the directory
         files = files + 1
      %finish
      time stamp(date, time)
      file == dir_file(files)
      ! Allocate the first extent in the file
      file_extents = last extent - 1
      allocate extent(block count,
                      common_partition(dir info_partition)_bitmap_b(0),
                      a size, a start)
      %if a start < 0 %start
         ! We've run out of space on the disc, so bounce the request
         Xno info_Uno = -1
         %result = disc full
      %finish
   !D %if common_diags & fsys diags # 0 %start
   !D    pdate
   !D    write(a size, 0);  printstring(" allocated at ")
   !D    write(a start, 0)
   !D    newline
   !D %finish
      ! Set up extent pointer in directory
      extent == dir_extent(file_extents)
      extent_start <- a start
      extent_size  = a size
      ! Set up file header in directory
      file_name1   = n1
      file_name2   = n2
      file_perms   = perms
      file_status  = time ! transient file
      file_date    = date
      ! Bump file count in header, remembering to preserve the default
      ! protection in the top bits.
      header_files = header_files + 1
      log access(Uno info, dir_header_owner, file, "OpenW")
      ! Set up the Xno
      Xno info_file slot = files
      Xno info_Uno = Uno
      Xno info_dir info == dir info
      Xno info_next file block = 1;                ! Start at first block
      Xno info_next extent block = -1;             ! To start in new extent
      Xno info_next disc block = a start - 1;      ! To start in new extent
      Xno info_extent = extent;                    ! Copy from directory
      Xno info_extent no = 0;                      ! First extent
      Xno info_extents = 0;                        ! Only extent
      Xno info_flags = Xno write;                  ! Write only
      Xno info_bytes = 0;                          ! Assume last block full
      Xno info_blocks = 0;                         ! None yet
      dir info_written = 1
      %result = success
%end

%integerfn open boot(%integer Uno, %integername Xno)
   ! Open the boot area as a special file
   %record(Uno info fm)%name Uno info
   %record(Xno info fm)%name Xno info
      %if common_diags & fsys diags # 0 %start
         pdate
         printstring("Open boot")
         newline
      %finish
      Uno info == common_Uno(Uno)
      %result = no authority %unless Uno info_q pass = common_system pass %c
                                 %or Uno info_l owner = GDMR %c
                                 %or Uno info_l owner = RWT  %c
                                 %or Uno info_l owner = SYSTEM
      Xno = allocate Xno
      %result = Xno %if Xno < success
      Xno info == common_Xno(Xno)
      Xno info = 0
      Xno info_Uno = Uno
      Xno info_context = ether context
      Xno info_flags = Xno read ! Xno write
      Xno info_file slot = -2
      %result = success
%end

%externalintegerfn FS openmod(%integer Uno, %string(255) filename,
                              %integername Xno, block count, pad count)
   ! Open file for both reading and writing.  The file may be extended
   ! but will not be truncated.  Non-owners may modify files provided
   ! they have full access to those files.
   %string(255) user name
   %record(Uno info fm)%name Uno info
   %record(Xno info fm)%name Xno info
   %record(dir info fm)%name dir info
   %record(directory fm)%name directory
   %record(header fm)%name header
   %record(entry fm)%name file
   %integer file index, x, z, part, entry, i, p extents, owner
   %integer p1, p2, d1, blank
   %short date, time
      %result = not writeable %if file system writeable = 0
      %result = param error & p1 error %if filename = ""
      x = validate Uno(Uno, success)
      %result = x %if x # success
      Uno info == common_Uno(Uno)
      %if filename -> user name . (":") . filename %start
         %result = param error & p1 error %if filename = ""
         ! Ownername provided, so check if it exists
         %result = param error & p1 error %if username = ""
         %if username = "$" %start
            %if filename = "BOOTAREA" %start
               block count = head size;  pad count = 0
               %result = open boot(Uno, Xno)
            %finish
            %result = not implemented
         %finish
         x = pack(user name, d1, blank)
         %result = param error & p1 error %if x # success %or blank # 0
         x = find owner(d1, part, entry)
         %if x # success %start
            err n1 = 0;  err n2 = 0;  err pling = 0
            err d = d1
            %result = x & xs error
         %finish
         x = get directory(d1, part, entry)
         %result = x %if x < success
         dir info == common_dir info(x)
      %else
         ! No ownername provided, so use default
         %result = not logged on %if Uno = 0
         dir info == Uno info_d directory
         remember directory(dir info)
      %finish
      directory == dir info_d
      ! Check for owner authority wrt directory
      %if dir info == Uno info_l directory %start
         owner = success
      %else
         owner = check password(Uno info_q pass, directory)
      %finish
      ! Now look for the file
      x = pack(filename, p1, p2)
      z = forget directory(dir info) %and %result = x & p1 error %if x # success
      file index = find file(directory, p1, p2, transient file)
      %if file index < 0 %start
         ! File doesn't exist
         err d = directory_header_owner
         z = forget directory(dir info)
         err n1 = p1;  err n2 = p2
         %result = file not found
      %finish
      file == directory_file(file index)
      ! Check authority -- must be full
      %unless (owner = success %and %c
                (file_perms >> owner  permission shift) & 3 = F permission) %c
          %or (owner # success %and %c
                (file_perms >> public permission shift) & 3 = F permission) %c
      %start
         err d = directory_header_owner
         z = forget directory(dir info)
         err n1 = p1;  err n2 = p2
         %result = file not found
      %finish
      ! Authority OK, check for access conflicts
      x = check conflicts(directory_header_owner, p1, p2, 1, Xno read ! Xno write)
      z = forget directory(dir info) %and %result = x %if x # success
      log access(Uno info, directory_header_owner, file, "OpenMod")
      ! Get an Xno
      Xno = allocate Xno
      %if Xno < 0 %start
         z = forget directory(dir info)
         %result = no Xno
      %finish
      time stamp(date, time)
      ! File may be modified, so update its time stamp
      file_date = date
      file_time = file_time & (\ time mask) ! time
      dir info_written = 1
      Xno info == common_Xno(Xno)
      Xno info_next file block = 1
      Xno info_next extent block = infinity - 1;      ! Force read of first extent
      Xno info_flags = Xno read ! Xno write;          ! Allow reading and writing
      Xno info_dir info == dir info
      Xno info_file slot = file index
      Xno info_bytes = file_bytes & bytes mask;       ! Bytes in last block
      Xno info_bytes = 512 %if Xno info_bytes = 0;    ! 0 means a full block
      header == directory_header
      ! Now find out where the extents are in the directory
      %if file index = 1 %start
         Xno info_extents = extent limit + 1 - file_extents
         p extents = extent limit + 1
      %else
         Xno info_extents = directory_file(file index - 1)_extents %c
                            - file_extents
         p extents = directory_file(file index - 1)_extents
      %finish
      Xno info_extent no = Xno info_extents;          ! First extent
      Xno info_extent = 0;                            ! Zap extent record
      Xno info_next disc block = 0;                   ! and disc address
      Xno info_Uno = Uno;                             ! Attach to Uno
      ! Now find out how big the file ie
      block count = 0
      i = file_extents
      %while i < p extents %cycle
         block count = block count + (directory_extent(i)_size & h)
         i = i + 1
      %repeat
      ! All done, set the block and pad counts
      pad count = 512 - Xno info_bytes
      Xno info_blocks = block count
      %result = success
%end

%externalintegerfn FS writesq(%integer Xno, %integer bytes,
                              %record(buffer fm)%name buffer)
   ! Write the next block in the file.  Bump the file size if the
   ! file was opened for writing only (not read/mod).
   %record(Xno info fm)%name Xno info
   %record(dir info fm)%name dir info
   %record(directory fm)%name d
   %record(header fm)%name header
   %record(extent fm)%name extent
   %record(entry fm)%name file
   %integer x, a start, a size, files, i
      %result = not writeable %if file system writeable = 0
      %result = param error & p2 error %unless 0 <= bytes <= 512
      x = validate Xno(Xno)
      %result = x %if x # success
      Xno info == common_Xno(Xno)
      %result = illegal operation %if Xno info_flags & Xno write = 0
      %result = not implemented %if Xno info_file slot < 0;  ! Special
   !D %if common_diags & fsys diags # 0 %start
   !D    pdate
   !D    printstring("WriteSQ:")
   !D    write(Xno info_next file block, 1)
   !D    write(Xno info_blocks, 1)
   !D    %if 0 < bytes < 512 %start
   !D       printstring(" (short ")
   !D       write(bytes, 0)
   !D       print symbol(')')
   !D    %finish
   !D    newline
   !D %finish
      %if Xno info_next file block = Xno info_blocks %start
         ! About to overwrite the last block, so set the last-block size.
      !D %if common_diags & fsys diags # 0 %start
      !D    pdate
      !D    printstring("About to overwrite last block, length was ")
      !D    write(Xno info_bytes, 0)
      !D    printstring(", becoming ")
      !D    write(bytes, 0)
      !D    newline
      !D %finish
         Xno info_bytes = bytes
      %else %if Xno info_next file block = Xno info_blocks + 1
         ! Beyond already-existing data.  Must be extending the file.  Check
         ! that the last (short) block hasn't already been seen.
         %if 0 < Xno info_bytes < 512 %start
            ! Last block has alread gone
         !D %if common_diags & fsys diags # 0 %start
         !D    pdate
         !D    printstring("Short block already gone:")
         !D    write(Xno info_next file block, 1)
         !D    write(Xno info_blocks, 1)
         !D    write(Xno info_bytes, 1)
         !D    newline
         !D %finish
            %result = protocol error
         %finish
         ! OK, so set last-block size
         Xno info_bytes = bytes
      %else
         ! In middle of file (as a result of having been reset).  Ensure
         ! that the current block is a full 512 bytes, as short blocks are
         ! only allowed as the last in the file.
         %if 0 < bytes < 512 %start
         !D %if common_diags & fsys diags # 0 %start
         !D    pdate
         !D    printstring("Short block in middle of file: ")
         !D    write(Xno info_next file block, 1)
         !D    write(Xno info_blocks, 1)
         !D    write(Xno info_bytes, 1)
         !D    newline
         !D %finish
            %result = protocol error
         %finish
      %finish
      dir info == Xno info_dir info
      ! Bump disc address and extent pointer.  NOTE that until we're
      ! sure we've got the space we better be certain we decrement them
      ! again on errors.
      Xno info_next extent block = Xno info_next extent block + 1
      Xno info_next disc block = Xno info_next disc block + 1
      d == dir info_d
      header == d_header
      extent == Xno info_extent
      %if Xno info_next extent block >= (extent_size & h) %start
         ! Off the end of the current extent -- get another one
      !D %if common_diags & fsys diags # 0 %start
      !D    pdate
      !D    printstring("New extent required")
      !D    newline
      !D %finish
         %if Xno info_extent no = 0 %start
            ! Already used last extent we had claimed, so we'll need to
            ! allocate another one
            files = header_files & files mask
            file == d_file(files)
            ! Make sure there's a slot in the directory for the new extent.
            ! 4 for each of the file headers, 4 for the directory header
            ! and 1 for the new extent itself.
            %if files * 4 + 4 + 1 > file_extents %start
               err d = header_owner
               err n1 = file_name1;  err n2 = file_name2
               err pling = file_status & transient file
               Xno info_next extent block = Xno info_next extent block - 1
               Xno info_next disc block = Xno info_next disc block - 1
               %result = no slot & xs error
            %finish
            allocate extent(default allocation,
                            common_partition(dir info_partition)_bitmap_b(0),
                            a size, a start)
            %if a start < 0 %start
               ! The disc was full, so we can't get more space
               Xno info_next extent block = Xno info_next extent block - 1
               Xno info_next disc block = Xno info_next disc block - 1
               %result = disc full
            %finish
         !D %if common_diags & fsys diags # 0 %start
         !D    pdate
         !D    write(a size, 0);  printstring(" allocated at ")
         !D    write(a start, 0)
         !D    newline
         !D %finish
            ! Adjust quota if not '$' or '!' file
            file == d_file(Xno info_file slot)
            %if file_name1 >> 16 < temporary %c
                  %and file_status & transient file = 0 %start
               %if header_quota left < a size %start
                  err d = header_owner
                  err n1 = file_name1;  err n2 = file_name2
                  err pling = 0
                  Xno info_next extent block = Xno info_next extent block - 1
                  Xno info_next disc block = Xno info_next disc block - 1
                  %result = no quota & xs error
               %finish
               header_quota left = header_quota left - a size
            %finish
            %if (extent_start & h) + extent_size = a start %c
                  %and extent_size + a size < 16384 %start
               ! The new extent is contiguous with the previous
               ! one, so we glue them together to save on
               ! directory slots
            !D %if common_diags & fsys diags # 0 %start
            !D    pdate
            !D    printstring("Contiguous extents -- joining")
            !D    newline
            !D %finish
               Xno info_next extent block = extent_size
               Xno info_next disc block = a start
               extent_size = extent_size + a size
               file == d_file(Xno info_file slot)
               extent == d_extent(file_extents)
               extent_size = extent_size + a size
            %else
               ! The new extent isn't contiguous with the previous one,
               ! so we can't join them together.  We'll need a new slot
               ! in the directory, and may have to shuffle to get it.
            !D %if common_diags & fsys diags # 0 %start
            !D    pdate
            !D    printstring("New extent not contiguous")
            !D    newline 
            !D %finish
               file == d_file(Xno info_file slot)
               %if Xno info_file slot # files %start
                  ! Not the last file in the directory, so we'll 
                  ! have to shuffle.
               !D %if common_diags & fsys diags # 0 %start
               !D    pdate
               !D    printstring("Shuffle extents")
               !D    newline
               !D %finish
                  %for i = d_file(files)_extents, 1, file_extents - 1 %cycle
                     d_extent(i - 1) = d_extent(i)
                  %repeat
                  ! Now adjust any file headers whose extents have moved
                  %for i = Xno info_file slot + 1, 1, files %cycle
                     d_file(i)_extents = d_file(i)_extents - 1
                  %repeat
               %finish
               ! Got our extent slot (the case of the last file in the
               ! directory comes for free).  Now set it up and modify the
               ! Xno to use the new extent.
               file_extents = file_extents - 1
               extent == d_extent(file_extents)
               extent_start <- a start
               extent_size = a size
               Xno info_next extent block = 0
               Xno info_next disc block = a start
               Xno info_extent = extent
               Xno info_extent no = 0
               Xno info_extents = Xno info_extents + 1
            %finish
            dir info_written = 1
         %else
            ! Already an extent allocated -- reuse it
         !D %if common_diags & fsys diags # 0 %start
         !D    pdate
         !D    printstring("Reuse existing extent")
         !D    newline
         !D %finish
            Xno info_extent no = Xno info_extent no - 1
            Xno info_extent = %c
               d_extent(d_file(Xno info_file slot)_extents + Xno info_extent no)
            Xno info_next disc block = Xno info_extent_start & h
            Xno info_next extent block = 0
         %finish
      %finish
      ! Extent pointers are now OK, so write the block out.
      x = write block(dir info_partition, Xno info_next disc block, buffer)
      %if x # success %start
         ! Block write failed.  Mark the file as dubious
         file == d_file(Xno info_file slot)
         file_status = file_status ! dud file
         dir info_written = 1
         ! Now complain and add it to a bad block list.
         pdate
         printstring("*** Bad block: partition ")
         write(dir info_partition, 0)
         printstring(", logical block ")
         write(Xno info_next disc block, 0)
         printstring(", file ")
         printstring(unpack(header_owner, 0));  print symbol(':')
         printstring(unpack(file_name1, file_name2))
         print symbol('?') ;!  %if file_status & dud file # 0
         print symbol('!') %if file_status & transient file # 0
         newline
!REACH   add to bad block list(p start(dir info_partition) %c
!REACH                         + Xno info_next disc block)
         P reach add to bad block list(dir info_partition,
                                       Xno info_next disc block)
         %result = x
      %finish
      ! Bump the file size if the last write has extended the file
      x = Xno info_blocks + 1
      Xno info_blocks = x %if x = Xno info_next file block
      Xno info_next file block = Xno info_next file block + 1
!O    %if 0 < bytes < 512 %start
!O       { Last block }
!O       %if common_diags & fsys diags # 0 %start
!O          pdate
!O          printstring("Last block gone")
!O          newline
!O       %finish
!O       Xno info_bytes = bytes
!O    %finish
      %result = success
%end

%externalintegerfn FS reset(%integer Xno, block number)
   ! Reset next-block pointer.  First block in file is 0.
   %record(Xno info fm)%name Xno info
   %record(dir info fm)%name dir info
   %record(entry fm)%name file
   %record(extent fm)%name extent
   %record(directory fm)%name d
   %record(special fm)%name special
   %integer x, e, e limit, slot, i, fb, eno
   %bytename qq
   !D %if common_diags & fsys diags # 0 %start
   !D    pdate
   !D    printstring("Reset Xno ");  write(Xno, 0)
   !D    printstring(" to block ");  write(block number, 0)
   !D    newline
   !D %finish
      x = validate Xno(Xno)
      %result = x %if x # success
      Xno info == common_Xno(Xno)
      %if Xno info_file slot < 0 %start
         ! Special file
         %result = not implemented %c
            %unless 0 < Xno info_special buffer <= specials
         special == common_specials(Xno info_special buffer)
         i = special_bytes >> 9
         %result = size error & p1 error %unless 0 <= block number <= i
         qq == special_b(1)
         Xno info_next to send == qq [512 * block number]
         Xno info_blocks to go = i - block number + 1
         %result = success
      %finish
      %result = size error & p1 error %unless 0 <= block number <= Xno info_blocks
      ! RH condition is <= to allow one beyond end of file.  The size is
      ! OK, so set the new next file block
      Xno info_next file block = block number + 1
      dir info == Xno info_dir info
      d == dir info_d
      slot = Xno info_file slot
      file == d_file(slot)
      ! Find extents in directory
      e limit = file_extents
      %if slot = 1 %start
         e = extent limit
      %else
         e = d_file(slot - 1)_extents - 1
      %finish
      ! Scan extents until we find which contains the desired block
      fb = 1;  eno = e - d_file(slot)_extents
      %while e >= e limit %cycle
         extent == d_extent(e)
         %if block number < extent_size %start
            ! Block lies in current extent
            Xno info_next extent block = block number                      - 1
            Xno info_next disc   block = block number + (extent_start & h) - 1
            Xno info_extent no = eno
            Xno info_extent = extent
            %if Xno info_flags & Xno read = 0 %start
               ! Write only, so reset file length
               Xno info_blocks = Xno info_next file block - 1
               Xno info_bytes = 0;  ! reset short block
            %finish
         !D %if common_diags & fsys diags # 0 %start
         !D    pdate
         !D    printstring("File reset:")
         !D    write(Xno info_next file block, 1)
         !D    write(Xno info_blocks, 1)
         !D    write(Xno info_next extent block, 1)
         !D    write(Xno info_next disc block, 1)
         !D    write(eno, 1)
         !D    newline
         !D %finish
            %result = success
         %finish
         ! Not in this extent, so take account of its size and then
         ! go round again for the next one.
         i = block number - extent_size
         fb = fb + extent_size
         eno = eno - 1
         e = e - 1
         block number = i
      %repeat
      ! Requested block was outwith extents.  Must be one block beyond
      ! the end of the last one, so set up to force either an empty read
      ! or a new extent when writing.
      Xno info_extent no = 0;                      ! Current extent is last
      Xno info_extent = extent;                    ! Set extent data!!!
      Xno info_next extent block = infinity - 1;   ! Way beyond end of file
      %result = success;  ! (we hope)
%end

%integerfn close file(%integer Xno, mode)
   ! Close/Uclose a file
   !     mode = 0: UClose
   !     mode # 0:  Close
   %record(Xno info fm)%name Xno info
   %record(Uno info fm)%name Uno info
   %record(dir info fm)%name dir info
   %record(extent fm)%name extent
   %record(entry fm)%name file, file x
   %record(header fm)%name header
   %integer x, old file slot, free, first to free, files, extents
   %integer f size, t size, i, new q, used, q restore
   %integer n1, n2
   !D %if common_diags & fsys diags # 0 %start
   !D    pdate
   !D    printstring("Close Xno ");  write(Xno, 0)
   !D    printstring(", mode ");  write(mode, 0)
   !D    printstring(", context ");  write(ether context, 0)
   !D    newline
   !D %finish
      x = validate Xno(Xno)
      %result = x %if x # success
      Xno info == common_Xno(Xno)
      %if Xno info_file slot < 0 %start
         ! Special file -- free the buffer
      !D %if common_diags & fsys diags # 0 %start
      !D    pdate
      !D    printstring("Closing special file")
      !D    newline
      !D %finish
         free special(Xno info_special buffer) %if Xno info_special buffer > 0
         x = forget directory(Xno info_forget) %if Xno info_forget ## nil
         Xno info_Uno = -1
         %result = success
      %finish
      ! Normal file, so we may have to delete it or un-'!' it and
      ! truncate it.
      Uno info == common_Uno(Xno info_Uno)
      dir info == Xno info_dir info
      header == dir info_d_header
      files = header_files & files mask
      file == dir info_d_file(Xno info_file slot)
      %if Xno info_flags & Xno write # 0 %start
         ! File must have been opened for writing
         %if {mode = 0 %and} Xno info_blocks = 0 %start
            ! No blocks written, so delete it
         !D %if common_diags & fsys diags # 0 %start
         !D    pdate
         !D    printstring("No blocks were written, deleting....")
         !D    newline
         !D %finish
            Xno info_Uno = -1;  ! Must forget Xno before deleting file
            x = delete file(Xno info_file slot, dir info)
            %result = forget directory(dir info)
         %else %if Xno info_next file block > Xno info_blocks
            ! File will require truncation
            q restore = 0
            file_bytes = file_bytes & permissions mask ! Xno info_bytes
            ! Spare in this extent?
            extent == dir info_d_extent(file_extents + Xno info_extent no)
            used = Xno info_next extent block + 1
            free = (extent_size & h) - used
            %if free > 0 %start
               ! Unused blocks in the current extent -- free them
            !D %if common_diags & fsys diags # 0 %start
            !D    pdate
            !D    write(free, 0)
            !D    printstring(" spare in current extent")
            !D    newline
            !D %finish
               free extent((extent_start & h) + used, free,
                           common_partition(dir info_partition)_bitmap_b(0))
               q restore = free
            %finish
            extent_size = used
            ! Now see if there are any more unused extents -- the file may
            ! have been reset to shorten it.
            extents = Xno info_extent no
            first to free = extents - 1
            %if first to free >= 0 %start
               ! There are unused extents.  Cycle round them, freeing
               ! the space they use
               %for i = 0, 1, first to free %cycle
               !D %if common_diags & fsys diags # 0 %start
               !D    pdate
               !D    printstring("Free unused extent ")
               !D    write(i, 0)
               !D    newline
               !D %finish
                  extent == dir info_d_extent(file_extents + i)
                  free extent(extent_start, extent_size,
                              common_partition(dir info_partition)_bitmap_b(0))
                  q restore = q restore + free
               %repeat
               ! Now remove the unused extents from the directory
               %if Xno info_file slot = files %start
                  ! Last file in directory -- easy special case
                  file_extents = file_extents + extents
               %else
                  ! Not last file in directory -- we'll have to shuffle
               !D %if common_diags & fsys diags # 0 %start
               !D    pdate
               !D    printstring("Shuffle extents")
               !D    newline
               !D %finish
                  dir info_d_extent(i + extents) = dir info_d_extent(i) %c
                     %for i = file_extents - 1, %c
                              -1, %c
                              dir info_d_file(files)_extents
                  ! Now reset the extent pointers for later files
                  %for i = Xno info_file slot, 1, files %cycle
                     file x == dir info_d_file(i)
                     file x_extents = file x_extents + extents
                  %repeat
               %finish
            %finish
            ! Restore quota if necessary
            %if file_name 1 >> 16 < temporary %c
                  %and file_status & transient file = 0 %start
               dir info_d_header_quota left = dir info_d_header_quota left + %c
                                              q restore
            %finish
            dir info_written = 1
         %finish
      %finish
      ! File has been truncated if required.  Now see if we have to
      ! de-'!' it, deleting a previous incarnation if one exists.
      %if mode # 0 %start
         ! Successful close, so de-'!'ing may be required.  First find
         ! out how big the new file is, so that we can adjust quotas as
         ! required.
         n1 = file_name1;  n2 = file_name2
         x = file size(Xno info_file slot, dir info_d, t size, i)
         %result = x %if x # success
         %if Xno info_flags & Xno read = 0 %c
               %and file_status & transient file # 0 %start
            ! May be an earlier '!'-version to replace (Write only!)
            old file slot = find file(dir info_d, n1, n2, transient file)
            %if old file slot > success %c
                  %and old file slot # Xno info_file slot %start
               ! Found a previous version (not the same file)
               ! Check to see if we have to deduct quota
               %if n1 >> 16 < temporary %start
                  ! Will be a permanent file, deduct quota
                  new q = header_quota left - t size
                  %if new q < 0 %start
                     err d = dir info_d_header_owner
                     err n1 = n1;  err n2 = n2
                     %result = no quota & xs error
                  %finish
                  header_quota left = new q
               %finish
               ! Now delete the previous version
               x = delete file(old file slot, dir info);  ! Restores quota
               %result = x %if x < success
            %else
               ! No previous version of the file exists
               %if n1 >> 16 < temporary %start
                  ! Enclosing condition ensures file is currently transient
                  ! Becoming permanent file, deduct quota
                  new q = header_quota left - t size
                  %if new q < 0 %start
                     err d = dir info_d_header_owner
                     err n1 = n1;  err n2 = n2
                     %result = no quota & xs error
                  %finish
                  header_quota left = new q
               %finish
            %finish
            ! Now de-'!' it
            file == dir info_d_file(Xno info_file slot)
            file_status = file_status & (\transient file)
            dir info_written = 1
         %finish
      %finish
      Xno info_Uno = -1
      %result = forget directory(dir info)
%end

%externalintegerfn FS close(%integer Xno)
   ! Successful close
   %result = close file(Xno, 1)
%end

%externalintegerfn FS Uclose(%integer Xno)
   ! Unsuccessful close
   %result = close file(Xno, 0)
%end

%externalintegerfn FS readsq(%integer Xno, %integername bytes,
                             %record(buffer fm)%name buffer)
   ! Read the next block in a file.
   %record(Xno info fm)%name Xno info
   %record(dir info fm)%name dir info
   %record(directory fm)%name d
   %record(entry fm)%name file
   %integer x
   !D %if common_diags & fsys diags # 0 %start
   !D    pdate
   !D    printstring("ReadSQ ");  write(Xno, 0)
   !D    newline
   !D %finish
      x = validate Xno(Xno)
      %result = x %if x # success
      Xno info == common_Xno(Xno)
      ! File must have been opened for reading, of course
      %result = illegal operation %if Xno info_flags & Xno read = 0
      %if Xno info_file slot < 0 %start
         %result = not implemented %if Xno info_file slot # -1
         ! Reading special buffer
         %if Xno info_blocks to go <= 0 %start
            ! At the end
            buffer_bytes = 0
            bytes = 0
            %result = success
         %finish
         ! One fewer left now
         Xno info_blocks to go = Xno info_blocks to go - 1
         %if Xno info_blocks to go = 0 %start
            ! This one is the last, so use short values
            buffer_bytes = Xno info_bytes
            bytes = Xno info_bytes
         %else
            ! Not the last, so use full block
            buffer_bytes = 512
            bytes = 512
         %finish
         ! Shift the data, bump the pointer
         bulk move(bytes, Xno info_next to send, buffer_b(0)) %if bytes > 0
         Xno info_next to send == Xno info_next to send[512]
         %result = success
      %finish
      ! Normal disc file.
      %if Xno info_next file block > Xno info_blocks %start
         ! Last block already gone
         bytes = 0
         buffer_bytes = 0
         %result = success
      %finish
      dir info == Xno info_dir info
      d == dir info_d
      ! Bump disc address and extent pointer
      Xno info_next disc block = Xno info_next disc block + 1
      Xno info_next extent block = Xno info_next extent block + 1
      %if Xno info_next extent block >= (Xno info_extent_size & h) %start
         ! Off the end of the extent -- we'll need to get the next one
      !D %if common_diags & fsys diags # 0 %start
      !D    pdate
      !D    printstring("Get next extent")
      !D    newline
      !D %finish
         file == d_file(Xno info_file slot)
         ! Get next extent index
         Xno info_extent no = Xno info_extent no - 1
         ! Get the extent itself
         Xno info_extent = d_extent(file_extents + Xno info_extent no)
         ! Disc start address for extent
         Xno info_next disc block = (Xno info_extent_start & h)
         ! First block in extent
         Xno info_next extent block = 0
      %finish
      %if Xno info_next file block = Xno info_blocks %start
         ! Last block of last extent -- use short size
         bytes = Xno info_bytes
         buffer_bytes = bytes
      %else
         ! Not the last block, so use full 512
         bytes = 512
         buffer_bytes = 512
      %finish
      ! Get the block off the disc
      x = read block(dir info_partition, Xno info_next disc block, buffer)
      ! Bump block-in-file pointer
      Xno info_next file block = Xno info_next file block + 1
      %result = x
%end

%externalintegerfn FS readda(%integer Xno, block number,
                             %integername bytes,
                             %record(buffer fm)%name buffer)
   ! Direct access (ie non-sequential) read, done as a Reset followed
   ! by a ReadSQ.  Vast extra checking, but.....
   %record(Xno info fm)%name Xno info
   %integer x
      x = validate Xno(Xno)
      %result = x %if x < success
      Xno info == common_Xno(Xno)
      %if Xno info_file slot < 0 %start
         ! A special file -- is it the boot area?
         %if Xno info_file slot = -2 %start
            ! Yes, allow it.
            bytes = 512;  buffer_bytes = 512
            %result = read boot area(block number, buffer_b(0))
         %finish
      %finish
      x = FS reset(Xno, block number)
      %result = x %if x # success
      %result = FS readsq(Xno, bytes, buffer)
%end

%externalintegerfn FS writeda(%integer Xno, block number, bytes,
                              %record(buffer fm)%name buffer)
   ! Direct access (ie non-sequential) write, done as a Reset followed
   ! by a WriteSQ.  Vast extra checking, but.....
   %record(Xno info fm)%name Xno info
   %integer x
      %result = not writeable %if file system writeable = 0
      x = validate Xno(Xno)
      %result = x %if x < success
      Xno info == common_Xno(Xno)
      %if Xno info_file slot < 0 %start
         ! A special file -- is it the boot area?
         %if Xno info_file slot = -2 %start
            ! Yes, allow it if a full block.
            %result = param error %if 0 # bytes # 512
            %result = write boot area(block number, buffer_b(0))
         %finish
      %finish
      x = FS reset(Xno, block number)
      %result = x %if x # success
      %result = FS writesq(Xno, bytes, buffer)
%end

%externalintegerfn FS readback(%integer Xno, %integername bytes,
                               %record(buffer fm)%name buffer)
   ! Read back the previous block in the file, decrementing current
   ! position pointers.
   %record(Xno info fm)%name Xno info
   %record(dir info fm)%name dir info
   %integer x
      x = validate Xno(Xno)
      %result = x %if x # success
      Xno info == common_Xno(Xno)
      %result = not implemented %if Xno info_file slot < 0;  ! Special
      dir info == Xno info_dir info
      %if Xno info_next file block = 1 %start
         ! Already at the start of the file
         bytes = 0
         buffer_bytes = 0
         %result = success
      %finish
      ! Decrement pointers.  Shorten the file if we are reading
      ! back the last block in the file.
      Xno info_next file block = Xno info_next file block - 1
      Xno info_blocks = Xno info_blocks - 1 %c
         %if Xno info_next file block = Xno info_blocks
      %if Xno info_next extent block < 0 %start 
         ! Off the start of the current extent -- bring in previous one
         Xno info_extent no = Xno info_extent no + 1
         Xno info_extent = %c
            dir info_d_extent(dir info_d_file(Xno info_file slot)_extents %c
                              + Xno info_extent no)
         Xno info_next extent block = Xno info_extent_size - 1
         Xno info_next disc block = (Xno info_extent_start & h) %c
                                    + Xno info_next extent block
      %finish
      x = read block(dir info_partition, Xno info_next disc block, buffer)
      Xno info_next disc   block = Xno info_next disc   block - 1
      Xno info_next extent block = Xno info_next extent block - 1
      %result = x %if x # success
      bytes = Xno info_bytes
      bytes = 512 %if bytes = 0
      buffer_bytes = bytes
      Xno info_bytes = 0
      !?? What happens if we readback from the middle of the file?!
      %result = success
%end

%externalintegerfn FS general(%integer Uno, case,
                              %string(255) sp2,
                              %integername bytes,
                              %record(buffer fm)%name buffer)
   ! Miscellaneous stuff, e.g. time of day
   %record(Uno info fm)%name Uno info
   %short date, time
   %string(255) d, t
   %integer x, common start
      x = validate Uno(Uno, success)
      %result = x %if x # success
      Uno info == common_Uno(Uno)
      %if case = 0 %start
         ! Date and time
         time stamp(date, time)
         d = unpack date(date)
         t = unpack time(time)
         buffer_bytes = 0
         add text(d, buffer)
         add text("  ", buffer)
         add text(t, buffer)
         bytes = buffer_bytes
         %result = success
      %else
         %result = not implemented
      %finish
%end

%constinteger control kill Uno  =  1
%constinteger control kill Xno  =  2
%constinteger control kill port =  3
%constinteger control diags     =  4
%constinteger control available =  5
%constinteger control sys pass  =  6
%constinteger control reboot    =  7
%constinteger control bad block =  8
%constinteger control setdate   =  9
%constinteger control lpzap     = 10
%constinteger last control      = 10

%externalinteger lpzap = -1

%externalintegerfnspec set date and time(%string(15) date, time)

%externalintegerfn FS control(%integer Uno, option, %string(255) param)
   ! Filestore control -- kill ports, Unos, Xnos, set trace, openness
   %record(Uno info fm)%name Uno info
   %record(Uno info fm)%name Uno info x
   %record(Xno info fm)%name Xno info
   %integer x, current context, i, j, u, q
   %string(127) sp1, sp2
   %switch case(0 : last control)
      x = validate Uno(Uno, not logged on)
      %result = x %if x # success
      Uno info == common_Uno(Uno)
      -> case(option) %if 0 < option <= last control

case(*):
      %result = not implemented

case(control kill Uno):
      current context = ether context
      u = hdx to i(param)
      %result = param error & p2 error %unless 0 < u <= Unos
      Uno info x == common_Uno(u)
      %result = no authority %unless Uno info_q pass = common_system pass %c
         %or Uno info x_l owner = Uno info_l owner  { Allow suicide }
      %result = not logged on %if Uno info x_l owner = 0
   !D %if common_diags & fsys diags # 0 %start
   !D    pdate
   !D    printstring(unpack(Uno info_l owner, 0))
   !D    printstring(" killing Uno ")
   !D    write(u, 0)
   !D    newline
   !D %finish
      ether context = Uno info x_context
      x = FS logoff(u)
      %if x # success %start
         printstring("*** Kill Uno ");  write(u, 0)
         printstring(": failed to log off user: ")
         write(x, 0)
         newline
      %finish
      ether context = current context
      %result = success

case(control kill Xno):
      %result = no authority %unless Uno info_q pass = common_system pass
      current context = ether context
      x = hdx to i(param)
      %result = param error & p2 error %unless 0 < x <= Xnos
      Xno info == common_Xno(x)
   !D %if common_diags & fsys diags # 0 %start
   !D    pdate
   !D    printstring(unpack(Uno info_l owner, 0))
   !D    printstring(" killing Xno ")
   !D    write(x, 0)
   !D    newline
   !D %finish
      ether context = Xno info_context
      q = FS Uclose(x)
      %if q # success %start
         printstring("*** Kill Xno ");  write(x, 0)
         printstring(": failed to log off user: ")
         write(q, 0)
         newline
      %finish
      ether context = current context
      %result = success

case(control diags):
      { Set diagnostic mode }
      %result = no authority %unless Uno info_q pass = common_system pass
      common_diags = hdx to i(param)
      %result = success

case(control available):
      { Open/close system }
      %result = no authority %unless Uno info_q pass = common_system pass
      common_system open = hdx to i(param)
      pdate
      printstring("System availability set to ");  write(common_system open, 0)
      printstring(" by ");  printstring(unpack(Uno info_l owner, 0))
      printstring(" at ");  print client address(ether context)
      newline
      %result = success

case(control sys pass):
      { Set a new system password }
      %result = no authority %unless Uno info_q pass = common_system pass
      pdate
      printstring(unpack(Uno info_l owner, 0))
      printstring(" at ");  print client address(ether context)
      printstring(" setting new system password")
      newline
!!    param = endecrypt(unpack(Uno info_l owner, 0), param, 0)
      q = set system pass(encrypt(param))
      %result = q %if q # success
      Uno info_q pass = common_system pass;  ! Preserve privilege
      %result = success

case(control reboot):
      { Reboot the filestore system }
      %result = no authority %unless Uno info_q pass = common_system pass
      pdate
      printstring(unpack(Uno info_l owner, 0))
      printstring(" rebooting.....")
      newlines(3)
      %for i = 1, 1, 500 000 %cycle;  %repeat
      *move.w  #16_2700, D0
      *trap    #0
      *move.l  0, SP
      *move.l  4, -(SP)
      *rts
      %result = illegal operation;  ! Placate compilers, etc....

case(control bad block):
      { Add a new bad block to the bad list }
      %result = no authority %unless Uno info_q pass = common_system pass
      i = hdx to i(param)
      %result = param error & p2 error %c
         %unless sy1 start + head size <= i < sy2 start
      pdate
      printstring(unpack(Uno info_l owner, 0))
      printstring(" at ");  print client address(ether context)
      printstring(" adding ");  write(i, 0)
      printstring(" to bad block list")
      newline
      add to bad block list(i)
      %result = success

case(control set date):
      { Set date and time }
      %result = no authority %unless Uno info_q pass = common_system pass
      %result = param error & p2 error %unless param -> sp1 . (" ") . sp2
      %result = param error & p2 error %unless length(sp1) = 8
      %result = param error & p2 error %unless length(sp2) = 5
      i = set date and time(sp1, sp2)
      %result = param error & p2 error %if i # success
      pdate
      printstring("Date and time reset by ")
      printstring(unpack(Uno info_l owner, 0))
      printstring(" at ");  print client address(ether context)
      newline
      %result = success

case(control lpzap):
      { Ask the printer to stop printing something }
      i = hdx to i(param)
      %result = param error & p2 error %unless 0 < i <= despoolers
      lpzap = i;  ! Printer will notice this "shortly"
      pdate
      printstring("Printer ");  write(lpzap, 0)
      printstring(" zapped by ")
      printstring(unpack(Uno info_l owner, 0))
      printstring(" at ");  print client address(ether context)
      newline
      %result = success
%end

%externalroutine FSx clear context(%integer context)
   ! Clear down an ether context (= port).  Uclose all transactions
   ! and log off all users using the port.
   %record(Uno info fm)%name Uno info
   %record(Xno info fm)%name Xno info
   %integer i, x
      %for i = 1, 1, Xnos %cycle
         ! First scan the Xno table looking for transactions owned
         ! by the context being killed....
         ether context = context
         Xno info == common_Xno(i)
         x = FS Uclose(i) %if Xno info_Uno >= 0 %c
            %and Xno info_context = context
      %repeat
      %for i = 1, 1, Unos %cycle
         ! Now scan the Uno table, doing similarly....
         ether context = context
         Uno info == common_Uno(i)
         x = FS logoff(i) %if Uno info_l owner # 0 %c
            %and Uno info_context = context
      %repeat
%end

%end %of %file