! Bitmap manipulation procedures for new filestores: search, claim, release

%integerfn search(%integername bitmap, %integer limit,
                  %integer requested start, requested size,
                  %integername allocated start, allocated size)
   %integer pos, word, bit, biggest, biggest pos = -1, found, size
   %integername x

      pos = requested start;  biggest = 0

try again:
      ! Find the first unallocated block in the bitmap.
      ! First look at the non-aligned part, starting
      ! at the current position.
      word = pos // 32;  bit = pos & 31
      x == bitmap [word]
      %if bit = 0 %start
         x == x [-1]
      %else
         %while bit # 0 %cycle
            -> got one %if x & (1 << bit) = 0
            bit = (bit + 1) & 31
            pos = pos + 1
            -> no more %if pos >= limit
         %repeat
      %finish

      ! Then the aligned part in the middle, taking
      ! it a full word at a time.
      %cycle
         x == x [1]
         %exit %if x # 16_FFFFFFFF
         pos = pos + 32
         -> no more %if pos >= limit
      %repeat

      ! A block was unallocated somewhere in the last word
      ! checked.  Find it.
      bit = 0
      %cycle
         -> got one %if x & (1 << bit) = 0
         ! Must be true somewhere, since x # 16_FFFFFFFF
         bit = bit + 1
         pos = pos + 1
      %repeat

got one:
      ! Found an unallocated block.  Now find out how many
      ! contiguous blocks there are.
      found = pos
      size = 0

      ! First the non-aligned part at the start
      bit = pos & 31;  word = pos // 32
      x == bitmap [word]
      %if bit = 0 %start
         x == x [-1]
      %else
         %while bit # 0 %cycle
            %if x & (1 << bit) = 0 %then size = size + 1 %c
                                   %else -> the lot
            bit = (bit + 1) & 31
            pos = pos + 1
            -> the lot %if pos >= limit
         %repeat
      %finish

      ! Then the aligned part in the middle, taking it
      ! a full word at a time
      %cycle
         x == x [1]
         %exit %if x # 0
         size = size + 32
         pos = pos + 32
         -> the lot %if size >= requested size %or pos >= limit
      %repeat

      ! One of the blocks in the last word was allocated.  Find
      ! out how many were unallocated.
      bit = 0
      %cycle
         %if x & (1 << bit) = 0 %then size = size + 1 %c
                                %else -> the lot
         ! %else part holds somewhere, since x # 0
         bit = bit + 1
         pos = pos + 1
         -> the lot %if pos >= limit
      %repeat

the lot:
      ! We now know how large the unallocated hole was.
      ! Determine if it is big enough.  If not, was it bigger than
      ! the largest we already know about?
      %if size >= requested size %start
         ! Big enough
         allocated size = size
         allocated start = found
         %result = 0
      %finish
      %if size > biggest %start
         ! Larger than the ones we already know about
         biggest = size
         biggest pos = found
      %finish
      ! Now set a new starting position and go looking for another
      ! unallocated hole.
      pos = pos + 1
      -> try again %if pos < limit

no more:
      ! We've searched the entire bitmap for a large enough
      ! hole.  We'll just have to return the largest we know about,
      ! since there weren't any sufficiently large.
      %if biggest = 0 %start
         ! No holes found?  The partition must be full
         %result = -1
      %else
         ! The largest we know about
         allocated size = biggest
         allocated start = biggest pos
         %result = 0
      %finish
%end

%integerfn test(%integername bitmap, %integer start, size)
   %integer bit, word
   %integername x

      ! First the non-aligned part at the start
      bit = start & 31;  word = start // 32
      x == bitmap [word]
      %if bit = 0 %start
         x == x [-1]
      %else
         %while size # 0 %and bit # 0 %cycle
            %result = -1 %if x & (1 << bit) = 0
            bit = (bit + 1) & 31
            size = size - 1
         %repeat
      %finish

      ! Then the aligned part in the middle, taking
      ! it a full word at a time.
      %while size // 32 # 0 %cycle
         x == x [1]
         %result = -1 %unless x = 16_FFFFFFFF
         size = size - 32
      %repeat

      ! Finally the non-full-word part at the end.
      ! 0 <= size <= 31 by now.
      bit = 0;  x == x [1]
      %while size > 0 %cycle
         %result = -1 %if x & (1 << bit) = 0
         bit = bit + 1
         size = size - 1
      %repeat
      %result = 0
%end

%integerfn test and set(%integername bitmap, %integer start, size)
   %integer bit, word, one set = 0, mask
   %integername x

      ! First the non-aligned part at the start
      bit = start & 31;  word = start // 32
      x == bitmap [word]
      %if bit = 0 %start
         x == x [-1]
      %else
         %while size # 0 %and bit # 0 %cycle
            mask = 1 << bit
            one set = -1 %if x & mask # 0
            ! ... but carry on to set the rest
            x = x ! mask
            bit = (bit + 1) & 31
            size = size - 1
         %repeat
      %finish

      ! Then the aligned part in the middle, taking
      ! it a full word at a time.
      %while size // 32 # 0 %cycle
         x == x [1]
         one set = -1 %if x # 0
         x = 16_FFFFFFFF
         size = size - 32
      %repeat

      ! Finally the non-full-word part at the end.
      ! 0 <= size <= 31 by now.
      bit = 0;  x == x [1]
      %while size > 0 %cycle
         mask = 1 << bit
         one set = -1 %if x & mask # 0
         x = x ! mask
         bit = bit + 1
         size = size - 1
      %repeat
      %result = one set
%end

%integerfn test and clear(%integername bitmap, %integer start, size)
   %integer bit, word, mask
   %integername x

      ! First the non-aligned part at the start
      bit = start & 31;  word = start // 32
      x == bitmap [word]
      %if bit = 0 %start
         x == x [-1]
      %else
         %while size # 0 %and bit # 0 %cycle
            mask = 1 << bit
            %result = -1 %if x & mask = 0
            x = x & (\ mask)
            bit = (bit + 1) & 31
            size = size - 1
         %repeat
      %finish

      ! Then the aligned part in the middle, taking
      ! it a full word at a time.
      %while size // 32 # 0 %cycle
         x == x [1]
         %result = -1 %unless x = 16_FFFFFFFF
         x = 0
         size = size - 32
      %repeat

      ! Finally the non-full-word part at the end.
      ! 0 <= size <= 31 by now.
      bit = 0;  x == x [1]
      %while size > 0 %cycle
         mask = 1 << bit
         %result = -1 %if x & mask = 0
         x = x & (\ mask)
         bit = bit + 1
         size = size - 1
      %repeat
      %result = 0
%end


! Bitmap header and exported interface

%recordformat bitmap fm(%integer size, next, increment,
                        %integername map,
                        %record(semaphore fm) semaphore)
! <size> is bitmap size in bits.  <next> is the next block which will be
! used in the "don't care" case.  <increment> (or a multiple thereof) will be
! added to <next> after a successful allocation.  <map> points to the start
! of the bitmap.  <semaphore> prevents inconsistent concurrent access.


%routine zap(%integer how many, %integername from)
   *subq.l #1, D0
L: *clr.l (A0)+
   *dbra D0, L
%end

%integerfn new bitmap(%integer size, increment)
   ! Create a new bitmap (off the heap), returning a token for it
   ! (actually, the address of its header).
   %record(bitmap fm)%name m
   %integer stamp
      %signal 10, 0, size, "Bad bitmap size" %if size <= 0
      %signal 10, 0, increment, "Bad bitmap increment" %if increment <= 0
      m == record(global heap get(size of(m)))
      size = size & (\ 31);  ! Round to allocation granularity (4-byte words)
      m_size = size
      stamp = get datestamp
      m_next = rem(stamp + (stamp & 16_0FFF), size);  ! Pretty arbitrary
      m_increment = increment
      !! printstring("Bitmap start: ");  write(m_next, 0)
      !! printstring(", increment: ");  write(m_increment, 0);  newline
      setup semaphore(m_semaphore);  signal semaphore(m_semaphore)
      m_map == integer(global heap get(size // 8 + 4));  ! Amount in bytes
      zap(size // 32, m_map)
      m_map = 255;  ! Preallocate 0..15 for the partition header area
      m_map [size // 32] = 16_FFFFFFFF;  ! Runout guard
      %result = addr(m)
%end


%predicate allocate extent(%integer desired size, desired start, bitmap,
                           %integername allocated size, start block)
   ! %true if the allocation succeeded
   ! %false otherwise (no space, bad size, bad after).
   %record(bitmap fm)%name m
   %integer status, after start, after size, before start, before size

      m == record(bitmap)

      %false %unless 0 < desired size <= m_size
      %false %unless desired start < m_size

      desired size = 256 %if desired size > 256;  ! Arbitrary
      %if desired start <= 0 %start
         desired start = m_next
         m_next = rem(m_next + m_increment, m_size)
      %finish

      semaphore wait(m_semaphore)

      ! Search from desired position onwards, then from start to desired
      ! position (effectively, a wrap search from desired position).
      status = search(m_map, m_size, desired start, desired size,
                      after start, after size)
      after size = -1 %if status # 0
      status = search(m_map, desired start, 16, desired size,
                      before start, before size)
      before size = -1 %if status # 0

      %if before size < 0 %and after size < 0 %start
         ! Nothing could be allocated
         signal semaphore(m_semaphore)
         %false
      %finish

      ! Now decide which of the allocated regions to use
      %if after size < 0 %start
         ! Must use the before region (exists, by above test).
         start block = before start
         allocated size = before size
      %else
         ! Can use the after region
         %if after start = desired start %start
            ! Got what we asked for, so use it.
            start block = after start
            allocated size = after size
         %else %if before size < 0 %c
               %or after size >= desired size %c
               %or after size >= before size
            ! Nothing before, or after is large enough, or at least, it's larger
            start block = after start
            allocated size = after size
         %else
            ! Whatever is before is larger (and after isn't large enough).
            start block = before start
            allocated size = before size
         %finish
      %finish

      ! Now claim the region and return
      status = test and set(m_map, start block, allocated size)
      signal semaphore(m_semaphore)
      %false %if status # 0
      %true
%end

%predicate check extent(%integer check start, check size, bitmap)
   ! %true if the extent is allocated
   ! %false otherwise
   %record(bitmap fm)%name m
   %integer status

      m == record(bitmap)

      %false %unless check size > 0
      %false %unless 0 <= check start
      %false %unless check start + check size <= m_size

      semaphore wait(m_semaphore)
      status = test(m_map, check start, check size)
      signal semaphore(m_semaphore)
      %false %if status # 0
      %true
%end

%predicate free extent(%integer free start, free size, bitmap)
   ! Release an extent (assumed to have already been checked).
   %record(bitmap fm)%name m
   %integer status

      m == record(bitmap)

      %false %unless free size > 0
      %false %unless 0 <= free start
      %false %unless free start + free size <= m_size

      semaphore wait(m_semaphore)
      status = test and clear(m_map, free start, free size)
      signal semaphore(m_semaphore)
      %false %if status # 0
      %true
%end

%predicate claim extent(%integer claim start, claim size, bitmap)
   ! %true if the claim was acceptable
   ! %false otherwise (overlap or bad chunk)
   %record(bitmap fm)%name m
   %integer status

      m == record(bitmap)

      %unless claim size > 0 %start
         {} printstring("Claim: bad size ");  write(claim size, 0)
         {} newline
         %false
      %finish
      %unless 0 <= claim start %start
         {} printstring("Claim: bad start address ");  write(claim start, 0)
         {} newline
         %false
      %finish
      %unless claim start + claim size <= m_size %start
         {} printstring("Claim: bad end address ")
         {} write(claim start + claim size, 0)
         {} printstring(" (");  write(claim start, 0)
         {} space;  write(claim size, 0);  printstring(") ")
         {} write(m_size, 0)
         {} newline
         %false
      %finish

      semaphore wait(m_semaphore)
      status = test and set(m_map, claim start, claim size)
      signal semaphore(m_semaphore)
      %false %if status # 0
      %true
%end

%end %of %file