! Partition control module.

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

! To do: don't signal %while....

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

%include "Moose:Mouse.Inc"

%systemintegerfnspec global heap get(%integer size)

%constinteger cache size = 32
%constinteger chunk size = 7;  ! 2**n - 1
! 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

{} %include "GDMR_H:Dump.Inc"


! Error codes

%constinteger partition 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


! Dictionary access

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


! Partition tables

%constinteger last partition = 31
%recordformat partition table fm(%integer unit, disc start, size, flags)

%constinteger partition shift = 24
%constinteger block mask      = 16_00FFFFFF


! 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))

! Cache tables

%constinteger cache chunk mask = \chunk size

%recordformat block fm(%bytearray b(0 : 511))

%recordformat cache fm(%integer chunk, stamp, state,
                       %record(semaphore fm) arrival,
                       %integerarray status(0 : chunk size),
                       %record(block fm)%array b(0 : chunk size))


! Global tables

%recordformat tables fm(%integer cache stamp,
                        %record(partition table fm)%array %c
                           partition table(1 : last partition),
                        %record(disc header fm)%array disc header(0 : 1),
                        %record(bad list fm)%array disc bad list(0 : 1),
                        %integerarray disc size(0 : 1),
                        %record(cache fm)%array cache(1 : cache size),
                        %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
                        %record(semaphore fm) cache mutex)

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


! Miscellaneous other stuff

%systemroutinespec phex(%integer i)

!%externalintegerfnspec disc size(%integername size 0, size 1)
!%externalintegerfnspec disc read(%integer block, %bytename buffer)
!%externalintegerfnspec disc read N(%integer block, blocks, %bytename buffer)
!%externalintegerfnspec disc write(%integer block, %bytename buffer)

%include "GDMR_H:Disc.Inc"

%constinteger infinity = 16_7FFFFFFF


! Initialisation

%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
         tables == record(i)
         semaphore wait(tables_cache mutex)
         signal semaphore(tables_cache mutex)
      %else
         tables == record(global heap get(size of(tables)));  tables = 0
         setup semaphore(tables_cache mutex)
         FS insert("FS_PARTITION_TABLES", addr(tables))
         !! printstring("Initialising, tables at ")
         !! phex(addr(tables));  newline
         !! printstring("Cache: ");  write(cache size, 0)
         !! printstring(" * ");  write(chunk size + 1, 0)
         !! printstring(" (");  write(cache size * (chunk size + 1) * 512, 0)
         !! printstring(" bytes)");  newline
         %for i = 1, 1, cache size %cycle
            tables_cache(i)_chunk = -1
            setup semaphore(tables_cache(i)_arrival)
         %repeat
         status = disc size(tables_disc size(0), tables_disc size(1))
         %if status # 0 %start
            printstring("Can't find disc size");  newline
            %stop
         %finish
         !! printstring("Size 0 ");  write(tables_disc size(0), 0)
         !! printstring(", size 1 ");  write(tables_disc size(1), 0);  newline
         %for drive = 0, 1, 1 %cycle
            !! printstring("Drive ");  write(drive, 0);  newline
            %if tables_disc size(drive) > 0 %start
               status = disc read((drive << 28) ! (tables_disc size(drive) - 1),
                                  byteinteger(addr(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(tables_disc size(drive) - 1, 0);  newline
               c = 0
               c <- c + 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) ! (tables_disc size(drive) - 8),
                                  byteinteger(addr(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(tables_disc size(drive) - 8, 0);  newline
               c = 0
               c <- c + 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(tables_disc bad list(drive))))
                  !? %stop
               %finish
               printstring("Drive ");  write(drive, 0)
               printstring(" bad list:");  newline
               %for i = 1, 1, 511 %cycle
                  %exit %if tables_disc bad list(drive)_block(i) <= 0
                  write(tables_disc bad list(drive)_block(i), 9)
                  newline %if i & 7 = 0
               %repeat
               newline %if i & 7 # 0 %c
                       %and tables_disc bad list(drive)_block(1) > 0
               %for i = 1, 1, 15 %cycle
                  hp == 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 <= last partition %start
                     p == 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(tables_cache mutex)
      %finish
%end


! Translation & I/O

%integerfn do read(%integer block, %bytename buffer)
   %record(partition table fm)%name p
   %integer partition
      partition = block >> partition shift
      %result = partition ID error %unless 0 < partition <= last partition
      p == 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 ID error %unless 0 < partition <= last partition
      p == 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 ID error %unless 0 < partition <= last partition
      p == 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
   tables_cache stamp = tables_cache stamp + 1
   %result = tables_cache stamp
%end

%record(cache fm)%map cache find(%integer chunk)
   %record(cache fm)%name c
   %integer oldest, oldest stamp = infinity
   %integer i
      %for i = 1, 1, cache size %cycle
         c == tables_cache(i)
         %if c_chunk = chunk %start
            !! printstring("Found chunk ");  phex(chunk)
            !! printstring(" at ");  write(i, 0)
            !! newline
            %result == c
         %finish
         oldest = i %and oldest stamp = c_stamp %if c_stamp < oldest stamp
      %repeat
      !! printstring("Can't find chunk ");  phex(chunk)
      !! printstring(", oldest is ");  write(oldest, 0)
      !! newline
      %result == tables_cache(oldest)
%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

%externalintegerfn partition read(%integer block, %record(*)%name buffer)
   %record(cache fm)%name c
   %integer status, chunk, offset, i, tries
!! %integer CPU before, CPU after
      !! CPU before = CPU time
      initialise partitions %if 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(tables_cache mutex)
      c == cache find(chunk)
      %if c_chunk = chunk %start
         !! printstring("Hit at ");  phex(addr(c));  newline
         tables_cache read hits = tables_cache read hits + 1
         c_stamp = infinity
         %while c_state # 0 %cycle
            signal semaphore(tables_cache mutex)
            semaphore wait(c_arrival)
            semaphore wait(tables_cache mutex)
         %repeat
         %unless c_chunk = chunk %start
            signal semaphore(tables_cache mutex)
            %result = partition readin error
         %finish
         copy buffer(c_b(offset), buffer)
         c_stamp = cache stamp
         signal semaphore(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)
      %else
         !! printstring("Miss, using ");  phex(addr(c));  newline
         tables_cache read misses = tables_cache read misses + 1
         c_chunk = chunk;  c_stamp = infinity;  ! Prevent reuse
         c_state = -1;  ! In transit
         !! c_chunk = -1;  ! Effectively disable the cache <<<<<<<<<<<<<<<<<<<<
         signal semaphore(tables_cache mutex)
         status = do read(chunk, byteinteger(addr(c_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, byteinteger(addr(c_b(i))))
                  %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(tables_cache mutex)
         c_state = 0;  ! Arrived
         c_stamp = cache stamp
         copy buffer(c_b(offset), buffer)
         signal semaphore(c_arrival) %while c_arrival_count < 0;  !???
         !! dump(512, byteinteger(addr(buffer)))
         signal semaphore(tables_cache mutex)
         !! CPU after = CPU time
         !! printstring("Miss: ");  write(CPU after - CPU before, 0);  newline
         %result = c_status(offset)
      %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(cache fm)%name c
   %integer status, chunk, offset, tries = retry limit
      initialise partitions %if 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(tables_cache mutex)
      c == cache find(chunk)
      %if c_chunk = chunk %start
         !! printstring("Hit, copy in");  newline
         tables_cache write copies = tables_cache write copies + 1
         c_stamp = cache stamp
         copy buffer(buffer, c_b(offset))
      %else
         !! printstring("Miss");  newline
         tables_cache write misses = tables_cache write misses + 1
      %finish
      signal semaphore(tables_cache mutex)
      %result = status
%end
      

! Enquiry

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

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

%recordformat partition bad list fm(%integer n,
                                    %integerarray b(0 : 511))

%externalroutine 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 <= last partition
      p == tables_partition table(pn)
      %return %if p_flags & valid flag = 0
      db == 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

%externalroutine partition info(%integer pn,
                                %integername unit, disc start, size, flags)
   %record(partition table fm)%name p
      %return %unless 0 < pn <= last partition
      p == 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

%end %of %file