! Disc cache stuff -- intercept disc requests made by FSys before they
! reach DisqIO.  Maintain a cache of disc blocks, in chunks.

%option "-nocheck-nostack-noline"

%constinteger cache base = 16_00C00000;   ! Outside known memory......
%constinteger cache size = 1024;          ! 1/2 K pages
%constinteger chunk size = 8;             ! pages

%constinteger disc timeout = 10 000;      ! milliseconds

%constinteger invalid = -99

%owninteger cache present = 0

%include "Config.Inc"

%include "System:Common"
%include "System:Disqio.Inc"
%include "System:Utility.Inc"
%include "System:Errors.Inc"
%include "System:Schedule.Inc"

%include "Inc:Util.Imp"

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

%recordformat disc done fm(%integername x)
%externalrecord(disc done fm)%spec disc done

%externalinteger disc high water    = 0
%externalinteger disc cache hits    = 0
%externalinteger disc cache misses  = 0
%externalinteger disc cache forgets = 0

%externalintegerspec ether context

%integerfn real disc request(%integer blocks, start, buffer, op, inhibit)
   ! General disc transfer procedure.  <blocks> is number of disc blocks
   ! to transfer.  <start> is disc block address.  <buffer> is address of
   ! buffer for reading/writing.  <op> is disc transfer request (one of
   ! read or write, possibly also verify).  <inhibit> is non-zero to 
   ! indicate that low priority wait queues should be blocked -- this is
   ! used to prevent consistency problems when directories are being
   ! transferred.
   %owninteger zero = 0
   %integer saved ether context
   %integer bytes wanted, bytes transferred
      ! Remember who we are, so that we can become ourselves
      ! again should another process be scheduled while we are
      ! waiting for the disc.
      saved ether context = ether context
      ! Disc driver works on a byte basis, so we have to convert our
      ! block count here, and later our start address.
      bytes wanted = blocks << 9
   !D %if common_diags & disc diags # 0 %start
   !D    pdate
   !D    printstring("Make transfer, op = ")
   !D    print symbol('R') %if op & D read   # 0
   !D    print symbol('W') %if op & D write  # 0
   !D    print symbol('V') %if op & D verify # 0
   !D    printstring(", blocks = ");  write(blocks, 0)
   !D    printstring(", start = ");  phex(start)
   !D    newline
   !D    pdate
   !D    printstring("Buffer = ");  phex(buffer)
   !D    printstring(", disc done at ");  phex(addr(disc done))
   !D    newline
   !D %finish
      ! Block low-priority wait queues
      inhibit noncritical %if inhibit # 0
      ! Disc has an associated semaphore.  Bump its count, and wait
      ! if necessary.  (Note the disc queue high water mark too.)
      common_disc request = common_disc request + 1
      disc high water = common_disc request %c
         %if common_disc request > disc high water
      %if common_disc request # 1 %start
         ! Semaphore already owned
         wait for(disc sema wait)
      %finish
      ! Now do the transfer.....
      disc done_x == transfer(op, bytes wanted, start << 9, integer(buffer))
      ! Note that we are expecting to be rewawakened sometime reasonably
      ! soon, and that steps should be taken otherwise....
      common_disc twait = CPU time + disc timeout
      ! The scheduler will kick us when it notices that the disc transfer
      ! has completed.  Sleep until then.
      wait for(disc transfer)
      ! Disc transfer has completed.  Mark disc as inactive and then
      ! become ourselves again.
      common_disc twait = 0
      ether context = saved ether context
      ! Unblock low-priority wait queues, if we had originally blocked them.
      uninhibit all %if inhibit # 0
      ! Decrement the disc semaphore count.  Kick the next waiting
      ! process (if any).
      common_disc request = common_disc request - 1
      %if common_disc request > 0 %start
         ! Another process is waiting
         kick(disc sema wait)
      %else %if common_disc request < 0
         ! Consistency check failed.  Everything will shortly
         ! grind to a halt.....
         pdate
         printstring("*** Disc wait count negative")
         newline
      %finish
      ! Remember actual transfer size
      bytes transferred = disc done_x
      ! Prevent the scheduler from retrying the last transfer
      disc done_x == zero
      %if bytes transferred = bytes wanted %start
         ! Transfer was OK -- we got what we expected
         %result = success
      %else
         ! We didn't get what we expected -- must have been a
         ! fatal disc error of some kind (the driver will have
         ! already logged it).
         pdate
         printstring("*** Fatal disc error ")
         phex(bytes transferred)
         %if op & D read = 0 %then printstring(" writing to") %c
                             %else printstring(" reading from")
         printstring(" block ");  write(start, 0)
         newline
         common_monitor_disc errors = common_monitor_disc errors + 1
         %result = disc error
      %finish
%end


! Bad block list format.  NB this format must be identical to
! the one in FSys (which is definitive)
%constinteger bad limit = 512 - 3
%recordformat bad fm((%integer stamp, %integerarray bad(1 : bad limit),
                      %integer last bad, checksum) %c
                 %or %integerarray x(1 : 512))

%externalrecord(bad fm) dc bad list = 0

! Bad block verification

%integerfn bad validation(%integer start)
   %integer i, re
      re = start + chunk size
      %for i = 1, 1, dc bad list_last bad %cycle
         %if start <= dc bad list_bad(i) < re %start
            %result = dc bad list_bad(i) - start
         %finish
      %repeat
      %if start + chunk size >= disc size %start
         %result = disc size - start
      %else
         %result = chunk size
      %finish
%end


! Now the cache control stuff

%owninteger first time = 0
%owninteger cache stamp = 1

%constinteger cache slots = cache size // chunk size

%recordformat cache fm(%integer stamp, address, size)

%ownrecord(cache fm)%array cache(1 : cache slots)

%routine initialise
   %integer i
      %on 0 %start
         ! Grope failed
         pdate
         printstring("Disc cache not present")
         newline
         first time = 1
         %return
      %finish
      common == common area
   !D common_diags = common_diags ! disc diags
      integer(cache base) = -1;  ! Grope for cache
      cache present = 1
      %for i = 1, 1, cache slots %cycle
         cache(i)_stamp = invalid;  cache(i)_address = invalid
      %repeat
      pdate
      printstring("Disc cache: ");  phex(cache base)
      printstring(" .. ");  phex(cache base + cache size << 9 - 1)
      printstring(" (");  write(cache size, 0)
      printstring(" pages)")
      newline
      first time = 1
%end

%owninteger zapped slot = invalid;  ! to save on a search

%routine invalidate all(%integer discaddr, size)
   %record(cache fm)%name c
   %integer i, ce, de
      de = discaddr + size
      %for i = 1, 1, cache slots %cycle
         c == cache(i)
         ce = c_address + c_size
         %if c_address <= discaddr < ce %or %c
               c_address < de <= ce %start
            c_stamp = invalid;  c_address = invalid
            zapped slot = i;  ! remember for future reference
            ! Keep on going in case there are any more...
         %finish
      %repeat
%end

%owninteger oldest = invalid
%owninteger oldest stamp = infinity

%integerfn locate(%integer discaddr, size)
   %record(cache fm)%name c
   %integer i, de
      de = discaddr + size
      %for i = 1, 1, cache slots %cycle
         c == cache(i)
         %result = i %if c_address <= discaddr %and de <= c_address + c_size
         %if c_stamp < oldest stamp %start
            oldest stamp = c_stamp
            oldest = i
         %finish
      %repeat
      %result = invalid
%end

%integerfn oldest slot
   %record(cache fm)%name c
   %integer i
      pdate
      printstring("*** Unknown oldest??!")
      newline
      %for i = 1, 1, cache slots %cycle
         c == cache(i)
         %if c_stamp < oldest stamp %start
            oldest stamp = c_stamp
            oldest = i
         %finish
      %repeat
      %result = oldest
%end


%constinteger chunk bytes = chunk size * 512

%externalintegerfn make disc request(%integer blocks, start, buffer,
                                     %integer op, inhibit)
   %record(cache fm)%name c
   %integer slot, from, status = success, t size
      initialise %if first time = 0
      %result = real disc request(blocks, start, buffer, op, inhibit) %c
         %if cache present = 0
      %if op & d write # 0 %start
         ! A write request.  Zap the cache and write it out....
         invalidate all(start, blocks)
         %result = real disc request(blocks, start, buffer, op, inhibit)
      %finish
      ! Must be a read request.....
      oldest = invalid;  oldest stamp = infinity
      slot = locate(start, blocks)
      %if 0 < slot <= cache slots %start
         ! Found it
         disc cache hits = disc cache hits + 1
         c == cache(slot)
         from = cache base - chunk bytes + chunk bytes * slot %c
                + 512 * (start - c_address)
got it:  c_stamp = cache stamp
         cache stamp = cache stamp + 1
         bulk move(blocks << 9, byteinteger(from), byteinteger(buffer))
         %result = status
      %finish
      ! Not in the cache, so we have to fetch it
      disc cache misses = disc cache misses + 1
      %if oldest > 0 %start
         slot = oldest
      %else
         slot = oldest slot
      %finish
      c == cache(slot)
      disc cache forgets = disc cache forgets + 1 %if c_address >= 0
      c_address = invalid;  c_stamp = infinity;  ! Claim it anonymously
      from = cache base - chunk bytes + chunk bytes * slot
      t size = bad validation(start)
      status = real disc request(t size, start, from,
                                 d read ! d verify, inhibit)
      c_size = t size %and c_address = start %if status = success
      -> got it
%end

%end %of %file