-- CellLibrarian.mesa
-- a program to run within Chipmonk

-- written by E. McCreight, August 27, 1981  3:50 PM
-- replace-cells-from-file written by R. Pasco, January 25, 1982
-- last modified by E. McCreight, March 29, 1983  2:14 PM

DIRECTORY
  ChipUserInt,
  InlineDefs,
  ppdddefs: FROM "ppdddefs" USING [AdjustCallersBBoxes],
  ppddefs,
  ppdefs,
  StringDefs;

CellLibrarian: PROGRAM
  IMPORTS ChipUserInt, InlineDefs, ppdddefs,
    ppddefs, ppdefs, StringDefs =
  BEGIN OPEN ChipUserInt, ppddefs, ppdefs, StringDefs;


  uz: PUBLIC UNCOUNTED ZONE ← NIL;


  maxStars: INTEGER = 8;
  spntAr: TYPE = ARRAY [0..maxStars) OF ssInd;
  ssInd: TYPE = RECORD[st, end: [0..255]];
    -- specifies a substring: chrs [st..end)


  -- G e n e r a l l y - U s e f u l   P r o c e d u r e s


  CalcBBox: PROC [ob: obPtr] RETURNS [noChange: BOOLEAN] =
    {RETURN[TRUE]};
  -- This is a stub to be replaced by the same routine in
  -- Chipmonk when it is repaired and exported.

  LibrarianExplain: PROCEDURE [why: STRING,
    explanation, what: STRING ← NIL] =
    BEGIN
    IF what = NIL THEN what ← "Can't run CellLibrarian [Confirm]";
    Explain[why, explanation, what];
    END;


  MarkList: PROCEDURE[head: listPtr,
    selectedOnly: BOOLEAN ← FALSE] =
    BEGIN
    FOR lp: listPtr ← head, lp.nxt WHILE lp#NIL DO
      IF lp.selected OR NOT selectedOnly THEN
        MarkObject[lp.ob];
      ENDLOOP;
    END;


  MarkObject: PROCEDURE[ob: obPtr] =
    BEGIN
    ob.marked ← TRUE;
    WITH dob: ob SELECT FROM
      cell => MarkList[dob.ptr];
      ENDCASE => NULL;
    END;


  BBList: PROCEDURE[head: listPtr] =
    BEGIN
    FOR lp: listPtr ← head, lp.nxt WHILE lp#NIL DO
      lp.ridx ← InlineDefs.BITXOR[lp.idx, 1];
      BBObject[lp.ob];
      ENDLOOP;
    END;


  BBObject: PROCEDURE[ob: obPtr] =
    BEGIN
    IF ob.marked THEN
      BEGIN
      ob.marked ← FALSE;
      ob.size[2] ← ob.size[0];
      WITH dob: ob SELECT FROM
        cell => BBList[dob.ptr];
        ENDCASE => NULL;
      [] ← CalcBBox[ob];
      END;
    END;


  UnlistUnmarkedCells: PROCEDURE[lpp: LONG POINTER TO listPtr, keepOnlySelected: BOOLEAN ← FALSE] =
    BEGIN
    WHILE lpp↑#NIL DO
      ob: LONG POINTER TO object ← lpp↑.ob;
      IF (ob.otyp=cell AND NOT ob.marked) OR
        (keepOnlySelected AND NOT lpp↑.selected) THEN
          lpp↑ ← lpp↑.nxt ELSE lpp ← @lpp↑.nxt;
      ENDLOOP;
    END;


  ReSizeCells: PROCEDURE[lpp: LONG POINTER TO listPtr, keepOnlySelected: BOOLEAN ← FALSE] =
    BEGIN
    WHILE lpp↑#NIL DO
      ob: LONG POINTER TO object ← lpp↑.ob;
      IF (ob.otyp=cell AND NOT ob.marked) OR
        (keepOnlySelected AND NOT lpp↑.selected) THEN
          lpp↑ ← lpp↑.nxt ELSE lpp ← @lpp↑.nxt;
      ENDLOOP;
    END;


  Capitalize: PROCEDURE[s: STRING] =
    BEGIN
    IF s#NIL THEN FOR i: CARDINAL IN [0..s.length) DO
      s[i] ← UpperCase[s[i]];
      ENDLOOP;
    END;


  starCount: PROCEDURE[s: STRING] RETURNS[c: INTEGER] =
    BEGIN
    c←0;
    FOR i: CARDINAL IN [0..s.length) DO
      IF s[i]='* THEN c←c+1;
      ENDLOOP;
    END;


  namesMatch: PROCEDURE[s1, s2: STRING, c1, c2: CARDINAL]
    RETURNS[BOOLEAN, spntAr] =
    BEGIN -- only s1 can have stars
    myAr, otherAr: spntAr;
    b: BOOLEAN;
    newc1: CARDINAL ← c1+1;
    myAr[0] ← [c2,c2];
    SELECT TRUE FROM
      c1=s1.length => RETURN[c2=s2.length, myAr];

      c2=s2.length =>
        RETURN[newc1=s1.length AND s1[c1]='*, myAr];

      s1[c1]='* =>
        FOR i: CARDINAL IN [c2..s2.length] DO
          myAr[0].end ← i;
          [b,otherAr] ← namesMatch[s1,s2,newc1,i];
          IF b THEN
            BEGIN
            FOR j: INTEGER IN [1..maxStars) DO
              myAr[j] ← otherAr[j-1];
              ENDLOOP;
            RETURN[TRUE,myAr];
            END;
          ENDLOOP;

      s2[c2]=s1[c1] =>
        BEGIN
        [b,myAr] ← namesMatch[s1,s2,newc1,c2+1];
        RETURN[b,myAr];
        END;

      ENDCASE => NULL;

    RETURN[FALSE, myAr];
    END;


  replaceName: PROCEDURE[cell: LONG POINTER TO cList,
    ar: spntAr, ns: STRING] =
    BEGIN
    newName: STRING ← [400];
    grpCnt: INTEGER ← 0;
    oldName:STRING ← cell.name;

    FOR i: CARDINAL IN [0..ns.length) DO
      IF ns[i]='* THEN
        BEGIN
        FOR j: INTEGER IN [ar[grpCnt].st..ar[grpCnt].end) DO
          AppendChar[newName,oldName[j]];
          ENDLOOP;
        grpCnt ← grpCnt+1;
        END
      ELSE AppendChar[newName,ns[i]];
      ENDLOOP;

    FOR c2: LONG POINTER TO cList ← cellList, c2.nxt
      WHILE c2#NIL DO
      IF StringDefs.EquivalentString[newName, c2.name] THEN
        BEGIN
        Explain[newName,"already in use. [Confirm]",
          "No replacement done."];
        EXIT;
        END;
      REPEAT
        FINISHED =>
          BEGIN -- nobody exists by new name
          -- for now:
          Explain[cell.name,"becomes [Confirm]", newName];
          FreeString[cell.name];
          cell.name ← newString[newName];
          END;
        ENDLOOP;
    END;


  -- O p e r a t o r   b o d i e s


  RenameCells: PROCEDURE =
    BEGIN
    name, newn: STRING ← NIL;

    ReturnString: PROCEDURE[s: LONG POINTER TO STRING] =
      {IF s↑#NIL THEN {FreeString[s↑]; s↑ ← NIL}};

      BEGIN ENABLE UNWIND =>
        {ReturnString[@name]; ReturnString[@newn]};
      nameSC, newnSC: INTEGER;

      theAr: spntAr;
      match: BOOLEAN;

      stNumMes: STRING ← [20];
      stNumMes.length ← 0;
      AppendString[stNumMes,"(up to "];
      AppendDecimal[stNumMes,maxStars];
      AppendString[stNumMes," stars)"];

      name ← RequestString[s1: "Old name:", s2: stNumMes,
        s3: "(CR or Cancel to exit)"];
      nameSC ← starCount[name];
      WHILE nameSC>maxStars DO
        ReturnString[@name];
        name ← RequestString[s1: "Old name:", s2: stNumMes,
          s3: "(too many stars; try again!)"];
        nameSC ← starCount[name];
        ENDLOOP;

      WHILE name#NIL AND name.length>0 DO
        newn ← RequestString[s1: "New name:", s2: stNumMes];
        newnSC ← starCount[newn];
        WHILE newnSC>maxStars DO
          ReturnString[@newn];
          newn ← RequestString[s1: "New name:", s2: stNumMes,
            s3: "(too many stars; try again!)"];
          newnSC ← starCount[newn];
          ENDLOOP;

        IF newn=NIL OR newn.length=0 THEN EXIT;

        Capitalize[name]; Capitalize[newn];
        FOR cell: LONG POINTER TO cList ← cellList, cell.nxt
          WHILE cell#NIL DO
          [match,theAr] ← namesMatch[name,cell.name,0,0];
          IF match THEN replaceName[cell,theAr,newn];
          ENDLOOP;

        name ← RequestString[s1: "Old name:", s2: stNumMes,
          s3: "(CR or Cancel to exit)"];
        nameSC ← starCount[name];
        WHILE nameSC>maxStars DO
          ReturnString[@name];
          name ← RequestString[s1: "Old name:", s2: stNumMes,
            s3: "(too many stars; try again!)"];
          nameSC ← starCount[name];
          ENDLOOP;
        ENDLOOP;
      END;
    ReturnString[@name]; ReturnString[@newn];
    END; -- of RenameCells


  PurgeUnusedCells: PROCEDURE
    [keepOnlySelected, prompt: BOOLEAN ← FALSE] =
    BEGIN
    FOR cell: LONG POINTER TO cList ← cellList, cell.nxt
      WHILE cell#NIL DO
      cell.ob.marked ← FALSE;
      ENDLOOP;
    FOR cell: LONG POINTER TO cell object ← GetCellSuper[],
      cell.super WHILE cell#NIL DO
      cell.marked ← FALSE;
      ENDLOOP;

    MarkList[masterList, keepOnlySelected];

    IF prompt THEN
      FOR cell: LONG POINTER TO cList ← cellList, cell.nxt
        WHILE cell#NIL DO
        IF NOT cell.ob.marked AND HeSaysYes[cell.name,
          "Shall I keep this cell type?"] THEN
          BEGIN
          cell.ob.marked ← TRUE;
          WITH c: cell.ob SELECT FROM
            cell => MarkList[c.ptr];
            ENDCASE => NULL;
          END;
        ENDLOOP;
    
    UnlistUnmarkedCells[@masterList, keepOnlySelected];
      -- take unreferenced cells
      -- out of pictures at this and higher levels
    FOR csp: LONG POINTER TO cellSE ← cellStack, csp.nxt
      WHILE csp#NIL DO
      UnlistUnmarkedCells[@csp.lp];
      ENDLOOP;

    BEGIN -- free names of unreferenced named objects
      prev: LONG POINTER TO LONG POINTER TO cList ←
        @cellList;
      cell: LONG POINTER TO cList ← prev↑;
      WHILE cell#NIL DO
        IF  cell.ob.marked THEN prev ← @cell.nxt ELSE
          BEGIN
          FreeString[cell.name];
          prev↑ ← cell.nxt;
          FreeSpace[cell];
          END;
        cell ← prev↑;
        ENDLOOP;
        END;

      BEGIN -- free all unreferenced cells. This will leave behind
        -- orphaned objects and lists, but they won't be written in
        -- the output file.
      nextCell: LONG POINTER TO cell object;
      FOR cell: LONG POINTER TO cell object ← GetCellSuper[],
        nextCell WHILE cell#NIL DO
        nextCell ← cell.super;
        IF NOT cell.marked THEN freeCell[cell];
        ENDLOOP;
      END;

    -- At this point, all unreferenced cells are gone and all
    -- referenced cells are marked.  Adjust the bounding boxes for
    -- consistency.
    BBList[masterList];
    END; -- of PurgeUnusedCells


  ReplaceCellsFromFile: PROCEDURE [prompt: BOOLEAN] =
    BEGIN
    oldCellList: LONG POINTER TO cList ← cellList;
    newCell, oldCell, nextNew, nextOld:
      LONG POINTER TO cList ← NIL;

    reReference: PROCEDURE [old, new: obPtr] =
    --  change all calls to "old" into calls to "new"
      BEGIN

      substRefsInList: PROCEDURE [head: listPtr] =
        BEGIN
        FOR lp: listPtr ← head, lp.nxt UNTIL lp=NIL DO
          lp.ob ← substRefsInOb[lp.ob];
          ENDLOOP;
        END;

      substRefsInOb: PROCEDURE [ob: obPtr] RETURNS [obPtr] =
        BEGIN
        WITH dob: ob SELECT FROM
          ENDCASE => NULL;
        IF ob=old THEN
          BEGIN
          old↑.refCnt ← old↑.refCnt - 1;
          new↑.refCnt ← new↑.refCnt + 1;
          RETURN[new]
          END
        ELSE RETURN[ob];
        END;

      FOR s: LONG POINTER TO cell object ← GetCellSuper[],
        s.super UNTIL s=NIL DO
        substRefsInList[s.ptr];
        ENDLOOP;
      substRefsInList[masterList];
      ppdddefs.AdjustCallersBBoxes[new];
      END; -- of reReference

    remove: PROCEDURE [cell: LONG POINTER TO cList,
      from: LONG POINTER TO LONG POINTER TO cList] =
      BEGIN
      found: BOOLEAN ← FALSE;
      super: LONG POINTER TO cell object ←
        LOOPHOLE[cell.ob, LONG POINTER TO cell object];
      list: listPtr ← super.ptr;
      flushDel[list];
      freeCell[super];
      -- now unlink cell
      IF cell=from↑ THEN  -- head cell
        BEGIN
        from↑ ← cell.nxt;
        found ← TRUE;
        END
      ELSE  -- elsewhere in list
        BEGIN
        FOR c: LONG POINTER TO cList ← from↑, c.nxt
          UNTIL c = NIL DO
          IF c.nxt = cell THEN
            BEGIN
            c.nxt ← cell.nxt;
            found ← TRUE;
            EXIT;
            END;
          ENDLOOP;
        END;
      IF found THEN FreeSpace[cell] ELSE ERROR;
      END; -- of remove

    cellList ← NIL;
    FreeString[RequestString["Do a ctl-tab-i now for the",
      "file you want to merge in. Then confirm",
      "this prompt with CR."]];
    FOR oldCell ← oldCellList, nextOld WHILE oldCell#NIL DO
      nextOld ← oldCell.nxt;  -- save in case we remove the old cell
      FOR newCell ← cellList, nextNew WHILE newCell#NIL DO
        nextNew ← newCell.nxt;
          -- save in case we remove the new cell
        IF StringDefs.EquivalentString[oldCell.name,newCell.name]
          THEN
          IF ~prompt OR HeSaysYes["Replace",oldCell.name] THEN
            BEGIN
            -- change all refs to oldCell into refs to newCell
            reReference[oldCell.ob,newCell.ob];
            -- delete oldCell from its list
            remove[oldCell,@oldCellList];
            END
          ELSE
            BEGIN
            -- change all refs to newCell into refs to oldCell
            reReference[newCell.ob,oldCell.ob];
            -- delete newCell from its list
            remove[newCell,@cellList];
            END;
        ENDLOOP;
      ENDLOOP;
--    concatenate new cell list onto end of old
    IF oldCellList#NIL THEN
      BEGIN
      FOR oldCell ← oldCellList,oldCell.nxt
        UNTIL oldCell.nxt = NIL DO
        ENDLOOP;
      oldCell.nxt ← cellList;
      cellList ← oldCellList;
      END;
    END; -- of ReplaceCellsFromFile


  -- M a i n   P r o g r a m

  BEGIN ENABLE Punt => GOTO Exit;  -- for exits
  tryAgain: BOOLEAN ← TRUE;

  WHILE tryAgain DO
    tryAgain ← FALSE;
    SELECT TRUE FROM
      HeSaysYes["Shall I purge ALL unreferenced cells?",
          "(this is what people usually want)"] =>
        PurgeUnusedCells[];

      HeSaysYes["Shall I replace cells from a file?"] =>
        ReplaceCellsFromFile[prompt: HeSaysYes[
          "Shall I ask before replacing each cell type?"]];

      HeSaysYes["Shall I rename some cells for you?"] =>
        RenameCells[];

      HeSaysYes["Shall I purge SOME unreferenced cells?"] =>
        PurgeUnusedCells[
          keepOnlySelected: HeSaysYes[
            "Shall I erase the unselected items in the design?",
            "(CAREFUL NOW!!)"],
          prompt: HeSaysYes[
            "Before I purge a cell type, should I ask you about it?"]];

      ENDCASE => tryAgain ← TRUE;
    ENDLOOP;

  EXITS Exit => NULL;
  END;

  dChange ← TRUE;

  END. -- of CellLibrarian