! File system for new filestores using Mouse kernel

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

! To do: interaction between delete and open files
!        support for append-mode
!        improved handling for improperly-closed files

%constinteger partitions = 31
%constinteger open file limit = 48
%constinteger bitmap increment = 6113;  ! Prime
%constinteger auto extend blocks = 32
%constinteger default initial blocks = 32
%constinteger access update interval = 1024;  ! Seconds, ~17 minutes

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

%constinteger infinity = 16_3FFFFFFF;  ! Large enough

%constinteger interrupts off = 16_0700;  ! SR with IPL 7

%include "Moose:Mouse.Inc"
%include "GDMR_H:FSysAcc.Inc"
%include "GDMR_H:DateTime.Inc"

%systemintegerfnspec global heap get(%integer size)

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


! Dictionary access

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

%conststring(31) state name = "FSYS_STATE"
%owninteger fsys state = 0

! File access mode flags

%constinteger auto truncate  flag = 1
%constinteger improper close flag = 2


! Error codes

%constinteger bugcheck                       = -100
%constinteger end of file              error = -101
%constinteger file header checksum     error = -102
%constinteger index file full          error = -103
%constinteger file table full          error = -104
%constinteger no such file             error = -105
%constinteger no authority             error = -106
%constinteger bad token                error = -107
%constinteger invalid size             error = -108
%constinteger bad operation            error = -109
%constinteger file header full         error = -110
%constinteger not file structured      error = -111
%constinteger partition ID             error = -112
%constinteger not implemented          error = -113
%constinteger incompatible mode        error = -114
%constinteger invalid block            error = -115
%constinteger no privilege             error = -116
%constinteger partition full           error = -117
%constinteger bad refcount increment   error = -118
%constinteger non zero refcount        error = -119
%constinteger dud file index           error = -120
%constinteger improperly closed file   error = -121
%constinteger file structured          error = -122


! Bitmap stuff

%externalintegerfnspec new bitmap(%integer size, increment)
%externalpredicatespec allocate extent(%integer desired size, desired start,
                                       %integer bitmap,
                                       %integername allocated size, start block)
%externalpredicatespec check extent(%integer check start, check size, bitmap)
%externalpredicatespec free extent(%integer free start, free size, bitmap)
%externalpredicatespec claim extent(%integer claim start, claim size, bitmap)


! File header formats & constants.

! Access definitions (conventionally ID > 0 for user, < 0 for group)
%recordformat header access fm(%integer ID, access)

%constinteger no        access =   0   { File is inaccessible
%constinteger read      access =   1   { File can be read
%constinteger modify    access =   2   { File can be modified
%constinteger append    access =   4   { File can be appended to
%constinteger exchange  access =   8   { File can be (extent) exchanged
%constinteger link      access =  16   { File can be (un)linked
%constinteger control   access =  32   { File attributes can be modified
%constinteger deny      access =  64   { Invert sense of access bits

%constinteger an altering access mode = modify access ! append access ! %c
                                        exchange access

%constinteger new owner access = read   access ! modify   access ! %c
                                 append access ! exchange access ! %c
                                 link   access ! control  access
%constinteger new local access = read access
%constinteger new world access = no access;  ! nil access -> local

%constinteger system ID = -1

! Flag word definitions
%constinteger overlapping        file  = 16_0002
%constinteger bad block          file  = 16_0004
%constinteger improperly closed  file  = 16_0008

%constinteger backup   required        = 16_0100
%constinteger archive  required        = 16_0200

%constinteger multiple references      = 16_40000000;  ! Pseudo-flag

! Extent definition
%recordformat extent fm(%integer start, size)


! Header definition
%constinteger non extent size = 8 + 2 + 2 + 12 + 8 + %c
                                12 + 12 + 16 + 4 + 2 + 2

%constinteger extent limit = (512 - non extent size) // 8
%constinteger access table size = extent limit;  ! One grows up, other down

%recordformat file header fm((%integer checksum, ID,
                              %short header refcount,
                              %short flags,
                              %integer owner, owner access, supervisor,
                              %integer world access, local access,
                              %integer creator, static ID, audit ID,
                              %integer created, modified, accessed,
                              %string(15) creation name,
                              %integer blocks used,
                              %short bytes in last block,
                              %short extent limit,
                              ( %record(header access fm)%array %c
                                    access(1 : access table size) %c
                            %or %record(extent fm)%array %c
                                    extent(1 : extent limit)) %c
                             ) %or %integerarray x(1 : 128))

! ID fields:
!     directory | partition | sequence | index
!       2 bits  |   6 bits  |  8 bits  | 16 bits

%constinteger index              part = 16_0000FFFF
%constinteger file ID            part = 16_00FFFFFF
%constinteger partition          part = 16_3F000000
%constinteger partition         shift = 24
%constinteger partition number   mask = partition part >> partition shift
%constinteger file ID            mask = 16_3FFFFFFF

%constinteger file sequence increment = 16_00010000


! Partition access

%externalintegerfnspec partition read(%integer block, %record(*)%name buffer)
%externalintegerfnspec partition write(%integer block, %record(*)%name buffer)
%externalroutinespec   partition enquiry(%integername v, s, h)

%recordformat partition fm(%integer size, flags, index site, index size, bitmap,
                           %bytename header allocation bitmap,
                           %record(file header fm) index header)
%constinteger partition valid          = 16_0001
%constinteger partition hazarded       = 16_0002
%constinteger partition structured     = 16_0004
%constinteger access logging enabled   = 16_0100


%recordformat partition header fm((%integer checksum, size, index, flags %c
                                  ) %or %integerarray x(1 : 128))
! Various extra stuff can go on the end later....


! Open file tables

%recordformat header cache fm(%integer refcount, status, dirty,
                              %record(semaphore fm) semaphore,
                              %record(file header fm) h)

%recordformat open file table fm(%integer ID,
                                 %integer mode,
                                 %integer compatible,
                                 %record(header cache fm)%name fh)
! Should be something about access here too?

%constinteger slot allocated = 16_80000000


! Process-common tables (including interlock semaphores) -> dictionary

%recordformat header lookaside fm(%record(header lookaside fm)%name next,
                                  %record(header cache fm) h)
! Needed, since we can't (easily) share the heap

%recordformat common tables fm(%record(semaphore fm) initialisation semaphore,
                               %record(semaphore fm) open file table semaphore,
                               %record(partition fm)%array %c
                                  partition(1 : partitions),
                               %record(open file table fm)%array %c
                                  open file table(1 : open file limit),
                               %record(header lookaside fm)%name hll)

%ownrecord(common tables fm)%name tables == nil


! File header lookaside list processing
! NB: these are interlocked by the open file semaphore (assumed claimed)
! Records are popped from the front of the list as required,
! and pushed on the front again when no longer required.

%record(header cache fm)%map new file header
   %record(header lookaside fm)%name hl
      hl == tables_hll
      %if hl == nil %start
         %signal 10, 98, 0, "lookaside list empty"
      %finish
      tables_hll == hl_next
      hl_next == nil;  ! Just in case
      %result == hl_h
%end

%routine dispose file header(%record(header cache fm)%name h)
   %record(header lookaside fm)%name hl
      hl == record(addr(h) - 4);  ! Link field
      hl_next == tables_hll
      tables_hll == hl
%end
      

! File header checksum generation & verification

%routine set header checksum(%record(file header fm)%name h)
   %integer i, c
      c = 0
      c <- c + h_x(i) %for i = 2, 1, 128
      h_checksum = -c
%end

%predicate check header checksum(%record(file header fm)%name h)
!  %integer i, c
!     c = 0
!     c <- c + h_x(i) %for i = 1, 1, 128
!     %true %if c = 0
!     %false
   %label L, F
      ! (already) A0 = addr(h)
      D0 = 0;  D1 = 127
   L: *add.l (A0)+, D0
      *dbra D1, L
      *tst.l D0
      *bne F
      %true
   F: %false
%end


! File I/O
! Scan through the extent list in the file header looking for the extent
! containing the requested block.  Apply the partition offset and do the
! transfer if found.

%integerfn read file block(%integer p,
                           %record(file header fm)%name h,
                           %integer block,
                           %record(*)%name buffer)
   %record(extent fm)%name e
   %integer i
      !! printstring("Read file block: partition ");  write(p, 0)
      !! printstring(", header at ");  phex(addr(h))
      !! printstring(", block ");  write(block, 0)
      !! printstring(", buffer ");  phex(addr(buffer));  newline
      %result = end of file error %if h_extent limit > extent limit
      %for i = extent limit, -1, h_extent limit %cycle
         e == h_extent(i)
         %if block < e_size %start
            %result = partition read((p << partition shift) + e_start + block,
                                     buffer)
         %else
            block = block - e_size
         %finish
      %repeat
      !! printstring("Read file block: out of extents")
      !! newline
      %result = end of file error
%end

%integerfn write file block(%integer p,
                            %record(file header fm)%name h,
                            %integer block,
                            %record(*)%name buffer)
   %record(extent fm)%name e
   %integer i
      %result = end of file error %if h_extent limit > extent limit
      %for i = extent limit, -1, h_extent limit %cycle
         e == h_extent(i)
         %if block < e_size %start
            %result = partition write((p << partition shift) + e_start + block,
                                      buffer)
         %else
            block = block - e_size
         %finish
      %repeat
      %result = end of file error
%end


! Index file I/O
! Since the index is just another file we can use the normal block
! transfer routines above.  The index's header is cached.

%integerfn read index block(%integer pn, n,
                            %record(file header fm)%name h)
   %integer status
      !! printstring("Read index block: partition ");  write(pn, 0)
      !! printstring(", slot ");  write(n, 0);  newline
      n = n & index part
      %unless 0 < n <= tables_partition(pn)_index size %start
         !! printstring("Read index block: n = ");  write(n, 0)
         !! printstring(", pn = ");  write(pn, 0);  newline
         %result = dud file index error
      %finish
      status = read file block(pn, tables_partition(pn)_index header, n - 1, h)
      %result = status %if status < 0
      %result = file header checksum error %unless check header checksum(h)
      %result = 0
%end

%integerfn write index block(%integer pn, n,
                             %record(file header fm)%name h)
   !! printstring("Write index block: partition ");  write(pn, 0)
   !! printstring(", slot ");  write(n, 0);  newline
   set header checksum(h)
   n = n & index part
   %unless 0 < n <= tables_partition(pn)_index size %start
      !! printstring("Write index block: n = ");  write(n, 0)
      !! printstring(", pn = ");  write(pn, 0);  newline
      %result = dud file index error
   %finish
   %result = write file block(pn, tables_partition(pn)_index header, n - 1, h)
%end


! File size determination
! Scan the extent list adding up the sizes.

%integerfn file size(%record(file header fm)%name h)
   %integer i, s
      !! display header(h)
      s = 0
      s = s + h_extent(i)_size %for i = extent limit, -1, h_extent limit
      %result = s
%end


! File slot allocation stuff
! Slots in the file header are allocated from a bitmap for each
! partition, access to which is interlocked via the open file table
! semaphore (ASSUMED claimed).
! *Should really cycle through slots*

%integerfn allocate file slot(%record(partition fm)%name p)
   %integer i, j, k
   %bytename b
      b == p_header allocation bitmap
      %for i = 1, 1, p_index size // 8 %cycle
         %if b # 255 %start
            k = 1
            %for j = 0, 1, 7 %cycle
               %if b & k = 0 %start
                  ! Found one
                  b = b ! k
                  %result = 8 * i + j - 7
               %finish
               k = k << 1
            %repeat
         %finish
         b == b [1]
      %repeat
      %result = index file full error
%end

%routine free file slot(%record(partition fm)%name p, %integer slot)
   %integer byte, bit
   %bytename b
      %signal 13, 99, bugcheck %unless 0 < slot <= p_index size
      slot = slot - 1
      byte = slot // 8;  bit = slot & 7
      b == p_header allocation bitmap
      b [byte] = b [byte] & (\ (1 << bit))
%end

%routine claim file slot(%record(partition fm)%name p, %integer slot)
   %integer byte, bit
   %bytename b
      slot = slot - 1
      byte = slot // 8;  bit = slot & 7
      b == p_header allocation bitmap
      b [byte] = b [byte] ! (1 << bit)
%end


! Initialisation
! Obtain the partition details from the partition module and the
! partition headers (conventionally block 0 of each).  If the
! partition is structured, scan the index file and verify and build
! the bitmaps.

%routine load claim(%record(file header fm)%name h, %integer bitmap,
                    %integername tally)
   %record(extent fm)%name e
   %integer i
      tally = 0
      %for i = extent limit, -1, h_extent limit %cycle
         e == h_extent(i)
         %unless claim extent(e_start, e_size, bitmap) %start
            printstring("Claim extent fails for file ")
            phex(h_ID);  printstring(" extent ");  write(i, 0)
            printstring(": start ");  write(e_start, 0)
            printstring(", size ");  write(e_size, 0)
            newline
         %finish
         tally = tally + e_size
      %repeat
%end

%bytemap zapped map(%integer bytes)
   %integer where
      bytes = (bytes + 7) & (\ 3)
      where = global heap get(bytes)
      D0 = bytes // 4 - 1
      A0 = where
   L: *clr.l (A0)+
      *dbra D0, L
      %result == byteinteger(where)
%end

%routine load partition(%integer pn, structured, hazarded)
   %record(partition header fm) partition header
   %record(file header fm) fh
   %record(partition fm)%name p
   %integer c, j, status, px, i, tally, size tally, size
      !! printstring("Load partition ");  write(pn, 0)
      !! printstring(" structured") %if structured # 0
      !! printstring(" hazarded") %if hazarded # 0
      !! newline
      p == tables_partition(pn)
      px = pn << partition shift
      p_flags = partition valid ! access logging enabled;  !<<<<<<<<<
      p_flags = p_flags ! partition hazarded %if hazarded # 0
      %return %if structured = 0
      ! Partition is structured, so we must scan its index file.
      p_flags = p_flags ! partition structured
      status = partition read(px, partition header)
      %if status < 0 %start
         printstring(" *disc error reading header*")
         newline
         %return
      %finish
      !! printstring("Got header");  newline
      c = 0
      c <- c + partition header_x(j) %for j = 1, 1, 128
      %if c # 0 %start
         printstring(" *header checksum error*")
         newline
         p_flags = 0
         %return
      %finish
      tally = 1
      ! Extract size and index offset, and set up bitmaps
      p_size = partition header_size
      p_index site = partition header_index
      p_bitmap = new bitmap(p_size, bitmap increment)
      status = partition read(px ! p_index site, p_index header)
      %if status < 0 %start
         printstring(" *index header checksum error*")
         newline
         p_flags = p_flags & (\ partition structured)
         %return
      %finish
      p_index size = file size(p_index header) & (\ 7)
      p_header allocation bitmap == zapped map(p_index size // 8)
      p_header allocation bitmap = 1;  ! Claim the index file
      load claim(p_index header, p_bitmap, size)
      size tally = size
      !! printstring("Index size is ");  write(p_index size, 0);  newline
      %for i = 2, 1, p_index size %cycle
         !! printstring("Reading ");  write(i, 0);  newline
         status = read index block(pn, i, fh)
         %if status < 0 %start
            printstring("Failed to read file header ");  write(i, 0)
            space;  write(status, 0)
            newline
            p_flags = p_flags & (\ partition hazarded);  ! Minimise damage
            %continue
         %finish
         %unless check header checksum(fh) %start
            printstring("File header checksum error for ")
            write(i, 0)
            newline
            p_flags = p_flags & (\ partition hazarded);  ! Minimise damage
            %continue
         %finish
         %if fh_ID & index part # 0 %start
            ! File slot is in use
            claim file slot(p, i)
            load claim(fh, p_bitmap, size)
            tally = tally + 1
            size tally = size tally + size
         %finish
      %repeat
      printstring("Partition ");  write(pn, 0)
      printstring(": ");  write(tally, 0)
      printstring(" file");  print symbol('s') %if tally # 1
      printstring(" (max ");  write(p_index size, 0);  printstring(", ")
      write(100 * tally // p_index size, 0)
      printstring("%), ");  write(size tally, 0);  printstring(" blocks (")
      write(100 * size tally // p_size, 0);  printstring("%)")
      newline
%end

%externalroutine fsys initialise
   %integer v, s, h, i, m, t
   %record(header lookaside fm)%name hl
      %if FS lookup("FS_FSYS_TABLES", t) %start
         ! Tables are already in the dictionary.  Map them.
         tables == record(t)
         semaphore wait(tables_initialisation semaphore)
         signal semaphore(tables_initialisation semaphore)
      %else
         ! Tables weren't in the dictionary, so we must create them
         ! and initialise them.
         FS insert(state name, addr(fsys state))
         tables == record(global heap get(size of(tables)));  tables = 0
         setup semaphore(tables_initialisation semaphore)
         FS insert("FS_FSYS_TABLES", addr(tables))
         setup semaphore(tables_open file table semaphore)
         signal semaphore(tables_open file table semaphore)
         tables_hll == nil
         %for i = 1, 1, open file limit %cycle
            hl == record(global heap get(size of(hl)))
            hl_next == tables_hll
            tables_hll == hl
         %repeat
         ! Tables initialised, now do the partitions.
         partition enquiry(v, s, h)
         %for i = 1, 1, 31 %cycle
            m = 1 << i
            load partition(i, s & m, h & m) %if v & m # 0
         %repeat
         fsys state = 1
         signal semaphore(tables_initialisation semaphore)
      %finish
%end


! Return valid partition map

%externalroutine fsys valid partitions(%integername v, s)
   %integer i, j
      v = 0;  s = 0
      %for i = 1, 1, partitions %cycle
         j = tables_partition(i)_flags
         v = v ! (1 << i) %if j & partition valid # 0
         s = s ! (1 << i) %if j & partition structured # 0
      %repeat
%end


! Authority checks

%predicate file access authority OK(%record(file header fm)%name h,
                                    %record(fsys access fm)%name access,
                                    %integer mode)
   %record(header access fm)%name a
   %integer permitted access, i, j, have owner access
      %true %if access == nil %or access_privileges & bypass privilege # 0
      permitted access = h_world access
      permitted access = permitted access ! h_local access %c
         %if access_privileges & no local privilege = 0;  ! NB inverted
      %for j = 1, 1, access table size %cycle
         a == h_access(j)
         %exit %if j = h_extent limit %or a_ID = 0
         %for i = 1, 1, access_groups %cycle
            %if access_group(i) = a_ID %start
               %if a_access & deny access = 0 %start
                  permitted access = permitted access ! a_access
               %else
                  permitted access = permitted access & (\ a_access)
               %finish
            %finish
         %repeat
      %repeat
      have owner access = 0
      %for i = 1, 1, access_groups %cycle
         j = access_group(i)
         %if j = h_owner %or j = h_supervisor # 0 %or j = h_creator %start
            have owner access = 1
            %exit
         %finish
      %repeat
      permitted access = permitted access ! h_owner access ! control access %c
         %if h_owner = access_user ID %or h_creator = access_user ID %c
         %or 0 # h_supervisor = access_user ID %or have owner access # 0
      permitted access = permitted access ! read access %c
         %if access_privileges & readall privilege # 0
      %true %if permitted access & mode = mode
      %false
%end


! Open file table access.
! Each open file has a record here, containing access modes etc and a
! pointer to the file's header cache entry.  Files which are open more
! than once share the same header cache entry, which has a reference
! count, a dirty-bit, and an access semaphore as well as the header.
! Semaphore strategy: any manipulations of the headers themselves require
! that the per-header semaphore be claimed.  Any manipulations of the
! tables, as opposed to the headers, require that the global semaphore
! be claimed.

! ASSUME the global semaphore has been claimed when these are called.
! For convenience, RELEASE it should an error condition arise.

%integerfn get open file slot
   %record(open file table fm)%name o
   %integer i
      ! Scan the tables looking for an unused slot
      %for i = 1, 1, open file limit %cycle
         o == tables_open file table(i)
         %if o_mode = 0 %start
            o_mode = slot allocated
            %result = i
         %finish
      %repeat
      ! None found
      signal semaphore(tables_open file table semaphore)
      %result = file table full error
%end

%predicate compatible mode(%integer mode, ID, compatible)
   %record(open file table fm)%name o
   %integer i
      ! Scan the tables checking whether the requested
      ! access mode is compatible with all the other
      ! users' modes.
      %for i = 1, 1, open file limit %cycle
         o == tables_open file table(i)
         %if o_mode # 0 %and o_ID = ID %start
            ! Found an instance of the file.  Check its compatibility
            %if o_compatible & mode # mode %c
                  %or o_mode & compatible # compatible %start
               ! One of the requested modes was prohibited.
               signal semaphore(tables_open file table semaphore)
               %false
            %finish
         %finish
      %repeat
      ! No complaints
      %true
%end

! WHATEVER happens, this one will RELEASE the file table semaphore.  If it
! succeeds it will return with the file header semaphore claimed.

%integerfn get header(%record(open file table fm)%name o)
   %record(open file table fm)%name x
   %integer i
      ! Scan the tables looking for another instance of the
      ! same file.  We must share the header if we find one.
      %for i = 1, 1, open file limit %cycle
         x == tables_open file table(i)
         %if x ## o %start
            ! Not interested in ourselves
            %if x_mode # 0 %and x_ID = o_ID %start
               ! Found another instance
               o_fh == x_fh
               o_fh_refcount = o_fh_refcount + 1
               signal semaphore(tables_open file table semaphore)
               semaphore wait(o_fh_semaphore)
               %if o_fh_status # 0 %start
                  ! Error on last readin.  We could attempt to re-read
                  ! it, but for now we'll just bounce the request....
                  signal semaphore(o_fh_semaphore)
                  %result = o_fh_status
               %finish
               %result = 0
            %finish
         %finish
      %repeat
      ! File is not already open, so must acquire header
      o_fh == new file header
      setup semaphore(o_fh_semaphore);  ! Implicitly claims the semaphore
      o_fh_dirty = 0
      o_fh_refcount = 1
      signal semaphore(tables_open file table semaphore)
      i = read index block(o_ID >> partition shift, o_ID, o_fh_h)
      %if i < 0 %start
         ! Care is required, as someone may be waiting for our header
         ! to arrive.  As we've just initialised the semaphore, however,
         ! we can wait for another without fear of deadlocks...
         semaphore wait(tables_open file table semaphore)
         %if o_fh_refcount <= 1 %start
            ! Only ourselves interested
            dispose file header(o_fh)
            o_fh == nil
         %else
            ! Someone else is now waiting, so don't dump it, just forget it,
            ! signal the semaphore, and return.
            o_fh_status = i
            o_fh_refcount = o_fh_refcount - 1
         %finish
         signal semaphore(tables_open file table semaphore)
         %result = i
      %finish
      o_fh_status = 0
      %result = 0
%end

! This one is entered with the per-header semaphore claimed.  It releases
! that one and claims the global semaphore.

%routine forget header(%record(header cache fm)%name fh)
   signal semaphore(fh_semaphore)
   semaphore wait(tables_open file table semaphore)
   fh_refcount = fh_refcount - 1
   %if fh_refcount <= 0 %start
      ! Header reference count indicates no-one is interested in
      ! the header, so get rid of it.
      fh = 0;  ! Safety??
      dispose file header(fh)
   %finish
   ! else someone is still interested.  We've signalled the semaphore
   ! to allow them to continue....
%end


! User-visible interface
! Open, close, read, write, delete, extend etc.

%externalintegerfn fsys open file(%record(fsys access fm)%name access,
                                  %integer ID, mode, compatible,
                                  %integername token, size, flags)
   %record(file header fm)%name h
   %record(open file table fm)%name f
   %record(partition fm)%name p
   %integer i, pn
      !! printstring("FSys open file ");  phex(ID)
      !! printstring(" mode ");  phex(mode)
      !! printstring(" compatible ");  phex(compatible);  newline
      ID = ID & file ID mask
      ! Find the partition record
      pn = ID >> partition shift
      %result = partition ID error %unless 0 < pn <= partitions
      p == tables_partition(pn)
      %result = partition ID error %if p_flags & partition valid = 0
      %if p_flags & partition structured = 0 %start
         %result = no privilege error %c
            %if access ## nil %and access_privileges & bootarea privilege = 0
         token = 16_80000000 ! pn
         !! printstring("Unstructured open: partition ");  write(pn, 0)
         !! printstring(" -> ");  phex(token);  newline
         size = p_size
         flags = 0
         %result = 0
      %finish
      ! Need access to the tables, so interlock.
      semaphore wait(tables_open file table semaphore)
      %result = incompatible mode error %unless compatible mode(mode, ID, compatible)
      ! Nothing incompatible.  Get a slot in the tables
      token = get open file slot
      %result = token %if token < 0
      f == tables_open file table(token)
      f_ID = ID;  f_mode = mode;  f_compatible = compatible
      ! Need the file's header to check.
      i = get header(f)
      %if i < 0 %start
         f_mode = 0;  ! Release the slot
         %result = i
      %finish
      h == f_fh_h
      %if h_ID # ID & file ID part %start
         forget header(f_fh);  f_fh == nil
         f_mode = 0
         signal semaphore(tables_open file table semaphore)
         %result = no such file error
      %finish
      %unless file access authority OK(h, access, mode) %start
         forget header(f_fh);  f_fh == nil
         f_mode = 0
         signal semaphore(tables_open file table semaphore)
         %result = no authority error
      %finish
      %if h_flags & improperly closed file # 0 %start
         forget header(f_fh);  f_fh == nil
         f_mode = 0
         signal semaphore(tables_open file table semaphore)
         %result = improperly closed file error
      %finish
      %if p_flags & access logging enabled # 0 %start
         i = get datestamp
         h_accessed = i %and f_fh_dirty = 1 %c
            %if i - h_accessed >= access update interval
      %finish
      %if h_blocks used > 0 %start
         size = (h_blocks used - 1) << 9 + h_bytes in last block
      %else
         ! Empty file, so can't use above calculation
         size = 0
      %finish
      flags = h_flags
      flags = flags ! multiple references %if h_header refcount >= 2
      %if mode & an altering access mode # 0 %start
         ! Update stamp on open (for RWT)
         h_modified = get datestamp;  f_fh_dirty = 1
      %finish
      signal semaphore(f_fh_semaphore)
      %result = 0
%end

%externalintegerfn fsys flush header(%record(fsys access fm)%name access,
                                     %integer token)
   %record(open file table fm)%name f
   %record(partition fm)%name p
   %record(header cache fm)%name fh
   %record(file header fm)%name h
   %record(extent fm)%name e
   %integer status, i, alloc, keep, pn
      %result = 0 %if token & 16_80000000 # 0;  ! Unstructured (probably)
      %result = bad token error %unless 0 < token <= open file limit
      semaphore wait(tables_open file table semaphore)
      f == tables_open file table(token)
      fh == f_fh;  h == fh_h
      pn = f_ID >> partition shift
      p == tables_partition(pn)
      signal semaphore(tables_open file table semaphore)
      semaphore wait(fh_semaphore)
      status = 0;  ! Provisionally
      %if fh_dirty # 0 %start
         ! The header has been modified, so we'll have to write
         ! it out to disc.  Maybe it wasn't us, but.....
         status = write index block(pn, f_ID, h)
         %if status < 0 %start
            !! printstring("Flush header: put index status ")
            !! phex(status);  newline
         %else
            fh_dirty = 0
         %finish
      %finish
      signal semaphore(fh_semaphore)
      %result = status
%end

%externalintegerfn fsys close file(%record(fsys access fm)%name access,
                                   %integer token, flags)
   ! If the refcount is zero we should delete the file too.
   %record(open file table fm)%name f
   %record(partition fm)%name p
   %record(header cache fm)%name fh
   %record(file header fm)%name h
   %record(extent fm)%name e
   %integer status, i, alloc, keep, pn
      %result = 0 %if token & 16_80000000 # 0;  ! Unstructured (probably)
      %result = bad token error %unless 0 < token <= open file limit
      semaphore wait(tables_open file table semaphore)
      f == tables_open file table(token)
      fh == f_fh;  h == fh_h
      pn = f_ID >> partition shift
      p == tables_partition(pn)
      signal semaphore(tables_open file table semaphore)
      semaphore wait(fh_semaphore)
      %if f_mode & (modify access ! append access) # 0 %start
         %if flags & auto truncate flag # 0 %start
            ! Excess extents at the end may need to be freed.
            ! (Note that they wouldn't have been readable by the user.)
            %if flags & improper close flag # 0 %start
               h_flags = h_flags ! improperly closed file
               fh_dirty = 1
            %finish
            %if h_flags & overlapping file # 0 %start
               -> close it
            %finish
            alloc = 0
            %for i = extent limit, -1, h_extent limit %cycle
               e == h_extent(i)
               %if alloc >= 0 %start
                  ! All used so far...
                  alloc = alloc + e_size
                  %if alloc > h_blocks used %start
                     keep = e_size - alloc + h_blocks used
                     %unless free extent(e_start + keep, e_size - keep, p_bitmap) %start
                        printstring("Free extent failed");  newline
                     %finish
                     %if keep = 0 %start
                        ! Nothing to keep, so forget the entire extent
                        e_start = -infinity;  e_size = -1;  ! Just in case...
                        h_extent limit = i + 1
                     %else
                        ! Something still in use, so note the new size
                        e_size = keep
                        h_extent limit = i
                     %finish
                     alloc = -1
                     fh_dirty = 1
                  %finish
               %else
                  ! Free from here on
                  %unless free extent(e_start, e_size, p_bitmap) %start
                     printstring("Free extent failed");  newline
                  %finish
                  e = 0
                  fh_dirty = 1
               %finish
            %repeat
         %finish
      %finish
close it:
      status = 0;  ! Provisionally
      %if fh_dirty # 0 %start
         ! The header has been modified, so we'll have to write
         ! it out to disc.  Maybe it wasn't us, but.....
         status = write index block(pn, f_ID, h)
         %if status < 0 %start
            printstring("Close file: put index status ")
            phex(status);  newline
         %else
            fh_dirty = 0
         %finish
      %finish
      forget header(fh);  f_fh == nil
      f_mode = 0
      signal semaphore(tables_open file table semaphore)
      %result = status
%end

%externalintegerfn fsys truncate open file(%record(fsys access fm)%name access,
                                           %integer token, bytes)
   %record(header cache fm)%name fh
   %record(open file table fm)%name f
   %record(file header fm)%name h
   %integer mode, blocks
      !! printstring("FSys truncate open file: access ");  phex(addr(access))
      !! printstring(", token: ");  write(token, 0)
      !! printstring(", blocks: ");  write(blocks, 0)
      !! printstring(", bytes: ");  write(bytes, 0);  newline
      %result = bad token error %unless 0 < token <= open file limit
      %if bytes = 0 %start
         blocks = 0;  bytes = 0
      %else %if bytes > 0
         blocks = bytes >> 9;  bytes = bytes & 511
         blocks = blocks - 1 %and bytes = 512 %if bytes = 0
         ! NB blocks now one too small
      %else
         %result = invalid block error
      %finish
      semaphore wait(tables_open file table semaphore)
      f == tables_open file table(token)
      fh == f_fh;  mode = f_mode
      signal semaphore(tables_open file table semaphore)
      %result = bad operation error %if mode & modify access = 0
      semaphore wait(fh_semaphore)
      h == fh_h
      !! printstring("File header at ");  phex(addr(h));  newline
      %if blocks > h_blocks used %c
            %or (blocks = h_blocks used %c
                 %and bytes > h_bytes in last block) %start
         signal semaphore(fh_semaphore)
         %result = end of file error
      %finish
      h_blocks used = blocks + 1
      h_bytes in last block = bytes
      fh_dirty = 1
      signal semaphore(fh_semaphore)
      %result = 0
%end

%externalintegerfn fsys read file block(%record(fsys access fm)%name access,
                                        %integer token, block,
                                        %integername bytes,
                                        %record(*)%name buffer)
   %record(partition fm)%name p
   %record(header cache fm)%name fh
   %record(open file table fm)%name f
   %record(file header fm)%name h
   %integer pn, status, mode
      !! printstring("FSys read file block: access ");  phex(addr(access))
      !! printstring(", token: ");  write(token, 0)
      !! printstring(", block: ");  write(block, 0)
      !! printstring(", buffer: ");  phex(addr(buffer));  newline
      %if token & 16_80000000 # 0 %start
         ! Unstructured.
         %result = no privilege error %c
            %if access ## nil %and access_privileges & bootarea privilege = 0
         pn = token & 16_7FFFFFFF
         %result = partition ID error %unless 0 < pn <= partitions
         p == tables_partition(pn)
         %result = partition ID error %if p_flags & partition valid = 0
         %result = file structured error %if p_flags & partition structured # 0
         !! printstring("Unstructured read: partition ");  write(pn, 0)
         !! printstring(", block ");  write(block, 0);  newline
         bytes = 512;  ! Assuming we succeed....
         %result = partition read((pn << partition shift) + block, buffer)
      %finish
      %result = bad token error %unless 0 < token <= open file limit
      %result = invalid block error %if block < 0
      semaphore wait(tables_open file table semaphore)
      f == tables_open file table(token)
      fh == f_fh;  mode = f_mode
      signal semaphore(tables_open file table semaphore)
      %result = bad operation error %if mode & read access = 0
      pn = f_ID >> partition shift
      semaphore wait(fh_semaphore)
      h == fh_h
      !! printstring("File header at ");  phex(addr(h));  newline
      %if block >= h_blocks used %start
         !! phex(f_ID);  printstring(" (");  phex(h_ID)
         !! printstring("): asking for ");  write(block, 0)
         !! printstring(", found ");  write(h_blocks used, 0);  newline
         !! display header(h)
         signal semaphore(fh_semaphore)
         %result = end of file error
      %finish
      %if block = h_blocks used - 1 %then bytes = h_bytes in last block %c
                                    %else bytes = 512
      status = read file block(pn, h, block, buffer)
      signal semaphore(fh_semaphore)
      !! printstring("Got block, status ");  write(status, 0);  newline
      %result = status
%end

%externalintegerfn fsys write file block(%record(fsys access fm)%name access,
                                         %integer token, block, bytes,
                                         %record(*)%name buffer)
   %record(partition fm)%name p
   %record(open file table fm)%name f
   %record(header cache fm)%name fh
   %record(file header fm)%name h
   %record(extent fm)%name e
   %integer status, pn, mode, extended = 0, actual, start, i
      %if token & 16_80000000 # 0 %start
         ! Unstructured.
         %result = no privilege error %c
            %if access ## nil %and access_privileges & bootarea privilege = 0
         pn = token & 16_7FFFFFFF
         %result = partition ID error %unless 0 < pn <= partitions
         p == tables_partition(pn)
         %result = partition ID error %if p_flags & partition valid = 0
         %result = file structured error %if p_flags & partition structured # 0
         %result = no authority error %if p_flags & partition hazarded = 0
         !! printstring("Unstructured write: partition ");  write(pn, 0)
         !! printstring(", block ");  write(block, 0);  newline
         ! <bytes> ignored.
         %result = partition write((pn << partition shift) + block, buffer)
      %finish
      %result = bad token error %unless 0 < token <= open file limit
      %result = invalid block error %if block < 0
      semaphore wait(tables_open file table semaphore)
      f == tables_open file table(token)
      fh == f_fh;  mode = f_mode
      signal semaphore(tables_open file table semaphore)
      %result = bad operation error %if mode & modify access = 0
      pn = f_ID >> partition shift
      p == tables_partition(pn)
      semaphore wait(fh_semaphore)
      h == fh_h
      %if block > h_blocks used %start
         ! Can't leave (security) holes in the file
         signal semaphore(fh_semaphore)
         %result = bad operation error
      %finish
      %if block = h_blocks used %start
         ! One beyond the (current) end
         h_blocks used = block + 1
         h_bytes in last block = bytes
         fh_dirty = 1
      %else %if block = h_blocks used - 1
         ! Update of current last block
         h_bytes in last block = bytes
         fh_dirty = 1
      %else %if bytes # 512
         ! Can't put a short block in the middle.
         signal semaphore(fh_semaphore)
         %result = bad operation error
      %finish
try write again:
      status = write file block(pn, h, block, buffer)
!RWT  h_modified = get datestamp;  fh_dirty = 1
      %if status # end of file error %or extended # 0 %start
         signal semaphore(fh_semaphore)
         %result = status
      %finish
      ! No space, get some more
      e == fh_h_extent(fh_h_extent limit)
      %unless allocate extent(auto extend blocks, e_start + e_size,
                              p_bitmap, actual, start) %start
         signal semaphore(fh_semaphore)
         printstring("Extend failed");  newline
         %result = partition full error
      %finish
      %if start = e_start + e_size %start
         ! New extent is contiguous with the old one
         !! printstring("Contiguous, appending");  newline
         e_size = e_size + actual
         fh_dirty = 1
         extended = 1
         -> try write again
      %finish
      i = fh_h_extent limit - 1
      %if i > 0 %start
         e == fh_h_extent(i)
         %if e_start = 0 %start
            ! Found a slot -- block 0 is reserved
            e_start = start
            e_size = actual
            fh_h_extent limit = i
            fh_dirty = 1
            extended = 1
            -> try write again
         %finish
      %finish
      signal semaphore(fh_semaphore)
      %result = file header full error
%end

%externalintegerfn fsys create file(%record(fsys access fm)%name access,
                                    %string(255) creation name,
                                    %integer pn, benefactor ID,
                                    %integer initial allocation,
                                    %integername ID)
   %record(file header fm) bh
   %record(partition fm)%name p, bp
   %record(file header fm)%name h
   %record(header access fm)%name g, bg
   %record(open file table fm)%name o
   %integer slot, status, start, size, i, bpn
      !! printstring("FSys create file: partition ");  write(pn, 0)
      !! printstring(", benefactor ");  phex(benefactor ID);  newline
      pn = pn & partition number mask
      %result = partition ID error %unless 0 < pn <= partitions
      p == tables_partition(pn)
      %result = partition ID error %if p_flags & partition valid = 0
      %result = not file structured error %if p_flags & partition structured = 0
      ! Get the benefactor's file header here
      %if benefactor ID # 0 %start
         !! printstring("Create: benefactor is ");  phex(benefactor ID);  newline
         benefactor ID = benefactor ID & file ID mask
         bpn = benefactor ID >> partition shift
         %result = partition ID error %unless 0 < bpn <= partitions
         bp == tables_partition(bpn)
         %result = partition ID error %if bp_flags & partition valid = 0
         %result = not file structured error %if bp_flags & partition structured = 0
         i = read index block(bpn, benefactor ID, bh)
         %result = i %if i < 0
         %result = no such file error %if bh_ID # benefactor ID & file ID part
         %result = no authority error %c
            %unless file access authority OK(bh, access, modify access)
         ! NB we check for modify access above so that users can't replace files
         ! which they otherwise wouldn't have write access to.  There's a
         ! similar check in the file system process for "do rename".
      %finish
      ! Now try for some disc allocation
      initial allocation = default initial blocks %if initial allocation <= 0
      %unless allocate extent(initial allocation, -1, p_bitmap, size, start) %start
         !! printstring("Allocate failed");  newline
         %result = partition full error %if size < 0
      %finish
      semaphore wait(tables_open file table semaphore)
      slot = allocate file slot(p)
      %if slot < 0 %start
         signal semaphore(tables_open file table semaphore)
         %result = slot
      %finish
      i = get open file slot
      %result = i %if i < 0
      o == tables_open file table(i)
      o_compatible = 0;  o_ID = pn << partition shift ! slot
      status = get header(o)
      %result = status %if status < 0
      h == o_fh_h
      %if h_ID & index part # 0 %start
         printstring("Duplicate index allocation for file ")
         phex(h_ID + file sequence increment);  newline
         forget header(o_fh);  o_fh == nil
         o_mode = 0
         signal semaphore(tables_open file table semaphore)
         %result = bugcheck
      %finish
      h_ID = (h_ID + file sequence increment ! slot) & file ID part
      o_ID = h_ID
      h_header refcount = 0;  ! Nobody (yet)
      h_flags = backup required
      %if benefactor ID = 0 %start
         ! No previous version, so use defaults
         %if access == nil %start
            ! System
            h_owner = system ID
            h_supervisor = system ID
            h_local access = new local access
            h_world access = new local access;  !<<<<<
         %else
            ! A real user
            !! printstring("NO benefactor, using user defaults");  newline
            h_owner = access_user ID
            h_supervisor = access_supervisor ID
            h_local access = no access;   !<<<<<
            h_world access = no access;   !<<<<<
         %finish
         h_owner access = new owner access
      %else
         ! There's a previous version, so we take our defaults from that.
         h_owner = bh_owner;  h_supervisor = bh_supervisor
         h_owner access = bh_owner access
         h_local access = bh_local access
         h_world access = bh_world access
         ! Now copy the groups (if any)
         g == h_access(1);  bg == bh_access(1);  i = 1
         %while i < bh_extent limit %and bg_ID # 0 %cycle
            g = bg
            bg == bg [1];  g == g [1]
            i = i + 1
         %repeat
      %finish
      length(creation name) = 15 %if length(creation name) > 15
      h_creation name = creation name
      h_created = get datestamp
      h_modified = h_created;  h_accessed = h_created
      %if access == nil %then h_creator = system ID %c
                        %else h_creator = access_user ID
      h_static ID = 0
      h_audit ID = 0
      h_blocks used = 0
      h_bytes in last block = 0
      h_extent limit = extent limit
      h_extent(extent limit)_start = start
      h_extent(extent limit)_size = size
      status = write index block(pn, slot, h)
      ID = h_ID ! pn << partition shift
      forget header(o_fh);  o_fh == nil
      o_mode = 0
      signal semaphore(tables_open file table semaphore)
      %result = status
%end

%externalintegerfn fsys delete file(%record(fsys access fm)%name access,
                                    %integer ID)
   %record(open file table fm)%name o
   %record(file header fm)%name h
   %record(partition fm)%name p
   %record(extent fm)%name e
   %integer i, status, pn
      ID = ID & file ID mask
      pn = ID >> partition shift
      %result = partition ID error %unless 0 < pn <= partitions
      p == tables_partition(pn)
      %result = partition ID error %if p_flags & partition valid = 0
      %result = not file structured error %if p_flags & partition structured = 0
      semaphore wait(tables_open file table semaphore)
      %result = incompatible mode error %unless compatible mode(-1, ID, 0)
      i = get open file slot
      %result = i %if i < 0
      o == tables_open file table(i)
      o_compatible = 0;  o_ID = ID
      status = get header(o)
      %if status < 0 %start
         ! Couldn't get the header
         ! Deal with failures properly here.....
         %result = status
      %finish
      h == o_fh_h
      %if h_ID # ID & file ID part %start
         forget header(o_fh);  o_fh == nil
         o_mode = 0
         signal semaphore(tables_open file table semaphore)
         %result = no such file error
      %finish
      %unless file access authority OK(h, access, link access) %start
         forget header(o_fh);  o_fh == nil
         o_mode = 0
         signal semaphore(tables_open file table semaphore)
         %result = no authority error
      %finish
      %if access ## nil %and h_header refcount > 0 %start
         forget header(o_fh);  o_fh == nil
         o_mode = 0
         signal semaphore(tables_open file table semaphore)
         %result = non zero refcount error
      %finish
      h_ID = h_ID & (\ index part)
      %if h_flags & overlapping file = 0 %start
         %for i = extent limit, -1, h_extent limit %cycle
            e == h_extent(i)
            %unless free extent(e_start, e_size, p_bitmap) %start
               printstring("Free extent failed");  newline
            %finish
            e = 0
         %repeat
      %finish
      h_blocks used = 0;  h_bytes in last block = 0
      status = write index block(pn, ID, h)
      %if o_fh_refcount # 1 %start
         printstring("Delete: bad file tables refcount ")
         write(o_fh_refcount, 0);  printstring(" for ");  phex(ID)
         newline
      %finish
      forget header(o_fh);  o_fh == nil
      o_mode = 0
      free file slot(p, ID & index part)
      signal semaphore(tables_open file table semaphore)
      %result = status
%end

! BEWARE deadlocks....
!%externalintegerfn fsys exchange(%record(fsys access fm)%name access,
!                                 %integer ID1, ID2)
!   %record(partition fm)%name p
!   %record(file header fm)%name h1, h2
!   %record(open file table fm)%name f1, f2
!   %record(extent fm)%name e1, e2
!   %integer t1, t2
!   %record(extent fm) e
!   %integer i, j, pn
!   %short q
!      ID1 = ID1 & file ID mask;  ID2 = ID2 & file ID mask
!      pn = ID1 >> partition shift
!      %result = bad operation error %unless pn = ID2 >> partition shift
!      %result = partition ID error %unless 0 < pn <= partitions
!      p == tables_partition(pn)
!      %result = partition ID error %if p_flags & partition valid = 0
!      %result = not file structured error %if p_flags & partition structured = 0
!      semaphore wait(tables_open file table semaphore)
!      %result = incompatible mode error %unless compatible mode(-1, ID1, 0)
!      t1 = get open file slot;  %result = t1 %if t1 < 0
!      f1 == tables_open file table(t1)
!      f1_ID = ID1;  f1_compatible = 0
!      f1_mode = 0 %and %result = incompatible mode error %c
!         %unless compatible mode(-1, ID2, 0);  !???
!      t2 = get open file slot
!      f1_mode = 0 %and %result = t2 %if t2 < 0
!      f2 == tables_open file table(t2)
!      f2_ID = ID1;  f2_compatible = 0
!      i = get header(f1)
!      f1_mode = 0 %and f2_mode = 0 %and %result = i %if i < 0
!      h1 == f1_fh_h
!      f1_mode = 0 %and f2_mode = 0 %and %result = no such file error %c
!         %if h1_ID # ID1 & file ID part
!      semaphore wait(tables_open file table semaphore);  ! Released by 'get header'
!      i = get header(f2)
!      %if i < 0 %start
!         forget header(f1_fh);  f1_fh == nil
!         f1_mode = 0
!         f2_mode = 0
!         %result = i
!      %finish
!      h2 == f2_fh_h
!      %if h2_ID # ID2 & file ID part %start
!         forget header(f1_fh);  f1_fh == nil
!         forget header(f2_fh);  f2_fh == nil
!         f1_mode = 0
!         f2_mode = 0
!         %result = no such file error
!      %finish
!      i = h1_static ID;  h1_static ID = h2_static ID;  h2_static ID = i
!      q = h1_bytes in last block
!      h1_bytes in last block = h2_bytes in last block
!      h2_bytes in last block = q
!      i = h1_blocks used
!      h1_blocks used = h2_blocks used
!      h2_blocks used = i
!      %for i = 1, 1, extent limit %cycle
!         e1 == h1_extent(i);  e2 == h2_extent(i)
!         %exit %if e1_size = 0 = e2_size;  ! All done
!         e = e1;  e1 = e2;  e2 = e
!      %repeat
!      i = write index block(pn, ID1, h1)
!      forget header(f1_fh);  f1_fh == nil
!      f1_mode = 0
!      j = write index block(pn, ID2, h2)
!      forget header(f2_fh);  f2_fh == nil
!      f2_mode = 0
!      %result = i %if i < 0
!      %result = j
!%end

%externalintegerfn fsys bump refcount(%record(fsys access fm)%name access,
                                      %integer ID, increment)
   ! Deletion is implied if the refcount -> 0
   %record(open file table fm)%name o
   %record(file header fm)%name h
   %record(partition fm)%name p
   %record(extent fm)%name e
   %integer i, status, pn, final refcount
      %result = bad refcount increment error %unless -1 <= increment <= 1
      ID = ID & file ID mask
      pn = ID >> partition shift
      %result = partition ID error %unless 0 < pn <= partitions
      p == tables_partition(pn)
      %result = 0 %if p_flags & partition structured = 0;  ! Ignore it
      semaphore wait(tables_open file table semaphore)
      !! %result = incompatible mode error %unless compatible mode(-1, ID, 0)
      i = get open file slot
      %result = i %if i < 0
      o == tables_open file table(i)
      o_compatible = 0;  o_ID = ID
      status = get header(o)
      %if status < 0 %start
         ! Couldn't get the header
         o_mode = 0
         %result = status
      %finish
      h == o_fh_h
      %if h_ID # ID & file ID part %start
         forget header(o_fh);  o_fh == nil
         o_mode = 0
         signal semaphore(tables_open file table semaphore)
         %result = no such file error
      %finish
      %unless file access authority OK(h, access, link access) %start
         forget header(o_fh);  o_fh == nil
         o_mode = 0
         signal semaphore(tables_open file table semaphore)
         %result = no authority error
      %finish
      ! Now modify the file's refcount
      h_header refcount = h_header refcount + increment
      final refcount = h_header refcount
   !? h_modified = get datestamp
      !! phex(ID);  printstring(" refcount -> ")
      !! write(h_header refcount, 0);  newline
      status = write index block(pn, ID, h)
      o_fh_dirty = 0
      forget header(o_fh);  o_fh == nil
      o_mode = 0
      signal semaphore(tables_open file table semaphore)
      %result = status %if status < 0
      %result = fsys delete file(access, ID) %if final refcount <= 0 
      %result = 0
%end


%externalintegerfn fsys get full ID(%integer partial ID, %integername full ID)
   %record(file header fm) h
   %integer status
      partial ID = partial ID & file ID mask
      status = read index block(partial ID >> partition shift, partial ID, h)
      %result = status %if status # 0
      %result = no such file error %if h_ID & index part = 0
      full ID = h_ID ! (partial ID & partition part)
      %result = 0
%end

%externalintegerfn fsys read file header(%record(fsys access fm)%name access,
                                         %integer ID, %record(*)%name fh)
   %record(file header fm) h
   %record(partition fm)%name p
   %integer i, pn
      ID = ID & file ID mask
      ! Find the partition record
      pn = ID >> partition shift
      %result = partition ID error %unless 0 < pn <= partitions
      p == tables_partition(pn)
      %result = partition ID error %if p_flags & partition valid = 0
      %result = not file structured error %if p_flags & partition structured = 0
      i = read index block(pn, ID, h)
      %result = i %if i < 0
      %result = no such file error %if h_ID # ID & file ID part
      %result = no authority error %c
         %unless file access authority OK(h, access, read access)
      fh = h
      %result = 0
%end

%string(31)%fn textual protection(%integer access)
   %string(31) s
      %result = "*none*" %if access = 0;  ! No access
      s = ""
      s = s . "\" %if access & deny     access # 0
      s = s . "R" %if access & read     access # 0
      s = s . "M" %if access & modify   access # 0
      s = s . "A" %if access & append   access # 0
      s = s . "X" %if access & exchange access # 0
      s = s . "L" %if access & link     access # 0
      s = s . "C" %if access & control  access # 0
      %result = s
%end

%externalintegerfn fsys short form info(%record(fsys access fm)%name access,
                                        %integer ID, %string(*)%name result)
   %record(file header fm) h
   %record(partition fm)%name p
   %record(header access fm)%name g
   %string(31) d, t
   %integer i, pn
      ID = ID & file ID mask
      ! Find the partition record
      pn = ID >> partition shift
      %result = partition ID error %unless 0 < pn <= partitions
      p == tables_partition(pn)
      %result = partition ID error %if p_flags & partition valid = 0
      %result = not file structured error %if p_flags & partition structured = 0
      i = read index block(pn, ID, h)
      %result = i %if i < 0
      %result = no such file error %if h_ID # ID & file ID part
      %result = no authority error %c
         %unless file access authority OK(h, access, read access)
      result = itos(h_owner, 0) 
      result = result . "," . itos(h_creator, 0) %if h_creator # h_owner
      result = result . ":" . textual protection(h_owner access)
      result = result . "$" %if h_flags & backup  required       # 0
      result = result . "&" %if h_flags & archive required       # 0
      result = result . "#" %if h_flags & improperly closed file # 0
      result = result . "?" %if h_flags & overlapping       file # 0
      %for i = 1, 1, h_extent limit - 1 %cycle
         g == h_access(i)
         %exit %if g_ID = 0
         result = result . ";" . itos(g_ID, 0) . ":" . textual protection(g_access)
      %repeat
      result = result . ";" . textual protection(h_world access). "  "
      %if h_modified = 0 %start
         unpack date(get datestamp, d, t)
         result = result . d . " " . t
      %else
         unpack date(h_modified, d, t)
         result = result . d . " " . t
      %finish
      result = result . "  " . itos(h_blocks used, 0) . "(" . %c
               itos(extent limit - h_extent limit + 1, 0) . ")"
      %result = 0
%end


%externalintegerfn fsys obtain attributes(%record(fsys access fm)%name access,
                                          %integer ID,
                                          %record(attributes list fm)%name a)
   %record(file header fm) h
   %record(partition fm)%name p
   %record(header access fm)%name g
   %integer i, pn, group pos = 0
   %switch r(first attribute - 1 : last attribute)
      ID = ID & file ID mask
      ! Find the partition record
      pn = ID >> partition shift
      %result = partition ID error %unless 0 < pn <= partitions
      p == tables_partition(pn)
      %result = partition ID error %if p_flags & partition valid = 0
      %result = not file structured error %if p_flags & partition structured = 0
      i = read index block(pn, ID, h)
      %result = i %if i < 0
      %result = no such file error %if h_ID # ID & file ID part
      %result = no authority error %c
         %unless file access authority OK(h, access, read access)
   
      ! Now scan the list, filling in the various attribute requests
      %while a ## nil %cycle
         -> r(a_code) %if first attribute <= a_code <= last attribute
r(*):    a_status = attribute unavailable
         -> next

r(file ID attribute):
         a_numeric = h_ID
         -> OK next

r(file owner attribute):
         a_numeric = h_owner
         -> OK next

r(file supervisor attribute):
         a_numeric = h_supervisor
         -> OK next

r(owner access attribute):
         a_numeric = h_owner access
         -> OK next

r(local access attribute):
         a_numeric = h_local access
         -> OK next

r(world access attribute):
         a_numeric = h_world access
         -> OK next

r(group access attribute):
         group pos = group pos + 1
         %if group pos >= h_extent limit %or h_access(group pos)_ID = 0 %start
            group pos = infinity;  ! Abort any other pending requests
            a_status = attribute unavailable
            -> next
         %finish
         a_numeric2 = h_access(group pos)_ID
         a_numeric = h_access(group pos)_access
         -> OK next

r(defined groups attribute):
         a_status = attribute unavailable
         -> next

r(file creator attribute):
         a_numeric = h_creator
         -> OK next

r(static ID attribute):
         a_numeric = h_static ID
         -> OK next

r(audit ID attribute):
         a_numeric = h_audit ID
         -> OK next

r(date created attribute):
         a_numeric = h_created
         -> OK next

r(date modified attribute):
         a_numeric = h_modified
         -> OK next

r(date accessed attribute):
         a_numeric = h_accessed
         -> OK next

r(creation name attribute):
         a_textual = h_creation name
         -> OK next

r(file size attribute):
         a_numeric = 512 * h_blocks used + h_bytes in last block - 512
         -> OK next

r(file extents attribute):
         a_status = attribute unavailable
         -> next

r(file flags attribute):
         a_numeric = h_flags
         -> OK next

OK next: a_status = attribute OK
next:    a == a_next
      %repeat
      %result = 0
%end

%externalintegerfn fsys modify attributes(%record(fsys access fm)%name access,
                                          %integer ID,
                                          %record(attributes list fm)%name a)
   %record(open file table fm)%name o
   %record(file header fm)%name h
   %record(partition fm)%name p
   %integer i, status, pn, privileged, group pos = 1
   %switch r(first attribute - 1 : last attribute)
      ID = ID & file ID mask
      pn = ID >> partition shift
      %result = partition ID error %unless 0 < pn <= partitions
      p == tables_partition(pn)
      %result = not file structured error %if p_flags & partition structured = 0
      semaphore wait(tables_open file table semaphore)
      !? %result = incompatible mode error %unless compatible mode(-1, ID, 0)
      i = get open file slot
      %result = i %if i < 0
      o == tables_open file table(i)
      o_compatible = 0;  o_ID = ID
      status = get header(o)
      %if status < 0 %start
         ! Couldn't get the header
         o_mode = 0
         %result = status
      %finish
      h == o_fh_h
      %if h_ID # ID & file ID part %start
         forget header(o_fh);  o_fh == nil
         o_mode = 0
         signal semaphore(tables_open file table semaphore)
         %result = no such file error
      %finish
      %unless file access authority OK(h, access, control access) %start
         forget header(o_fh);  o_fh == nil
         o_mode = 0
         signal semaphore(tables_open file table semaphore)
         %result = no authority error
      %finish
      %if access == nil %then privileged = -1 %c
                        %else privileged = access_privileges & admin privilege

      ! Now scan the attributes list, performing modifications as requested
      %while a ## nil %cycle
         -> r(a_code) %if first attribute <= a_code <= last attribute

r(file owner attribute):
         -> unavailable %if privileged = 0
         h_owner = a_numeric
         -> OK next

r(file supervisor attribute):
         -> unavailable %if privileged = 0
         h_supervisor = a_numeric
         -> OK next

r(owner access attribute):
         h_owner access = a_numeric
         -> OK next

r(local access attribute):
         h_local access = a_numeric
         -> OK next

r(world access attribute):
         h_world access = a_numeric
         -> OK next

r(group access attribute):
         !! printstring("Setting group access for ");  phex(ID)
         !! printstring(": ID ");  write(a_numeric2, 0)
         !! printstring(", access ");  write(a_numeric, 0)
         !! printstring(", position ");  write(group pos, 0);  newline
         %if group pos >= h_extent limit %start
            a_status = attribute list overflow
            -> next
         %finish
         h_access(group pos)_ID = a_numeric2
         h_access(group pos)_access = a_numeric
         group pos = group pos + 1
         h_access(group pos)_ID = 0 %if group pos < h_extent limit
         -> OK next

r(file flags attribute):
         h_flags = a_numeric
         -> OK next

! The following are either unimplemented as yet, or cannot meaningfully
! be modified by the user.
! r(file ID attribute):
! r(defined groups attribute):
! r(file creator attribute):
! r(static ID attribute):
! r(audit ID attribute):
! r(date created attribute):
! r(date modified attribute):
! r(date accessed attribute):
! r(creation name attribute):
! r(file size attribute):
! r(file extents attribute):

unavailable:
r(*):    a_status = attribute unavailable
         -> next

OK next: a_status = attribute OK
next:    a == a_next
      %repeat

      ! All done, mark the header as modified and write it out.
      h_modified = get datestamp
      status = write index block(pn, ID, h)
      o_fh_dirty = 0
      forget header(o_fh);  o_fh == nil
      o_mode = 0
      signal semaphore(tables_open file table semaphore)
      %result = status
%end

%end %of %file