--  core allocation routines for silicon (pretty picture) program
-- last edited by McCreight, December 20, 1983  4:34 PM

DIRECTORY
  IODefs,
  StreamDefs,
  StringDefs,
  ppdefs,
  ppddefs,
  AltoDefs,
  InlineDefs,
  FSPDefs,
  SegmentDefs,
  SystemDefs,
  ZoneAllocDefs;

ppspace: PROGRAM
  IMPORTS ppdefs, StringDefs, SystemDefs, FSPDefs, ZoneAllocDefs
  EXPORTS ppdefs, ppddefs =
  BEGIN
  OPEN StringDefs, InlineDefs, ppdefs, ppddefs, IODefs, StreamDefs, SegmentDefs;

  superListList: LONG POINTER TO list ← NIL;
  superCellList: LONG POINTER TO cell object ← NIL;
  swdsAloc: PUBLIC CARDINAL ← 0;
  lwdsAloc: PUBLIC LONG INTEGER ← 0;
  rlList: LONG POINTER TO rectList ← NIL;

  myHeap: FSPDefs.ZonePointer ← NIL;
  ppUncZone: PUBLIC UNCOUNTED ZONE ← NIL;

  GetSuperPointer: PUBLIC PROCEDURE RETURNS [LONG POINTER TO list] =
    BEGIN RETURN[superListList]; END;

  GetCellSuper: PUBLIC PROCEDURE RETURNS [LONG POINTER TO cell object] =
    BEGIN RETURN[superCellList]; END;

  GetStrSpace: PROCEDURE [nwds: CARDINAL] RETURNS [p: POINTER] =
    BEGIN OPEN SystemDefs, FSPDefs;
    np: CARDINAL;
    p ← MakeNode[
      myHeap, nwds !
      NoRoomInZone =>
        BEGIN
        np ← PagesForWords[nwds + ZoneOverhead + NodeOverhead];
        AddToNewZone[
          myHeap, AllocateResidentPages[np], np*AltoDefs.PageSize, FreePages];
        RESUME
        END];
    swdsAloc ← swdsAloc + FSPDefs.NodeSize[p];
    RETURN
    END;

  FreeStrSpace: PROCEDURE [p: POINTER] =
    BEGIN
    IF p#NIL THEN
      BEGIN
      swdsAloc ← swdsAloc - FSPDefs.NodeSize[p];
      FSPDefs.FreeNode[myHeap, p];
      END;
    END;

  InitHeap: PUBLIC PROCEDURE [np: CARDINAL] =
    BEGIN OPEN SystemDefs, FSPDefs;
    IF myHeap # NIL THEN EraseHeap[];
    myHeap ← MakeNewZone[
      AllocateResidentPages[np], np*AltoDefs.PageSize, FreePages];
    rlList ← NIL;
    ppUncZone ← ZoneAllocDefs.GetAnXMZone[];
    END;

  EraseHeap: PUBLIC PROCEDURE =
    BEGIN
    FSPDefs.DestroyZone[myHeap];
    myHeap ← NIL;
    lwdsAloc ← 0;
    swdsAloc ← 0;
    superListList ← NIL;
    superCellList ← NIL;
    wireList ← [NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL,
		NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL];
    tranList ← NIL;
    puList ← NIL;
    contList ← NIL;
    rlList ← NIL;
    ppUncZone ← ZoneAllocDefs.DestroyAnXMZone[ppUncZone];
    END;

  GetString: PUBLIC PROCEDURE [nchars: CARDINAL] RETURNS [s: STRING] =
    BEGIN
    s ← GetStrSpace[StringDefs.WordsForString[nchars]];
    s↑ ← [length: 0, maxlength: nchars, text:];
    RETURN
    END;

  FreeString: PUBLIC PROCEDURE [s: STRING] = LOOPHOLE[FreeStrSpace];

  newString: PUBLIC PROCEDURE [s: STRING] RETURNS [ss: STRING] =
    BEGIN ss ← GetString[s.length]; AppendString[ss, s]; END;

  GetSpace: PUBLIC PROCEDURE [nwds: CARDINAL] RETURNS [p: LONG POINTER] =
    BEGIN
    WordSeq: TYPE = RECORD[SEQUENCE COMPUTED CARDINAL OF WORD];
    p←ppUncZone.NEW[WordSeq[nwds]];
    lwdsAloc←ZoneAllocDefs.XMZoneWordsInUse[ppUncZone];
    END;

  FreeSpace: PUBLIC PROCEDURE [p: LONG POINTER] =
    {t: LONG POINTER ← p; ppUncZone.FREE[@t];
	lwdsAloc←ZoneAllocDefs.XMZoneWordsInUse[ppUncZone];};

  alocRectD: PUBLIC PROCEDURE RETURNS [p: LONG POINTER TO rect object] =
    BEGIN
    p ← GetSpace[SIZE[rect object]];
    p↑ ← [
      p: NIL, size: [0, 0, 0], l: cut, refCnt: 1, returnable: TRUE, marked: FALSE,
      varpart: rect[]];
    END;
  alocWireD: PUBLIC PROCEDURE RETURNS [p: LONG POINTER TO wire object] =
    BEGIN
    p ← GetSpace[SIZE[wire object]];
    p↑ ← [
      p: NIL, size: [0, 0, 0], l: cut, refCnt: 1, returnable: TRUE, marked: FALSE,
      varpart: wire[]];
    END;
  alocBusD: PUBLIC PROCEDURE RETURNS [p: LONG POINTER TO bus object] =
    BEGIN
    p ← GetSpace[SIZE[bus object]];
    p↑ ← [
      p: NIL, size: [0, 0, 0], l: cut, refCnt: 1, returnable: TRUE, marked: FALSE,
      varpart: bus[]];
    END;
  alocXstrD: PUBLIC PROCEDURE RETURNS [p: LONG POINTER TO xstr object] =
    BEGIN
    p ← GetSpace[SIZE[xstr object]];
    p↑ ← [
      p: NIL, size: [0, 0, 0], l: cut, refCnt: 1, returnable: TRUE, marked: FALSE,
      varpart: xstr[impl: enhancement, width: 2, length: 2, wExt: 0, lExt: 0]];
    END;
  alocCellD: PUBLIC PROCEDURE RETURNS [p: LONG POINTER TO cell object] =
    BEGIN
    p ← GetSpace[SIZE[cell object]];
    p↑ ← [
      p: NIL, size: [0, 0, 0], l: cut, refCnt: 1, returnable: TRUE, marked: FALSE,
      varpart: cell[cnt: 0, ptr: NIL]];
    p.super ← superCellList;
    superCellList ← p;
    END;
  alocContD: PUBLIC PROCEDURE RETURNS [p: LONG POINTER TO cont object] =
    BEGIN
    p ← GetSpace[SIZE[cont object]];
    p↑ ← [
      p: NIL, size: [0, 0, 0], l: met, refCnt: 1, returnable: TRUE, marked: FALSE,
      varpart: cont[typ: mPol]];
    END;
  alocTextD: PUBLIC PROCEDURE RETURNS [p: LONG POINTER TO text object] =
    BEGIN
    p ← GetSpace[SIZE[text object]];
    p↑ ← [
      p: NIL, size: [8, 8, 8], l: cut, refCnt: 1, returnable: TRUE, marked: FALSE,
      varpart: text[s: ""]];
    END;
  alocCnTextD: PUBLIC PROCEDURE RETURNS [p: LONG POINTER TO cnText object] =
    BEGIN
    p ← GetSpace[SIZE[cnText object]];
    p↑ ← [
      p: NIL, size: [8, 8, 8], l: cut, refCnt: 1, returnable: TRUE, marked: FALSE,
      varpart: cnText[s: ""]];
    END;

  alocList: PUBLIC PROCEDURE RETURNS [p: listPtr] =
    BEGIN
    p ← ppUncZone.NEW[list ← [lx: 0, ly: 0, super: superListList]];
    lwdsAloc←ZoneAllocDefs.XMZoneWordsInUse[ppUncZone];
    superListList ← p;
    END;

  freeList: PUBLIC PROCEDURE [p: listPtr] =
    BEGIN
    pp: listPtr;
    pp ← superListList;
    IF pp = p THEN superListList ← p.super
    ELSE
      WHILE pp # NIL DO
        IF pp.super = p THEN BEGIN pp.super ← p.super; EXIT; END;
        pp ← pp.super;
        ENDLOOP;
    WHILE p.props#NIL DO
      prop: propPtr ← p.props;
      p.props ← prop.next;
      ppUncZone.FREE[@prop]; -- but don't free its atoms
      ENDLOOP;
    ppUncZone.FREE[@p];
    lwdsAloc←ZoneAllocDefs.XMZoneWordsInUse[ppUncZone];
    END;

  freeCell: PUBLIC PROCEDURE [p: cellPtr] =
    BEGIN
    pp: cellPtr ← superCellList;
    IF pp = p THEN superCellList ← p.super
    ELSE
      WHILE pp # NIL DO
        IF pp.super = p THEN BEGIN pp.super ← p.super; EXIT; END;
        pp ← pp.super;
        ENDLOOP;
    freeObject[p];
    END;

  freeObject: PUBLIC PROCEDURE [ob: obPtr] =
    BEGIN
    WHILE ob.props#NIL DO
      prop: propPtr ← ob.props;
      ob.props ← prop.next;
      ppUncZone.FREE[@prop]; -- but don't free its atoms
      ENDLOOP;
    ppUncZone.FREE[@ob];
    lwdsAloc←ZoneAllocDefs.XMZoneWordsInUse[ppUncZone];
    END;

  alocCList: PUBLIC PROCEDURE RETURNS [p: LONG POINTER TO cList] =
    {p ← GetSpace[SIZE[cList]]; p↑ ← [NIL, NIL, NIL]};

  alocRectList: PUBLIC PROCEDURE RETURNS [p: LONG POINTER TO rectList] =
    BEGIN
    IF rlList # NIL THEN BEGIN p ← rlList; rlList ← p.nxt; END
    ELSE p ← GetSpace[SIZE[rectList]];
    p.nxt ← NIL;
    p.freebl ← TRUE;
    END;

  returnRectList: PUBLIC PROCEDURE [p: LONG POINTER TO rectList] =
    BEGIN p.nxt ← rlList; rlList ← p; END;

  END.