--  core allocation routines for silicon (pretty picture) program
-- last edited by McCreight, December 3, 1982  9:54 AM
--  to eliminate repeated objects

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: 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[]];
    RETURN
    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[]];
    RETURN
    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[]];
    RETURN
    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: FALSE, width: 2, length: 2, wExt: 0, lExt: 0]];
    RETURN
    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;
    RETURN
    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]];
    RETURN
    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: ""]];
    RETURN
    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: ""]];
    RETURN
    END;

  alocList: PUBLIC PROCEDURE RETURNS [p: LONG POINTER TO list] =
    BEGIN
    p _ GetSpace[SIZE[list]];
    p.super _ superListList;
    superListList _ p;
    p.nxt _ NIL;
    p.ob _ NIL;
    p.selected _ FALSE;
    p.deleted _ FALSE;
    p.gotText _ FALSE;
    p.props _ NIL;
    RETURN
    END;
  freeList: PUBLIC PROCEDURE [p: LONG POINTER TO list] =
    BEGIN
    pp: LONG POINTER TO list;
    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;
    FreeSpace[p];
    RETURN
    END;
  freeCell: PUBLIC PROCEDURE [p: LONG POINTER TO cell object] =
    BEGIN
    pp: LONG POINTER TO cell object;
    pp _ 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;
    FreeSpace[p];
    RETURN
    END;
  alocCList: PUBLIC PROCEDURE RETURNS [p: LONG POINTER TO cList] =
    BEGIN p _ GetSpace[SIZE[cList]]; p^ _ [NIL, NIL, NIL]; RETURN END;
  alocTextProp: PUBLIC PROCEDURE RETURNS [p: LONG POINTER TO text prop] =
    BEGIN p _ GetSpace[SIZE[text prop]]; p^ _ [nxt: NIL, varpart: text[]]; END;
  alocTailProp: PUBLIC PROCEDURE RETURNS [p: LONG POINTER TO tail prop] =
    BEGIN
    p _ GetSpace[SIZE[tail prop]];
    p^ _ [nxt: NIL, varpart: tail[bpnt: NIL]];
    END;
  alocInterPnt: PUBLIC PROCEDURE RETURNS [p: LONG POINTER TO interPnt prop] =
    BEGIN
    p _ GetSpace[SIZE[interPnt prop]];
    p^ _ [nxt: NIL, varpart: interPnt[pnt: NIL]];
    END;
  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.