-- 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.