[Indigo]<Rosemary>2.6>Rosemary.DF=>SwitchTypesImpl.Mesa
Last Edited by: Spreitzer, October 7, 1984 2:26:38 pm 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,
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] ← MAX[h.held.s[u], h.held.s[d]]};
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,
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 ROPE ← NEW [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] ← MAX[s[sd.offset+i].s[u], s[sd.offset+i].s[d]];
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: BOOLEAN ← FALSE;
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: CARDINAL ← NARROW[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: BOOL ← TRUE;
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 CARDINAL ← NARROW[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 CARDINAL ← NARROW[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.