%routinespec(16_1198)phex(%integer x)

! Heap for JGH (RWT Aug 83)

%owninteger freelist=0

%externalroutine heapinit(%integer bytes)
%integerfnspec(16_1138)rawheapget(%integer x)
  bytes = (bytes+3)&\3
  freelist = rawheapget(bytes+8)
  integer(freelist) = 0
  integer(freelist+4) = bytes
{printstring("Heapinit "); phex(bytes); space; phex(freelist); newline
%end

%externalintegerfn heapget(%integer bytes)
%integer bestsize=0,thissize,it
%integername best,this == freelist
  bytes = (bytes+3)&\3
{printstring("Heapget "); phex(bytes); newline
  %while this#0 %cycle
{printstring(" considering "); phex(this)
    thissize = integer(this+4)
{space; phex(thissize); newline
    %if thissize>=bytes %start
      %if bestsize=0 %or thissize<bestsize %start
        best == this; bestsize = thissize
      %finish
      %exitif bestsize=bytes
    %finish
    this == integer(this)
  %repeat
  %signal 2,1 %if bestsize=0
  it = best
  %if bestsize-bytes>8 %start
{printstring(" splitting ")
    integer(it+4) = integer(it+4)-bytes-8
    it = it+8+integer(it+4)
    integer(it) = -bytes; integer(it+4) = bytes
  %else
{printstring(" extracting ")
    best = integer(it)
    integer(it) = -integer(it+4)
  %finish
{phex(it); newline
  %result = it+8
%end

%externalroutine heapput(%integer pos)
%integername this == freelist
%integer end
  pos = pos-8; %signal 2,-1 %unless integer(pos)+integer(pos+4)=0
  end = pos+8+integer(pos+4)
{printstring("Heapput "); phex(pos); space; phex(end); newline
  %cycle
{printstring(" considering "); phex(this); newline
    %if this=0 %start
{printstring(" appending"); newline
      this = pos; integer(pos) = 0; %return
    %finish
    %if this=end %start
{printstring(" sticking on front"); newline
      integer(pos) = integer(this)
      integer(pos+4) = integer(pos+4)+8+integer(this+4)
      this = pos; %return
    %finish
    %if this>end %start
{printstring(" inserting"); newline
      integer(pos) = this; this = pos; %return
    %finish
    %if this+8+integer(this+4)=pos %start
{printstring(" sticking on end"); newline
      integer(this+4) = integer(this+4)+8+integer(pos+4)
      %if integer(this)=end %start
{printstring(" joining"); newline
        integer(this+4) = integer(this+4)+8+integer(end+4)
        integer(this) = integer(end)
      %finish
      %return
    %finish
    this == integer(this)
  %repeat
%end

%externalroutine dispose(%record(*)%name x)
  heapput(addr(x))
%end

!%externalrecord(*)%map new(%record(*)%name x)
!  %result == record(heapget(sizeof(x)))
!%end

%endoffile