{Portable Prolog Heap Manager}

%external %INTEGER %spec HEAP FREE,
                         HEAP USED,
                         FHPP,
                         SKEL0,
                         HEAP FREE 2,
                         GLB0,
                         Skel Limit

%external %routine %spec No Space (%string (31) In)

{-RELEASEP-}

{Formerly just RELEASE - P added to indicate Prolog to avoid class with}
{brainless APM system software}

{P does not imply predicate!}

{Returns area of length L pointed to by P to free area}

%EXTERNALROUTINE RELEASEP(%INTEGER P, L)
   %INTEGER P1,P2
   
   HEAPUSED=HEAPUSED-L
   %IF L=8 %START
      INTEGER(P)=HEAPFREE2
      HEAPFREE2=P
      %RETURN
   %FINISH
   P1=ADDR(HEAPFREE)
L1:
   %IF INTEGER(P1)=0 %START
      INTEGER(P)=0
      INTEGER(P+8)=L
      INTEGER(P+4)=0
      INTEGER(P1)=P
      %RETURN
   %FINISH
   P2=INTEGER(P1)
   %IF INTEGER(P2+8)<L %START
      P1=P2+4
      ->L1
   %FINISH
   %IF INTEGER(P2+8)=L %START
      INTEGER(P)=P2
      INTEGER(P+8)=L
      INTEGER(P+4)=INTEGER(P2+4)
      INTEGER(P1)=P
      %RETURN
   %FINISH
   INTEGER(P+4)=P2
   INTEGER(P)=0
   INTEGER(P+8)=L
   INTEGER(P1)=P
%END {Release}

{-GET SP-}

{Allocates a block of heap of size 8 <= L <=252}

%EXTERNAL %INTEGER %function GET SP (%INTEGER L)
   %INTEGER P1,P
   P = ADDR(HEAPFREE)
   HEAP USED= HEAP USED + L
   %IF L < 8 %OR %c
       L > 252 %START
      NEW LINES (2)
      PRINT STRING("** ATTEMPT TO ALLOCATE A BLOCK OF:")
      WRITE(L,1)
      %MONITOR
      %STOP
   %FINISH
   %IF L = 8 %AND %c
       HEAP FREE 2 # 0 %START
      P1 = HEAP FREE 2
      HEAP FREE 2 = INTEGER (HEAP FREE 2)
      %RESULT = P1
   %FINISH
L1: 
   P1 = INTEGER (P)
   %IF P1 = 0 %START
      {end of hole list - allocate new space}
      %if FHPP + L > Skel Limit %start
         No Space ("SKEL")
      %finish
      P = FHPP
      FHPP = FHPP + L 
      %RESULT = P 
   %FINISH
   %IF INTEGER (P1 + 8) <= L + 4 %AND %c
       INTEGER (P1 + 8) # L %START
      P = P1 + 4
      ->L1
   %FINISH
   %IF INTEGER(P1)=0 %start
      INTEGER(P)=INTEGER(P1+4)
   %ELSE 
      INTEGER(P)=INTEGER(P1)
      INTEGER(INTEGER(P1)+4)=INTEGER(P1+4)
   %finish
   %RESULT=P1 %IF INTEGER(P1+8)=L
   P=INTEGER(P1+8)-L
   HEAPUSED=HEAPUSED+P
   RELEASEP(P1+L,P)
   %RESULT=P1
%END {Get SP}

{-RELEASE C-}

{Release space occupied by source term C}

%EXTERNALROUTINE RELEASEC(%INTEGER C)
   %INTEGER N,P,K

   %RETURN %UNLESS SKEL0<=C<GLB0
   %RETURN %IF INTEGER(C)<SKEL0
   N=BYTEINTEGER(INTEGER(C)+4)
   P=C
   K=N
   %WHILE N>0 %CYCLE
      P=P+4
      RELEASEC(INTEGER(P))
      N=N-1
   %REPEAT
   RELEASEP(C,(K+1)*4)
%END {Release C}

%ENDOFFILE
