%externalinteger Hfree = 0
%externalinteger Hmax  = -1
%externalinteger Hmin  = 16_7FFFFFFF

%routine Corrupt(%integer N)
   Event_Message = "Heap corrupt" %if N # 0
   %signal 2, 4, N
%end

%integerfn Extend Heap(%integer Bytes)
   %externalintegerspec Load End %alias "Image$$DataLimit"
   %integer N
   %if Hmax < 0 %start   {first call}
      Hmin = (Addr(Load End)+3)&(\3) +4096+4096 {for testing}
      Hmax = Hmin
   %finish
   N = Hmax
   Hmax = Hmax+Bytes
   %result = N %if Addr(N)-4096 > Hmax
   Hmax = Hmax-Bytes
   Corrupt(0)
%end

%externalintegerfn Get Space %alias "3L_GET_SPACE"(%integer Size)
   %integer A, N
   %integername Head == Hfree
   Size = (Size+3+4)&(\3)
   %while Head # 0 %cycle
      N = Integer(Head)
      %if N = Size %start
         A = Head
         Head = Integer(A+4)
         %result = A
      %finish
      N = N-Size
      %if N >= 8 %start
         A = Head
         Head = Head+Size
         Integer(Head+4) = Integer(A+4)
         Integer(Head+0) = N
         %result = A
      %finish
      Head == Integer(Head+4)
   %repeat
   %result = Extend Heap(Size)
%end

%externalroutine Free Space %alias "3L_FREE_SPACE"(%integer Size, A)
   %integer Da, Dn, De, E
   %integername Head == Hfree
   Size = (Size+3+4)&(\3)
   Corrupt(1) %if (Size!A)&16_80000003 # 0
   E = A+Size
   Corrupt(2) %if A < Hmin %or E > Hmax
   %cycle
      Da = Head
      %if Da = 0 %start
         Integer(A+0) = Size
         Integer(A+4) = 0
         Head = A
         %exit
      %finish
      Dn = Integer(Da)
      De = Da+Dn
      %if E <= Da %start
         %if E = Da %start
            Integer(A+0) = Dn+Size
            Integer(A+4) = Integer(Da+4)
         %else
            Integer(A+0) = Size
            Integer(A+4) = Da
         %finish
         Head = A
         %exit
      %finish
      %if A = De %start
         Size = Size+Dn
         A    = Da
         Head = Integer(Da+4)
      %else
         Head == Integer(Da+4)
      %finish
   %repeat
   %if Head+Integer(Head) = Hmax %start
      Corrupt(5) %if Integer(Head+4) # 0
      Hmax = Head
      Head = 0
   %finish     
%end

%externalintegerfn Free Store %alias "3L___free_store"
   %integer N
   %result = Addr(N)-Extend Heap(0)-4096
%end

%externalrecord(*)%map NEW %alias "3L_IMP_NEW"(%name V)
   %integer Size = (Sizeof(V)+3)&(\3)
   %result == Record(Get Space(Size))
%end

%externalroutine Dispose %alias "3L_IMP_DISPOSE"(%name V)
   %integer Size = (Sizeof(V)+3)&(\3)
   Free Space(Size, Addr(V))
%end

%externalroutine Clear %alias "3L_CLEAR"(%integer From, Length)
   %while Length> 0 %cycle
      Length = Length-1
      Byte(From) = 16_80
      From = From+1
   %repeat
%end