! Partition and cache control module.

! This module manages the disc block cache.  This is either a dedicated 1/2 meg
! store board, or if there isn't one present then an area of (global) heap.
! In the latter case the cache will be smaller, and will have to be allowed
! for in the process's allocation.

%constinteger chunk size = 7;  ! 2**n - 1

%constinteger dedicated cache address = 16_00D80000
%constinteger dedicated cache size = 1024 {blocks} // (chunk size + 1)

%constinteger heap cache size = 32
! The cache size must be larger than the expected number of calling
! processes, otherwise we may end up overwriting cache entries before we've
! even had a chance to use one of the blocks.

%constinteger retry limit = 3


! Error codes

%constinteger partition slot ID    error = -51
%constinteger partition validity   error = -52
%constinteger partition block ID   error = -53
%constinteger partition protection error = -54
%constinteger partition readin     error = -55
%constinteger buffer alignment     error = -56


! Partition tables

%recordformat partition table fm(%integer unit, disc start, size, flags)

%constinteger block mask = \(16_FFFFFFFF << partition shift)


! Disc tables

%recordformat header partition fm(%integer start, finish, lp, flags,
                                  %string(15) name)
%recordformat disc header fm((%integer checksum,
                              %record(header partition fm)%array p(1 : 15)) %c
                         %or %integerarray x(1 : 128))

%constinteger hazarded   flag = 1
%constinteger structured flag = 2
%constinteger valid      flag = 4

%recordformat bad list fm((%integer checksum, %integerarray block(1 : 511)) %c
                      %or %integerarray x(0 : 511))

%include "GDMR_H:Disc.Inc"


%constinteger cache chunk mask = \chunk size

%recordformat block fm(%bytearray b(0 : 511))
%recordformat chunk fm(%record(block fm)%array b(0 : chunk size))
%recordformat cache area fm(%record(chunk fm)%array c(1 : dedicated cache size))

%recordformat chunk data fm(%integer state, waiting,
                            %record(semaphore fm) arrival,
                            %integerarray status(0 : chunk size))


! Global tables

%recordformat tables fm(%record(partition table fm)%array %c
                           partition table(1 : partitions),
                        %record(disc header fm)%array disc header(0 : 1),
                        %record(bad list fm)%array disc bad list(0 : 1),
                        %integerarray disc size(0 : 1),
                        %integer cache stamp,
                        %integerarray chunk address(1 : dedicated cache size),
                        %integerarray chunk stamp(1 : dedicated cache size),
                        %record(chunk data fm)%array chunk data(1 : dedicated cache size),
                        %integer actual cache size,
                        %record(cache area fm)%name cache,
                        %integer cache read hits,     { Already there
                        %integer cache read misses,   { Brought in
                        %integer cache write copies,  { There, so overwritten
                        %integer cache write misses,  { Not there, so ignored
                        %integer cache prefetches,    { Brought in just in case
                        %record(semaphore fm) cache mutex)

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


! Initialisation

%predicate probe cache
   %on 0 %start;  %false;  %finish
   integer(dedicated cache address) = -1;  ! Write anything other than zero!!
   %true
%end

%routine initialise partitions
   %record(partition table fm)%name p
   %record(header partition fm)%name hp
   %integer status, i, j, c, drive
   %bytename b
      %if FS lookup("FS__PARTITION_TABLES", i) %start
         ! Already initialised
         !! printstring("Already initialised, tables at ")
         !! phex(i);  newline
         partition tables == record(i)
         semaphore wait(partition tables_cache mutex)
         signal semaphore(partition tables_cache mutex)
      %else
         partition tables == record(global heap get(size of(partition tables)))
         partition tables = 0
         setup semaphore(partition tables_cache mutex)
         FS insert("FS__PARTITION_TABLES", addr(partition tables))
         !! printstring("Initialising, partition tables at ")
         !! phex(addr(partition tables));  newline
         %if probe cache %start
            !! printstring("Dedicated cache");  newline
            partition tables_cache == record(dedicated cache address)
            partition tables_actual cache size = dedicated cache size
         %else
            !! printstring("Heap cache");  newline
            partition tables_cache == record(global heap get( %c
                                      heap cache size * (chunk size + 1) * 512))
            partition tables_actual cache size = heap cache size
         %finish
         {} printstring("Cache at ");  phex(addr(partition tables_cache))
         {} printstring(", size ");  write(partition tables_actual cache size, 0)
         {} printstring(" * ");  write(chunk size + 1, 0);  printstring(" (")
         {} write(partition tables_actual cache size * (chunk size + 1) * 512, 0)
         {} printstring(" bytes)");  newline
         %for i = 1, 1, dedicated cache size %cycle
            partition tables_chunk address(i)= -1
            setup semaphore(partition tables_chunk data(i)_arrival)
         %repeat
         status = disc size(partition tables_disc size(0), partition tables_disc size(1))
         %if status # 0 %start
            printstring("Can't find disc size");  newline
            %stop
         %finish
         !! printstring("Size 0 ");  write(partition tables_disc size(0), 0)
         !! printstring(", size 1 ");  write(partition tables_disc size(1), 0);  newline
         %for drive = 0, 1, 1 %cycle
            !! printstring("Drive ");  write(drive, 0);  newline
            %if partition tables_disc size(drive) > 0 %start
               status = disc read((drive << 28) ! (partition tables_disc size(drive) - 1),
                                  byteinteger(addr(partition tables_disc header(drive))))
               %if status # 0 %start
                  printstring("Initialise partitions: read header status ")
                  phex(status);  newline
                  %stop
               %finish
               !! printstring("Disc tables read from ")
               !! write(partition tables_disc size(drive) - 1, 0);  newline
               c = 0
               c <- c + partition tables_disc header(drive)_x(i) %for i = 1, 1, 128
               %if c # 0 %start
                  printstring("Initialise partitions: disc header checksum error")
                  newline
                  %stop
               %finish
               status = disc read((drive << 28) ! (partition tables_disc size(drive) - 8),
                                  byteinteger(addr(partition tables_disc bad list(drive))))
               %if status # 0 %start
                  printstring("Initialise partitions: read bad list status ")
                  phex(status);  newline
                  %stop
               %finish
               !! printstring("Disc bad list read from ")
               !! write(partition tables_disc size(drive) - 8, 0);  newline
               c = 0
               c <- c + partition tables_disc bad list(drive)_x(i) %for i = 0, 1, 511
               %if c # 0 %start
                  printstring("Initialise partitions: disc bad list checksum error ")
                  write(c, 0);  newline
                  !! dump(512 * 4, byteinteger(addr(partition tables_disc bad list(drive))))
                  !? %stop
               %finish
               printstring("Drive ");  write(drive, 0)
               printstring(" bad list:");  newline
               %for i = 1, 1, 511 %cycle
                  %exit %if partition tables_disc bad list(drive)_block(i) <= 0
                  write(partition tables_disc bad list(drive)_block(i), 9)
                  newline %if i & 7 = 0
               %repeat
               newline %if i & 7 # 0 %c
                       %and partition tables_disc bad list(drive)_block(1) > 0
               %for i = 1, 1, 15 %cycle
                  hp == partition tables_disc header(drive)_p(i)
                  %continue %if hp_flags & valid flag = 0
                  printstring("PP ");  write(drive, 0)
                  print symbol('.');  write(i, 0)
                  hp_lp = hp_lp + (drive << 4)
                  %if 0 < hp_lp <= partitions %start
                     p == partition tables_partition table(hp_lp)
                     p_unit = drive << 28
                     p_disc start = hp_start
                     p_size = hp_finish - hp_start + 1
                     p_flags = hp_flags
                     printstring(": LP ");  write(hp_lp, 0)
                     printstring(" (");  printstring(hp_name)
                     printstring("), ");  write(hp_start, 0)
                     printstring("..");  write(hp_finish, 0)
                     printstring(" (");  write(p_size, 0)
                     printstring(" blocks)")
                     printstring(", unstructured") %if p_flags & structured flag = 0
                     printstring(", *hazarded*") %if p_flags & hazarded flag # 0
                  %else
                     printstring("*bad LP number ")
                     write(hp_lp, 0)
                     print symbol('*')
                  %finish
                  newline
               %repeat
            %finish
         %repeat
         signal semaphore(partition tables_cache mutex)
      %finish
%end


! Translation & I/O

%integerfn do read(%integer block, %bytename buffer)
   %record(partition table fm)%name p
   %integer partition
      !! printstring("Do read: ");  phex(block);  printstring(" -> ")
      !! phex(addr(buffer));  newline
      partition = block >> partition shift
      %result = partition slot ID error %unless 0 < partition <= partitions
      p == partition tables_partition table(partition)
      %result = partition validity error %if p_flags & valid flag = 0
      block = block & block mask
      %result = partition block ID error %unless 0 <= block < p_size
      %result = disc read N(p_unit ! (block + p_disc start),
                            chunk size + 1, buffer)
%end

%integerfn do read one(%integer block, %bytename buffer)
   %record(partition table fm)%name p
   %integer partition
      !! printstring("Do read one: ");  phex(block);  newline
      partition = block >> partition shift
      %result = partition slot ID error %unless 0 < partition <= partitions
      p == partition tables_partition table(partition)
      %result = partition validity error %if p_flags & valid flag = 0
      block = block & block mask
      %result = partition block ID error %unless 0 <= block < p_size
      %result = disc read(p_unit ! (block + p_disc start), buffer)
%end

%integerfn do write(%integer block, %bytename buffer)
   %record(partition table fm)%name p
   %integer partition
      !! printstring("Do write: ");  phex(block);  newline
      partition = block >> partition shift
      %result = partition slot ID error %unless 0 < partition <= partitions
      p == partition tables_partition table(partition)
      %result = partition validity error %if p_flags & valid flag = 0
      %result = partition protection error %if p_flags & hazarded flag = 0
      block = block & block mask
      %result = partition block ID error %unless 0 <= block < p_size
      %result = disc write(p_unit ! (block + p_disc start), buffer)
%end


! Cache management

%integerfn cache stamp
   partition tables_cache stamp = partition tables_cache stamp + 1
   %result = partition tables_cache stamp
%end

!%integerfn cache find(%integer chunk)
!   %integer oldest, oldest stamp = infinity, i
!      %for i = 1, 1, partition tables_actual cache size %cycle
!         %if partition tables_chunk address(i) = chunk %start
!            !! printstring("Found chunk ");  phex(chunk)
!            !! printstring(" at ");  write(i, 0)
!            !! newline
!            %result = i
!         %finish
!         oldest = i %and oldest stamp = partition tables_chunk stamp(i) %c
!            %if partition tables_chunk stamp(i) < oldest stamp
!      %repeat
!      !! printstring("Can't find chunk ");  phex(chunk)
!      !! printstring(", oldest is ");  write(oldest, 0)
!      !! newline
!      %result = oldest
!%end

!! %routine show loop
!!    %integer Dzero, Done, Azero, Aone
!!       *move.l D0, Dzero
!!       *move.l D1, Done
!!       *move.l A0, Azero
!!       *move.l A1, Aone
!!       printstring("D0: ");  write(Dzero, 0)
!!       printstring(", D1: ");  phex(Done)
!!       printstring(", A0: ");  phex(Azero)
!!       printstring(", @A0: ");  phex(integer(Azero))
!!       printstring(", A1: ");  phex(Aone)
!!       newline
!!       *move.l Dzero, D0
!!       *move.l Done, D1
!!       *move.l Azero, A0
!!       *move.l Aone, A1
!! %end

%integerfn cache find(%integer chunk)
   %integer i, x
   %label AL, found it, SL, all checked
      ! Search the cache, using 010 loop mode.  Note that because the processor
      ! behaves slightly differently when in and out of loop mode, this isn't
      ! entirely straightforward....  In particular, if the comparison happens
      ! to succeed for the last entry tested, the value of the loop register
      ! on exit may not be the same.  For that reason we base our calculations
      ! on the (post-incremented) value of our pointer register.

      ! First loop: search the chunk address list for a match
      x = addr(partition tables_chunk address(1))
      i = partition tables_actual cache size - 1
      *move.l chunk, D1       { The address we're looking for
      *move.l x, A0           { The address of the current address (!)
      *move.l i, D0           { Loop count
   AL:!! show loop
      *cmp.l (A0)+, D1        { Compare chunk addresses
      *dbeq D0, AL            { Test comparison, decrement & loop
      ! NB: for the DBcc instruction, the cc tests true for NOT performing
      ! the decrement and branch!!  Either the cc test has succeeded, or we've
      ! reached the end of the loop.  The cc are still the same so we can just
      ! perform the appropriate conditional branch....
      *beq found it           { Test was true, we've found the entry

      ! If we reach here there was no match, so loop testing the stamp.  
      !! printstring("Not found, looking for oldest");  newline
      x = addr(partition tables_chunk stamp(1))
      i = partition tables_actual cache size - 1
      *move.l #infinity, D1   { Current oldest stamp
      *move.l x, A0           { Address of current stamp
      *move.l i, D0           { Loop count
   SL:!! show loop
      *cmp.l (A0)+, D1        { Compare stamps
      *dbgt D0, SL            { Test comparison, decrement & loop
      ! Either we've reached the end, or the comparison succeeded (i.e. the
      ! stamp was older).
      *ble all checked        { Test was false, we must have done the lot
      ! Must have been an older one.
      *move.l A0, A1          { Save pointer register
      *move.l -4(A0),D1       { Note new stamp
      *subq.l #1, D0          { Do the decrement
      *bge SL                 { ... try again (if we haven't reached the end)

all checked:
      ! We've been round all the tables.  The chunk address isn't in the
      ! cache, but we know the pointer register corresponding to the oldest.
      ! We have to calculate the chunk slot from this.
      *move.l A1, x
      !! printstring("Using oldest at ");  phex(x);  printstring(", base ")
      !! phex(addr(partition tables_chunk stamp(1)));  newline
      %result = (x - addr(partition tables_chunk stamp(1))) >> 2

found it:
      ! The chunk address is in cache.
      *move.l A0, x
      !! printstring("Found it at ");  phex(x);  printstring(", base ")
      !! phex(addr(partition tables_chunk address(1)));  newline
      %result = (x - addr(partition tables_chunk address(1))) >> 2
%end

%routine copy buffer(%record(*)%name from, to)
   ! From (A0), to (A1)
   D0 = 127
L: *move.l (A0)+, (A1)+
   *dbra D0, L
%end


! Exported interface, talking via cache

%integerfn partition read(%integer block, %record(*)%name buffer)
   %record(chunk data fm)%name c
   %integer status, chunk, offset, chunk slot, i, tries
   %integername chunk address, chunk stamp
!! %integer CPU before, CPU after
      !! CPU before = CPU time
      initialise partitions %if partition tables == nil
      %result = buffer alignment error %if addr(buffer) & 1 # 0
      chunk = block & cache chunk mask;  offset = block & chunk size
      !! printstring("Partition read ");  phex(block)
      !! printstring(" (chunk ");  phex(chunk)
      !! printstring(" offset ");  write(offset, 0)
      !! print symbol(')');  newline
      semaphore wait(partition tables_cache mutex)
      chunk slot = cache find(chunk)
      chunk address == partition tables_chunk address(chunk slot)
      chunk stamp == partition tables_chunk stamp(chunk slot)
      c == partition tables_chunk data(chunk slot)
      %if chunk address = chunk %start
         !! printstring("Hit at ");  write(chunk slot, 0);  newline
         partition tables_cache read hits = partition tables_cache read hits + 1
         chunk stamp = infinity
         %if c_state # 0 %start
            ! Chunk is in transit from disc, so note our interest and
            ! wait to be told when it arrives...
            c_waiting = c_waiting + 1
            signal semaphore(partition tables_cache mutex)
            semaphore wait(c_arrival)
            semaphore wait(partition tables_cache mutex)
         %finish
         %unless chunk address = chunk %start
            signal semaphore(partition tables_cache mutex)
            %result = partition readin error
         %finish
         copy buffer(partition tables_cache_c(chunk slot)_b(offset), buffer)
         chunk stamp = cache stamp
         signal semaphore(partition tables_cache mutex)
         !! dump(512, byteinteger(addr(buffer)))
         !! CPU after = CPU time
         !! printstring("Hit: ");  write(CPU after - CPU before, 0);  newline
         %result = c_status(offset) %if c_status(offset) < 0
         %result = 1 %if offset = chunk size
         %result = 0
      %else
         !! printstring("Miss, using ");  write(chunk slot, 0)
         !! printstring(", currently ");  phex(chunk address);  newline
         partition tables_cache read misses = partition tables_cache read misses + 1
         chunk address = chunk;  chunk stamp = infinity;  ! Prevent reuse
         c_state = -1;   ! In transit
         c_waiting = 0;  ! No-one (yet)
         signal semaphore(partition tables_cache mutex)
         status = do read(chunk, partition tables_cache_c(chunk slot)_b(0)_b(0))
         %if status = 0 %start
            c_status(i) = 0 %for i = 0, 1, chunk size
         %else
            %for i = 0, 1, chunk size %cycle
               !! printstring("Retrying chunk ");  phex(chunk)
               !! printstring(" offset ");  write(i, 0);  newline
               tries = retry limit - 1;  ! Already had one attempt
               %while tries > 0 %cycle
                  status = do read one(chunk + i, %c
                                       partition tables_cache_c(chunk slot)_b(i)_b(0))
                  %exit %if status = 0
                  tries = tries - 1
               %repeat
               c_status(i) = status
               {} %if status # 0 %start
               {}    printstring("Chunk ");  phex(chunk)
               {}    printstring(" offset ");  write(i, 0)
               {}    printstring(" status ");  write(status, 0);  newline
               {} %finish
            %repeat
         %finish
         semaphore wait(partition tables_cache mutex)
         c_state = 0;  ! Arrived
         chunk stamp = cache stamp
         copy buffer(partition tables_cache_c(chunk slot)_b(offset), buffer)
         %while c_waiting > 0 %cycle
            signal semaphore(c_arrival)
            c_waiting = c_waiting - 1
         %repeat
         !! dump(512, byteinteger(addr(buffer)))
         signal semaphore(partition tables_cache mutex)
         !! CPU after = CPU time
         !! printstring("Miss: ");  write(CPU after - CPU before, 0);  newline
         %result = c_status(offset) %if c_status(offset) < 0
         %result = 1 %if offset = chunk size
         %result = 0
      %finish
%end

! We have to be very careful here about the order we do things in, as the
! disc driver is at liberty to reorder requests from ourselves and our peers.
! In particular, we have to write the block out to the disc FIRST, and only
! when it has got there can we copy into the cache entry (if there is one).
! We don't have to wait for everyone else to finish actively using the slot,
! however, as either we got the disc before the other process, in which case
! it will merely recopy the same data, or we got there after, in which case
! we overwrite its data.  Either way, the result is the same (?)....

%externalintegerfn partition write(%integer block, %record(*)%name buffer)
   %record(chunk data fm)%name c
   %integer status, chunk, offset, chunk slot, tries = retry limit
      initialise partitions %if partition tables == nil
      %result = buffer alignment error %if addr(buffer) & 1 # 0
      !! dump(512, byteinteger(addr(buffer)))
      chunk = block & cache chunk mask;  offset = block & chunk size
      !! printstring("Partition write ");  phex(block)
      !! printstring(" (chunk ");  phex(chunk)
      !! printstring(" offset ");  write(offset, 0)
      !! print symbol(')');  newline
      %while tries > 0 %cycle
         status = do write(block, byteinteger(addr(buffer)))
         %exit %if status = 0
         tries = tries - 1
      %repeat
      semaphore wait(partition tables_cache mutex)
      chunk slot = cache find(chunk)
      %if partition tables_chunk address(chunk slot) = chunk %start
         !! printstring("Hit, copy in");  newline
         partition tables_cache write copies = partition tables_cache write copies + 1
         partition tables_chunk stamp(chunk slot) = cache stamp
         %if status = 0 %start
            ! OK, copy data into the cache
            copy buffer(buffer, partition tables_cache_c(chunk slot)_b(offset))
         %else
            ! Write failed, note the error status
            partition tables_chunk data(chunk slot)_status(offset) = status
         %finish
      %else
         !! printstring("Miss");  newline
         partition tables_cache write misses = partition tables_cache write misses + 1
      %finish
      signal semaphore(partition tables_cache mutex)
      %result = status
%end
      

! Enquiry

%routine partition enquiry(%integername v, s, h)
   %integer  i
      initialise partitions %if partition tables == nil
      v = 0
      %for i = 1, 1, partitions %cycle
         v = v ! (1 << i) %if partition tables_partition table(i)_flags & valid flag # 0
      %repeat
      s = 0
      %for i = 1, 1, partitions %cycle
         s = s ! (1 << i) %if partition tables_partition table(i)_flags & structured flag # 0
      %repeat
      h = 0
      %for i = 1, 1, partitions %cycle
         h = h ! (1 << i) %if partition tables_partition table(i)_flags & hazarded flag # 0
      %repeat
%end

%externalroutine cache enquiry(%integername crh, crm, cwc, cwm, cpf)
   initialise partitions %if partition tables == nil
   crh = partition tables_cache read hits
   crm = partition tables_cache read misses
   cwc = partition tables_cache write copies
   cwm = partition tables_cache write misses
   cpf = partition tables_cache prefetches
%end

%routine partition bad list(%integer pn, %record(partition bad list fm)%name b)
   %record(bad list fm)%name db
   %record(partition table fm)%name p
   %integer x, end
      b_n = 0
      %return %unless 0 < pn <= partitions
      p == partition tables_partition table(pn)
      %return %if p_flags & valid flag = 0
      db == partition tables_disc bad list(p_unit >> 28)
      x = 1
      %cycle
         %return %if db_block(x) <= 0;  ! End of list
         %exit %if db_block(x) >= p_disc start
         x = x + 1
      %repeat
      end = p_disc start + p_size - 1
      %while 0 < db_block(x) <= end %cycle
         b_n = b_n + 1
         b_b(b_n) = db_block(x) - p_disc start
         x = x + 1
      %repeat
%end

%routine partition info(%integer pn, %integername unit, disc start, size, flags)
   %record(partition table fm)%name p
      %return %unless 0 < pn <= partitions
      p == partition tables_partition table(pn)
      size = 0 %and %return %if p_flags & valid flag = 0
      unit = p_unit;  disc start = p_disc start
      size = p_size;  flags = p_flags
%end


! Cache pre-fetch.  At the request of the layer above us (the file system, most
! likely), fetch a chunk into the cache.  We keep a list of pre-fetch records,
! each of which contains a disc request.  Always provided the free list of these
! requests isn't empty, we grab a cache slot and enqueue a request to the disc
! driver; this latter will reorder the requests to suit itself, but will
! eventually complete the request and reply; this reply is intercepted by an
! autonomous process which checks the completion status, retrying synchronously
! if required, and finally returns the request buffer to the pool.

%constinteger prefetch list size = 32

%constinteger prefetcher size = 10240
%constinteger prefetcher priority = 7

%recordformat prefetch fm(%record(prefetch fm)%name next,
                          %integer chunk address, chunk slot,
                          %record(disc message fm) request)

%ownrecord(prefetch fm)%name prefetch list == nil
%ownrecord(semaphore fm) prefetch list semaphore = 0

%ownrecord(semaphore fm) prefetch done semaphore = 0
%ownrecord(mailbox fm) prefetch done box = 0

%routine partition prefetch(%integer block)
   %record(partition table fm)%name pt
   %record(prefetch fm)%name p
   %record(chunk data fm)%name c
   %integername chunk address
   %integer partition
      ! First off, check to see if there's an available request record.
      ! Note that we do this BEFORE claiming the semaphore as if prefetching
      ! hasn't been turned on the list will be empty but the semaphore won't
      ! have been set up.  Then validate the partition number.
      %return %if prefetch list == nil
      partition = block >> partition shift
      %return %unless 0 < partition <= partitions
      pt == partition tables_partition table(partition)
      %return %if pt_flags & valid flag = 0
      ! Now get a request buffer
      semaphore wait(prefetch list semaphore)
      p == prefetch list
      %if p == nil %start
         ! We have to check this again, as someone else may have been
         ! actively manipulating the list while we were waiting for the sem.
         signal semaphore(prefetch list semaphore)
         %return
      %finish
      prefetch list == p_next
      signal semaphore(prefetch list semaphore)
      p_chunk address = block & cache chunk mask
      !! printstring("Prefetch ");  phex(p_chunk address)
      !! printstring(" using ");  phex(addr(p));  newline
      semaphore wait(partition tables_cache mutex)
      p_chunk slot = cache find(p_chunk address)
      chunk address == partition tables_chunk address(p_chunk slot)
      %if chunk address = p_chunk address %start
         ! Already in the cache, so drop it
         signal semaphore(partition tables_cache mutex)
         !! printstring("Already there at ");  write(p_chunk slot, 0);  newline
         semaphore wait(prefetch list semaphore)
         p_next == prefetch list
         prefetch list == p
         signal semaphore(prefetch list semaphore)
         %return
      %finish
      ! Set up and queue the request to the disc
      !! printstring("Fetching ");  phex(p_chunk address)
      !! printstring(" into ");  write(p_chunk slot, 0);  newline
      partition tables_cache prefetches = partition tables_cache prefetches + 1
      chunk address = p_chunk address
      partition tables_chunk stamp(p_chunk slot) = infinity
      c == partition tables_chunk data(p_chunk slot)
      c_state = -1;  c_waiting = 0
      signal semaphore(partition tables_cache mutex)
      p_request_code = read request
      p_request_block = pt_unit ! ((chunk address & block mask) + pt_disc start)
      p_request_buffer = addr(partition tables_cache_c(p_chunk slot))
      p_request_size = chunk size + 1
      p_request_tag = addr(p)
      send message(p_request, disc request mailbox, prefetch done box)
%end

%routine prefetcher process
   %record(disc message fm)%name d
   %record(prefetch fm)%name p
   %record(chunk data fm)%name c
   %integer tries, i, status, chunk
      open input(2, ":N");  select input(2)
      open output(2, ":T");  select output(2)
      !! printstring("Prefetch done started");  newline
      %cycle
         d == receive message(prefetch done box)
         p == record(d_tag);  c == partition tables_chunk data(p_chunk slot)
         !! printstring("Prefetch done: ");  phex(p_request_block);  newline
         ! Check the status.  If it's OK note success for all the chunk blocks.
         ! If it's not OK retry each block individually.
         %if d_status = 0 %start
            c_status(i) = 0 %for i = 0, 1, chunk size
         %else
            !! printstring("Prefetch status ");  write(d_status, 0);  newline
            %for i = 0, 1, chunk size %cycle
               chunk = partition tables_chunk address(p_chunk slot)
               !! printstring("Retrying chunk prefetch ");  phex(chunk)
               !! printstring(" offset ");  write(i, 0);  newline
               tries = retry limit - 1;  ! Already had one attempt
               %while tries > 0 %cycle
                  status = do read one(chunk + i, %c
                                       partition tables_cache_c(p_chunk slot)_b(i)_b(0))
                  %exit %if status = 0
                  tries = tries - 1
               %repeat
               c_status(i) = status
               {} %if status # 0 %start
               {}    printstring("Chunk ");  phex(chunk)
               {}    printstring(" offset ");  write(i, 0)
               {}    printstring(" status ");  write(status, 0);  newline
               {} %finish
            %repeat
         %finish
         ! Note the arrival, signal anyone who's waiting
         semaphore wait(partition tables_cache mutex)
         c_state = 0;  ! Arrived
         partition tables_chunk stamp(p_chunk slot) = cache stamp
         %while c_waiting > 0 %cycle
            signal semaphore(c_arrival)
            c_waiting = c_waiting - 1
         %repeat
         signal semaphore(partition tables_cache mutex)
         ! All done, return the request record to the free list.
         p_chunk slot = infinity;  ! Safety
         semaphore wait(prefetch list semaphore)
         p_next == prefetch list
         prefetch list == p
         signal semaphore(prefetch list semaphore)
      %repeat
%end

%externalroutine partition start prefetcher
   %record(prefetch fm)%name p
   %record(process fm)%name created
   %integer i
   %label pfp
      !! printstring("Start cache prefetcher");  newline
      setup semaphore(prefetch list semaphore)
      %for i = 1, 1, prefetch list size %cycle
         p == record(global heap get(size of(prefetch list)))
         setup message(p_request, size of(p_request))
         p_next == prefetch list
         prefetch list == p
      %repeat
      signal semaphore(prefetch list semaphore)
      setup semaphore(prefetch done semaphore)
      setup mailbox(prefetch done box, prefetch done semaphore)
      created == create process(prefetcher size, addr(pfp),
                                prefetcher priority, nil)
      %return

pfp:  prefetcher process
%end

%end %of %file