
<<CombinatorialImpl.mesa    >>
<<Copyright Ó 1987 by Xerox Corporation.  All rights reversed.>>
    <<Created by Bertrand Serlet August 24, 1987 9:59:31 pm PDT>>
    <<Bertrand Serlet September 17, 1987 3:39:32 pm PDT>>

    DIRECTORY
        Combinatorial, Convert, Core, CoreClasses, CoreFlat, CoreOps, CoreProperties, GList, IO, List, Ports, Process, RefTab, Rope, 
        Rosemary, SymTab, TerminalIO;

    CombinatorialImpl: CEDAR PROGRAM
        IMPORTS Convert, CoreClasses, CoreFlat, CoreOps, CoreProperties, GList, IO, List, Ports, Process, RefTab, Rope, Rosemary, SymTab, 
        TerminalIO
        EXPORTS Combinatorial
        ~ BEGIN OPEN Combinatorial;
<<Predicates>>
    IsCombinatorial: PUBLIC PROC [cell: Core.CellType] RETURNS [BOOL] = {
        value: REF BOOL = NARROW [CoreProperties.GetCellTypeProp[cell, $Combinatorial]];
        RETURN [value#NIL AND value^];
        };

    IsNonCombinatorial: PUBLIC PROC [cell: Core.CellType] RETURNS [BOOL] = {
        value: REF BOOL = NARROW [CoreProperties.GetCellTypeProp[cell, $Combinatorial]];
        RETURN [value#NIL AND NOT value^];
        };

    NotCombinatorial: PUBLIC ERROR [cell: Core.CellType] = CODE;
<<Typing of wires>>
    EnumerateTypedWires: PUBLIC PROC [cc: Core.CellType, each: PROC [Core.Wire, ROPE, WireType] RETURNS [quit: BOOL _ FALSE]] RETURNS 
    [quit: BOOL] = {
        EachWire: CoreOps.EachWireProc = {
            name: ROPE = CoreOps.GetFullWireName[cc.public, wire];
            SELECT TRUE FROM
                wire.size#0                => RETURN;
                Rope.Equal[name, "Gnd"]            => quit _ each[wire, name, gnd];
                Rope.Equal[name, "Vdd"]            => quit _ each[wire, name, vdd];
            GetOutput[wire]#NIL                                    => quit _ each[wire, name, output];
            ENDCASE                                                    => quit _ each[wire, name, input];
            };
        IF NOT IsCombinatorial[cc] THEN ERROR NotCombinatorial[cc];
        quit _ CoreOps.VisitWireSeq[cc.public, EachWire];
        };

    GetTypedWires: PUBLIC PROC [cc: Core.CellType, type: WireType] RETURNS [wires: Core.Wires _ NIL] = {
        Each: PROC [wire: Core.Wire, name: ROPE, tt: WireType] RETURNS [quit: BOOL _ FALSE] = {
            IF tt=type AND NOT CoreOps.Member[wires, wire] THEN wires _ CONS [wire, wires];
            };
        [] _ EnumerateTypedWires[cc, Each];
        };
        <<>>
    GetWireType: PUBLIC PROC [cc: Core.CellType, wire: Core.Wire] RETURNS [type: WireType] = {
        Each: PROC [ww: Core.Wire, name: ROPE, tt: WireType] RETURNS [quit: BOOL _ FALSE] = {
            type _ tt; quit _ ww=wire;
            };
        [] _ EnumerateTypedWires[cc, Each];
    };

    PutOutput: PUBLIC PROC [wire: Core.Wire, expr: ROPE] = {
        CoreProperties.PutWireProp[wire, $Output, expr];
        };

    GetOutput: PUBLIC PROC [wire: Core.Wire] RETURNS [ROPE _ NIL] = {
    RETURN [CoreOps.FixStupidRef[CoreProperties.GetWireProp[wire, $Output]]];
        };
<<Creation Conveniences>>
    Oper: PUBLIC PROC [oper: ROPE, params: ParseTrees] RETURNS [ParseTree] = 
        {RETURN [NEW [ParseOperRec _ [oper, params]]]};

    Not: PUBLIC PROC [tree: ParseTree] RETURNS [ParseTree] = 
        {RETURN [Oper["~", LIST [tree]]]};

    And: PUBLIC PROC [trees: ParseTrees] RETURNS [ParseTree] = 
        {RETURN [Oper["*", trees]]};

    Or: PUBLIC PROC [trees: ParseTrees] RETURNS [ParseTree] = 
        {RETURN [Oper["+", trees]]};

    And2: PUBLIC PROC [tree1, tree2: ParseTree] RETURNS [ParseTree] = 
        {RETURN [And[LIST [tree1, tree2]]]};

    Or2: PUBLIC PROC [tree1, tree2: ParseTree] RETURNS [ParseTree] = 
        {RETURN [Or[LIST [tree1, tree2]]]};
<<Parsing of Expressions>>
    IncorrectExpression: PUBLIC ERROR [expr, msg: ROPE] = CODE;
    ParseExpression: PUBLIC PROC [expr: ROPE] RETURNS [tree: ParseTree _ NIL] = {
        stream: IO.STREAM _ IO.RIS[expr];
        tokenKind: IO.TokenKind; token: ROPE;
        Scan: PROC = {
            ENABLE IO.EndOfStream    => {tokenKind _ tokenEOF; CONTINUE};
            [tokenKind, token] _ IO.GetCedarTokenRope[stream];
            };
        IsChar: PROC [char: CHAR] RETURNS [ok: BOOL] = {
            ok _ tokenKind=tokenSINGLE AND Rope.Length[token]=1 AND Rope.Fetch[token]=char;
            };
        <<assumes that tokenKind and token are already set.  Leaves them set at the end.>>
        ParseTerm: PROC RETURNS [tree: ParseTree] = {
            SELECT TRUE FROM
                tokenKind=tokenDECIMAL OR tokenKind=tokenOCTAL OR tokenKind=tokenHEX    => tree _ NEW [INT _ Convert.IntFromRope[token]];
                IsChar['(]                    => {
                    Scan[]; tree _ ParseExpr[];
                    IF NOT IsChar[')] THEN ERROR IncorrectExpression[expr, "Missing )"];
                    };
                IsChar['~]                    => {
                    Scan[]; RETURN [Not[ParseTerm[]]]; 
                    };
                IsChar['[] OR tokenKind=tokenID            => {
                    variable: ROPE _ NIL;
                    params: ParseTrees _ NIL;
                    WHILE tokenKind=tokenID OR NOT (tokenKind=tokenEOF OR IsChar[',] OR IsChar['+] OR IsChar['*] OR IsChar['(] OR IsChar[')]) DO
                        variable _ Rope.Cat[variable, token]; Scan[];
                        ENDLOOP;
                    IF NOT IsChar['(] THEN RETURN [variable];
                    <<We have a function here!>>
                    Scan[];
                    UNTIL tokenKind=tokenEOF OR IsChar[')] DO
                        params _ CONS [ParseExpr[], params];
                        IF IsChar[')] THEN EXIT;
                        IF NOT IsChar[',] THEN ERROR IncorrectExpression[expr, ", or ) expected"];
                        Scan[];
                        ENDLOOP;
                    tree _ Oper[variable, List.Reverse[params]];
                    };
                ENDCASE    => ERROR IncorrectExpression[expr, Rope.Cat["Incorrect token :", token]];
            Scan[];
            };
        ParseAnds: PROC RETURNS [tree: ParseTree] = {
            ands: ParseTrees _ LIST [ParseTerm[]];
            WHILE IsChar['*] DO Scan[]; ands _ CONS[ParseTerm[], ands] ENDLOOP;
        tree _ IF ands.rest=NIL THEN ands.first ELSE And[List.Reverse[ands]];
            };
        ParseExpr: PROC RETURNS [tree: ParseTree] = {
            ors: ParseTrees _ LIST [ParseAnds[]];
            WHILE IsChar['+] DO Scan[]; ors _ CONS[ParseAnds[], ors] ENDLOOP;
        tree _ IF ors.rest=NIL THEN ors.first ELSE Or[List.Reverse[ors]];
            };
    Scan[]; tree _ ParseExpr[];
    IF ISTYPE [tree, REF INT] THEN ERROR IncorrectExpression[expr, "Cannot be just an integer"];
        IF tokenKind#tokenEOF THEN ERROR IncorrectExpression[expr, "Too much left"];
        };

    UnParseExpression: PUBLIC PROC [tree: ParseTree] RETURNS [expr: ROPE _ NIL] = {
    WITH tree SELECT FROM
    var: Rope.ROPE            => expr _ var;
    refInt: REF INT            => expr _ IO.PutR1[IO.int[refInt^]];
    rptr: REF ParseOperRec    => IF Rope.Equal[rptr.oper, "~"] 
    THEN expr _ Rope.Cat["~", UnParseExpression[rptr.params.first]] 
    ELSE {
    char: BOOL = Rope.Equal[rptr.oper, "*"] OR Rope.Equal[rptr.oper, "+"];
    FOR params: ParseTrees _ rptr.params, params.rest WHILE params#NIL DO
    expr _ IF expr=NIL 
    THEN IF char THEN "(" ELSE Rope.Cat[rptr.oper, "("]
    ELSE IF char THEN Rope.Cat[expr, rptr.oper] ELSE Rope.Cat[expr, ", "];
    expr _ Rope.Cat[expr, UnParseExpression[params.first]];
    ENDLOOP;
    expr _ Rope.Cat[expr, ")"];
    };
    ENDCASE                    => ERROR;

        };

    RenameVariables: PUBLIC PROC [tree: ParseTree, var: PROC [ROPE] RETURNS [ROPE]] RETURNS [ParseTree] = {
        WITH tree SELECT FROM
        rope: ROPE                => RETURN [var[rope]];
        refInt: REF INT            => RETURN [refInt];
        rptr: REF ParseOperRec    => {
        news: ParseTrees _ NIL;
        FOR params: ParseTrees _ rptr.params, params.rest WHILE params#NIL DO
            news _ CONS [RenameVariables[params.first, var], news];
        ENDLOOP;
        RETURN [Oper[rptr.oper, List.Reverse[news]]];
        };
        ENDCASE                    => ERROR;
        };

    ParseOutput: PUBLIC PROC [wire: Core.Wire] RETURNS [tree: ParseTree] = {
    RETURN [ParseExpression[GetOutput[wire]]];
        };

<<Defining new Operators>>
    opers: SymTab.Ref _ SymTab.Create[];

    RegisterOperator: PUBLIC PROC [oper: ROPE, recast: RecastProc] = {
        [] _ SymTab.Store[opers, oper, NEW [RecastProc _ recast]];
        };

    FetchOperator: PUBLIC PROC [oper: ROPE] RETURNS [recast: RecastProc] = {
        refProc: REF RecastProc _ NARROW [SymTab.Fetch[opers, oper].val];
        recast _ IF refProc=NIL THEN NIL ELSE refProc^;
        };

    Recast: PUBLIC PROC [tree: ParseTree] RETURNS [ParseTree] = {
        rptr: REF ParseOperRec = NARROW [tree];
        RETURN [FetchOperator[rptr.oper][rptr.params]];
        };
<<Simulation of Combinatorial cells>>
<<Why isn't this one in Rosemary???>>
FindPort: PROC [rootWire: Core.WireSeq, rootPort: Ports.Port, searched: Core.Wire] RETURNS [found: Ports.Port _ NIL] = {
SearchWire: Ports.EachWirePortPairProc = {
found _ port; quit _ wire=searched;
};
IF NOT Ports.VisitBinding[rootWire, rootPort, SearchWire] THEN found _ NIL;
};

FindPorts: PROC [rootWire: Core.WireSeq, rootPort: Ports.Port, searched: Core.Wires] RETURNS [ports: LIST OF Ports.Port _ NIL] = {
    FOR wires: Core.Wires _ searched, wires.rest WHILE wires#NIL DO
    port: Ports.Port = FindPort[rootWire, rootPort, wires.first];
    IF port=NIL THEN ERROR;
    ports _ CONS [port, ports];
        ENDLOOP;
ports _ NARROW [GList.Reverse[ports]];
};

RosemaryState: TYPE = REF RosemaryStateRec;
RosemaryStateRec: TYPE = RECORD [
SEQUENCE size: NAT OF RECORD [port: Ports.Port, roseValue: RoseValue]
];

RoseValue: TYPE = REF; -- union of Ports.Port and NAndNode
NAndNode: TYPE = REF NAndNodeRec;
NAndNodeRec: TYPE = RECORD [nodes: SEQUENCE size: NAT OF RoseValue];

    RoseMakeNot: PROC [roseValue: RoseValue] RETURNS [RoseValue] = {
    notRoseValue: NAndNode;
    WITH roseValue SELECT FROM
        nand: NAndNode    => IF nand.size=1 THEN RETURN [nand[0]];
        ENDCASE        => {};
        notRoseValue _ NEW [NAndNodeRec[1]];
        notRoseValue[0] _ roseValue;
        RETURN [notRoseValue];
        };

    RoseMakeMaybeNot: PROC [roseValue: RoseValue, negate: BOOL _ FALSE] RETURNS [RoseValue] = {
        RETURN [IF negate THEN RoseMakeNot[roseValue] ELSE roseValue];
        };

    RoseMakeNand: PROC [roseValues: LIST OF RoseValue, negate: BOOL _ FALSE] RETURNS [RoseValue] = {
    count: NAT _ List.Length[roseValues];
        roseValue: NAndNode _ NEW [NAndNodeRec[count]];
        IF count=1 THEN RETURN [RoseMakeMaybeNot[roseValues.first, NOT negate]];
        FOR i: NAT IN [0 .. count) DO 
            roseValue[i] _ RoseMakeMaybeNot[roseValues.first, negate]; 
            roseValues _ roseValues.rest;
            ENDLOOP;
        RETURN [roseValue];
        };

RosemaryParses: PROC [params: ParseTrees, var: PROC [ROPE] RETURNS [RoseValue]] RETURNS [roseValues: LIST OF RoseValue _ NIL] = {
WHILE params#NIL DO 
roseValues _ CONS [RosemaryParse[params.first, var], roseValues];
params _ params.rest;
ENDLOOP;
};

RosemaryParse: PROC [tree: ParseTree, var: PROC [ROPE] RETURNS [RoseValue]] RETURNS [roseValue: RoseValue] = {
roseValue _ WITH tree SELECT FROM
rope: ROPE                => var[rope],
rptr: REF ParseOperRec    => SELECT TRUE FROM
Rope.Equal[rptr.oper, "~"]        => 
RoseMakeNot[RosemaryParse[rptr.params.first, var]],
Rope.Equal[rptr.oper, "*"]        => 
RoseMakeNot[RoseMakeNand[RosemaryParses[rptr.params, var]]],
Rope.Equal[rptr.oper, "+"]        => 
RoseMakeNand[RosemaryParses[rptr.params, var], TRUE],
ENDCASE                            => 
RosemaryParse[Recast[tree], var],
ENDCASE                    => ERROR;
};

    RoseEval: PROC [roseValue: RoseValue] RETURNS [level: Ports.Level _ L] = {
        <<note initialization to L important for the case when we have a nand!>>
        WITH roseValue SELECT FROM
            port: Ports.Port    => level _ port.l;
            nand: NAndNode    => FOR i: NAT IN [0 .. nand.size) DO
                SELECT RoseEval[nand[i]] FROM
                    L => RETURN [H];
                    H => {};
                    ENDCASE => level _ X;
                    ENDLOOP;
            ENDCASE        => ERROR;
        };

CombinatorialInit: Rosemary.InitProc = {
    RoseVar: PROC [var: ROPE] RETURNS [roseValue: RoseValue] = {
        roseValue _ FindPort[cellType.public, p, CoreOps.FindWire[cellType.public, var]];
        IF roseValue=NIL THEN ERROR;
        };
outputs: Core.Wires _ GetTypedWires[cellType, output];
count: NAT _ GList.Length[outputs];
    state: RosemaryState _ NEW [RosemaryStateRec[count]];
    FOR i: NAT IN [0 .. count) DO
        state[i].port _ FindPort[cellType.public, p, outputs.first];
        state[i].roseValue _ RosemaryParse[ParseOutput[outputs.first], RoseVar];
        outputs _ outputs.rest;
        ENDLOOP;
stateAny _ state;
};

CombinatorialEval: Rosemary.EvalProc = {
state: RosemaryState = NARROW [stateAny];
    FOR i: NAT IN [0 .. state.size) DO state[i].port.l _ RoseEval[state[i].roseValue] ENDLOOP;
};

    CheckUnsuccessful: PUBLIC SIGNAL [level1, level2: Ports.Level] = CODE;

    BindCombinatorial: PUBLIC PROC [cc: Core.CellType] = {
        BlastPortData: CoreOps.EachWireProc = {CoreProperties.PutWireProp[wire, $PortData, NIL]};
        Each: PROC [wire: Core.Wire, name: ROPE, type: WireType] RETURNS [quit: BOOL _ FALSE] = {
            SELECT type FROM
                input    => {
                    [] _ Ports.InitPort[wire: wire, levelType: l, initDrive: none];
                    Ports.InitTesterDrive[wire: wire, initDrive: force];
                    };
                output    => {
                    [] _ Ports.InitPort[wire: wire, levelType: l, initDrive: drive];
                    Ports.InitTesterDrive[wire: wire, initDrive: expect];
                    };
                gnd    => {
                    [] _ Ports.InitPort[wire: wire, levelType: l, initDrive: none];
                    [] _ Rosemary.SetFixedWire[wire, L];
                    };
                vdd    => {
                    [] _ Ports.InitPort[wire: wire, levelType: l, initDrive: none];
                    [] _ Rosemary.SetFixedWire[wire, H];
                    };
                ENDCASE    => ERROR;
            };
        <<Hack to get rid of properties added by Logic!>>
        [] _ CoreOps.VisitWireSeq[cc.public, BlastPortData];
        [] _ EnumerateTypedWires[cc, Each];
        [] _ Rosemary.BindCellType[cellType: cc, roseClassName: "Combinatorial"];
        [] _ CoreFlat.CellTypeCutLabels[cc, "LogicMacro", "Logic"];
        };

    CheckTransistorsAgainstExpressions: PUBLIC PROC [cc: Core.CellType, checkXValues: BOOL _ TRUE] = {
        TryAll: PROC [inputsToFix: Core.Wires] = {
            Process.Yield[];
            IF inputsToFix=NIL THEN {
                Rosemary.Settle[simulation1]; 
                Rosemary.Settle[simulation2]; 
                FOR outs: Core.Wires _ outputs, outs.rest WHILE outs#NIL DO
                p1: Ports.Port = FindPort[cc.public, port1, outs.first];
                p2: Ports.Port = FindPort[cc.public, port2, outs.first];
                    IF p1.l#p2.l THEN SIGNAL CheckUnsuccessful[p1.l, p2.l];
                    ENDLOOP;
                } ELSE FOR level: Ports.Level IN Ports.Level DO
                p1: Ports.Port = FindPort[cc.public, port1, inputsToFix.first];
                p2: Ports.Port = FindPort[cc.public, port2, inputsToFix.first];
                    IF level=X AND NOT checkXValues THEN LOOP;
                    p1.l _ level; p2.l _ level;
                    TryAll[inputsToFix.rest];
                    ENDLOOP;
            };
        inputs: Core.Wires = GetTypedWires[cc, input];
        outputs: Core.Wires = GetTypedWires[cc, output];
        port1: Ports.Port = Ports.CreatePort[cc, TRUE];
        port2: Ports.Port = Ports.CreatePort[cc, TRUE];
        <<We create two simulations>>
        simulation1: Rosemary.Simulation _ Rosemary.Instantiate[cc, port1];
        simulation2: Rosemary.Simulation _ Rosemary.Instantiate[cc, port2, CoreFlat.CreateCutSet[flatCells: LIST [NEW 
        [CoreFlat.FlatCellTypeRec _ CoreFlat.rootCellType]]]];
        <<We initialize both>>
        Rosemary.Initialize[simulation1];
        Rosemary.Initialize[simulation2];
        <<For each input, we loop>>
        TryAll[inputs];
        };
<<Statically Making Combinatorial Cells>>
    InputOutputWarning: PROC [type: ATOM, root: Core.CellType, flatWire: CoreFlat.FlatWire] = {
        TerminalIO.PutF["*** %g in cell %g with %g.\n", IO.atom[type], IO.rope[CoreOps.GetCellTypeName[root]], 
        IO.rope[CoreFlat.WirePathRope[root, flatWire^]]];
        SIGNAL InputOutputProblem[type, root, flatWire];
        };

    InputOutputProblem: PUBLIC SIGNAL [type: ATOM, root: Core.CellType, flatWire: CoreFlat.FlatWire] = CODE;

    TranslateOutputs: PROC [root, actual, public: Core.WireSeq, eachOutput: PROC [act: Core.Wire, tree: ParseTree]] = {
        table: RefTab.Ref _ CoreOps.CreateBindingTable[public, actual];
        RenameVar: PROC [old: ROPE] RETURNS [new: ROPE] = {
            pub: Core.Wire _ CoreOps.FindWire[public, old];
            act: Core.Wire = NARROW [RefTab.Fetch[table, pub].val];
            RETURN [CoreOps.GetFullWireName[root, act]];
            };
        EachWirePair: CoreOps.EachWirePairProc = {
            IF GetOutput[publicWire]=NIL THEN RETURN;
            eachOutput[actualWire, RenameVariables[ParseOutput[publicWire], RenameVar]];
            };
        [] _ CoreOps.VisitBindingSeq[actual, public, EachWirePair];
        };

    MakeCombinatorial: PUBLIC PROC [cell: Core.CellType] = {
        signalled: Core.Wires _ NIL;
        Process.Yield[];
        IF IsCombinatorial[cell] THEN RETURN;
        IF IsNonCombinatorial[cell] THEN ERROR NotCombinatorial[cell];
        SELECT cell.class FROM
            CoreClasses.transistorCellClass    => ERROR NotCombinatorial[cell];
            CoreClasses.unspecifiedCellClass    => ERROR NotCombinatorial[cell];
            CoreClasses.recordCellClass    => {
                table: RefTab.Ref _ RefTab.Create[]; -- maps internal wires to their ParseTree, expressed with variables as part of the internal
                rct: CoreClasses.RecordCellType = NARROW [cell.data];
                count: INT _ 0;
                ReplaceVars: PROC [tree: ParseTree, forbidden: Core.Wires] RETURNS [ParseTree] = {
                    WITH tree SELECT FROM
                    rope: ROPE                => {
                    wire: Core.Wire _ CoreOps.FindWire[rct.internal, rope];
                    aux: ParseTree = RefTab.Fetch[table, wire].val;
                    IF wire=NIL THEN ERROR;
                    IF aux=NIL THEN {
                    <<it must be an input!>>
                    inputName: ROPE = CoreOps.GetFullWireName[cell.public, wire];
                    IF inputName=NIL THEN {
                    IF NOT CoreOps.Member[signalled, wire] THEN {
                    InputOutputWarning[$NonPublicInput, cell, NEW [CoreFlat.FlatWireRec _ [wire: wire]]]; 
                    signalled _ CONS [wire, signalled];
                    };
                    };
                    RETURN [inputName]; 
                    };
                    IF CoreOps.Member[forbidden, wire] THEN {
                    IF NOT CoreOps.Member[signalled, wire] THEN {
                    InputOutputWarning[$OutputLoop, cell, NEW [CoreFlat.FlatWireRec _ [wire: wire]]]; -- Loop!
                    signalled _ CONS [wire, signalled];
                    };
                    RETURN [rope];
                    };
                    RETURN [ReplaceVars[aux, CONS [wire, forbidden]]];
                    };
                    refInt: REF INT            => RETURN [refInt];
                    rptr: REF ParseOperRec    => {
                    news: ParseTrees _ NIL;
                    FOR params: ParseTrees _ rptr.params, params.rest WHILE params#NIL DO
                        news _ CONS [ReplaceVars[params.first, forbidden], news];
                    ENDLOOP;
                    RETURN [Oper[rptr.oper, List.Reverse[news]]];
                    };
                    ENDCASE                    => ERROR;
                    };
                EachOutput: PROC [act: Core.Wire, tree: ParseTree] = {
                prev: ParseTree = RefTab.Fetch[table, act].val;
                IF prev#NIL THEN {
                IF NOT CoreOps.Member[signalled, act] THEN {
                InputOutputWarning[$OutputOfTwoCombinatorialCells, cell, NEW [CoreFlat.FlatWireRec _ [wire: act]]];
                signalled _ CONS [act, signalled];
                };
                };
                [] _ RefTab.Store[table, act, tree];
                    };
                SetOutput: CoreOps.EachWireProc = {
                tree: ParseTree = RefTab.Fetch[table, wire].val;
                IF tree=NIL THEN RETURN; -- Not an output, proceed!
                    PutOutput[wire, UnParseExpression[ReplaceVars[tree, LIST [wire]]]];
                    count _ count + 1;
                    };
                FOR i: NAT IN [0 .. rct.size) DO
                    MakeCombinatorial[rct[i].type];
                    TranslateOutputs[rct.internal, rct[i].actual, rct[i].type.public, EachOutput];
                    ENDLOOP;
                IF signalled#NIL THEN ERROR NotCombinatorial[cell];
                [] _ CoreOps.VisitWireSeq[cell.public, SetOutput];
                IF count=0 THEN TerminalIO.PutF["*** Cell %g made combinatorial, but has no output.\n", IO.rope[CoreOps.GetCellTypeName[cell]]];
                CoreProperties.PutCellTypeProp[cell, $Combinatorial, NEW [BOOL _ TRUE]];
            BindCombinatorial[cell];
            TerminalIO.PutF["Cell %g made combinatorial.  %g outputs.\n", IO.rope[CoreOps.GetCellTypeName[cell]], IO.int[count]];
                };
            ENDCASE            => {
                count: INT _ 0;
                EachOutput: PROC [act: Core.Wire, tree: ParseTree] = {
                    PutOutput[act, UnParseExpression[tree]];
                    count _ count + 1;
                    };
                recasted: Core.CellType _ CoreOps.Recast[cell]; 
                MakeCombinatorial[recasted];
                TranslateOutputs[cell.public, cell.public, recasted.public, EachOutput];
                IF count=0 THEN TerminalIO.PutF["*** Cell %g made combinatorial, but has no output.\n", IO.rope[CoreOps.GetCellTypeName[cell]]];
                CoreProperties.PutCellTypeProp[cell, $Combinatorial, NEW [BOOL _ TRUE]];
            BindCombinatorial[cell];
            TerminalIO.PutF["Cell %g made combinatorial.  %g outputs.\n", IO.rope[CoreOps.GetCellTypeName[cell]], IO.int[count]];
                };
        };

    AttemptMakeCombinatorial: PUBLIC PROC [cell: Core.CellType] RETURNS [trans, ok, notOK: INT _ 0] = {
        Each: CoreFlat.UnboundFlatCellProc = {
            IF IsCombinatorial[cell] OR IsNonCombinatorial[cell] THEN RETURN;
            SELECT cell.class FROM
                CoreClasses.transistorCellClass    => trans _ trans + 1;
                ENDCASE            => {
                CoreFlat.NextUnboundCellType[cell: cell, target: target, flatCell: flatCell, instance: instance, index: index, parent: parent, 
                flatParent: flatParent, data: data, proc: Each ! ANY => GOTO GRRR];
                MakeCombinatorial[cell ! NotCombinatorial, InputOutputProblem => GOTO GRRR];
                    ok _ ok + 1;
                    EXITS GRRR    => {notOK _ notOK + 1; CoreProperties.PutCellTypeProp[cell, $Combinatorial, NEW [BOOL _ FALSE]]};
                    };
            };
        Each[cell];
        };
<<Splitting Combinatorial Cells>>
    SearchRefTab: PROC [x: RefTab.Ref, val: RefTab.Val] RETURNS [found: BOOL, key: RefTab.Key _ NIL] = {
        fval: RefTab.Val _ val;
        fkey: RefTab.Key _ NIL;
        EachPair: RefTab.EachPairAction = {fkey _ key; quit _ val=fval};
        found _ RefTab.Pairs[x, EachPair];
        key _ fkey;
        };

    InternalIsCombinatorial: PROC [cell: Core.CellType] RETURNS [BOOL] = {
        MakeCombinatorial[cell ! NotCombinatorial, InputOutputProblem => GOTO GRRR];
        RETURN [TRUE];
        EXITS GRRR    => {CoreProperties.PutCellTypeProp[cell, $Combinatorial, NEW [BOOL _ FALSE]]; RETURN [FALSE]};
        };

    ConsIfNotMember: PROC [wire: Core.Wire, wires: Core.Wires] RETURNS [Core.Wires] = {
        FOR list: Core.Wires _ wires, list.rest WHILE list#NIL DO
            IF list.first=wire OR CoreOps.RecursiveMember[list.first, wire] THEN RETURN [wires];
            ENDLOOP;
        RETURN [CONS [wire, wires]];
        };

    WireUse: TYPE = {PublicUse, CombUse, NonCombUse};
    WireUses: TYPE = ARRAY WireUse OF BOOL _ ALL [FALSE];

AddIntType: PROC [intType: RefTab.Ref, int: Core.Wire, type: WireUse] = {
wireUses: REF WireUses _ NARROW [RefTab.Fetch[intType, int].val];
IF wireUses=NIL THEN wireUses _ NEW [WireUses];
wireUses[type] _ TRUE;
[] _ RefTab.Store[intType, int, wireUses];
FOR i: NAT IN [0 .. int.size) DO AddIntType[intType, int[i], type] ENDLOOP;
};

    MakeNewSeq: PROC [old: Core.WireSeq, oldToNew: RefTab.Ref] RETURNS [new: Core.WireSeq] = {
        new _ CoreOps.CreateWires[size: old.size];
        FOR j: NAT IN [0 .. new.size) DO 
            new[j] _ CoreOps.CopyWireUsingTable[old[j], oldToNew];
            ENDLOOP;
        };

    SplitCombinatorial: PUBLIC PROC [record: Core.CellType] RETURNS [split: Core.CellType _ NIL] = {
        rct: CoreClasses.RecordCellType = NARROW [record.data];
    intTable: RefTab.Ref = RefTab.Create[]; -- maps internals of record to internals of split
        public: Core.WireSeq = MakeNewSeq[record.public, intTable];
    intType: RefTab.Ref = RefTab.Create[]; -- maps internals of split to WireUses
    combs: LIST OF CoreClasses.CellInstance _ NIL; -- new combinatorial instances
    nonCombs: LIST OF CoreClasses.CellInstance _ NIL; -- new non-combinatorial instances
        combInt, combPub, combAct: Core.Wires _ NIL;
        combCT: Core.CellType;
        combInstance: CoreClasses.CellInstance;
        combNewInt: RefTab.Ref = RefTab.Create[]; -- maps internals of split to internals of combCT
        internals: Core.Wires _ NIL;
    CreateNew: PROC [int: Core.Wire] RETURNS [new: Core.Wire] = {
        new _ NARROW [RefTab.Fetch[combNewInt, int].val];
        IF new#NIL THEN RETURN;
        new _ CoreOps.CreateWires[int.size];
        [] _ RefTab.Store[combNewInt, int, new];
        FOR i: NAT IN [0 .. int.size) DO new[i] _ CreateNew[int[i]] ENDLOOP;
        };
    EachIntTypeCreateNew: RefTab.EachPairAction = {
    wireUses: REF WireUses = NARROW [val];
    IF wireUses[CombUse] THEN [] _ CreateNew[NARROW [key]];
    };
    EachIntType: RefTab.EachPairAction = {
    int: Core.Wire = NARROW [key];
    wireUses: REF WireUses = NARROW [val];
    IF wireUses[CombUse] 
    THEN {
        new: Core.Wire _ NARROW [RefTab.Fetch[combNewInt, int].val];
        combInt _ ConsIfNotMember[new, combInt];
    IF NOT wireUses[NonCombUse] AND NOT wireUses[PublicUse] THEN RETURN;
    internals _ ConsIfNotMember[int, internals];
        combInt _ ConsIfNotMember[new, combInt];
        IF NOT CoreOps.Member[combPub, new] THEN {
            combAct _ CONS [int, combAct]; 
            combPub _ CONS [new, combPub]; 
            };
    }
    ELSE internals _ ConsIfNotMember[int, internals]; 
    };
        FOR i: NAT IN [0 .. rct.size) DO
            ct: Core.CellType = rct[i].type;
            actual: Core.WireSeq = MakeNewSeq[rct[i].actual, intTable];
            instance: CoreClasses.CellInstance = CoreClasses.CreateInstance[actual, ct];
            IF InternalIsCombinatorial[ct] 
                THEN combs _ CONS [instance, combs]
                ELSE nonCombs _ CONS [instance, nonCombs];
            ENDLOOP;
    FOR i: NAT IN [0 .. public.size) DO AddIntType[intType, public[i], PublicUse] ENDLOOP;
        FOR list: LIST OF CoreClasses.CellInstance _ combs, list.rest WHILE list#NIL DO
        FOR i: NAT IN [0 .. list.first.actual.size) DO AddIntType[intType, list.first.actual[i], CombUse] ENDLOOP;
            ENDLOOP;
        FOR list: LIST OF CoreClasses.CellInstance _ nonCombs, list.rest WHILE list#NIL DO
        FOR i: NAT IN [0 .. list.first.actual.size) DO AddIntType[intType, list.first.actual[i], NonCombUse] ENDLOOP;
            ENDLOOP;
    [] _ RefTab.Pairs[intType, EachIntTypeCreateNew];
    [] _ RefTab.Pairs[intType, EachIntType];
        FOR list: LIST OF CoreClasses.CellInstance _ combs, list.rest WHILE list#NIL DO
        actual: Core.WireSeq _ CoreOps.CreateWires[list.first.actual.size];
        FOR i: NAT IN [0 .. actual.size) DO
        actual[i] _ NARROW [RefTab.Fetch[combNewInt, list.first.actual[i]].val];
        IF actual[i]=NIL THEN ERROR;
        ENDLOOP;
            list.first.actual _ actual;
            ENDLOOP;
    combCT _ CoreClasses.CreateRecordCell[
    public: CoreOps.CreateWire[combPub], internal: CoreOps.CreateWire[combInt], 
    instances: combs, giveNames: TRUE
    ];
    MakeCombinatorial[combCT ! InputOutputProblem    => {
    wire: Core.Wire _ flatWire.wire;
    newInt: Core.Wire _ NARROW [SearchRefTab[combNewInt, wire].key];
    oldInt: Core.Wire _ NARROW [SearchRefTab[intTable, newInt].key];
    IF root#combCT OR oldInt=NIL THEN ERROR;
    InputOutputWarning[type, record, NEW [CoreFlat.FlatWireRec _ [wire: oldInt]]];
    RESUME;
    }];
    combInstance _ CoreClasses.CreateInstance[actual: CoreOps.CreateWire[combAct], type: combCT];
    split _ CoreClasses.CreateRecordCell[
    public: public, 
    internal: CoreOps.CreateWire[internals], 
    instances: CONS [combInstance, nonCombs],
    giveNames: TRUE
    ];
        TerminalIO.PutF[
            "Splitting done for %g: combinatorial cell with %g outputs and %g non combinatorial cells.\n", 
            IO.rope[CoreOps.GetCellTypeName[record]], 
            IO.int[GList.Length[GetTypedWires[combCT, output]]], 
            IO.int[GList.Length[nonCombs]]
            ];
        };
<<Initialization>>
    Xor2Recast: RecastProc = {
        p1: REF = params.first;
        p2: REF = params.rest.first;
        tree _ Or2[And2[p1, Not[p2]], And2[p2, Not[p1]]];
        };

    [] _ Rosemary.Register["Combinatorial", CombinatorialInit, CombinatorialEval];
    RegisterOperator["xor2", Xor2Recast];

    END.