! Directory package for new filestores.
! Uses B-tree package for key manipulation, and related data-storage
! mechanism for keeping large equivalence records.
!
! Strategy is that if the translation is a single file ID then it
! is inserted directly into the tree.  Otherwise, if it has several
! versions, or is a textual equivalent, then it is packaged up in a
! separate record as follows:
!     Each record starts with a tag field, indicating whether the translation
!     is a list of IDs, a local translation, or an external translation.
!     If it is a list of IDs, then there is a count field, followed by the
!     corresponding IDs.  If it is a textual translation, then the actual
!     text appears as a string immediately after the tag field.
!
! Paths can be either absolute (relative to the root) or start with a
! file ID.  Paths are presented as a list of components (already split).
!
! IDs which do not explicitly specify a partition are taken to be in the
! same partition as their parent.  The partition ID is taken as 4 bits of
! partition-within-drive + 2 bits of drive.  This is a NASTY HACK -- it's
! necessary to allow entire drives to be moved to another system which might
! well result in partition number clashes otherwise.  If the drive-ID isn't
! specified it too defaults to the parent's drive.  This has the unfortunate
! side-effect that we can't refer to files on drive 0 from directories on
! other drives except via the root (redirector).  We'll worry about this at
! some other time, though -- just make everything drive-relative for now...
! BEWARE: the constants are hard-coded in!!
!
! The top few bits of IDs are reserved for use by the directory structure.
! <non ID> and <directory> are defined at present

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

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

%constinteger NUL = 0

%constinteger external textual         OK =    1
%constinteger local    textual         OK =    2
%constinteger dud path              error = -201
%constinteger not a directory       error = -202
%constinteger dud component         error = -203
%constinteger non empty directory   error = -204
%constinteger no versions           error = -205
%constinteger version not found     error = -206
%constinteger too many versions     error = -207

%include "GDMR_H:FSysAcc.Inc"
%include "GDMR_H:FSys.Inc"
%include "GDMR_H:Tree.Inc"

%externalroutinespec fsys initialise
%externalintegerfnspec fsys get full ID(%integer partial, %integername full)

%constinteger directory          flag = 16_40000000
%constinteger non ID             flag = 16_80000000
%constinteger directory relative flag = non ID flag

!%include "Moose:Mouse.Inc"
%include "Sys:Util.Imp"

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

!constinteger partition shift = 24
!constinteger partition mask  = 16_3F000000
!constinteger ID        mask  = 16_00FFFFFF

%constinteger max compound ID = 32;  ! Meantime
%recordformat compound fm(%short tag,
                          ((%short count,
                            %integerarray ID(1 : max compound ID)) %c
                       %or %string(255) text))
%constinteger compound ID           tag = 1
%constinteger local    translation  tag = 2
%constinteger external translation  tag = 3

%constinteger ID escape character = 2


! Root directory stuff

%owninteger root directory ID = -1
%constinteger root ID = 16_01000002;  ! No sequence

%routine get root ID
   %integer status, x, token, flags
      fsys initialise
      status = fsys get full ID(root ID, root directory ID)
      %if status # 0 %start
         printstring("Failed to find root directory's ID: ")
         write(status, 0);  newline
         prompt("Would you like to create a new one? ")
         read symbol(x) %until x # NL
         %stop %unless x = 'y' %or x = 'Y'
         status = B tree create(nil, "Root", 1, 0, root directory ID)
         %if status # 0 %start
            printstring("Failed to create new root ");  write(status, 0)
            newline
            %stop
         %finish
         printstring("New root directory is ");  phex(root directory ID)
         newline
         ! Bump the refcount.  It's not actually IN any directories,
         ! but it'll stop it being deleted.
         status = fsys bump refcount(nil, root directory ID, 1)
         %if status # 0 %start
            printstring("Failed to bump refcount for new root");  newline
         %finish
         ! Now insert BootArea
         prompt("Would you like to insert BootArea as 04000000? ")
         read symbol(x) %until x # NL
         %if x = 'y' %or x = 'Y' %start
            status = B tree open by ID(nil, root directory ID, 1, token, flags)
            %if status # 0 %start
               printstring("Failed to open new root directory: ")
               write(status, 0);  newline
            %else
               status = B tree add entry(token, "BootArea", 16_04000000)
               %if status # 0 %start
                  printstring("Failed to insert BootArea: ")
                  write(status, 0);  newline
               %finish
               status = B tree close(token, status)
            %finish
         %finish
      %finish
      root directory ID = root directory ID ! directory flag
      !! printstring("Root directory is ");  phex(root directory ID)
      !! newline
%end


! Diagnostic string-putter

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

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


%predicate path component OK(%string(*)%name s)
   %integer i
      %false %if s = ""
      %for i = 1, 1, length(s) %cycle
         %false %unless ' ' < charno(s, i) <= '~'
      %repeat
      %true
%end

%externalintegerfn directory lookup one(%record(fsys access fm)%name access,
                                        %integer directory ID,
                                        %string(*)%name key, %integer version,
                                        %integername resulting ID,
                                        %string(*)%name textual translation)
   %record(compound fm) c
   %integer token, status, size, x, flags, drive mask
      !! printstring("Lookup one : component ");  zput string(key)
      !! printstring(" in ");  phex(directory ID);  newline
      %result = not a directory error %if directory ID & directory flag = 0
      %if key = "" %start
         ! Null name -> directory self-reference
         resulting ID = directory ID
         %result = 0
      %else %if length(key) = 5 %and charno(key, 1) = ID escape character
         ! Absolute ID escape in path.  First character is escape, next
         ! four are (binary) ID.
         resulting ID = integer(addr(key) + 2)
         !! printstring("Absolute lookup: ");  phex(resulting ID);  newline
         %result = 0
      %finish
      %result = dud component error %unless path component OK(key)
      status = B tree open by ID(access, directory ID, 0, token, flags)
      textual translation = key %and %result = status %if status # 0
      status = B tree find entry(token, key, resulting ID)
      %if status # 0 %start
         x = B tree close(token, 0)
         !! %if x # 0 %start
         !!    printstring("Lookup one: close status ")
         !!    write(x, 0);  newline
         !! %finish
         textual translation = key
         %result = status
      %finish
      %if resulting ID & non ID flag = 0 %start
         ! Simple ID
         x = B tree close(token, 0)
         !! %if x # 0 %start
         !!    printstring("Lookup one: close status ")
         !!    write(x, 0);  newline
         !! %finish
         %result = version not found error %unless version = 0
done ID: %if resulting ID & 16_3F000000 = 0 %start
            ! Drive and partition defaulted
            resulting ID = resulting ID ! (directory ID & 16_3F000000)
         %else %if resulting ID & 16_30000000 = 0
            ! Drive only defaulted
            resulting ID = resulting ID ! (directory ID & 16_30000000)
         %finish
         textual translation = ""
         !! printstring("Result is ");  phex(resulting ID);  newline
         %result = 0
      %else
         ! Compound ID
         status = B tree data value(token, resulting ID & (\ non ID flag),
                                    size, c)
         x = B tree close(token, 0)
         !! %if x # 0 %start
         !!    printstring("Lookup one: close status ")
         !!    write(x, 0);  newline
         !! %finish
         %if status # 0 %start
            textual translation = key
            %result = status
         %finish
         %if c_tag = compound ID tag %start
            version = 1 - version
            %result = version not found error %unless 0 < version <= c_count
            resulting ID = c_ID(version)
            -> done ID
         %else %if c_tag = local translation tag
            ! Local translation -- pass it back to the message interface
            !! printstring("Local textual equivalent");  newline
            textual translation = c_text
            %result = local textual OK
         %else {*assume* %if c_tag = external translation tag
            ! External translation -- pass it back to the client
            !! printstring("External textual equivalent");  newline
            textual translation = c_text
            %result = external textual OK
         %finish
      %finish
%end

! Search for the specified path.  Halts search at last-but-one component.
! Returns: file ID (> 0) if a local filename; or component count + translation
! if non-local; or component count + offending component + error status.
! Always start looking in the file system root directory.

%externalrecord(path fm)%map directory penultimate %c
                                    (%record(fsys access fm)%name access,
                                     %record(path fm)%name path, 
                                     %integername components translated,
                                     %integername resulting ID,
                                     %string(*)%name textual translation,
                                     %integername status)
   %integer ID, current directory ID
      status = dud path error %and %result == nil %if path == nil
      get root ID %if root directory ID < 0
      current directory ID = root directory ID
      ID = root directory ID
      components translated = 0
      %cycle
         %if path_next == nil %start
            ! Stop at the penultimate one
            !! printstring("Lookup terminating with ");  phex(ID);  newline
            resulting ID = ID
            textual translation = ""
            status = 0
            %result == path
         %finish
         current directory ID = ID
         !! printstring("Lookup: component ");  zput string(path_key)
         !! printstring(" in ");  phex(current directory ID);  newline
         status = directory lookup one(access, current directory ID,
                                       path_key, 0 {not until final},
                                       ID, textual translation)
         resulting ID = 0 %and %result == nil %if status < 0;  ! Not there
         %result == path %if status > 0;  ! Non-local
         components translated = components translated + 1
         path == path_next
      %repeat
%end

%externalintegerfn directory lookup(%record(fsys access fm)%name access,
                                    %record(path fm)%name path,
                                    %integername components translated,
                                    %integername file ID, penultimate ID,
                                    %string(*)%name textual translation)
   %integer status
      !! printstring("Directory lookup");  newline
      path == directory penultimate(access, path, components translated,
                                    penultimate ID, textual translation, status)
      %result = status %if status # 0
      status = directory lookup one(access, penultimate ID,
                                    path_key, path_version,
                                    file ID, textual translation)
      components translated = components translated + 1 %if status = 0
      !! printstring("Returning file ");  phex(file ID)
      !! printstring(", penultimate ");  phex(penultimate ID)
      !! printstring(", status ");  write(status, 0);  newline
      %result = status
%end


%integerfn insert new compound ID(%integer token, previous ID, new ID,
                                  %integername resulting)
   %record(compound fm) c
   %integer status, size, i
      !! printstring("Insert new compound ID: ");  phex(new ID)
      !! printstring(", previous: ");  phex(previous ID);  newline
      %if previous ID & non ID flag = 0 %start
         ! Inserting new with previously simple
         !! printstring("New + previously simple: ")
         !! phex(previous ID);  newline
         %result = no versions error %c
            %if previous ID & (directory flag ! non ID flag) # 0 %c
            %or new ID & (directory flag ! non ID flag) # 0
         c = 0
         c_tag = compound ID tag
         c_count = 2
         c_ID(1) = new ID
         c_ID(2) = previous ID
         %result = B tree data insert(token, 12, c, resulting)
      %else
         ! Previously compound
         previous ID = previous ID & (\ non ID flag)
         !! printstring("New + previous compound @ ")
         !! phex(previous ID);  newline
         status = B tree data value(token, previous ID, size, c)
         %result = status %if status # 0
         %result = no versions error %unless c_tag = compound ID tag
         %result = too many versions error %if c_count = max compound ID
         c_count = c_count + 1
         c_ID(i) = c_ID(i - 1) %for i = c_count, -1, 2
         c_ID(1) = new ID
         status = B tree data insert(token, 4 * (c_count + 1), c, resulting)
         %result = status %if status # 0
         %result = B tree data delete(token, previous ID)
      %finish
%end

%externalintegerfn directory insert ID(%record(fsys access fm)%name access,
                                       %integer directory ID,
                                       %string(*)%name inserting key,
                                       %integer inserting ID)
   %integer status, ID, token, x, flags, resulting, bump ID
      %result = dud component error %if inserting ID & 16_0F000000 = 0
      %result = dud component error %unless path component OK(inserting key)
      %result = not a directory error %if directory ID & directory flag = 0
      inserting ID = inserting ID & (\ directory relative flag);  ! Obsolete
      bump ID = inserting ID
      %if inserting ID & 16_3F000000 = directory ID & 16_3F000000 %start
         ! Drive and partition same, so default them
         inserting ID = inserting ID & (16_00FFFFFF ! directory flag)
      %else %if inserting ID & 16_30000000 = directory ID & 16_30000000
         ! Drive only same -- default it
         inserting ID = inserting ID & (16_0FFFFFFF ! directory flag)
      %finish
      !! printstring("Inserting ");  phex(inserting ID)
      !! printstring(" into ");  phex(directory ID);  newline
      status = B tree open by ID(access, directory ID, 1, token, flags)
      %result = status %if status # 0
      status = B tree find entry(token, inserting key, ID)
      %if status = 0 %start
         ! Entry is already there, so compound it.
         status = insert new compound ID(token, ID, inserting ID, resulting)
         status = B tree modify entry(token, inserting key,
                                      resulting ! non ID flag) %if status = 0
      %else
         ! Not there, so insert a new simple ID
         status = B tree add entry(token, inserting key, inserting ID)
      %finish
      x = B tree close(token, status)
      !! %if x # 0 %start
      !!    printstring("Insert ID: close status ")
      !!    write(x, 0);  newline
      !! %finish
      %result = status %if status # 0
      %result = fsys bump refcount(access, bump ID, 1)
%end

%integerfn directory insert textual(%record(fsys access fm)%name access,
                                    %integer directory ID,
                                    %string(*)%name inserting key,
                                    %integer inserting mode,
                                    %string(*)%name inserting text)
   %integer status, ID, token, x, flags, resulting
   %record(compound fm) c
      %result = dud component error %unless path component OK(inserting key)
      %result = not a directory error %if directory ID & directory flag = 0
      !! printstring("Inserting ");  printstring(inserting text)
      !! printstring(" into ");  phex(directory ID)
      !! printstring(" as ");  printstring(inserting key)
      !! printstring(", mode ");  write(inserting mode, 0);  newline
      status = B tree open by ID(access, directory ID, 1, token, flags)
      %result = status %if status # 0
      status = B tree find entry(token, inserting key, ID)
      %if status = 0 %start
         ! Entry is already there & versions aren't allowed
         x = B tree close(token, -1)
         !! %if x # 0 %start
         !!    printstring("Insert textual: close status ")
         !!    write(x, 0);  newline
         !! %finish
         %result = no versions error
      %finish
      ! Not there, so insert a new textual translation
      c = 0
      c_tag = inserting mode;  ! Assume correct
      c_text = inserting text
      status = B tree data insert(token, length(inserting text) + 3,
                                  c, resulting)
      %if status # 0 %start
         x = B tree close(token, -1)
         !! %if x # 0 %start
         !!    printstring("Insert textual: close status ")
         !!    write(x, 0);  newline
         !! %finish
         %result = status
      %finish
      !! printstring("Data inserted as ");  phex(resulting);  newline
      status = B tree add entry(token, inserting key, resulting ! non ID flag)
      x = B tree close(token, status)
      !! %if x # 0 %start
      !!    printstring("Insert textual: close status ")
      !!    write(x, 0);  newline
      !! %finish
      %result = status
%end

%externalintegerfn directory insert local(%record(fsys access fm)%name access,
                                          %integer directory ID,
                                          %string(*)%name inserting key,
                                          %string(*)%name inserting text)
   %result = directory insert textual(access, directory ID, inserting key,
                                      local translation tag, inserting text)
%end

%externalintegerfn directory insert external(%record(fsys access fm)%name access,
                                             %integer directory ID,
                                             %string(*)%name inserting key,
                                             %string(*)%name inserting text)
   %result = directory insert textual(access, directory ID, inserting key,
                                      external translation tag, inserting text)
%end


%externalintegerfn directory delete entry(%record(fsys access fm)%name access,
                                          %integer directory ID,
                                          %string(255) key, %integer version)
   %integer status, token, flags, translated ID, bump status, x
   %integer size, site, new site, i
   %record(compound fm) c
      %result = dud component error %unless path component OK(key)
      %result = not a directory error %if directory ID & directory flag = 0
      !! printstring("Deleting ");  printstring(key)
      !! printstring(" from ");  phex(directory ID);  newline
      status = B tree open by ID(access, directory ID, 1, token, flags)
      %result = status %if status # 0
      status = B tree find entry(token, key, translated ID)
      %if status = 0 %start
         %if translated ID & non ID flag = 0 %start
            ! Simple translation
            status = B tree delete entry(token, key)
         %else
            ! Translation is non-simple
            site = translated ID & (\ non ID flag)
            status = B tree data value(token, site, size, c)
            %if status # 0 %start
               x = B tree close(token, -1)
               !! %if x # 0 %start
               !!    printstring("Delete entry: close status ")
               !!    write(x, 0);  newline
               !! %finish
               %result = status
            %finish
            %if c_tag # compound ID tag %start
               ! Non-ID, so just zap the entry & translation
               status = B tree data delete(token, site)
               status = B tree delete entry(token, key)
               x = B tree close(token, status)
               !! %if x # 0 %start
               !!    printstring("Delete entry: close status ")
               !!    write(x, 0);  newline
               !! %finish
               %result = status
            %finish
            version = 1 - version
            %unless 0 < version <= c_count %start
               x = B tree close(token, -1)
               !! %if x # 0 %start
               !!    printstring("Delete entry: close status ")
               !!    write(x, 0);  newline
               !! %finish
               %result = version not found error
            %finish
            translated ID = c_ID(version)
            %if version < c_count %start
               ! Shuffle down
               c_ID(i) = c_ID(i + 1) %for i = version, 1, c_count - 1
            %finish
            c_count = c_count - 1
            %if c_count = 1 %start
               status = B tree modify entry(token, key, c_ID(1))
               %if status # 0 %start
                  x = B tree close(token, -1)
                  !! %if x # 0 %start
                  !!    printstring("Delete entry: close status ")
                  !!    write(x, 0);  newline
                  !! %finish
                  %result = status
               %finish
               status = B tree data delete(token, site)
            %else
               status = B tree data insert(token, 4 * (c_count + 1), c, new site)
               %if status # 0 %start
                  x = B tree close(token, -1)
                  !! %if x # 0 %start
                  !!    printstring("Delete entry: close status ")
                  !!    write(x, 0);  newline
                  !! %finish
                  %result = status
               %finish
               status = B tree modify entry(token, key,
                                            new site ! non ID flag)
               %if status # 0 %start
                  x = B tree close(token, -1)
                  !! %if x # 0 %start
                  !!    printstring("Delete entry: close status ")
                  !!    write(x, 0);  newline
                  !! %finish
                  %result = status
               %finish
               status = B tree data delete(token, site)
            %finish
         %finish
      %finish
      x = B tree close(token, status)
      !! %if x # 0 %start
      !!    printstring("Delete entry: close status ")
      !!    write(x, 0);  newline
      !! %finish
      %if translated ID & 16_3F000000 = 0 %start
         ! Drive and partition defaulted
         translated ID = translated ID ! (directory ID & 16_3F000000)
      %else %if translated ID & 16_30000000 = 0
         ! Drive only defaulted
         translated ID = translated ID ! (directory ID & 16_30000000)
      %finish
      bump status = fsys bump refcount(access, translated ID, -1)
      %result = bump status %if bump status # 0
      %result = status
%end


%externalintegerfn create directory(%record(fsys access fm)%name access,
                                    %record(path fm)%name path,
                                    %integer desired partition,
                                    %integer no inherit,
                                    %integername components translated,
                                    %integername final directory ID,
                                    %string(*)%name textual translation)
   %record(path fm)%name final
   %integer status, ID, token, x, actual partition, flags, benefactor ID
      final == directory penultimate(access, path, components translated,
                                     final directory ID, textual translation,
                                     status)
      %result = status %if status # 0
      %result = not a directory error %if final directory ID & directory flag = 0
      %if desired partition > 0 %start
         actual partition = desired partition
      %else
         actual partition = (final directory ID & partition mask) >> partition shift
      %finish
      !! printstring("Creating directory ");  printstring(final_key)
      !! printstring(" in ");  phex(final directory ID)
      !! printstring(", partition ");  write(actual partition, 0);  newline
      ! Note that when we create the directory below we use its parent as
      ! its benefactor, so that directories inherit ownership, protection
      ! and so on from the directory they were created in.  This has the
      ! side effect of requiring modify access to the parent directory
      ! (because of FSys's version replacement check), but that's OK as we
      ! are going to be trying to modify the parent directory anyway...
      benefactor ID = final directory ID
      benefactor ID = 0 %if no inherit # 0
      status = B tree create(access, final_key, actual partition,
                             benefactor ID, ID)
      !! printstring("Create status ");  write(status, 0);  newline
      %result = status %if status # 0
      ID = ID ! directory flag
      ! Bump the refcount
      status = fsys bump refcount(access, ID, 1)
      !! printstring("Bump status ");  write(status, 0);  newline
      %if status # 0 %start
         ! For some reason we don't have access to our own newly-created
         ! directory, so we'll just (attempt to) delete it again.
         x = fsys delete file(nil, ID)
         %result = status
      %finish
      ! Now insert in the final directory
      %if ID & 16_3F000000 = final directory ID & 16_3F000000 %start
         ! Drive and partition same, so default them
         ID = ID & (16_00FFFFFF ! directory flag)
      %else %if ID & 16_30000000 = final directory ID & 16_30000000
         ! Drive only same -- default it
         ID = ID & (16_0FFFFFFF ! directory flag)
      %finish
      status = B tree open by ID(access, final directory ID, 1, token, flags)
      %result = status %if status # 0
      status = B tree find entry(token, final_key, x)
      %if status = 0 %start
         ! Directory already exists, so we'll have to delete the new one
         x = B tree close(token, -1)
         !! %if x # 0 %start
         !!    printstring("Create directory: close status ")
         !!    write(x, 0);  newline
         !! %finish
         x = fsys delete file(nil, ID)
         %result = no versions error
      %finish
      status = B tree add entry(token, final_key, ID)
      x = B tree close(token, status)
      !! %if x # 0 %start
      !!    printstring("Create directory: close status ")
      !!    write(x, 0);  newline
      !! %finish
      %result = status
%end

%externalintegerfn directory check empty(%record(fsys access fm)%name access,
                                         %integer directory ID)
   %integer token, flags, status, empty
      %result = not a directory error %if directory ID & directory flag = 0
      status = B tree open by ID(access, directory ID, 0, token, flags)
      %result = status %if status # 0
      %if flags & multiple references # 0 %or B tree empty(token) %start
         ! Directories with multiple references to them are always
         ! assumed to be empty (so all but one can be deleted).
         empty = 0
      %else
         empty = non empty directory error
      %finish
      status = B tree close(token, 0)
      !! %if status # 0 %start
      !!    printstring("Check empty: close status ")
      !!    write(status, 0);  newline
      !! %finish
      %result = empty
%end


%externalrecord(*)%map directory contents(%record(fsys access fm)%name access,
                                          %integer ID, %integername status, flags)
   %record(key list fm)%name key list, last == nil, current, next
   %integer token, x, i, size
   %record(compound fm) c
   %string(255) text
      %if root directory ID < 0 %start
         printstring("*** Calling ""directory contents"" before a lookup??")
         newline
         status = dud path error
         %result == nil
      %finish
      status = not a directory error %and %result == nil %c
         %if ID & directory flag = 0
      !! printstring("Get key list for ");  phex(ID);  newline
      status = B tree open by ID(access, ID, 0, token, flags)
      %result == nil %if status # 0
      key list == B tree key list(token, status)
      current == key list
      %while current ## nil %cycle
         %if current_value & non ID flag = 0 %start
            last == nil
         %else
            ! Compound with (maybe) versions)
            status = B tree data value(token, current_value & (\ non ID flag),
                                       size, c)
            %if status # 0 %start
               ! Error on lookup, so just assume it's simple
               last == nil
            %else %if c_tag = compound ID tag
               text = current_key
               next == current_next
               last == current
               current_value = c_ID(1)
               %for i = 2, 1, c_count %cycle
                  current == record(heap get(length(text) + 9 + 4))
                  current_value = c_ID(i)
                  current_key = text . to string(NUL) . itos(1 - i, 0)
                  current_next == next
                  last_next == current
                  last == current
               %repeat
            %finish
         %finish
         current == current_next
      %repeat
      x = B tree close(token, 0)
      !! %if x # 0 %start
      !!    printstring("Directory contents: close status ")
      !!    write(x, 0);  newline
      !! %finish
      !! print key list(key list)
      %result == key list
%end

%end %of %file