[Indigo]<Rosemary>2.6>Rosemary.DF=>SwitchTypesImpl.Mesa
Last Edited by: Spreitzer, October 10, 1984 11:46:26 am PDT
Last Edited by: Barth, April 23, 1984 5:37:27 pm PST
Last Edited by: Gasbarro, August 16, 1984 4:22:48 pm PDT
DIRECTORY Atom, IO, List, Rope, RoseCreate, RoseEvents, RoseRun, RoseTranslateTypes, RoseTypes, SignalTypeRegistration, SwitchNumConvert, SwitchTypes, SwitchTypesPrivate, VFonts;
SwitchTypesImpl: CEDAR PROGRAM
IMPORTS Atom, IO, Rope, RoseCreate, RoseEvents, RoseRun, RoseTranslateTypes, RoseTypes, SignalTypeRegistration, SwitchNumConvert, SwitchTypesPrivate, VFonts
EXPORTS SwitchTypes =
BEGIN OPEN RoseTypes, SwitchTypes, SwitchTypesPrivate;
refInput:  PUBLIC REF Strength ← NEW [Strength ← input];
refDriveStrong: PUBLIC REF Strength ← NEW [Strength ← driveStrong];
refDrive:  PUBLIC REF Strength ← NEW [Strength ← drive];
refDriveWeak: PUBLIC REF Strength ← NEW [Strength ← driveWeak];
refChargeStrong: PUBLIC REF Strength ← NEW [Strength ← chargeStrong];
refCharge: PUBLIC REF Strength ← NEW [Strength ← charge];
refChargeWeak: PUBLIC REF Strength ← NEW [Strength ← chargeWeak];
refNone:  PUBLIC REF Strength ← NEW [Strength ← none];
bitProcs: NodeProcs ← NEW [NodeProcsRep ← [
Bits: BitBits,
MesaUse: BitMesaUse,
UserDescription: BitUserDescription,
MesaDescription: BitMesaDescription,
ListFormats: BitListFormats,
GetFormat: BitGetFormat,
MakeTransducer: MakeSwitchNumTransducer,
InitNode: BitInitNode,
InitPort: BitInitPort,
InitQ: BitInitQ,
InitUD: BitInitUD,
NewVal: BitNewVal,
ComputeQ: BitComputeQ,
CompareUD: BitCompareUD,
CopyUD: BitCopyUD,
CopyVal: BitCopyVal,
ClearUD: BitClearUD,
NewQ: BitNewQ,
NewUD: BitNewUD,
QFromNode: BitQFromNode,
UDFromNode: BitUDFromNode,
ValFromNode: BitValFromNode,
SetNode: BitSetNode]];
bitType: PUBLIC NodeType ← NEW [NodeTypeRep[atom] ← [
procs: bitProcs,
typeData: NIL,
simple: FALSE,
structure: atom[]]];
shortBitFormat: Format ← NEW [FormatRep ← [
FormatValue: BitFormatValue,
ParseValue: BitParseValue,
FormatTest: BitFormatTest,
ParseTest: BitParseTest,
MaxWidth: BitMaxWidth,
key: "short"]];
longBitFormat: Format ← NEW [FormatRep ← [
FormatValue: LBitFormatValue,
ParseValue: LBitParseValue,
FormatTest: BitFormatTest,
ParseTest: BitParseTest,
MaxWidth: LBitMaxWidth,
key: "long"]];
BitData: TYPE = REF BitDataRep;
BitDataRep: TYPE = RECORD [
sv: SwitchVal ← [],
size, realSize: Strength ← none,
cap: REAL ← 0];
Int: TYPE = RoseTranslateTypes.Int;
one: Int ← NEW [RoseTranslateTypes.IntRep ← [RoseTranslateTypes.nullSR, 1]];
ConstructBitType: RoseTranslateTypes.NodeTypeConstructor--PROC [parms: REF ANY - -UNION [BindingList, Args]- -] RETURNS [type: NodeType]-- =
BEGIN
type ← bitType;
END;
BitBits: PROC [NodeType] RETURNS [INTEGER] = {RETURN [bitsPerSwitchVal]};
BitMesaUse: PROC [NodeType] RETURNS [m: Mesa] =
{m ← [mesa: "SwitchTypes.SwitchVal", directory: LIST["SwitchTypes"]]};
BitUserDescription: PROC [NodeType] RETURNS [r: ROPE] = {r ← "Switch"};
BitMesaDescription: PROC [NodeType] RETURNS [m: Mesa] =
{m ← [mesa: "SwitchTypes.bitType", imports: LIST["SwitchTypes"]]};
BitListFormats: PROC [NodeType] RETURNS [l: RopeList] =
{l ← LIST ["short", "long"]};
BitGetFormat: PROC [nt: NodeType, fmtKey: ROPE] RETURNS [Format] =
{RETURN [IF fmtKey.Equal["long", FALSE] OR fmtKey.Equal["QUD"] THEN longBitFormat ELSE shortBitFormat]};
BitInitPort: PROC [n: Node, wp: WordPtr] = TRUSTED {
bd: BitData ← NARROW[n.data];
h: Holder ← LOOPHOLE[wp];
h.held ← bd.sv};
BitInitNode: PROC [node: Node, initData: REF ANY, steady: BOOL] = {
s: Strength ← charge;
iv: SwitchVal;
bd: BitData;
initialLevel: Level ← IF steady THEN L ELSE X;
IF initData # NIL THEN WITH initData SELECT FROM
rs: REF Strength => s ← rs^;
a: ATOM => SELECT a FROM
$PlusPower => {s ← input; initialLevel ← H};
$ZeroPower => {s ← input; initialLevel ← L};
$Input => s ← input;
$Output => s ← chargeWeak;
ENDCASE => ERROR;
ENDCASE => ERROR;
iv ← [s: ALL[s], val: initialLevel];
[iv.s[u], iv.s[d]] ← Parts[initialLevel, s];
bd ← NEW [BitDataRep ← [sv: iv, size: s, realSize: s]];
node.data ← bd};
BitInitQ: PROC [n: Node] = {
bd: BitData ← NARROW[n.data];
bd.sv.s[q] ← bd.size};
BitNewQ: PROC [n: Node, wp: WordPtr] RETURNS [b: BOOLEAN] = TRUSTED {
h: Holder ← LOOPHOLE[wp];
bd: BitData ← NARROW[n.data];
IF b ← h.held.s[q] > bd.sv.s[q] THEN bd.sv.s[q] ← h.held.s[q]};
BitComputeQ: PROC [n: Node, wp: WordPtr] = TRUSTED {
h: Holder ← LOOPHOLE[wp];
h.held.s[q] ← IF h.held.s[u] = none THEN h.held.s[d]
ELSE IF h.held.s[d] = none THEN h.held.s[u]
ELSE MIN[h.held.s[u], h.held.s[d]];
};
BitCompareUD: PROC [nt: NodeType, wp1, wp2: WordPtr] RETURNS [diff: BOOL] = TRUSTED {
h1: Holder ← LOOPHOLE[wp1];
h2: Holder ← LOOPHOLE[wp2];
diff ← h1.held.s[u] # h2.held.s[u] OR h1.held.s[d] # h2.held.s[d]};
BitCopyUD: PROC [nt: NodeType, from, to: WordPtr] = TRUSTED {
hFrom: Holder ← LOOPHOLE[from];
hTo: Holder ← LOOPHOLE[to];
hTo.held.s[u] ← hFrom.held.s[u];
hTo.held.s[d] ← hFrom.held.s[d]};
BitCopyVal: PROC [nt: NodeType, from, to: WordPtr] = TRUSTED {
hFrom: Holder ← LOOPHOLE[from];
hTo: Holder ← LOOPHOLE[to];
hTo.held.val ← hFrom.held.val};
BitClearUD: PROC [nt: NodeType, at: WordPtr] = TRUSTED {
h: Holder ← LOOPHOLE[at];
h.held.s[u] ← none;
h.held.s[d] ← none};
Block: PUBLIC PROC [a, b: Strength] RETURNS [c: Strength] =
{c ← IF a < b THEN none ELSE a};
BitInitUD: PROC [n: Node] = {
bd: BitData ← NARROW[n.data];
u, d: Strength;
[u, d] ← Parts[bd.sv.val, bd.size];
bd.sv.s[u] ← Block[u, bd.sv.s[q]];
bd.sv.s[d] ← Block[d, bd.sv.s[q]];
n.isInput ← bd.sv.s[q] = input};
Parts: PROC [l: Level, s: Strength] RETURNS [u, d: Strength] = {
RETURN [
SELECT l FROM
L => none,
H, X => s,
ENDCASE => ERROR,
SELECT l FROM
H => none,
L, X => s,
ENDCASE => ERROR]};
BitNewUD: PROC [n: Node, wp: WordPtr] RETURNS [b: BOOLEAN] = TRUSTED {
h: Holder ← LOOPHOLE[wp];
bd: BitData ← NARROW[n.data];
u: Strength ← Block[h.held.s[u], bd.sv.s[q]];
d: Strength ← Block[h.held.s[d], bd.sv.s[q]];
b ← FALSE;
IF u > bd.sv.s[u] THEN {b ← TRUE; bd.sv.s[u] ← u};
IF d > bd.sv.s[d] THEN {b ← TRUE; bd.sv.s[d] ← d}};
BitNewVal: PROC [n: Node] = {
bd: BitData ← NARROW[n.data];
temp: Level ←
IF bd.sv.s[u] = none AND bd.sv.s[d] > none THEN L ELSE
IF bd.sv.s[d] = none AND bd.sv.s[u] > none THEN H ELSE
X;
IF n.XPhobic THEN
BEGIN
IF temp = X THEN SetXHood[n, TRUE]
ELSE BEGIN
bd.sv.val ← temp;
SetXHood[n, FALSE];
END;
END
ELSE bd.sv.val ← temp;
};
Xed: PROC [n: Node] RETURNS [xed: BOOL] = {xed ← n.nextX # notInNodeList};
SetXHood: PROC [n: Node, xed: BOOLEAN] = {
sim: Simulation;
IF Xed[n] = xed THEN RETURN;
sim ← n.cellIn.sim;
IF xed THEN {
IF sim.firstX = notInNodeList THEN ERROR;
n.nextX ← sim.firstX;
n.prevX ← NIL;
IF n.nextX = NIL THEN sim.lastX ← n ELSE n.nextX.prevX ← n;
sim.firstX ← n}
ELSE {
IF n.nextX = NIL THEN sim.lastX ← n.prevX ELSE n.nextX.prevX ← n.prevX;
IF n.prevX = NIL THEN sim.firstX ← n.nextX ELSE n.prevX.nextX ← n.nextX;
n.nextX ← n.prevX ← notInNodeList}};
XCheck: PROC [event: ATOM, watched, watcherData, arg: REF ANY]--RoseEvents.NotifyProc-- =
BEGIN
sim: Simulation ← NARROW[watched];
names: RopeList ← NIL;
FOR n: Node ← sim.firstX, n.nextX WHILE n # NIL DO
IF n = notInNodeList THEN ERROR;
names ← CONS[RoseCreate.LongNodeName[n], names];
RoseRun.PerturbNode[n, n.cellIn];
ENDLOOP;
IF names # NIL THEN SIGNAL Warning["Nodes want Xes", names];
END;
GreetSim: PROC [event: ATOM, watched, watcherData, arg: REF ANY]--RoseEvents.NotifyProc-- =
BEGIN
sim: Simulation ← NARROW[arg];
RoseEvents.AddWatcher[event: $Settled, watcher: [Notify: XCheck], watched: sim];
END;
BitQFromNode: PROC [n: Node, to: WordPtr] = TRUSTED {
h: Holder ← LOOPHOLE[to];
bd: BitData ← NARROW[n.data];
h.held.s[q] ← bd.sv.s[q]};
BitUDFromNode: PROC [n: Node, to: WordPtr] = TRUSTED {
h: Holder ← LOOPHOLE[to];
bd: BitData ← NARROW[n.data];
h.held.s[u] ← bd.sv.s[u];
h.held.s[d] ← bd.sv.s[d]};
BitValFromNode: PROC [n: Node, to: WordPtr] = TRUSTED {
h: Holder ← LOOPHOLE[to];
bd: BitData ← NARROW[n.data];
h.held.val ← bd.sv.val};
BitSetNode: PROC [n: Node, to: WordPtr] = TRUSTED {
h: Holder ← LOOPHOLE[to];
bd: BitData ← NARROW[n.data];
bd.sv ← h.held};
Holder: TYPE = LONG POINTER TO SwitchValHolder;
BitFormatValue: PROC [node: Node, fmt: Format, wp: WordPtr] RETURNS [r: ROPE] = {
bd: BitData ← NARROW[node.data];
IF wp # NIL THEN ERROR;
r ← levelToRope[bd.sv.val]};
BitParseValue: PROC [node: Node, fmt: Format, wp: WordPtr, s: STREAM] RETURNS [success: BOOLEAN] = {
bd: BitData ← NARROW[node.data];
ans: Level;
success ← TRUE;
IF wp # NIL THEN ERROR;
ans ← GetLevel[s !IO.EndOfStream, IO.Error => {success ← FALSE; CONTINUE}];
IF NOT success THEN RETURN;
bd.sv.val ← ans;
};
LBitFormatValue: PROC [node: Node, fmt: Format, wp: WordPtr] RETURNS [r: ROPE] = {
bd: BitData ← NARROW[node.data];
IF wp # NIL THEN ERROR;
r ← Rope.Cat[
strengthToRope[bd.sv.s[q]],
strengthToRope[bd.sv.s[u]],
strengthToRope[bd.sv.s[d]],
levelToRope[bd.sv.val],
strengthToRope[bd.size],
strengthToRope[bd.realSize]]
.Cat[IF NOT node.XPhobic THEN "*" ELSE IF Xed[node] THEN "+" ELSE "-"]};
LBitParseValue: PROC [node: Node, fmt: Format, wp: WordPtr, s: STREAM] RETURNS [success: BOOLEAN] = {
bd: BitData ← NARROW[node.data];
new: BitDataRep ← [];
success ← TRUE;
IF wp # NIL THEN ERROR;
new.sv.s[q] ← GetStrength[s !IO.EndOfStream, IO.Error => {success ← FALSE; CONTINUE}];
IF NOT success THEN RETURN;
new.sv.s[u] ← GetStrength[s !IO.EndOfStream, IO.Error => {success ← FALSE; CONTINUE}];
IF NOT success THEN RETURN;
new.sv.s[d] ← GetStrength[s !IO.EndOfStream, IO.Error => {success ← FALSE; CONTINUE}];
IF NOT success THEN RETURN;
new.sv.val ← GetLevel[s !IO.EndOfStream, IO.Error => {success ← FALSE; CONTINUE}];
IF NOT success THEN RETURN;
new.size ← GetStrength[s !IO.EndOfStream, IO.Error => {success ← FALSE; CONTINUE}];
IF NOT success THEN RETURN;
new.realSize ← GetStrength[s !IO.EndOfStream, IO.Error => {success ← FALSE; CONTINUE}];
IF NOT success THEN RETURN;
bd^ ← new;
};
GetLevel: PROC [s: STREAM] RETURNS [l: Level] =
BEGIN
char: CHARACTER;
[] ← s.SkipWhitespace[];
IF s.EndOf[] THEN ERROR IO.EndOfStream[stream: s];
char ← s.GetChar[];
SELECT char FROM
'L => l ← L;
'H => l ← H;
'X => l ← X;
ENDCASE => ERROR IO.Error[stream: s, ec: SyntaxError];
END;
GetStrength: PROC [s: STREAM] RETURNS [strength: Strength] =
BEGIN
char: CHARACTER;
asRope: ROPE;
[] ← s.SkipWhitespace[];
IF s.EndOf[] THEN ERROR IO.EndOfStream[stream: s];
char ← s.GetChar[];
asRope ← Rope.FromChar[char];
FOR strength IN Strength DO
IF strengthToRope[strength].Equal[asRope, FALSE] THEN RETURN;
ENDLOOP;
ERROR IO.Error[stream: s, ec: SyntaxError];
END;
BitFormatTest: PROC [nt: NodeType, fmt: Format, tp: NodeTestProc, td: NodeTestData] RETURNS [r: ROPE] =
BEGIN
r ← SELECT td FROM $L => "L", $H => "H", $X => "X", ENDCASE => "??";
END;
BitParseTest: PROC [nt: NodeType, fmt: Format, s: STREAM] RETURNS [success: BOOLEAN, tp: NodeTestProc, td: NodeTestData] =
BEGIN
ans: Level;
success ← TRUE;
ans ← GetLevel[s !IO.EndOfStream, IO.Error => {success ← FALSE; CONTINUE}];
IF NOT success THEN RETURN;
tp ← BitTest;
td ← SELECT ans FROM L => $L, H => $H, X => $X, ENDCASE => ERROR;
END;
BitTest: NodeTestProc--PROC [where: WordPtr, testData: NodeTestData, nodeType: NodeType] RETURNS [passes: BOOLEAN]-- =
BEGIN
l: Level ← SELECT testData FROM $L => L, $H => H, $X => X, ENDCASE => ERROR;
TRUSTED {passes ← LOOPHOLE[where, Holder].held.val = l};
END;
BitMaxWidth: PROC [nt: NodeType, fmt: Format, font: VFonts.Font] RETURNS [INT] =
{RETURN [VFonts.StringWidth["H", font]]};
LBitMaxWidth: PROC [nt: NodeType, fmt: Format, font: VFonts.Font] RETURNS [INT] =
{RETURN [VFonts.StringWidth["555H55+", font]]};
NodeTypeList: TYPE = LIST OF ArrayNodeType;
switchTypes: NodeTypeList ← NIL;
Bundle: PUBLIC PROC [bits: CARDINAL] RETURNS [nt: NodeType] =
BEGIN
FOR it: NodeTypeList ← switchTypes, it.rest WHILE it # NIL DO
IF it.first.last+1 = INTEGER[bits] THEN RETURN [it.first];
ENDLOOP;
switchTypes ← CONS[nt ← MakeSwitchOfWidth[bits], switchTypes];
END;
MakeSwitchOfWidth: PROC [bits: CARDINAL] RETURNS [nt: ArrayNodeType] =
BEGIN
nt ← NEW [NodeTypeRep[array] ← [
procs: switchProcs,
typeData: NIL,
simple: FALSE,
structure: array[0, bits-1, bitType]]];
END;
switchProcs: NodeProcs ← NEW [NodeProcsRep ← [
Bits: SwitchBits,
MesaUse: SwitchMesaUse,
UserDescription: SwitchUserDescription,
MesaDescription: SwitchMesaDescription,
ListFormats: SwitchListFormats,
GetFormat: SwitchGetFormat,
MakeSubarrayType: SwitchMakeSubarrayType,
MakeSplitJoin: SwitchMakeSplitJoin,
MakeTransducer: MakeSwitchNumTransducer,
InitNode: SwitchesInitNode,
InitPort: SwitchesInitPort,
InitQ: SwitchesInitQ,
InitUD: SwitchesInitUD,
NewVal: SwitchesNewVal,
ComputeQ: SwitchesComputeQ,
CompareUD: SwitchesCompareUD,
CopyUD: SwitchesCopyUD,
CopyVal: SwitchesCopyVal,
ClearUD: SwitchesClearUD,
NewQ: SwitchesNewQ,
NewUD: SwitchesNewUD,
QFromNode: SwitchesQFromNode,
UDFromNode: SwitchesUDFromNode,
ValFromNode: SwitchesValFromNode,
SetNode: SwitchesSetNode]];
ConstructSwitchType: RoseTranslateTypes.NodeTypeConstructor--PROC [parms: REF ANY - -UNION [BindingList, Args]- -] RETURNS [type: SwitchType]-- =
BEGIN
bits: Int ← NARROW[RoseTranslateTypes.GetParm[n: 1, name: "bits", parms: parms, default: one]];
type ← Bundle[bits.i];
END;
SwitchBits: PROC [nt: NodeType] RETURNS [bits: INTEGER] = {
ant: ArrayNodeType ← NARROW[nt];
bits ← 16*((ant.last - ant.first + switchValsPerWord)/switchValsPerWord)};
SwitchMesaUse: PROC [nt: NodeType] RETURNS [m: Mesa] = {
ant: ArrayNodeType ← NARROW[nt];
m ← [
mesa: IO.PutFR[
"PACKED ARRAY [%g .. %g] OF SwitchTypes.SwitchVal",
IO.int[ant.first],
IO.int[ant.last]],
directory: LIST["SwitchTypes"]]};
SwitchUserDescription: PROC [nt: NodeType] RETURNS [ud: ROPE] = {
ant: ArrayNodeType ← NARROW[nt];
ud ← IO.PutFR["Switch[%g .. %g]", IO.int[ant.first], IO.int[ant.last]]};
SwitchMesaDescription: PROC [nt: NodeType] RETURNS [m: Mesa] = {
ant: ArrayNodeType ← NARROW[nt];
m ← [
mesa: IO.PutFR["SwitchTypes.Bundle[%g]", IO.int[ant.last+1]],
imports: LIST["SwitchTypes"]]};
SwitchListFormats: PROC [NodeType] RETURNS [l: RopeList] = {l ← sfl};
sfl: RopeList ← LIST["short", "long"];
SwitchGetFormat: PROC [nt: NodeType, key: ROPE] RETURNS [fmt: Format] = {
atom: ATOM ← Atom.MakeAtom[key];
fmt ← NARROW[Atom.GetProp[atom: atom, prop: switchFmtKey]];
};
switchFmtKey: REF ROPENEW [ROPE ← "Switch Format Key"];
shortSwitchesFormat: Format ← NEW [FormatRep ← [
FormatValue: SwitchesFormatValue,
ParseValue: SwitchesParseValue,
FormatTest: NIL,
ParseTest: NIL,
MaxWidth: SwitchesMaxWidth,
key: "switches"]];
longSwitchesFormat: Format ← NEW [FormatRep ← [
FormatValue: SwitchesLongFormatValue,
ParseValue: SwitchesLongParseValue,
FormatTest: NIL,
ParseTest: NIL,
MaxWidth: SwitchesLongMaxWidth,
key: "long"]];
SwitchMakeSubarrayType: PROC [nt: NodeType, first, last: INTEGER] RETURNS [st: NodeType] =
BEGIN
st ← Bundle[1+last-first];
END;
MakeSwitchNumTransducer: PROC [myKind, otherKind: Node, within: Cell, writeMine, writeOther: BOOLEAN, for: ExpansionReceiver] RETURNS [t: Cell] =
{t ← SwitchNumConvert.MakeTransducer[switchy: myKind, nummy: otherKind, within: within, writeSwitchy: writeMine, writeNummy: writeOther, to: for]};
SwitchData: TYPE = REF SwitchDataRep;
SwitchDataRep: TYPE = RECORD [
size, realSize: Strength,
offset: [0 .. switchValsPerWord),
cap: REAL ← 0,
vals: PACKED SEQUENCE length: CARDINAL OF SwitchVal];
SwitchesInitPort: PROC [n: Node, wp: WordPtr] = TRUSTED {
sd: SwitchData ← NARROW[n.data];
s: Switches ← LOOPHOLE[wp];
FOR i: CARDINAL IN [0 .. sd.length) DO
s[sd.offset+i] ← sd.vals[i];
ENDLOOP};
SwitchesInitNode: PROC [node: Node, initData: REF ANY, steady: BOOL] = {
ant: ArrayNodeType ← NARROW[node.type];
s: Strength ← charge;
sd: SwitchData;
iv: SwitchVal;
initialLevel: Level ← IF steady THEN L ELSE X;
IF initData # NIL THEN WITH initData SELECT FROM
rs: REF Strength => s ← rs^;
a: ATOM => SELECT a FROM
$PlusPower => {s ← input; initialLevel ← H};
$ZeroPower => {s ← input; initialLevel ← L};
$Input => s ← input;
$Output => s ← chargeWeak;
ENDCASE => ERROR;
ENDCASE => ERROR;
iv ← [s: ALL[s], val: initialLevel];
[iv.s[u], iv.s[d]] ← Parts[initialLevel, s];
sd ← NEW [SwitchDataRep[1+ant.last - ant.first]];
sd.size ← sd.realSize ← s; sd.cap ← 0;
FOR i: CARDINAL IN [0 .. sd.length) DO sd[i] ← iv ENDLOOP;
node.data ← sd;
};
SwitchesInitQ: PROC [n: Node] = {
sd: SwitchData ← NARROW[n.data];
FOR i: CARDINAL IN [0 .. sd.length) DO sd.vals[i].s[q] ← sd.size ENDLOOP};
SwitchesComputeQ: PROC [n: Node, wp: WordPtr] = TRUSTED {
sd: SwitchData ← NARROW[n.data];
s: Switches ← LOOPHOLE[wp];
FOR i: CARDINAL IN [0 .. sd.length) DO
s[sd.offset+i].s[q] ←
IF s[sd.offset+i].s[u] = none THEN s[sd.offset+i].s[d] ELSE
IF s[sd.offset+i].s[d] = none THEN s[sd.offset+i].s[u] ELSE
MIN[s[sd.offset+i].s[u], s[sd.offset+i].s[d]];
ENDLOOP};
SwitchesCompareUD: PROC [nt: NodeType, wp1, wp2: WordPtr] RETURNS [diff: BOOL] = TRUSTED {
ant: ArrayNodeType ← NARROW[nt];
s1: Switches ← LOOPHOLE[wp1];
s2: Switches ← LOOPHOLE[wp2];
FOR i: NAT IN [0 .. ant.last - ant.first] DO
IF s1[i].s[u] # s2[i].s[u] OR s1[i].s[d] # s2[i].s[d] THEN RETURN [TRUE];
ENDLOOP;
diff ← FALSE};
SwitchesCopyUD: PROC [nt: NodeType, from, to: WordPtr] = TRUSTED {
ant: ArrayNodeType ← NARROW[nt];
sFrom: Switches ← LOOPHOLE[from];
sTo: Switches ← LOOPHOLE[to];
FOR i: NAT IN [0 .. ant.last - ant.first] DO
sTo[i].s[u] ← sFrom[i].s[u];
sTo[i].s[d] ← sFrom[i].s[d];
ENDLOOP};
SwitchesCopyVal: PROC [nt: NodeType, from, to: WordPtr] = TRUSTED {
ant: ArrayNodeType ← NARROW[nt];
sFrom: Switches ← LOOPHOLE[from];
sTo: Switches ← LOOPHOLE[to];
FOR i: INTEGER IN [0 .. ant.last - ant.first] DO
sTo[i].val ← sFrom[i].val;
ENDLOOP};
SwitchesClearUD: PROC [nt: NodeType, at: WordPtr] = TRUSTED {
ant: ArrayNodeType ← NARROW[nt];
s: Switches ← LOOPHOLE[at];
FOR i: INTEGER IN [0 .. ant.last - ant.first] DO
s[i].s[u] ← none;
s[i].s[d] ← none;
ENDLOOP};
SwitchesNewQ: PROC [n:Node, wp:WordPtr] RETURNS [b: BOOLEAN] = TRUSTED {
sd: SwitchData ← NARROW[n.data];
s: Switches ← LOOPHOLE[wp];
b ← FALSE;
FOR i: CARDINAL IN [0 .. sd.length) DO
IF s[sd.offset+i].s[q]>sd.vals[i].s[q] THEN {sd.vals[i].s[q] ← s[sd.offset+i].s[q]; b ← TRUE};
ENDLOOP};
SwitchesInitUD: PROC [n: Node] = {
sd: SwitchData ← NARROW[n.data];
n.isInput ← TRUE;
FOR i: CARDINAL IN [0 .. sd.length) DO
u, d: Strength;
[u, d] ← Parts[sd.vals[i].val, sd.size];
sd.vals[i].s[u] ← Block[u, sd.vals[i].s[q]];
sd.vals[i].s[d] ← Block[d, sd.vals[i].s[q]];
n.isInput ← n.isInput AND sd.vals[i].s[q] = input;
ENDLOOP};
SwitchesNewUD: PROC [n:Node, wp:WordPtr] RETURNS [b:BOOLEAN] = TRUSTED {
sd: SwitchData ← NARROW[n.data];
s: Switches ← LOOPHOLE[wp];
b ← FALSE;
FOR i: CARDINAL IN [0 .. sd.length) DO
u: Strength ← Block[s[i].s[u], sd.vals[i].s[q]];
d: Strength ← Block[s[i].s[d], sd.vals[i].s[q]];
IF u > sd.vals[i].s[u] THEN {sd.vals[i].s[u] ← u; b ← TRUE};
IF d > sd.vals[i].s[d] THEN {sd.vals[i].s[d] ← d; b ← TRUE};
ENDLOOP};
SwitchesNewVal: PROC [n: Node] = {
sd: SwitchData ← NARROW[n.data];
Xed: BOOLEANFALSE;
FOR i: CARDINAL IN [0 .. sd.length) DO
temp: Level ←
IF sd.vals[i].s[u] = none AND sd.vals[i].s[d] > none THEN L ELSE
IF sd.vals[i].s[d] = none AND sd.vals[i].s[u] > none THEN H ELSE
X;
IF n.XPhobic THEN
BEGIN
IF temp = X THEN Xed ← TRUE
ELSE sd.vals[i].val ← temp;
END
ELSE sd.vals[i].val ← temp;
ENDLOOP;
IF n.XPhobic THEN SetXHood[n, Xed];
};
SwitchesQFromNode: PROC [n: Node, to: WordPtr] = TRUSTED {
sd: SwitchData ← NARROW[n.data];
s: Switches ← LOOPHOLE[to];
FOR i: CARDINAL IN [0 .. sd.length) DO s[i].s[q] ← sd.vals[i].s[q] ENDLOOP};
SwitchesUDFromNode: PROC [n: Node, to: WordPtr] = TRUSTED {
sd: SwitchData ← NARROW[n.data];
s: Switches ← LOOPHOLE[to];
FOR i: CARDINAL IN [0 .. sd.length) DO
s[i].s[u] ← sd.vals[i].s[u];
s[i].s[d] ← sd.vals[i].s[d];
ENDLOOP};
SwitchesValFromNode: PROC [n: Node, to: WordPtr] = TRUSTED {
sd: SwitchData ← NARROW[n.data];
s: Switches ← LOOPHOLE[to];
FOR i: CARDINAL IN [0 .. sd.length) DO s[i].val ← sd.vals[i].val ENDLOOP};
SwitchesSetNode: PROC [n: Node, to: WordPtr] = TRUSTED {
sd: SwitchData ← NARROW[n.data];
s: Switches ← LOOPHOLE[to];
FOR i: CARDINAL IN [0 .. sd.length) DO sd.vals[i] ← s[i] ENDLOOP};
SwitchesLongFormatValue: PROC [node: Node, fmt: Format, wp: WordPtr] RETURNS [rope: ROPE] =
BEGIN
sd: SwitchData ← NARROW[node.data];
ant: ArrayNodeType ← NARROW[node.type];
bits: INTEGER ← 1 + ant.last - ant.first;
rope ← "";
IF wp # NIL THEN ERROR;
FOR i: INTEGER IN [0 .. bits) DO
rope ← rope.Cat[
strengthToRope[sd[i].s[q]],
strengthToRope[sd[i].s[u]],
strengthToRope[sd[i].s[d]],
levelToRope[sd[i].val]];
ENDLOOP;
rope ← rope.Cat[
strengthToRope[sd.size],
strengthToRope[sd.realSize],
IF NOT node.XPhobic THEN "*" ELSE IF Xed[node] THEN "+" ELSE "-"];
END;
SwitchesLongParseValue: PROC [node: Node, fmt: Format, wp: WordPtr, s: STREAM] RETURNS [success: BOOLEAN] =
BEGIN
sd: SwitchData ← NARROW[node.data];
ant: ArrayNodeType ← NARROW[node.type];
bits: INTEGER ← ant.last - ant.first + 1;
td: SwitchData ← NEW [SwitchDataRep[sd.length]];
success ← TRUE;
IF wp # NIL THEN ERROR;
FOR i: INTEGER IN [0 .. bits) DO
td[i].s[q] ← GetStrength[s !IO.EndOfStream, IO.Error => {success ← FALSE; CONTINUE}];
IF NOT success THEN RETURN;
td[i].s[u] ← GetStrength[s !IO.EndOfStream, IO.Error => {success ← FALSE; CONTINUE}];
IF NOT success THEN RETURN;
td[i].s[d] ← GetStrength[s !IO.EndOfStream, IO.Error => {success ← FALSE; CONTINUE}];
IF NOT success THEN RETURN;
td[i].val ← GetLevel[s !IO.EndOfStream, IO.Error => {success ← FALSE; CONTINUE}];
IF NOT success THEN RETURN;
ENDLOOP;
td.size ← GetStrength[s !IO.EndOfStream, IO.Error => {success ← FALSE; CONTINUE}];
IF NOT success THEN RETURN;
td.realSize ← GetStrength[s !IO.EndOfStream, IO.Error => {success ← FALSE; CONTINUE}];
IF NOT success THEN RETURN;
FOR i: INTEGER IN [0 .. bits) DO sd[i] ← td[i] ENDLOOP;
sd.size ← td.size;
sd.realSize ← td.realSize;
END;
SwitchesLongMaxWidth: PROC [nt: NodeType, fmt: Format, font: VFonts.Font] RETURNS [INT] =
BEGIN
ant: ArrayNodeType ← NARROW[nt];
bits: INTEGER ← ant.last - ant.first + 1;
RETURN [VFonts.StringWidth["555H55+", font]*bits]
END;
SwitchesFormatValue: PROC [node: Node, fmt: Format, wp: WordPtr] RETURNS [rope: ROPE] =
BEGIN
sd: SwitchData ← NARROW[node.data];
ant: ArrayNodeType ← NARROW[node.type];
bits: INTEGER ← 1 + ant.last - ant.first;
rope ← "";
IF wp # NIL THEN ERROR;
FOR i: INTEGER IN [0 .. bits) DO
rope ← rope.Cat[levelToRope[sd[i].val]];
ENDLOOP;
END;
levelToRope: ARRAY Level OF ROPE ← ["L", "H", "X"];
strengthToRope: ARRAY Strength OF ROPE ← ["0", "1", "2", "3", "4", "5", "6", "7"];
SwitchesParseValue: PROC [node: Node, fmt: Format, wp: WordPtr, s: STREAM] RETURNS [success: BOOLEAN] =
BEGIN
sd: SwitchData ← NARROW[node.data];
ant: ArrayNodeType ← NARROW[node.type];
bits: INTEGER ← ant.last - ant.first + 1;
success ← TRUE;
IF wp # NIL THEN ERROR;
FOR i: INTEGER IN [0 .. bits) DO
c: CHARACTER;
l: Level;
c ← s.GetChar[!IO.EndOfStream => {success ← FALSE; CONTINUE}];
IF NOT success THEN RETURN;
SELECT c FROM
'L, '0 => l ← L;
'H, '1 => l ← H;
'X => l ← X;
ENDCASE => RETURN [FALSE];
sd[i].val ← l;
ENDLOOP;
END;
SwitchesMaxWidth: PROC [nt: NodeType, fmt: Format, font: VFonts.Font] RETURNS [INT] =
BEGIN
ant: ArrayNodeType ← NARROW[nt];
bits: INTEGER ← ant.last - ant.first + 1;
RETURN [VFonts.StringWidth["H", font]*bits]
END;
BSwitchFormatValue: PROC [node: Node, fmt: Format, wp: WordPtr] RETURNS [rope: ROPE] =
BEGIN
sd: SwitchData ← NARROW[node.data];
ant: ArrayNodeType ← NARROW[node.type];
bits: INTEGER ← 1 + ant.last - ant.first;
base: CARDINALNARROW[fmt.formatData, REF CARDINAL]^;
bitsPerDigit: CARDINAL ← bitsPerBase[base];
digits: INTEGER ← (bits + bitsPerDigit - 1) / bitsPerDigit;
rope ← baseKeys[base];
FOR d: INTEGER IN [0 .. digits) DO
r: INTEGER ← bits - d * bitsPerDigit;
n: CARDINAL ← 0;
xless: BOOLTRUE;
FOR i: INTEGER IN [MAX[r - bitsPerDigit, 0] .. r) DO
n ← n + n;
SELECT sd[i].val FROM
L => NULL;
X => xless ← FALSE;
H => n ← n + 1;
ENDCASE => ERROR;
ENDLOOP;
rope ← (IF xless THEN encode[n] ELSE "?").Concat[rope];
ENDLOOP;
END;
baseKeys: ARRAY [2 .. 16] OF ROPE = ["B", "R3", "R4", "R5", "R6", "R7", "O", "R9", "D", "R11", "R12", "R13", "R14", "R15", "H"];
numToLevel: ARRAY [0 .. 1] OF Level = [L, H];
bitsPerBase: ARRAY [2 .. 16] OF CARDINAL = [1, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4];
decode: ARRAY CHARACTER OF [0..16] ← ALL[16];
encode: ARRAY [0..16) OF ROPE = ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F"];
BSwitchParseValue: PROC [node: Node, fmt: Format, wp: WordPtr, s: STREAM] RETURNS [success: BOOLEAN] =
BEGIN
sd: SwitchData ← NARROW[node.data];
ant: ArrayNodeType ← NARROW[node.type];
bits: INTEGER ← ant.last - ant.first + 1;
rope: ROPE ← s.GetTokenRope[IO.IDProc].token;
rlen, rend: INTEGER ← rope.Length[];
base: CARDINAL ← 0;
fb: REF CARDINALNARROW[fmt.formatData];
bitsPerDigit: CARDINAL;
IF rlen < 1 THEN RETURN [FALSE];
SELECT rope.Fetch[rlen - 1] FROM
'b, 'B => {base ← 2; rend ← rlen - 1};
'o, 'O => {base ← 8; rend ← rlen - 1};
'h, 'H => {base ← 16; rend ← rlen - 1};
'a, 'A, 'c, 'C, 'd, 'D, 'e, 'E, 'f, 'F => {base ← 16};
ENDCASE => {base ← fb^};
bitsPerDigit ← bitsPerBase[base];
FOR d: INT IN [1 .. rend] DO
c: CHAR ← rope.Fetch[rend - d];
digit: [0 .. 16] ← decode[c];
x: BOOL ← c = 'x OR c = 'X;
IF (digit > base) AND (NOT x) THEN RETURN [FALSE];
ENDLOOP;
FOR d: INT IN [1 .. rend] DO
c: CHAR ← rope.Fetch[rend - d];
digit: [0 .. 16] ← decode[c];
x: BOOL ← c = 'x OR c = 'X;
FOR b: CARDINAL IN [1 .. bitsPerDigit] DO
l: Level ← IF x THEN X ELSE numToLevel[digit MOD 2];
i: INTEGER ← bits - (d-1)*bitsPerDigit - b;
next: [0 .. 16] ← digit / 2;
IF i >= 0 THEN sd[i].val ← l;
digit ← next;
ENDLOOP;
ENDLOOP;
success ← TRUE;
END;
BSwitchMaxWidth: PROC [nt: NodeType, fmt: Format, font: VFonts.Font] RETURNS [INT] =
BEGIN
ant: ArrayNodeType ← NARROW[nt];
bits: INTEGER ← ant.last - ant.first + 1;
base: REF CARDINALNARROW[fmt.formatData];
bitsPerDigit: CARDINAL ← bitsPerBase[base^];
digits: INTEGER ← (bits + bitsPerDigit - 1) / bitsPerDigit;
RETURN [VFonts.StringWidth["H", font]*(digits+1)]
END;
SetCapacitance: PUBLIC PROC [n: Node, cap: REAL] =
BEGIN
WITH n.data SELECT FROM
bd: BitData => bd.cap ← cap;
sd: SwitchData => sd.cap ← cap;
ENDCASE => ERROR;
END;
GetCapacitance: PUBLIC PROC [n: Node] RETURNS [cap: REAL] =
BEGIN
WITH n.data SELECT FROM
bd: BitData => cap ← bd.cap;
sd: SwitchData => cap ← sd.cap;
ENDCASE => ERROR;
END;
SetSizes: PUBLIC PROC [n: Node, currentSize, normalSize: Strength] =
BEGIN
WITH n.data SELECT FROM
bd: BitData => {bd.size ← currentSize; bd.realSize ← normalSize};
sd: SwitchData => {sd.size ← currentSize; sd.realSize ← normalSize};
ENDCASE => ERROR;
END;
GetSizes: PUBLIC PROC [n: Node] RETURNS [currentSize, normalSize: Strength] =
BEGIN
WITH n.data SELECT FROM
bd: BitData => {currentSize ← bd.size; normalSize ← bd.realSize};
sd: SwitchData => {currentSize ← sd.size; normalSize ← sd.realSize};
ENDCASE => ERROR;
END;
AddFormat: PROC [key: ROPE, base: CARDINAL] RETURNS [fmt: Format] =
BEGIN
atom: ATOM ← Atom.MakeAtom[key];
fmt ← NEW [FormatRep ← [
FormatValue: BSwitchFormatValue,
ParseValue: BSwitchParseValue,
FormatTest: NIL,
ParseTest: NIL,
MaxWidth: BSwitchMaxWidth,
formatData: NEW [CARDINAL ← base],
key: key]];
Atom.PutProp[atom: atom, prop: switchFmtKey, val: fmt];
sfl ← CONS[key, sfl];
END;
defaultSwitchesFormat: Format ← NIL;
Start: PROC =
BEGIN
FOR c: CARDINAL IN [0..9] DO
decode['0 + c] ← c;
ENDLOOP;
FOR c: CARDINAL IN [0..5] DO
decode['A + c] ← 10 + c;
decode['a + c] ← 10 + c;
ENDLOOP;
Atom.PutProp[atom: $short, prop: switchFmtKey, val: shortSwitchesFormat];
Atom.PutProp[atom: $long, prop: switchFmtKey, val: longSwitchesFormat];
Atom.PutProp[atom: $QUD, prop: switchFmtKey, val: longSwitchesFormat];
[] ← AddFormat["2", 2];
[] ← AddFormat["8", 8];
[] ← AddFormat["16", 16];
defaultSwitchesFormat ← AddFormat["", 16];
RoseEvents.AddWatcher[event: $NewSim, watcher: [Notify: GreetSim]];
SignalTypeRegistration.RegisterNodeTypeConstructor["SWITCH", ConstructSwitchType];
SignalTypeRegistration.RegisterNodeTypeConstructor["BIT", ConstructBitType];
END;
Start[];
END.