
<<[Indigo]<Rosemary>Ž>Rosemary.DF=>SwitchTypesImpl.Mesa>>
<<Last Edited by: Spreitzer, May 1, 1985 8:24:44 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, Basics, IO, List, NumTypes, Rope, RoseRun, RoseTranslateTypes, RoseTypes, SignalTypeRegistration, SwitchNumConvert, 
    SwitchTypes, VFonts;

    SwitchTypesImpl: CEDAR PROGRAM
        IMPORTS Atom, IO, NumTypes, Rope, RoseRun, RoseTranslateTypes, SignalTypeRegistration, SwitchNumConvert, VFonts
        EXPORTS SwitchTypes =

    BEGIN OPEN RoseTypes, SwitchTypes;

    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 _ [
        UserDescription: BitUserDescription,
        ListFormats: BitListFormats,
        GetFormat: BitGetFormat,
        MesaForSelf: BitMesaForSelf,
        SelectorOffset: BitSelectorOffset,
        SubType: BitSubType,
        Bits: BitBits,
        MesaRepresentation: BitMesaRepresentation,
        Equivalent: BitEquivalent,
        SimpleEquivalent: BitSimpleEquivalent,
        Transduce: SwitchNumConvert.Transduce,
        InitPort: BitInitPort,
        InitQ: BitInitQ,
        InitUD: BitInitUD,
        NewVal: BitNewVal,
        CopyVal: BitCopyVal,
        NewQ: BitNewQ,
        NewUD: BitNewUD,
        QFromNode: BitQFromNode,
        UDFromNode: BitUDFromNode,
        ValFromNode: BitValFromNode,
        SetNode: BitSetNode,
        CompareUD: BitCompareUD
        ]];

    bitType: PUBLIC NodeType _ NEW [NodeTypeRep[atom] _ [
        procs: bitProcs,
        typeData: NIL,
        simple: FALSE,
        structure: atom[$DigitalWire]]];

    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"]];

    initBitFormat: Format _ NEW [FormatRep _ [
        ParseValue: InitialBitParse,
        key: "init"]];

    Int: TYPE = RoseTranslateTypes.Int;

    one: Int _ NEW [RoseTranslateTypes.IntRep _ [RoseTranslateTypes.nullSR, 1]];

    Holder: TYPE = LONG POINTER TO SwitchValHolder;

    ConstructBitType: PROC [parms: REF ANY --UNION [BindingList, Args]--] RETURNS [type: NodeType] 
    --RoseTranslateTypes.NodeTypeConstructor-- =
        BEGIN
        type _ bitType;
        END;

    BitUserDescription: PROC [NodeType] RETURNS [r: ROPE] = {r _ "Switch"};
    BitListFormats: PROC [NodeType] RETURNS [l: RopeList] =
        {l _ LIST ["short", "long"]};
    BitGetFormat: PROC [nt: NodeType, fmtKey: ROPE] RETURNS [Format] =
        {RETURN [IF fmtKey.Equal["init"] THEN initBitFormat ELSE IF fmtKey.Equal["long", FALSE] OR fmtKey.Equal["QUD"] THEN longBitFormat 
        ELSE shortBitFormat]};
    BitMesaForSelf: PROC [NodeType] RETURNS [m: Mesa] =
        {m _ [mesa: "SwitchTypes.bitType", imports: LIST["SwitchTypes"]]};
    BitSelectorOffset: PROC [nt: NodeType, s: Selector] RETURNS [o: NAT] = {
        o _ WITH s SELECT FROM
            whole => 0,
            number, range => ERROR,
            ENDCASE => ERROR};
    BitSubType: PROC [nt: NodeType, s: Selector] RETURNS [snt: NodeType] = {
        snt _ WITH s SELECT FROM
            whole => nt,
            number, range => ERROR,
            ENDCASE => ERROR};
    BitBits: PROC [NodeType] RETURNS [container, data, leftPad: INT] = {RETURN [bpw, bitsPerSwitchVal, bpw-bitsPerSwitchVal]};
    BitMesaRepresentation: PROC [NodeType] RETURNS [m: Mesa] =
        {m _ [mesa: "SwitchTypes.SwitchVal", directory: LIST["SwitchTypes"]]};
    BitEquivalent: PROC [self, other: NodeType] RETURNS [eqv: BOOL] = {
        IF self # bitType THEN ERROR;
        eqv _ other = bitType OR other = oneBitSwitches};
    BitSimpleEquivalent: PROC [NodeType] RETURNS [NodeType] =
        {RETURN [NumTypes.boolType]};

    BitInitPort: PROC [n: Node, p: Ptr] = TRUSTED {
        nh: Holder _ PtrToHolder[n.valPtr];
        ph: Holder _ PtrToHolder[p];
        ph.held _ nh.held};

    PtrToHolder: PROC [p: Ptr] RETURNS [h: Holder] = {
        IF p.bit # 0 THEN ERROR;
        TRUSTED {h _ LOOPHOLE[p.word]};
        };

    BitInitQ: PROC [n: Node] = {
        nh: Holder _ PtrToHolder[n.valPtr];
        TRUSTED {nh.held.s[q] _ n.strength}};

    BitInitUD: PROC [n: Node] = TRUSTED {
        nh: Holder _ PtrToHolder[n.valPtr];
        u, d: Strength;
        [u, d] _ Parts[nh.held.val, n.strength];
        nh.held.s[u] _ Block[u, nh.held.s[q]];
        nh.held.s[d] _ Block[d, nh.held.s[q]];
        n.isInput _ nh.held.s[q] = input};

    BitNewVal: PROC [n: Node] RETURNS [delay: BOOL] = TRUSTED {
        nh: Holder _ PtrToHolder[n.valPtr];
        temp: Level _
            IF nh.held.s[u] = none AND nh.held.s[d] > none THEN L ELSE
            IF nh.held.s[d] = none AND nh.held.s[u] > none THEN H ELSE
            X;
        delay _ FALSE;
        IF n.XPhobic AND temp = X THEN delay _ TRUE ELSE nh.held.val _ temp;
        };

    BitCopyVal: PROC [nt: NodeType, from, to: Ptr] = TRUSTED {
        hFrom: Holder _ PtrToHolder[from];
        hTo: Holder _ PtrToHolder[to];
        hTo.held.val _ hFrom.held.val};

    BitNewQ: PROC [n: Node, p: Ptr] RETURNS [b: BOOLEAN] = TRUSTED {
        h: Holder _ PtrToHolder[p];
        nh: Holder _ PtrToHolder[n.valPtr];
        IF b _ h.held.s[q] > nh.held.s[q] THEN nh.held.s[q] _ h.held.s[q]};

    BitNewUD: PROC [n: Node, p: Ptr] RETURNS [b: BOOLEAN] = TRUSTED {
        h: Holder _ PtrToHolder[p];
        nh: Holder _ PtrToHolder[n.valPtr];
        u: Strength _ Block[h.held.s[u], nh.held.s[q]];
        d: Strength _ Block[h.held.s[d], nh.held.s[q]];
        b _ FALSE;
        IF u > nh.held.s[u] THEN {b _ TRUE; nh.held.s[u] _ u};
        IF d > nh.held.s[d] THEN {b _ TRUE; nh.held.s[d] _ d}};

    BitQFromNode: PROC [n: Node, to: Ptr] = TRUSTED {
        h: Holder _ PtrToHolder[to];
        nh: Holder _ PtrToHolder[n.valPtr];
        h.held.s[q] _ nh.held.s[q]};

    BitUDFromNode: PROC [n: Node, to: Ptr] = TRUSTED {
        h: Holder _ PtrToHolder[to];
        nh: Holder _ PtrToHolder[n.valPtr];
        h.held.s[u] _ nh.held.s[u];
        h.held.s[d] _ nh.held.s[d]};

    BitValFromNode: PROC [n: Node, to: Ptr] = TRUSTED {
        h: Holder _ PtrToHolder[to];
        nh: Holder _ PtrToHolder[n.valPtr];
        h.held.val _ nh.held.val};

    BitSetNode: PROC [n: Node, to: Ptr] = TRUSTED {
        h: Holder _ PtrToHolder[to];
        nh: Holder _ PtrToHolder[n.valPtr];
        nh.held _ h.held};

    BitCompareUD: PROC [nt: NodeType, p1, p2: Ptr] RETURNS [diff: BOOL] = TRUSTED {
        h1: Holder _ PtrToHolder[p1];
        h2: Holder _ PtrToHolder[p2];
        diff _ h1.held.s[u] # h2.held.s[u] OR h1.held.s[d] # h2.held.s[d]};

    Block: PUBLIC PROC [a, b: Strength] RETURNS [c: Strength] =
        {c _ IF a < b THEN none ELSE a};

    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]};

    BitFormatValue: PROC [node: Node, fmt: Format, p: Ptr] RETURNS [r: ROPE] = {
        h: Holder _ PtrToHolder[p];
        TRUSTED {r _ levelToRope[h.held.val]}};

    BitParseValue: PROC [node: Node, fmt: Format, p: Ptr, s: STREAM] RETURNS [success: BOOLEAN] = {
        h: Holder _ PtrToHolder[p];
        ans: Level;
        success _ TRUE;
        ans _ GetLevel[s !IO.EndOfStream, IO.Error => {success _ FALSE; CONTINUE}];
        IF NOT success THEN RETURN;
        TRUSTED {h.held.val _ ans};
        };

    InitialBitParse: PROC [node: Node, fmt: Format, p: Ptr, s: STREAM] RETURNS [success: BOOLEAN] = {
        h: Holder _ PtrToHolder[p];
        ans: Level;
        val: ATOM _ Atom.MakeAtom[s.GetID[]];
        success _ TRUE;
        SELECT val FROM
            $steady => ans _ L;
            $initial => ans _ X;
            $vdd => ans _ H;
            $gnd => ans _ L;
            ENDCASE => success _ FALSE;
        IF NOT success THEN RETURN;
        TRUSTED {h.held.val _ ans};
        };

    LBitFormatValue: PROC [node: Node, fmt: Format, p: Ptr] RETURNS [r: ROPE] = TRUSTED {
        h: Holder _ PtrToHolder[p];
        r _ Rope.Cat[
            strengthToRope[h.held.s[q]],
            strengthToRope[h.held.s[u]],
            strengthToRope[h.held.s[d]],
            levelToRope[h.held.val],
            strengthToRope[node.strength]]
            .Cat[IF NOT node.XPhobic THEN "*" ELSE IF RoseRun.Delayed[node] THEN "+" ELSE "-"]};

    LBitParseValue: PROC [node: Node, fmt: Format, p: Ptr, s: STREAM] RETURNS [success: BOOLEAN] = TRUSTED {
        h: Holder _ PtrToHolder[p];
        newStrength: Strength;
        newSV: SwitchVal _ [];
        success _ TRUE;
        newSV.s[q] _ GetStrength[s !IO.EndOfStream, IO.Error => {success _ FALSE; CONTINUE}];
        IF NOT success THEN RETURN;
        newSV.s[u] _ GetStrength[s !IO.EndOfStream, IO.Error => {success _ FALSE; CONTINUE}];
        IF NOT success THEN RETURN;
        newSV.s[d] _ GetStrength[s !IO.EndOfStream, IO.Error => {success _ FALSE; CONTINUE}];
        IF NOT success THEN RETURN;
        newSV.val _ GetLevel[s !IO.EndOfStream, IO.Error => {success _ FALSE; CONTINUE}];
        IF NOT success THEN RETURN;
        newStrength _ GetStrength[s !IO.EndOfStream, IO.Error => {success _ FALSE; CONTINUE}];
        IF NOT success THEN RETURN;
        IF p = node.valPtr THEN node.strength _ newStrength;
        h.held _ newSV;
        };

    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, test: NodeTest] RETURNS [r: ROPE] =
        BEGIN
        r _ SELECT test.data FROM $L => "L", $H => "H", $X => "X", ENDCASE => "??";
        END;

    BitParseTest: PROC [nt: NodeType, fmt: Format, s: STREAM] RETURNS [success: BOOLEAN, test: NodeTest] =
        BEGIN
        ans: Level;
        success _ TRUE;
        ans _ GetLevel[s !IO.EndOfStream, IO.Error => {success _ FALSE; CONTINUE}];
        IF NOT success THEN RETURN;
        test.proc _ BitTest;
        test.data _ SELECT ans FROM L => $L, H => $H, X => $X, ENDCASE => ERROR;
        END;

    BitTest: PROC [where: Ptr, testData: REF ANY, nodeType: NodeType] RETURNS [passes: BOOLEAN] --NodeTestProc-- =
        BEGIN
        l: Level _ SELECT testData FROM $L => L, $H => H, $X => X, ENDCASE => ERROR;
        TRUSTED {passes _ PtrToHolder[where].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.length = 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[bits, NARROW[bitType]]]];
        END;

    switchProcs: NodeProcs _ NEW [NodeProcsRep _ [
        UserDescription: SwitchUserDescription,
        ListFormats: SwitchListFormats,
        GetFormat: SwitchGetFormat,
        MesaForSelf: SwitchMesaForSelf,
        SelectorOffset: SwitchSelectorOffset,
        SubType: SwitchSubType,
        Bits: SwitchBits,
        MesaRepresentation: SwitchMesaRepresentation,
        Equivalent: SwitchEquivalent,
        SimpleEquivalent: SwitchSimpleEquivalent,
        Transduce: SwitchNumConvert.Transduce,
        InitPort: SwitchesInitPort,
        InitQ: SwitchesInitQ,
        InitUD: SwitchesInitUD,
        NewVal: SwitchesNewVal,
        CopyVal: SwitchesCopyVal,
        NewQ: SwitchesNewQ,
        NewUD: SwitchesNewUD,
        QFromNode: SwitchesQFromNode,
        UDFromNode: SwitchesUDFromNode,
        ValFromNode: SwitchesValFromNode,
        SetNode: SwitchesSetNode,
        CompareUD: SwitchesCompareUD
        ]];

    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;

    bpw: NAT = Basics.bitsPerWord;

    SwitchUserDescription: PROC [nt: NodeType] RETURNS [ud: ROPE] = {
        ant: ArrayNodeType _ NARROW[nt];
        ud _ IO.PutFR["Switch[%g]", IO.int[ant.length]]};

    SwitchListFormats: PROC [NodeType] RETURNS [l: RopeList] = {l _ sfl};

    SwitchGetFormat: PROC [nt: NodeType, key: ROPE] RETURNS [fmt: Format] = {
        atom: ATOM _ Atom.MakeAtom[key];
        fmt _ NARROW[Atom.GetProp[atom: atom, prop: switchFmtKey]];
        };

    SwitchMesaForSelf: PROC [nt: NodeType] RETURNS [m: Mesa] = {
        ant: ArrayNodeType _ NARROW[nt];
        m _ [
            mesa: IO.PutFR["SwitchTypes.Bundle[%g]", IO.int[ant.length]],
            imports: LIST["SwitchTypes"]]};

    SwitchSelectorOffset: PROC [nt: NodeType, s: Selector] RETURNS [o: NAT] = {
        o _ WITH s SELECT FROM
            number => index*bpw,
            whole => 0,
            range => bpw*(IF up THEN first ELSE first+1-count),
            ENDCASE => ERROR;
        };

    SwitchSubType: PROC [nt: NodeType, s: Selector] RETURNS [snt: NodeType] = {
        snt _ WITH s SELECT FROM
            whole => nt,
            number => bitType,
            range => Bundle[count],
            ENDCASE => ERROR;
        };

    SwitchBits: PROC [nt: NodeType] RETURNS [container, data, leftPad: INT] = {
        ant: ArrayNodeType _ NARROW[nt];
        container _ bpw*((ant.length + switchValsPerWord -1)/switchValsPerWord);
        data _ container;
        leftPad _ 0;
        };

    SwitchMesaRepresentation: PROC [nt: NodeType] RETURNS [m: Mesa] = {
        ant: ArrayNodeType _ NARROW[nt];
        m _ [
            mesa: IO.PutFR["PACKED ARRAY [0 .. %g) OF SwitchTypes.SwitchVal", IO.int[ant.length]],
            directory: LIST["SwitchTypes"]]};

    sfl: RopeList _ LIST["short", "long"];

    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"]];

    initSwitchesFormat: Format _ NEW [FormatRep _ [
        ParseValue: InitialSwitchesParse,
        key: "init"]];

    Switches: TYPE = LONG POINTER TO PACKED ARRAY NAT OF SwitchVal;

    PtrToSwitches: PROC [p: Ptr] RETURNS [ss: Switches] = {
        IF p.bit # 0 THEN ERROR;
        TRUSTED {ss _ LOOPHOLE[p.word]}};

    SwitchEquivalent: PROC [self, other: NodeType] RETURNS [eqv: BOOL] = {
        ant: ArrayNodeType _ NARROW[self];
        IF ant.element # bitType THEN ERROR;
        eqv _ other = self OR (other = bitType AND ant.length=1);
        };

    SwitchSimpleEquivalent: PROC [self: NodeType] RETURNS [NodeType] = {
        ant: ArrayNodeType _ NARROW[self];
        RETURN [NumTypes.NumType[ant.length]]};

    SwitchesInitPort: PROC [n: Node, p: Ptr] = TRUSTED {
        ant: ArrayNodeType _ NARROW[n.type];
        ns: Switches _ PtrToSwitches[n.valPtr];
        s: Switches _ PtrToSwitches[p];
        FOR i: CARDINAL IN [0 .. ant.length) DO
            s[i] _ ns[i];
            ENDLOOP};

    SwitchesInitQ: PROC [n: Node] = TRUSTED {
        ant: ArrayNodeType _ NARROW[n.type];
        ns: Switches _ PtrToSwitches[n.valPtr];
        FOR i: CARDINAL IN [0 .. ant.length) DO ns[i].s[q] _ n.strength ENDLOOP};

    SwitchesInitUD: PROC [n: Node] = TRUSTED {
        ant: ArrayNodeType _ NARROW[n.type];
        ns: Switches _ PtrToSwitches[n.valPtr];
        n.isInput _ TRUE;
        FOR i: CARDINAL IN [0 .. ant.length) DO
            u, d: Strength;
            [u, d] _ Parts[ns[i].val, n.strength];
            ns[i].s[u] _ Block[u, ns[i].s[q]];
            ns[i].s[d] _ Block[d, ns[i].s[q]];
            n.isInput _ n.isInput AND ns[i].s[q] = input;
            ENDLOOP};

    SwitchesNewVal: PROC [n: Node] RETURNS [delay: BOOL] = TRUSTED {
        ant: ArrayNodeType _ NARROW[n.type];
        ns: Switches _ PtrToSwitches[n.valPtr];
        delay _ FALSE;
        FOR i: CARDINAL IN [0 .. ant.length) DO
            temp: Level _
                IF ns[i].s[u] = none AND ns[i].s[d] > none THEN L ELSE
                IF ns[i].s[d] = none AND ns[i].s[u] > none THEN H ELSE
                X;
            IF n.XPhobic AND temp = X THEN delay _ TRUE ELSE ns[i].val _ temp;
            ENDLOOP;
        };

    SwitchesCopyVal: PROC [nt: NodeType, from, to: Ptr] = TRUSTED {
        ant: ArrayNodeType _ NARROW[nt];
        sFrom: Switches _ PtrToSwitches[from];
        sTo: Switches _ PtrToSwitches[to];
        FOR i: INTEGER IN [0 .. ant.length) DO
            sTo[i].val _ sFrom[i].val;
            ENDLOOP};

    SwitchesNewQ: PROC [n: Node, p: Ptr] RETURNS [b: BOOLEAN] = TRUSTED {
        ant: ArrayNodeType _ NARROW[n.type];
        ns: Switches _ PtrToSwitches[n.valPtr];
        s: Switches _ PtrToSwitches[p];
        b _ FALSE;
        FOR i: CARDINAL IN [0 .. ant.length) DO
            IF s[i].s[q]>ns[i].s[q] THEN {ns[i].s[q] _ s[i].s[q]; b _ TRUE};
            ENDLOOP};

    SwitchesNewUD: PROC [n: Node, p: Ptr] RETURNS [b: BOOLEAN] = TRUSTED {
        ant: ArrayNodeType _ NARROW[n.type];
        ns: Switches _ PtrToSwitches[n.valPtr];
        s: Switches _ PtrToSwitches[p];
        b _ FALSE;
        FOR i: CARDINAL IN [0 .. ant.length) DO
            u: Strength _ Block[s[i].s[u], ns[i].s[q]];
            d: Strength _ Block[s[i].s[d], ns[i].s[q]];
            IF u > ns[i].s[u] THEN {ns[i].s[u] _ u; b _ TRUE};
            IF d > ns[i].s[d] THEN {ns[i].s[d] _ d; b _ TRUE};
            ENDLOOP};

    SwitchesQFromNode: PROC [n: Node, to: Ptr] = TRUSTED {
        ant: ArrayNodeType _ NARROW[n.type];
        ns: Switches _ PtrToSwitches[n.valPtr];
        s: Switches _ PtrToSwitches[to];
        FOR i: CARDINAL IN [0 .. ant.length) DO s[i].s[q] _ ns[i].s[q] ENDLOOP};

    SwitchesUDFromNode: PROC [n: Node, to: Ptr] = TRUSTED {
        ant: ArrayNodeType _ NARROW[n.type];
        ns: Switches _ PtrToSwitches[n.valPtr];
        s: Switches _ PtrToSwitches[to];
        FOR i: CARDINAL IN [0 .. ant.length) DO
            s[i].s[u] _ ns[i].s[u];
            s[i].s[d] _ ns[i].s[d];
            ENDLOOP};

    SwitchesValFromNode: PROC [n: Node, to: Ptr] = TRUSTED {
        ant: ArrayNodeType _ NARROW[n.type];
        ns: Switches _ PtrToSwitches[n.valPtr];
        s: Switches _ PtrToSwitches[to];
        FOR i: CARDINAL IN [0 .. ant.length) DO s[i].val _ ns[i].val ENDLOOP};

    SwitchesSetNode: PROC [n: Node, to: Ptr] = TRUSTED {
        ant: ArrayNodeType _ NARROW[n.type];
        ns: Switches _ PtrToSwitches[n.valPtr];
        s: Switches _ PtrToSwitches[to];
        FOR i: CARDINAL IN [0 .. ant.length) DO ns[i] _ s[i] ENDLOOP};

    SwitchesCompareUD: PROC [nt: NodeType, p1, p2: Ptr] RETURNS [diff: BOOL] = TRUSTED {
        ant: ArrayNodeType _ NARROW[nt];
        s1: Switches _ PtrToSwitches[p1];
        s2: Switches _ PtrToSwitches[p2];
        FOR i: NAT IN [0 .. ant.length) 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};

    SwitchesLongFormatValue: PROC [node: Node, fmt: Format, p: Ptr] RETURNS [rope: ROPE] = TRUSTED {
        ant: ArrayNodeType _ NARROW[node.type];
        s: Switches _ PtrToSwitches[p];
        rope _ "";
        FOR i: INTEGER IN [0 .. ant.length) DO
            rope _ rope.Cat[
                strengthToRope[s[i].s[q]],
                strengthToRope[s[i].s[u]],
                strengthToRope[s[i].s[d]],
                levelToRope[s[i].val]];
            ENDLOOP;
        rope _ rope.Cat[
            strengthToRope[node.strength],
            IF NOT node.XPhobic THEN "*" ELSE IF RoseRun.Delayed[node] THEN "+" ELSE "-"];
        };

    SwitchSeq: TYPE = RECORD [switches: PACKED SEQUENCE length: NAT OF SwitchVal];

    SwitchesLongParseValue: PROC [node: Node, fmt: Format, p: Ptr, s: STREAM] RETURNS [success: BOOLEAN] = TRUSTED {
        ant: ArrayNodeType _ NARROW[node.type];
        ss: Switches _ PtrToSwitches[p];
        bits: INTEGER _ ant.length;
        newStrength: Strength;
        ts: REF SwitchSeq _ NEW [SwitchSeq[bits]];
        success _ TRUE;
        FOR i: INTEGER IN [0 .. bits) DO
            ts[i].s[q] _ GetStrength[s !IO.EndOfStream, IO.Error => {success _ FALSE; CONTINUE}];
            IF NOT success THEN RETURN;
            ts[i].s[u] _ GetStrength[s !IO.EndOfStream, IO.Error => {success _ FALSE; CONTINUE}];
            IF NOT success THEN RETURN;
            ts[i].s[d] _ GetStrength[s !IO.EndOfStream, IO.Error => {success _ FALSE; CONTINUE}];
            IF NOT success THEN RETURN;
            ts[i].val _ GetLevel[s !IO.EndOfStream, IO.Error => {success _ FALSE; CONTINUE}];
            IF NOT success THEN RETURN;
            ENDLOOP;
        newStrength _ GetStrength[s !IO.EndOfStream, IO.Error => {success _ FALSE; CONTINUE}];
        IF NOT success THEN RETURN;
        FOR i: INTEGER IN [0 .. bits) DO ss[i] _ ts[i] ENDLOOP;
        IF p = node.valPtr THEN {node.strength _ newStrength};
        };

    SwitchesLongMaxWidth: PROC [nt: NodeType, fmt: Format, font: VFonts.Font] RETURNS [INT] =
        BEGIN
        ant: ArrayNodeType _ NARROW[nt];
        bits: INTEGER _ ant.length;
        RETURN [VFonts.StringWidth["555H", font]*bits + VFonts.StringWidth["55+", font]]
        END;

    InitialSwitchesParse: PROC [node: Node, fmt: Format, p: Ptr, s: STREAM] RETURNS [success: BOOLEAN] =
        BEGIN
        ant: ArrayNodeType _ NARROW[node.type];
        ss: Switches _ PtrToSwitches[p];
        bits: INTEGER _ ant.length;
        atom: ATOM _ Atom.MakeAtom[s.GetID[]];
        val: Level;
        success _ TRUE;
        SELECT atom FROM
            $initial => val _ X;
            $steady => val _ L;
            $vdd => val _ H;
            $gnd => val _ L;
            ENDCASE => success _ FALSE;
        IF NOT success THEN RETURN;
        FOR i: INTEGER IN [0 .. bits) DO
            TRUSTED {ss[i].val _ val};
            ENDLOOP;
        END;

    SwitchesFormatValue: PROC [node: Node, fmt: Format, p: Ptr] RETURNS [rope: ROPE] = {
        ant: ArrayNodeType _ NARROW[node.type];
        ss: Switches _ PtrToSwitches[p];
        bits: INTEGER _ ant.length;
        rope _ "";
        FOR i: INTEGER IN [0 .. bits) DO
            TRUSTED {rope _ rope.Cat[levelToRope[ss[i].val]]};
            ENDLOOP;
        };

    levelToRope: ARRAY Level OF ROPE _ ["L", "H", "X"];
    strengthToRope: ARRAY Strength OF ROPE _ ["2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F"];

    SwitchesParseValue: PROC [node: Node, fmt: Format, p: Ptr, s: STREAM] RETURNS [success: BOOLEAN] =
        BEGIN
        ant: ArrayNodeType _ NARROW[node.type];
        ss: Switches _ PtrToSwitches[p];
        bits: INTEGER _ ant.length;
        success _ TRUE;
        FOR i: INTEGER IN [0 .. bits) DO
            l: Level;
            l _ GetLevel[s !IO.EndOfStream, IO.Error => {success _ FALSE; CONTINUE}];
            IF NOT success THEN RETURN;
            TRUSTED {ss[i].val _ l};
            ENDLOOP;
        END;

    SwitchesMaxWidth: PROC [nt: NodeType, fmt: Format, font: VFonts.Font] RETURNS [INT] =
        BEGIN
        ant: ArrayNodeType _ NARROW[nt];
        bits: INTEGER _ ant.length;
        RETURN [VFonts.StringWidth["H", font]*bits]
        END;

    BSwitchFormatValue: PROC [node: Node, fmt: Format, p: Ptr] RETURNS [rope: ROPE] =
        BEGIN
        ant: ArrayNodeType _ NARROW[node.type];
        ss: Switches _ PtrToSwitches[p];
        bits: INTEGER _ ant.length;
        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;
                TRUSTED {SELECT ss[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, p: Ptr, s: STREAM] RETURNS [success: BOOLEAN] =
        BEGIN
        ant: ArrayNodeType _ NARROW[node.type];
        ss: Switches _ PtrToSwitches[p];
        bits: INTEGER _ ant.length;
        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 TRUSTED {ss[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.length;
        base: REF CARDINAL _ NARROW[fmt.formatData];
        bitsPerDigit: CARDINAL _ bitsPerBase[base^];
        digits: INTEGER _ (bits + bitsPerDigit - 1) / bitsPerDigit;
        RETURN [VFonts.StringWidth["H", font]*(digits+1)]
        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;

    IsSwitchType: PUBLIC PROC [nt: NodeType] RETURNS [switchy: BOOLEAN] = {
        WITH nt SELECT FROM
            ant: ArrayNodeType => switchy _ IsSwitchType[ant.element];
            ant: AtomNodeType => switchy _ ant = bitType;
            ENDCASE => ERROR};

    defaultSwitchesFormat: Format _ NIL;
    oneBitSwitches: ArrayNodeType _ NARROW[Bundle[1]];

    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];
        Atom.PutProp[atom: $init, prop: switchFmtKey, val: initSwitchesFormat];
        [] _ AddFormat["2", 2];
        [] _ AddFormat["8", 8];
        [] _ AddFormat["16", 16];
        defaultSwitchesFormat _ AddFormat["", 16];
        SignalTypeRegistration.RegisterNodeTypeConstructor["SWITCH", ConstructSwitchType];
        SignalTypeRegistration.RegisterNodeTypeConstructor["BIT", ConstructBitType];
        END;

    Start[];

    END.