
<<
JunoStorageImpl.mesa>>
<<>>
<<Coded June 81 by Greg Nelson.>>
<<Last edited by GNelson (?) January 19, 1984 1:52 pm>>
<<Last edited by Stolfi    June 2, 1984 8:14:56 am PDT>>
<<
Defines record types, allocation and deallocation functions.>>
<<
TO FIX:  Is it necessary for it to be a monitor?.>>
<<
TO FIX:  Frames in constraints --- pass them to NewXXX procedures?.>>

DIRECTORY

JunoStorage;

JunoStorageImpl: MONITOR

  EXPORTS JunoStorage =

BEGIN OPEN JunoStorage;
<<
- - - - POINTS >>

pointAvail: Point  _ NIL;

nPoints, mPoints: INT _ 0;
<<nPoints counts calls to NewPoint, mPoints counts actual allocations  >>

NewPoint: PUBLIC ENTRY PROC [coords: Coords, visible: BOOL _ FALSE] RETURNS [p: Point] =

  BEGIN 
    IF pointAvail = NIL THEN
       THROUGH [1..50] DO
         pointAvail _ NEW [PointRec _ [link: pointAvail]];
         mPoints _ mPoints+1
        ENDLOOP;
    p _ pointAvail;
    pointAvail _ pointAvail.link;
    p.link _ NIL;
    p^ _ [coords: coords, visible: visible, link: NIL];
    nPoints _ nPoints+1
  END;

DeletePoint: PUBLIC PROC [p, ant: Point, list: PointList] RETURNS [newList: PointList] =

BEGIN
  IF p = list.first THEN
      {IF ant # NIL THEN ERROR;
       newList.first _ p.link}
   ELSE
      {IF ant = NIL THEN
          {ant _ list.first;
           WHILE ant.link # p DO ant _ ant.link ENDLOOP}
        ELSE
          {IF ant.link # p THEN ERROR};
       ant.link _ p.link;
       newList.first _ list.first};
  newList.last _ IF p = list.last THEN ant ELSE list.last;
  p.link _ NIL
END; 

InsertPoint: PUBLIC PROC [p, ant: Point, list: PointList] RETURNS [newList: PointList] =

BEGIN
  IF ant = NIL THEN
     {p.link _ list.first;
      newList.first _ p}
  ELSE
      {p.link _ ant.link;
       ant.link _ p;
       newList.first _ list.first};
  newList.last _ IF p.link = NIL THEN p ELSE list.last
END; 

GcPoints: PUBLIC PROC [start: Point, lim: Point _ NIL] =

BEGIN
  t: Point;
  GcIt: ENTRY PROC [p: Point] = {p^ _ [link: pointAvail]; pointAvail _ p};
  WHILE start # lim DO
     t _ start.link; GcIt[start]; start _ t
    ENDLOOP
END;
<<
- - - - CONSTRAINTS>>

constrAvail: ARRAY ConstrKind OF Constr _ ALL[NIL];

nConstrs, mConstrs: ARRAY ConstrKind OF INT _ ALL[0];
<<nConstrs counts total allocations, mConstrs counts max in use at same time  >>

NewConstr: ENTRY PROC [kind: ConstrKind] RETURNS [cp: Constr] =  

BEGIN
  IF constrAvail[kind] = NIL THEN

 BEGIN -- Create a bunch of new records
  t: Constr;
  THROUGH [1..50] DO
    t _ constrAvail[kind];
    constrAvail[kind] _ 
        SELECT kind FROM
            ver => NEW[ver ConstrRec],
            ccw => NEW[ccw ConstrRec],
            para => NEW[para ConstrRec],
            perp => NEW[perp ConstrRec],
            cong => NEW[cong ConstrRec],
            at => NEW[at ConstrRec],
            hor => NEW[hor ConstrRec],
          ENDCASE => ERROR;
    constrAvail[kind].link _ t;
    mConstrs[kind] _ mConstrs[kind]+1
   ENDLOOP
END;

  cp _ constrAvail[kind];
  constrAvail[kind] _ constrAvail[kind].link;
  cp.link _ NIL;
  nConstrs[kind] _ nConstrs[kind]+1 
END;

DeleteConstr: PUBLIC PROC [c, ant: Constr, list: ConstrList] RETURNS [newList: ConstrList] =

BEGIN
  IF c = list.first THEN
     {IF ant # NIL THEN ERROR;
      newList.first _ c.link}
  ELSE
     {IF ant = NIL THEN
          {ant _ list.first;
           WHILE ant.link # c DO ant _ ant.link ENDLOOP}
        ELSE
          {IF ant.link # c THEN ERROR};
       ant.link _ c.link;
       newList.first _ list.first};
  newList.last _ IF c = list.last THEN ant ELSE list.last;
  c.link _ NIL
END; 

InsertConstr: PUBLIC PROC [c, ant: Constr, list: ConstrList] RETURNS [newList: ConstrList] =

BEGIN
  IF ant = NIL THEN
     {c.link _ list.first;
      newList.first _ c}
   ELSE
     {c.link _ ant.link;
      ant.link _ c;
      newList.first _ list.first};
  newList.last _ IF c.link = NIL THEN c ELSE list.last
END; 

GcConstrs: PUBLIC PROC [start: Constr, lim: Constr _ NIL] =

BEGIN
  t: Constr;
  GcIt: ENTRY PROC [c: Constr] = {c.link _ constrAvail[c.kind]; constrAvail[c.kind] _ c};
  WHILE start # lim DO
    t _ start.link;
    GcIt[start];
    start _ t
   ENDLOOP
END;

NewHor: PUBLIC PROC [i,j: Point]
  RETURNS [cp: HorConstr] =

  BEGIN
    IF i = NIL OR j = NIL THEN ERROR;
    cp _ NARROW [NewConstr[hor]];
    cp.i _ i;
    cp.j _ j
  END;

NewVer: PUBLIC PROC [i,j: Point]
  RETURNS [cp: VerConstr] =

  BEGIN
    IF i = NIL OR j = NIL THEN ERROR;
    cp _ NARROW [NewConstr[ver]];
    cp.i _ i;
    cp.j _ j;
  END;

NewPara: PUBLIC PROC [i,j,k,l: Point]
  RETURNS [cp: ParaConstr] =

  BEGIN
    IF i = NIL OR j = NIL OR k = NIL OR l=NIL THEN ERROR;
    cp _ NARROW [NewConstr[para]];
    cp.i _ i;
    cp.j _ j;
    cp.k _ k;
    cp.l _ l
  END;

NewPerp: PUBLIC PROC [i,j,k,l: Point]
  RETURNS [cp: PerpConstr] =

  BEGIN
    IF i = NIL OR j = NIL OR k = NIL OR l=NIL THEN ERROR;
    cp _ NARROW [NewConstr[perp]];
    cp.i _ i;
    cp.j _ j;
    cp.k _ k;
    cp.l _ l
  END;

NewCong: PUBLIC PROC [i,j,k,l: Point]
  RETURNS [cp: CongConstr] = 

  BEGIN
    IF i = NIL OR j = NIL OR k = NIL OR l=NIL THEN ERROR;
    cp _ NARROW [NewConstr[cong]];
    cp.i _ i;
    cp.j _ j;
    cp.k _ k;
    cp.l _ l
  END;

NewAt: PUBLIC PROC [p: Point, coords: Coords]
  RETURNS [cp: AtConstr] =

  BEGIN
    IF p = NIL THEN ERROR;
    cp _ NARROW [NewConstr[at]];
    cp.p _ p;
    cp.coords _ coords;
  END;

NewCcw: PUBLIC PROC [i,j,k: Point]
  RETURNS [cp: CcwConstr] =

  BEGIN
    IF i = NIL OR j = NIL OR k = NIL THEN ERROR;
    cp _ NARROW [NewConstr[ccw]];
    cp.i _ i;
    cp.j _ j;
    cp.k _ k
  END;
<<
- - - - ACTIONS>>

actionAvail: Action _ NIL;

nActions, mActions: INT _ 0;
<<nActions counts total allocations, mActions counts max in use at same time  >>

NewAction: PUBLIC ENTRY PROC [kind: ActionKind, args: ActionArgs]
  RETURNS [ap: Action] =

BEGIN
  IF actionAvail = NIL THEN

 BEGIN
  t: Action;
  THROUGH [1..50] DO
    t _ actionAvail;
    actionAvail _  NEW[ActionRec];
    actionAvail.link _ t;
    mActions _ mActions + 1
   ENDLOOP
END;

  ap _ actionAvail;
  actionAvail _ actionAvail.link;
  ap^ _ [link: NIL, kind: kind, args: args];
  nActions _ nActions+1
END;

DeleteAction: PUBLIC PROC [a, ant: Action, list: ActionList] RETURNS [newList: ActionList] =

BEGIN
  IF a = list.first THEN
     {IF ant # NIL THEN ERROR;
      newList.first _ a.link}
  ELSE
     {IF ant = NIL THEN
          {ant _ list.first;
           WHILE ant.link # a DO ant _ ant.link ENDLOOP}
        ELSE
          {IF ant.link # a THEN ERROR};
       ant.link _ a.link;
       newList.first _ list.first};
  newList.last _ IF a = list.last THEN ant ELSE list.last;
  a.link _ NIL
END; 

InsertAction: PUBLIC PROC [a, ant: Action, list: ActionList] RETURNS [newList: ActionList] =

BEGIN
  IF ant = NIL THEN
     {a.link _ list.first;
      newList.first _ a}
   ELSE
     {a.link _ ant.link;
      ant.link _ a;
      newList.first _ list.first};
  newList.last _ IF a.link = NIL THEN a ELSE list.last
END; 

GcActions: PUBLIC PROC [start: Action, lim: Action _ NIL] = 

BEGIN
  t: Action;
  GcIt: ENTRY PROC [a: Action] =
     {a^ _ [link: actionAvail, kind: draw, args: NIL]; actionAvail _ a};
  WHILE start # lim DO
    t _ start.link;
    GcList[start.args, NIL];
    GcIt[start];
    start _ t
   ENDLOOP
END;

<<
- - - - LISTS>>

listAvail: List _ NIL;

nLists, mLists: INT _ 0;
<<nLists counts total list cell allocations, mLists counts max in use at same time  >>

Cons: PUBLIC ENTRY PROC [first: REF ANY, rest: List] RETURNS [cons: List] =

BEGIN
  IF listAvail = NIL THEN

 BEGIN
  THROUGH [1..100] DO
    listAvail _  CONS[NIL, listAvail];
    mLists _ mLists+1
   ENDLOOP
END;

  cons _ listAvail;
  listAvail _ listAvail.rest;
  cons.first _ first; cons.rest _ rest;
  nLists _ nLists+1
END;

GcList: PUBLIC PROC [start: LIST OF REF ANY, lim: LIST OF REF ANY _ NIL] =

BEGIN
  t: LIST OF REF ANY;
  GcIt: ENTRY PROC [s: LIST OF REF ANY] = {s.first _ NIL; s.rest _ listAvail; listAvail _ s};
  WHILE start # lim DO
    t _ start.rest;
    GcIt[start];
    start _ t
   ENDLOOP
END;
<<
- - - - INITIALIZATION>>

InitStorage: PROC =
<<Allocator warming-up exercises  >>

BEGIN
    GcPoints[NewPoint[[0, 0]], NIL];
    FOR kind: ConstrKind IN ConstrKind DO
       GcConstrs[NewConstr[kind], NIL]
      ENDLOOP;
    GcActions[NewAction[kind: draw, args: NIL], NIL];
    GcList[Cons[NIL, NIL], NIL]
END;

InitStorage[]

END.