-- File: [Cherry]<Thyme>System>CSIM01>spBomb.mesa
-- Last editted:
-- Wilhelm March 16, 1982  9:41 AM, reformated by Barth and stored under
--   [Cherry]<Barth>Thyme>1.97> .
DIRECTORY spGlobals, AltoDefs, Real, CWF;
spBomb:  PROGRAM
  IMPORTS spGlobals, CWF
  EXPORTS spGlobals =
  BEGIN
    OPEN spGlobals;

    treeRoot:     instTreePtr;
    unusedNodes:  nodePtr _ NIL;
    nodeCount:    CARDINAL _ 0;
    branchCount:  CARDINAL _ 0;
    modelCount:   CARDINAL _ 0;
    funcCount:    CARDINAL _ 0;

    printString:  STRING = [256];

    n:  nodePtr;    -- Real ones!!!
    b:  branchPtr;
    p:  REAL;
    m:  modelPtr;

    gndNode:        PUBLIC nodePtr;
    nodeList:       PUBLIC nodePtr       _ NIL;
    capacitorList:  PUBLIC capacitorPtr  _ NIL;
    inductorList:   PUBLIC inductorPtr   _ NIL;
    vSourceList:    PUBLIC vSourcePtr    _ NIL;
    iSourceList:    PUBLIC iSourcePtr    _ NIL;
    functionList:   PUBLIC modFuncPtr    _ NIL;


    pushCopies:  PROCEDURE[nameList:  namePtr] =
      BEGIN
        r:  realThingPtr;

        WHILE nameList # NIL DO
          WITH n:  nameList^ SELECT FROM
            nodeName, branchName, conName, modelName =>
              r _ makeRealThing[n.realCopy];
            parmName =>
              BEGIN
                r _ makeRealThing[n.realCopy];
                IF n.default THEN r.thing _ realParm[n.dfltValue]
              END
          ENDCASE => r _ NIL;
          nameList^.realCopy _ r;
          nameList _ nameList^.srchLink;
        ENDLOOP
      END;

    advanceLevel:  PROCEDURE[nameList:  namePtr] =
      BEGIN
        UNTIL nameList = NIL DO
          IF nameList^.realCopy # NIL THEN
            nameList^.realCopy^.newLevel _ FALSE;
          nameList _ nameList^.srchLink
        ENDLOOP
      END;

    popCopies:  PROCEDURE[nameList:  namePtr] =
      BEGIN
        WHILE nameList # NIL DO
          WITH n:  nameList^ SELECT FROM
            parmName, branchName, conName, modelName =>
              n.realCopy _ n.realCopy^.nextThing;
            nodeName =>
              WITH r:  n.realCopy^ SELECT FROM
                realNode =>
                  BEGIN
                    IF r.rn^.branches # NIL THEN
                      BEGIN
                        nodeCount _ nodeCount + 1;
                        r.rn^.nextNode _ nodeList;
                        nodeList _ r.rn
                      END
                    ELSE
                      BEGIN
                        r.rn^.nextNode _ unusedNodes;
                        unusedNodes _ r.rn
                      END;
                    n.realCopy _ r.nextThing
                  END
              ENDCASE => n.realCopy _ n.realCopy^.nextThing 
          ENDCASE;
          nameList _ nameList^.srchLink;
        ENDLOOP
      END;

    getParmValue:  PUBLIC PROCEDURE[name:  namePtr] RETURNS[REAL] =
      BEGIN
        ENABLE ErrorSignal => ErrorSignal[331, s];

        getRealThing[name];
        IF n # NIL THEN RETURN[LOOPHOLE[n]] ELSE RETURN[p]
      END;

    getRealThing:  PROCEDURE[name:  namePtr] =
      BEGIN
        thing:  realThingPtr;

        n _ NIL; b _ NIL; m _ NIL; p _ 0.0;
        IF name = NIL THEN RETURN;
        thing _ name^.realCopy;
        IF thing # NIL AND thing^.newLevel THEN thing _ thing^.nextThing;
        IF thing # NIL THEN
          WITH rt:  thing^ SELECT FROM
            realNode   => n _ rt.rn;
            realBranch => b _ rt.rb;
            realParm   => p _ rt.rp;
            realModel  => m _ rt.rm;
            unReal     => ErrorSignal[330, name^.name]
          ENDCASE
        ELSE
          WITH pn:  name^ SELECT FROM
            parmName =>
              IF pn.default THEN p _ pn.dfltValue
              ELSE ErrorSignal[331, name^.name]
          ENDCASE => error2[390, name]
      END;

    makeConnections:  PROCEDURE[connections:  conLinkPtr, fakes:  namePtr] =
      BEGIN
        UNTIL fakes = NIL DO
          getRealThing[connections^.namedNode];
          putRealThing[fakes, realNode];
          fakes _ fakes^.nextName;
          connections _ connections^.nextLink
        ENDLOOP
      END;

    apply:  PROCEDURE[apList:  expressionPtr] =
      BEGIN
        UNTIL apList = NIL DO
          [] _ eval[apList];
          apList _ apList^.nextExpression
        ENDLOOP;
      END;

    putParmValue:  PUBLIC PROCEDURE[name:  namePtr, val:  REAL] =
      BEGIN
        p _ val;
        putRealThing[name, realParm]
      END;

    putRealThing:  PROCEDURE[name:  namePtr, t:  realThings] =
      BEGIN
        IF name^.realCopy # NIL THEN
          SELECT t FROM
            realNode   => name^.realCopy^.thing _ realNode[n];
            realBranch => name^.realCopy^.thing _ realBranch[b];
            realParm   => name^.realCopy^.thing _ realParm[p];
            realModel  => name^.realCopy^.thing _ realModel[m]
          ENDCASE
      END;

    explodeInstance:  PROCEDURE[inst:  cktInstNamePtr]
                        RETURNS[t:  instTreePtr] =
      BEGIN
        exp:  expressionPtr;

        pushCopies[inst^.of^.names];
        makeConnections[inst^.connections, inst^.of^.fakeNodes];
        apply[inst^.actualParms];
        advanceLevel[inst^.of^.names];
        t _ makeTreeNode[inst];
        exp _ inst^.of^.assertions;
        UNTIL exp = NIL DO
          IF eval[exp] = 0.0 THEN error2[341, inst];
          exp _ exp^.nextExpression
        ENDLOOP;
        explode[inst^.of, t];
        popCopies[inst^.of^.names]
      END;

    explodeModelFunc:  PROCEDURE[mfName:  namePtr, newFunc:  modFuncPtr] =
      BEGIN
        index:      CARDINAL;
        arguments:  argNames;
        parms, p:   expressionPtr;

        WITH mf:  mfName^ SELECT FROM
          modelName =>
            BEGIN
              newFunc^.argVector _ mf.modelArgVec;
              arguments _ mf.modelArgs;
              parms _ mf.modelParms
            END;
          functionName =>
            BEGIN
              newFunc^.argVector _ mf.funcArgVec;
              arguments _ mf.funcArgs;
              parms _ mf.funcParms
            END
        ENDCASE => error2[399, mfName];
        newFunc^.arguments _ makeArgSource[LENGTH[arguments]];
        FOR index IN [0..LENGTH[arguments]) DO
          IF arguments[index] # NIL THEN
            getRealThing[arguments[index]];
          newFunc^.arguments[index] _ n
        ENDLOOP;

        index _ 0;
        FOR p _ parms, p^.nextExpression UNTIL p = NIL DO
          index _ index + 1
        ENDLOOP;
        newFunc^.parmVector _ makeArgList[index];
        UNTIL index = 0 DO
          index _ index - 1;
          newFunc^.parmVector[index] _ eval[parms];
          parms _ parms^.nextExpression
        ENDLOOP
      END;

    explodeController:  PROCEDURE[bn:  branchNamePtr, newB:  branchPtr] =
      BEGIN
        oldmf:    namePtr _ bn^.controller;
        newFunc:  functionPtr;
        newModB:  modBrPtr;

        WITH mf:  oldmf^ SELECT FROM
          functionName =>
            BEGIN
              funcCount _ funcCount + 1;
              newFunc _ makeFunction[];
              newFunc^.nextFunction _ functionList;
              functionList _ newFunc;
              newFunc^.branch _ newB;
              newFunc^.functionProc _ mf.functionProc;
              explodeModelFunc[oldmf, newFunc];
              newB^.controller _ newFunc
            END;
          modelName =>
            BEGIN
              getRealThing[@mf];
              newModB _ makeModBranch[m^.modelBranches, newB];
              m^.modelBranches _ newModB;
              newB^.controller _ m;
              newB^.modelIndex _ bn^.modelIndex
            END
        ENDCASE => error2[399, bn]
      END;


    connectBranch:  PROCEDURE[n:  nodePtr, b:  branchPtr,
                              pos:  BOOLEAN] =
      BEGIN
        newLink:  branchLinkPtr;

        IF n # NIL THEN
          BEGIN
            newLink _ makeBranchLink[n^.branches, b, pos];
            n^.branches _ newLink;
            IF pos THEN b^.posNode _ n ELSE b^.negNode _ n
          END
        ELSE ErrorSignal[242, b^.branchName^.name]
      END;

    explodeBranch:  PROCEDURE[bn:  branchNamePtr]
                      RETURNS[newB:  branchPtr _ NIL] =
      BEGIN
        pNode, nNode:  nodePtr;
        newC:  capacitorPtr;
        newL:  inductorPtr;
        newV:  vSourcePtr;
        newI:  iSourcePtr;

        branchCount _ branchCount + 1;
        getRealThing[bn^.posNode];
        pNode _ n;
        getRealThing[bn^.negNode];
        nNode _ n;
        IF pNode # nNode THEN
          BEGIN
            SELECT bn^.branchType FROM
              resistor =>
                newB _ makeResistor[];
              capacitor =>
                BEGIN
                  newB _ newC _ makeCapacitor[];
                  newC.nextCapacitor _ capacitorList;
                  capacitorList _ newC
                END;
              inductor  =>
                BEGIN
                  newB _ newL _ makeInductor[];
                  newL.nextInductor _ inductorList;
                  inductorList _ newL
                END;
              vSource   =>
                BEGIN
                  newB _ newV _ makeVoltage[];
                  newV.nextvSource _ vSourceList;
                  vSourceList _ newV
                END;
              iSource   =>
                BEGIN
                  newB _ newI _ makeCurrent[];
                  newI.nextiSource _ iSourceList;
                  iSourceList _ newI
                END
            ENDCASE => error2[391, bn];

            b _ newB;
            putRealThing[bn, realBranch];
            newB^.branchName _ bn;
            connectBranch[pNode, newB, TRUE];
            connectBranch[nNode, newB, FALSE];

            IF bn^.controller # NIL THEN
              explodeController[bn, newB]
            ELSE newB^.comVal _ eval[bn^.valExpr];
          END
      END;

    explode:  PROCEDURE[ckt:  circuitNamePtr, tree:  instTreePtr] =
      BEGIN
        curName:   namePtr;
        newNode:   nodePtr _ NIL;
        newModel:  modelPtr;
        newB:      branchPtr;
        newTree:   instTreePtr;

        curName _ ckt^.names;
        UNTIL curName = NIL DO
          WITH cn:  curName^ SELECT FROM
            nodeName =>
              BEGIN
                newNode _ makeNode[];
                newNode^.nodeName _ curName;
                newNode^.treeLevel _ tree;
                newNode^.brotherNodes _ tree^.nodes;
                tree^.nodes _ newNode;
                n _ newNode;
                putRealThing[curName, realNode]
              END
          ENDCASE;
          curName _ curName^.srchLink
        ENDLOOP;
        curName _ ckt^.names;
        UNTIL curName = NIL DO
          ENABLE
            ErrorSignal =>
              BEGIN
                ErrorStrings[error, treeError[tree, curName], s];
                curName _ curName^.srchLink;
                LOOP
              END;
          WITH cn:  curName^ SELECT FROM
            modelName =>
              BEGIN
                modelCount _ modelCount + 1;
                newModel _ makeModel[];
                newModel^.modelProc _ cn.modelProc;
                newModel^.modelName _ @cn;
                newModel^.modelResults _ cn.modelResults;
                newModel^.modelBranches _ NIL;
                newModel^.nextFunction _ functionList;
                functionList _ newModel;
                explodeModelFunc[@cn, newModel];
                m _ newModel;
                putRealThing[curName, realModel]
              END
          ENDCASE;
          curName _ curName^.srchLink
        ENDLOOP;
        curName _ ckt^.names;
        UNTIL curName = NIL DO
          ENABLE
            ErrorSignal =>
              BEGIN
                ErrorStrings[error, treeError[tree, curName], s];
                curName _ curName^.srchLink;
                LOOP
              END;
          IF curName^.expExpr = NIL OR eval[curName^.expExpr] # 0.0 THEN
            WITH cn:  curName^ SELECT FROM
              branchName  =>
                BEGIN
                  newB _ explodeBranch[@cn];
                  IF newB # NIL THEN
                    BEGIN
                      newB^.brotherBranches _ tree^.branches;
                      newB^.treeLevel _ tree;
                      tree^.branches _ newB
                    END
                END;
              cktInstance =>
                BEGIN
                  newTree _ explodeInstance[@cn];
                  newTree^.father _ tree;
                  newTree^.brothers _ tree^.sons;
                  tree^.sons _ newTree
                END
            ENDCASE;
          curName _ curName^.srchLink
        ENDLOOP
      END;

    treeError:  PROCEDURE[t:  instTreePtr, n:  namePtr] RETURNS[STRING] =
      BEGIN
        oldProc:  PROCEDURE[CHARACTER];

        printString.length _ 0;
        oldProc _ CWF.WriteToString[printString];
        printTree[t];
        CWF.WF1["%s", n^.name];
        [] _ CWF.SetWriteProcedure[oldProc];
        RETURN[printString]
      END;

    funnyCharsInName:  PROCEDURE[name:  LONG STRING]
                         RETURNS[f:  BOOLEAN _ FALSE] =
      BEGIN
        f _ name[0] ~IN ['A..'Z] AND name[0] ~IN ['a..'z];
        IF f THEN RETURN;
        FOR i:  CARDINAL IN [1..name.length) DO
          f _ name[i] ~IN ['A..'Z] AND name[i] ~IN ['a..'z] AND
              name[i] ~IN ['0..'9];
          IF f THEN EXIT
        ENDLOOP
      END;

    printTree:  PROCEDURE[t:  instTreePtr] =
      BEGIN
        IF t # NIL AND t # treeRoot THEN
          BEGIN
            printTree[t^.father];
            IF ~funnyCharsInName[t^.instance^.name] THEN
              CWF.WF1["%s/", t^.instance^.name]
            ELSE CWF.WF1["$%s$/", t^.instance^.name]
          END;
      END;

    printNode:  PUBLIC PROCEDURE[n:  nodePtr, ok:  BOOLEAN] =
      BEGIN
        printTree[n^.treeLevel];
        IF ok OR ~funnyCharsInName[n^.nodeName^.name] THEN
          CWF.WF1["%s", n^.nodeName^.name]
        ELSE CWF.WF1["$%s$", n^.nodeName^.name]
      END;

    printBranch:  PUBLIC PROCEDURE[b:  branchPtr, ok:  BOOLEAN] =
      BEGIN
        printTree[b^.treeLevel];
        IF ok OR ~funnyCharsInName[b^.branchName^.name] THEN
          CWF.WF1["%s", b^.branchName^.name]
        ELSE CWF.WF1["$%s$", b^.branchName^.name]
      END;

    makeStringNB:  PUBLIC PROCEDURE[n:  nodePtr, b:  branchPtr,
                                    ok:  BOOLEAN _ TRUE]
                            RETURNS[STRING] =
      BEGIN
        oldProc:  PROCEDURE[CHARACTER];

        printString.length _ 0;
        oldProc _ CWF.WriteToString[printString];
        IF n # NIL THEN printNode[n, ok] ELSE printBranch[b, ok];
        [] _ CWF.SetWriteProcedure[oldProc];
        RETURN[printString]
      END;

    printHole:  PUBLIC PROCEDURE =
      BEGIN
        n:  nodePtr;
        bLink:  branchLinkPtr;

        CWF.WF0["*nNodes --*n"];
        n _ nodeList;
        UNTIL n = NIL DO
          printNode[n, TRUE];
          CWF.WF0[" _ {"];
          bLink _ n^.branches;
          UNTIL bLink = NIL DO
            printBranch[bLink^.branch, TRUE];
            IF bLink^.branch^.posNode = n THEN CWF.WFC['+]
            ELSE CWF.WFC['-];
            bLink _ bLink^.nextLink;
            IF bLink # NIL THEN CWF.WF0[", "]
          ENDLOOP;
          CWF.WF0["}.*n"];
          n _ n^.nextNode
        ENDLOOP
      END;

    findNB:  PROCEDURE[tree:  instTreePtr]
               RETURNS[n:  nodePtr _ NIL, b:  branchPtr _ NIL] =
      BEGIN
        i:  instTreePtr;

        IF item = name THEN
          BEGIN
            i _ tree^.sons;
            UNTIL i = NIL DO
              IF LongEqualStrings[i^.instance^.name,newString] THEN EXIT;
              i _ i^.brothers
            ENDLOOP;
            IF i # NIL THEN
              BEGIN
                next[];
                IF item = slash THEN next[] ELSE error[300, FALSE];
                [n, b] _ findNB[i]
              END
            ELSE
              BEGIN
                n _ tree^.nodes;
                UNTIL n = NIL DO
                  IF LongEqualStrings[newString,n^.nodeName^.name]
                    THEN EXIT;
                  n _ n^.brotherNodes
                ENDLOOP;
                IF n = NIL THEN
                  BEGIN
                    b _ tree^.branches;
                    UNTIL b = NIL DO
                      IF LongEqualStrings[newString,
                                          b^.branchName^.name]
                        THEN EXIT;
                      b _ b^.brotherBranches
                    ENDLOOP
                  END;
                next[]
              END
          END
        ELSE error[301, FALSE]
      END;

    findNodeOrBranch:  PUBLIC PROCEDURE RETURNS[n:  nodePtr, b:  branchPtr] =
      BEGIN
        [n, b] _ findNB[treeRoot]
      END;

    fillInBranchLinks:  PROCEDURE =
      BEGIN
        nodes:  nodePtr _ nodeList;
        links:  branchLinkPtr;

        UNTIL nodes = NIL DO
          links _ nodes^.branches;
          UNTIL links = NIL DO
            links^.otherNode _ IF links^.pos THEN links^.branch^.negNode
                               ELSE links^.branch^.posNode;
            links _ links^.nextLink
          ENDLOOP;
          nodes _ nodes^.nextNode
        ENDLOOP
      END;

    bomb:  PUBLIC PROCEDURE =
      BEGIN
        treeRoot _ makeTreeNode[NIL];
        pushCopies[cktRoot^.names];
        advanceLevel[cktRoot^.names];
        explode[cktRoot, treeRoot];
        getRealThing[gndNodeName];
        gndNode _ n;
        popCopies[cktRoot^.names];
        fillInBranchLinks[];

        CWF.SWF4[printString,
                 "%u nodes %u models %u functions %u branches",
                 @nodeCount, @modelCount, @funcCount, @branchCount];
        printSysWindow[printString];
        IF unusedNodes # NIL THEN printSysWindow["Unused nodes --"];
        UNTIL unusedNodes = NIL DO
          printSysWindow[makeStringNB[unusedNodes, NIL]];
          unusedNodes _ unusedNodes^.nextNode
        ENDLOOP
      END;

  END.