-- HeapPack.Mesa  Edited by: Bruce on August 29, 1980  1:27 PM

DIRECTORY
  DebugFormat USING [Fob, Foo],
  DOutput USING [Text],
  DHeap USING [Zero],
  Init USING [FlushCaches],
  Inline USING [LongNumber],
  Pc USING [CtxLink],
  State USING [DNode, Get, Handle, NodeHandle, NodeType],
  Storage USING [Expand, Free, Node, Prune],
  Table USING [WordsFree];

HeapPack: PROGRAM
  IMPORTS DOutput, Init, DHeap, State, Storage, Table
  EXPORTS DHeap, Init, Pc =
  BEGIN OPEN DebugFormat;
  
  MoreHeapSpace: CARDINAL = 7;
  NotInHeap: PUBLIC SIGNAL = CODE;
  InvalidNodeType: ERROR = CODE;

  FreeContextList: PUBLIC PROC [p: Pc.CtxLink] =
    BEGIN
    next: Pc.CtxLink;
    FOR p _ p, next UNTIL p = NIL DO next _ p.link; Storage.Free[p] ENDLOOP;
    END;

  AllocFob: PUBLIC PROCEDURE RETURNS [f: Foo] =
    BEGIN
    f _ MyAlloc[SIZE[Fob],fobs];
    DHeap.Zero[f, SIZE[Fob]];
    END;

  TopLevel: PUBLIC PROC = {MyFree[fobs]; [] _ Storage.Prune[]; CheckSymTabLength[]};

  FreeFobs: PUBLIC PROC = {MyFree[fobs]};

  CheckSymTabLength: PUBLIC PROC =
    BEGIN
    IF Table.WordsFree[] < 300 THEN
      BEGIN
      DOutput.Text[" Resetting symbol table! "L];
      Init.FlushCaches[flushSymbols];
      END;
    END;

  -- utilities

  FreeLong: PUBLIC PROC [p: LONG POINTER] =
    BEGIN OPEN Inline;
    ln: LongNumber _ LOOPHOLE[p];
    IF ln.highbits # 0 THEN {SIGNAL NotInHeap; RETURN};
    Storage.Free[LOOPHOLE[ln.lowbits]]
    END;

  Initialize: PUBLIC PROC = BEGIN Storage.Expand[MoreHeapSpace] END;

  FreeEverything: PUBLIC PROC = {FreeFobs[]};

  MyAlloc: PROC [nwords: CARDINAL, nt: State.NodeType] RETURNS [POINTER] =
    BEGIN
    h: State.Handle _ State.Get[];
    root: POINTER TO State.NodeHandle _ SELECT nt FROM
      fobs => @h.fobs,
      ENDCASE => ERROR InvalidNodeType;
    n: State.NodeHandle _ Storage.Node[SIZE[State.DNode]];
    n^ _ [link: root^, node: Storage.Node[nwords]];
    root^ _ n;
    RETURN[n.node];
    END;

  MyFree: PROCEDURE [nt: State.NodeType] =
    BEGIN
    h: State.Handle _ State.Get[];
    first: POINTER TO State.NodeHandle _ SELECT nt FROM
      fobs => @h.fobs,
      ENDCASE => ERROR InvalidNodeType;
    i, next: State.NodeHandle;
    FOR i _ first^, next UNTIL i = NIL DO
      next _ i.link;
      SELECT nt FROM
	fobs =>
	  BEGIN
	  f: Foo _ i.node;
	  IF ~f.there THEN FreeLong[f.addr.base];
	  END;
	ENDCASE;
      Storage.Free[i.node]; Storage.Free[i];
      ENDLOOP;
    IF first^ # NIL THEN first^ _ NIL;
    END;

  END.