! 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


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

%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: disc read status ")
                  phex(status);  newline
                  %stop
               %finish
               !! printstring("Disc tables read from ")
               !! write(tables_disc size(drive), 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
               %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


! Set things up on disc -- not normally commented in

%constinteger boot size = 4096
%constinteger header size = 32;  ! Min.

!I %externalroutine create partition table(%integername p size)
!I    %record(header partition fm)%name p
!I    %record(disc header fm) disc header = 0
!I    %integer i, c, status, size, last end
!I       status = disc size(size)
!I       printstring("Disc size is ");  write(size, 0);  newline
!I       p size = ((size - boot size - header size) // 3) & (\ 31)
!I 
!I       p == disc header_p(1)
!I       p_start = 0;  p_finish = boot size - 1  { assume start at 0 }
!I       p_lp = 4;  p_name = "Boot"
!I       p_flags = valid flag
!I       last end = p_finish + 1
!I 
!I       p == disc header_p(2)
!I       p_start = last end;  p_finish = p_start + p size - 1
!I       p_lp = 2;  p_name = "U0"
!I       p_flags = hazarded flag ! structured flag ! valid flag
!I       last end = p_finish + 1
!I 
!I       p == disc header_p(3)
!I       p_start = last end;  p_finish = p_start + p size - 1
!I       p_lp = 1;  p_name = "System"
!I       p_flags = hazarded flag ! structured flag ! valid flag
!I       last end = p_finish + 1
!I 
!I       p == disc header_p(4)
!I       p_start = last end;  p_finish = p_start + p size - 1
!I       p_lp = 3;  p_name = "U1"
!I       p_flags = hazarded flag ! structured flag ! valid flag
!I       last end = p_finish + 1
!I 
!I       p == disc header_p(5)
!I       p_start = last end;  p_finish = size - 1
!I       p_lp = 5;  p_name = "Header"
!I       p_flags = valid flag
!I       c = 0
!I       c <- c + disc header_x(i) %for i = 2, 1, 128
!I       disc header_checksum = -c
!I       status = disc write(size - 1, byteinteger(addr(disc header)))
!I       printstring("Partition tables initialised at ")
!I       write(size - 1, 0);  printstring(", status = ")
!I       write(status, 0);  newline
!I %end

%end %of %file
