
<<[Indigo]<Rosemary>2.5>Rosemary.DF=>SwitchTypesImpl.Mesa>>
<<Last Edited by: Spreitzer, July 13, 1984 10:37:31 pm PDT>>
<<Last Edited by: Barth, April 23, 1984 5:37:27 pm PST>>

    DIRECTORY Atom, IO, List, Rope, RoseEvents, RoseTranslateTypes, RoseTypes, SignalTypeRegistration, SwitchNumConvert, SwitchTypes, 
    SwitchTypesPrivate, VFonts;

    SwitchTypesImpl: CEDAR PROGRAM
        IMPORTS Atom, IO, Rope, RoseEvents, 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 = REF INT;

    one: Int _ NEW [INT _ 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["UD"] 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] = {
        rs: REF Strength _ NARROW[initData];
        s: Strength _ IF rs = NIL THEN charge ELSE rs^;
        iv: SwitchVal _ IF steady THEN [s: [s, none, s], val: L] ELSE [s: ALL[s], val: X];
        bd: BitData _ NEW [BitDataRep _ [sv: iv, size: s, realSize: s]];
        IF node.initialValue # NIL THEN {
            ivs: IO.STREAM _ IO.RIS[node.initialValue];
            bd.sv.val _ GetLevel[ivs !IO.EndOfStream, IO.Error => CONTINUE];
            ivs.Close[]};
        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]]};

    Parts: PROC [l: Level, s: Strength] RETURNS [u, d: Strength] = {
        RETURN [IF l = L THEN none ELSE s, IF l = H THEN none ELSE s]};

    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: NotifyProc--PROC [event: ATOM, watched, watcherData, arg: REF ANY]-- =
        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[n.name, names];
            ENDLOOP;
        IF names # NIL THEN ERROR Error["Nodes want Xes", names];
        END;

    GreetSim: NotifyProc--PROC [event: ATOM, watched, watcherData, arg: REF ANY]-- =
        BEGIN
        sim: Simulation _ NARROW[arg];
        RoseEvents.AddWatcher[event: $EndOfRun, 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, '0 => l _ L;
            'X, 'x => l _ X;
            'H, 'h, '1 => l _ H;
            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", $X => "X", $H => "H", 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, $X => X, $H => H, 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^];
        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: "short"]];

    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] RETURNS [t: Cell] =
        {t _ SwitchNumConvert.MakeTransducer[switchy: myKind, nummy: otherKind, within: within, writeSwitchy: writeMine, writeNummy: 
        writeOther]};

    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];
        rs: REF Strength _ NARROW[initData];
        s: Strength _ IF rs = NIL THEN charge ELSE rs^;
        sd: SwitchData _ NEW [SwitchDataRep[1+ant.last - ant.first]];
        iv: SwitchVal _ IF steady THEN [s: [s, none, s], val: L] ELSE [s: ALL[s], val: X];
        sd.size _ sd.realSize _ s; sd.cap _ 0;
        FOR i: CARDINAL IN [0 .. sd.length) DO sd[i] _ iv ENDLOOP;
        node.data _ sd;
        IF node.initialValue # NIL THEN {
            ivs: IO.STREAM _ IO.RIS[node.initialValue];
            TRUSTED {[] _ SwitchesParseValue[node, defaultSwitchesFormat, NIL, ivs]};
            ivs.Close[]}
        };

    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];
        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]]
            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", "X", "H"];
    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, 'L, '0 => l _ L;
                'x, 'X => l _ X;
                'h, 'H, '1 => l _ H;
                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: $UD, 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.