<> <> <> <> <<>> <> <<>> DIRECTORY BitOps, CDEnvironment, CDMenus, CDSequencer, Core, CoreClasses, CoreCreate, CoreFlat, CoreOps, CoreProperties, FileNames, FileViewerOps, FS, HashTable, IO, Logic, LogicUtils, Ports, Rope, RopeList, Rosemary, RosemaryUser, SinixOps, Sisyph, Static; LogicRosemaryImpl: CEDAR PROGRAM IMPORTS BitOps, CDEnvironment, CDMenus, CoreClasses, CoreCreate, CoreFlat, CoreOps, CoreProperties, FileNames, FileViewerOps, FS, HashTable, IO, Logic, LogicUtils, Ports, Rope, RopeList, Rosemary, RosemaryUser, SinixOps, Sisyph, Static EXPORTS LogicUtils, Logic = BEGIN OPEN LogicUtils, CoreCreate; <> <<-- oracle name -> file name; default is oracle name=file name>> oracleBindings: HashTable.Table _ HashTable.Create[equal: HashTable.RopeEqual, hash: HashTable.HashRope]; <<-- called from the interpreter by a user to bind a new file to an oracle>> SetOracleFileName: PUBLIC PROC [id, fileName: ROPE] ~ { [] _ HashTable.Store[oracleBindings, id, fileName]; }; <<-- called from the interpreter by a user to find out which file is bound to an oracle>> GetOracleFileName: PUBLIC PROC [id: ROPE] RETURNS [fileName: ROPE]~ { ref: REF _ HashTable.Fetch[oracleBindings, id].value; RETURN[IF ref=NIL THEN id ELSE NARROW[ref]]; }; <<-- syntax accepted: in _ " 0 2 32 (0 2) 1 (2 4 (3 3))">> <<-- 0 means atomic wire>> <<-- 8 means a byte, ...>> <<-- (w1 w2 w3) means a composite wire made of ...>> WireFromRope: PROC [descr, name: ROPE, driveLevel: Ports.Drive] RETURNS [wire: Wire] = { s: IO.STREAM = IO.RIS[IO.PutFR["(%s)", IO.rope[descr]]]; ref: REF ANY = IO.GetRefAny[s]; IO.Close[s]; wire _ WireFromRef[ref, driveLevel]; IF name#NIL THEN wire _ CoreOps.SetShortWireName[wire, name]; }; WireFromRef: PROC [ref: REF, driveLevel: Ports.Drive] RETURNS [wire: Wire] = { WireListFromRefList: PROC [lora: LIST OF REF ANY] RETURNS [wl: LIST OF WR] = { wl _ IF lora=NIL THEN NIL ELSE CONS[WireFromRef[lora.first, driveLevel], WireListFromRefList[lora.rest]]; }; WITH ref SELECT FROM refSize: REF INT => { size: INT = refSize^; wire _ CoreCreate.Seq[size: size]; IF size=0 THEN [] _ Ports.InitPort[wire, l, , driveLevel] ELSE [] _ Ports.InitPort[wire, ls, , driveLevel]; CoreProperties.PutWireProp[wire, oracleValueProp, $Busy]; <<-- I tag the wires which will receive sequences of values>> }; lora: LIST OF REF ANY => wire _ CoreCreate.WireList[wrs: WireListFromRefList[lora]]; -- no l or ls ENDCASE => ERROR; }; OracleName: IO.ROPE = Rosemary.Register[roseClassName: "Oracle", init: OracleInit, evalSimple: OracleSimple]; Oracle: PUBLIC PROC [in, out, name: ROPE] RETURNS [ct: CellType] = { inWire, outWire: Wire; IF out=NIL OR in=NIL OR name=NIL THEN Error["Missing parameter on oracle"]; inWire _ WireFromRope[in, "In", none]; -- also sets the ports outWire _ WireFromRope[out, "Out", force]; -- also sets the ports ct _ CoreClasses.CreateUnspecified[name: OracleName, public: Wires["CK", inWire, outWire]]; CoreProperties.PutCellTypeProp[ct, $oracle, name]; [] _ Rosemary.BindCellType[cellType: ct, roseClassName: OracleName]; [] _ CoreFlat.CellTypeCutLabels[ct, Logic.logicCutSet]; Ports.InitPorts[ct, l, none, "CK"]; }; OracleState: TYPE = REF OracleStateRec; OracleStateRec: TYPE = RECORD [ clk, in, out: NAT _ LAST[NAT], inWire, outWire: Wire, prevClk: Ports.Level _ L, oracleName: ROPE _ NIL, -- entry in `oracleBindings' table maxNbCycle: INT _ 0, stopAfterOneRun: BOOL _ FALSE, cycle: INT _ 0 ]; OracleInit: Rosemary.InitProc = { state: OracleState = NEW[OracleStateRec]; clk, in, out: NAT _ LAST[NAT]; id: ROPE _ NARROW[CoreProperties.GetCellTypeProp[cellType, $oracle]]; path: LIST OF ROPE = LIST [CDEnvironment.GetWorkingDirectory[]]; state.oracleName _ FileNames.FileWithSearchRules[root: GetOracleFileName[id], defaultExtension: "oracle", requireExtension: FALSE, requireExact: FALSE, searchRules: path].fullPath; [state.clk, state.in, state.out] _ Ports.PortIndexes[cellType.public, "CK", "In", "Out"]; state.inWire _ cellType.public[state.in]; state.outWire _ cellType.public[state.out]; [state.stopAfterOneRun, state.maxNbCycle] _ ParseFileAndDecorateWires[state.oracleName, state.inWire, state.outWire]; stateAny _ state; }; <<-- Wrong value during the simulation>> Disagreement: SIGNAL [shouldBe, is: Ports.Level] = CODE; Mismatch: PROC [oracleName: ROPE, shouldBe, is: Ports.Level, index: NAT] ~ { PointAt[oracleName, index]; Disagreement[shouldBe, is]; }; OracleSimple: Rosemary.EvalProc = { <<-- bit-wise comparison; if L or H, check; if X, ignore>> Compare: PROC [wire: Wire, cycle: NAT, p: Ports.Port] ~ { CompareLevel: PROC [shouldBe, is: Ports.Level, index: NAT] ~ { IF shouldBe#X AND shouldBe#is THEN Mismatch[state.oracleName, shouldBe, is, index]; }; CompareLS: PROC [shouldBe, is: Ports.LevelSequence, index: NAT] ~ { FOR i: NAT IN [0..shouldBe.size) DO CompareLevel[shouldBe[i], is[i], index] ENDLOOP; }; ref: REF _ CoreProperties.GetWireProp[wire, oracleValueProp]; IF ref=NIL THEN FOR i: NAT IN [0..wire.size) DO Compare[wire[i], cycle, p[i]] ENDLOOP ELSE { values: Values _ NARROW[ref]; IF wire.size=0 THEN CompareLevel[values[cycle].ls[0], p.l, values[cycle].filePosition] ELSE CompareLS[values[cycle].ls, p.ls, values[cycle].filePosition]; }; }; <<-- if L or H, drive; if X, tristate (drive_none)>> SetPort: PROC [wire: Wire, cycle: NAT, p: Ports.Port] ~ { ref: REF _ CoreProperties.GetWireProp[wire, oracleValueProp]; IF ref=NIL THEN FOR i: NAT IN [0..wire.size) DO SetPort[wire[i], cycle, p[i]] ENDLOOP ELSE { values: Values _ NARROW[ref]; IF wire.size=0 THEN { -- special case for atomic p.l _ values[cycle].ls[0]; p.d _ IF p.l=X THEN none ELSE drive; } ELSE { Ports.CopyLS[from: values[cycle].ls, to: p.ls]; FOR i: NAT IN [0..p.ls.size) DO p.ds[i] _ IF p.ls[i]=X THEN none ELSE drive; ENDLOOP; }; }; }; state: OracleState _ NARROW[stateAny]; curClk: Ports.Level = p[state.clk].l; IF state.prevClk=L AND curClk=H THEN { -- up-transition: send outputs <<-- put values on "out" ports for cycle n+1>> FOR i: NAT IN [0..state.outWire.size) DO SetPort[state.outWire[i], state.cycle, p[state.out][i]]; ENDLOOP; }; IF state.prevClk=H AND curClk=L THEN { -- down-transition: check inputs <<-- compare values on "in" ports for cycle n>> FOR i: NAT IN [0..state.inWire.size) DO Compare[state.inWire[i], state.cycle, p[state.in][i]]; ENDLOOP; IF state.cycle=state.maxNbCycle-1 AND state.stopAfterOneRun THEN Rosemary.Stop[msg: "Oracle completed successfully"]; state.cycle _ (state.cycle+1) MOD state.maxNbCycle; }; IF curClk#X THEN state.prevClk _ curClk; }; PointAt: PROC [oracleName: ROPE, index: NAT] = { FileViewerOps.OpenSource[fileName: oracleName, index: index, chars: 1]; }; Bug: ERROR [msg: ROPE] = CODE; CrashAndPointTo: PROC [oracleName, msg: ROPE, index: NAT] = { PointAt[oracleName, index]; Bug[msg]; }; oracleValueProp: ATOM = $OracleValueProp; -- of type Values Values: TYPE = REF ValuesRec; ValuesRec: TYPE = RECORD[seq: SEQUENCE size: NAT OF Value]; <> Value: TYPE = REF ValueRec; ValueRec: TYPE = RECORD[ ls: Ports.LevelSequence _ NIL, -- if atomic wire, use ls[0] filePosition: NAT _ 0 ]; <<-- Parses the file and decorates every sub-wire of "In" and "Out" with the values>> <<-- Values are coded in hex, but digits are extended to accomodate X>> <<-- Hex digits are 0, 1, 2, ..., 9, A, B, C, D, E , F, X, or (b b b b) with b=0, 1, or X>> <<-- Examples of values: 37, FFEA7B, 7AXX2, 2BAD, XXXX>> <<-- If not enough digits are specified, the value is right-justified and the msb are zero-extended>> <<-- Atomic wires are restricted to 0, 1, X>> <<-- Parser always absorbs any white space before the token>> ParseFileAndDecorateWires: PROC [oracleName: ROPE, in, out: Wire] RETURNS [stopAfterOneRun: BOOL _ FALSE, numberOfCycles: NAT _ 0] ~ { <<-- skip white space, then get a char and check it >> Absorb: PROC [source: IO.STREAM, c: CHAR, msg: ROPE] ~ { [] _ IO.SkipWhitespace[source]; IF IO.GetChar[source] # c THEN CrashAndPointTo[oracleName, msg, IO.GetIndex[source]-1]; }; <<-- a hack to get the number of vectors>> CountBars: PROC [source: IO.STREAM] RETURNS [length: NAT _ 0] ~ { DO IF IO.GetChar[source ! IO.EndOfStream => GOTO Done] = '| THEN length _ length+1; REPEAT Done => NULL; ENDLOOP; }; GetLevel: PROC [] RETURNS [level: Ports.Level] ~ { SELECT IO.GetChar[source] FROM '0 => level _ L; '1 => level _ H; 'X, 'x => level _ X; ENDCASE => CrashAndPointTo[oracleName, "Not a valid level", IO.GetIndex[source]-1]; }; GetHexDigit: PROC [] RETURNS [h: Ports.LevelSequence] ~ { h _ NEW[Ports.LevelSequenceRec[4]]; SELECT IO.PeekChar[source] FROM '( => { [] _ IO.GetChar[source]; -- absorb the '( h[0] _ GetLevel[]; h[1] _ GetLevel[]; h[2] _ GetLevel[]; h[3] _ GetLevel[]; Absorb[source, '), "Missing )"]; }; ENDCASE => { c: CHAR; SELECT c _ IO.GetChar[source] FROM IN ['0 .. '9] => Ports.LCToLS[ORD[c]-ORD['0], h]; IN ['A .. 'F] => Ports.LCToLS[ORD[c]-ORD['A]+10, h]; 'X => Ports.SetLS[h, X]; ENDCASE => CrashAndPointTo[oracleName, "not a hex digit", IO.GetIndex[source]]; }; }; IsTerminator: PROC [c: CHAR] RETURNS [BOOL] ~ { RETURN [c IN [IO.NUL .. IO.SP] OR c='|]}; GetToken: PROC [nbBits: NAT] RETURNS [ls: Ports.LevelSequence]= { digitIndex: NAT _ 100; -- we can extend on the left with 100 zeros lsSize: NAT _ MAX[nbBits, 1]; -- atomic => 0, but represented as ls ls _ NEW[Ports.LevelSequenceRec[lsSize]]; [] _ IO.SkipWhitespace[source]; IF IsTerminator[IO.PeekChar[source]] THEN CrashAndPointTo[oracleName, "not a value", IO.GetIndex[source]]; WHILE NOT IsTerminator[IO.PeekChar[source]] DO h: Ports.LevelSequence _ GetHexDigit[]; FOR i: NAT IN [0..4) DO bigValue[digitIndex+i] _ h[i]; ENDLOOP; digitIndex _ digitIndex+4; ENDLOOP; <<-- parsed value is now left-justified in bigValue>> FOR i: NAT IN [0..lsSize) DO ls[i] _ bigValue[digitIndex-lsSize+i]; ENDLOOP; Ports.SetLS[bigValue, L]; -- clean-up }; <<-- We know at this point how many tokens to find on a line>> ParseOneLine: PROC [cycle: NAT] ~ { values: Values; val: Value; PutValuesOnLeavesLtoR: PROC [wire: Wire, level: NAT] ~ { ref: REF _ CoreProperties.GetWireProp[wire, oracleValueProp]; IF ref#NIL THEN { values _ NARROW[ref]; val _ NEW[ValueRec _ [ ls: GetToken[nbBits: wire.size], filePosition: IO.GetIndex[source]-1]]; values[cycle] _ val; } ELSE { IF level>0 THEN Absorb[source, '(, "Missing ("]; -- get the "(" FOR i: NAT IN [0..wire.size) DO PutValuesOnLeavesLtoR[wire[i], level+1] ENDLOOP; IF level>0 THEN Absorb[source, '), "Missing )"]; -- get the ")" }; }; PutValuesOnLeavesLtoR[out, 0]; -- read left side (stimuli) Absorb[source, '|, "Missing |"]; PutValuesOnLeavesLtoR[in, 0]; -- read right side (correct answers) }; InitValueSequences: PROC [wire: Wire, nb: NAT] ~ { IF CoreProperties.GetWireProp[wire, oracleValueProp]#NIL THEN CoreProperties.PutWireProp[wire, oracleValueProp, NEW[ValuesRec[nb]]] ELSE FOR i: NAT IN [0..wire.size) DO InitValueSequences[wire[i], nb] ENDLOOP; }; <<-- Get the file and find the number of vectors>> source: IO.STREAM _ FS.StreamOpen[oracleName]; bigValue: Ports.LevelSequence _ NEW[Ports.LevelSequenceRec[300]]; -- for parser numberOfCycles _ CountBars[source]; Ports.SetLS[bigValue, L]; IO.SetIndex[source, 0]; -- return to beginning of test <<-- Initialize values on In and Out wires>> InitValueSequences[in, numberOfCycles]; InitValueSequences[out, numberOfCycles]; <<-- Parse the file>> FOR cycle: NAT IN [0..numberOfCycles) DO ParseOneLine[cycle] ENDLOOP; [] _ IO.SkipWhitespace[source]; SELECT TRUE FROM IO.EndOf[source] => stopAfterOneRun _ FALSE; IO.PeekChar[source]='. => stopAfterOneRun _ TRUE; ENDCASE => CrashAndPointTo[oracleName, "What is this???", IO.GetIndex[source]]; }; <> <> <<- val: a rope of 0's, 1's and X's specifying the sequence of levels to be affected to the output port>> <<- freq: the requency of change (default is 2, the default period of the clock generator)>> <<- firstEdge: the instant in time of the first transition (default is 1, as for the clock generator)>> <> <<>> Wave: TYPE ~ REF WaveRec; WaveRec: TYPE ~ RECORD [index: NAT _ 0, ls: Ports.LevelSequence _ NIL]; WaveFormName: ROPE = Rosemary.Register[roseClassName: "WaveForm", init: WaveFormInit, evalSimple: WaveFormSimple]; WaveForm: PUBLIC PROC [val: ROPE, freq: NAT, firstEdge: INT] RETURNS [ct: CellType] ~ { Analyze: Rope.ActionType ~ { SELECT c FROM '0, 'L => ls[index] _ L; '1, 'H => ls[index] _ H; 'X, 'x => ls[index] _ X; ENDCASE => quit _ TRUE; IF quit THEN RETURN; index _ index+1; }; wave: Wave _ NEW[WaveRec]; index: NAT _ 0; ls: Ports.LevelSequence _ NEW[Ports.LevelSequenceRec[Rope.Length[val]]]; IF Rope.Length[val]=0 THEN LogicUtils.Error["The waveform value is missing"]; IF Rope.Map[base: val, action: Analyze] THEN LogicUtils.Error["The waveform value contains illegal characters"]; ct _ CoreClasses.CreateUnspecified[ name: WaveFormName, public: CoreCreate.Wires["RosemaryLogicTime", "Out"]]; CoreProperties.PutCellTypeProp[ct, $ls, ls]; CoreProperties.PutCellTypeProp[ct, $freq, NEW[NAT _ freq]]; CoreProperties.PutCellTypeProp[ct, $firstEdge, NEW[INT _ firstEdge]]; [] _ Rosemary.BindCellType[cellType: ct, roseClassName: WaveFormName]; [] _ CoreFlat.CellTypeCutLabels[ct, Logic.logicCutSet]; Ports.InitPorts[ct, l, drive, "Out"]; Ports.InitPorts[ct, l, none, "RosemaryLogicTime"]; }; WaveState: TYPE = REF WaveStateRec; WaveStateRec: TYPE = RECORD [ out, time: NAT _ LAST[NAT], index: NAT _ 0, ls: Ports.LevelSequence, freq: NAT _ 0, counter: INT _ 0, lastTime: Ports.Level _ H]; WaveFormInit: Rosemary.InitProc = { state: WaveState _ IF oldStateAny=NIL THEN NEW[WaveStateRec] ELSE NARROW[oldStateAny]; firstEdge: INT = NARROW[CoreProperties.GetCellTypeProp[cellType, $firstEdge], REF INT]^; [state.out, state.time] _ Ports.PortIndexes[cellType.public, "Out", "RosemaryLogicTime"]; state.index _ 0; state.ls _ NARROW[CoreProperties.GetCellTypeProp[cellType, $ls]]; state.freq _ NARROW[CoreProperties.GetCellTypeProp[cellType, $freq], REF NAT]^; state.counter _ 0-state.freq-firstEdge; state.lastTime _ p[state.time].l; stateAny _ state; }; WaveFormSimple: Rosemary.EvalProc = { state: WaveState _ NARROW[stateAny]; IF state.lastTime=p[state.time].l THEN RETURN; state.counter _ state.counter+1; IF state.counter>=state.freq THEN { state.counter _ 0; state.index _ state.index+1; IF state.index>=state.ls.size THEN state.index _ 0; }; p[state.out].l _ state.ls[state.index]; state.lastTime _ p[state.time].l; }; <> ClockGenName: ROPE = Rosemary.Register[roseClassName: "ClockGen", init: ClockGenInit, evalSimple: ClockGenSimple]; ClockGen: PUBLIC PROC [up, dn, firstEdge: INT, initLow: BOOL] RETURNS [ct: CellType] ~ { ct _ CoreClasses.CreateUnspecified[ name: ClockGenName, public: Wires["Clock", "RosemaryLogicTime"]]; CoreProperties.PutCellTypeProp[ct, $up, NEW[INT _ up]]; CoreProperties.PutCellTypeProp[ct, $dn, NEW[INT _ dn]]; CoreProperties.PutCellTypeProp[ct, $firstEdge, NEW[INT _ firstEdge]]; CoreProperties.PutCellTypeProp[ct, $initLow, NEW[BOOL _ initLow]]; [] _ Rosemary.BindCellType[cellType: ct, roseClassName: ClockGenName]; [] _ CoreFlat.CellTypeCutLabels[ct, logicCutSet]; Ports.InitPorts[ct, l, drive, "Clock"]; Ports.InitPorts[ct, l, none, "RosemaryLogicTime"]; }; ClockState: TYPE = REF ClockStateRec; ClockStateRec: TYPE = RECORD [ ck, time: NAT _ LAST[NAT], up, dn, firstEdge: INT, initLow: BOOL, counter: INT _ 0, lastTime: Ports.Level _ H]; ClockGenInit: Rosemary.InitProc = { state: ClockState _ NEW[ClockStateRec]; {OPEN state; infinity: INT _ LAST[INT]/4; -- to avoid overflow [ck, time] _ Ports.PortIndexes[cellType.public, "Clock", "RosemaryLogicTime"]; initLow _ NARROW[CoreProperties.GetCellTypeProp[cellType, $initLow], REF BOOL]^; up _ NARROW[CoreProperties.GetCellTypeProp[cellType, $up], REF INT]^; dn _ NARROW[CoreProperties.GetCellTypeProp[cellType, $dn], REF INT]^; firstEdge _ NARROW[CoreProperties.GetCellTypeProp[cellType, $firstEdge], REF INT]^; IF up=-1 THEN up _ infinity; IF dn=-1 THEN dn _ infinity; IF firstEdge=-1 THEN firstEdge _ infinity; lastTime _ p[time].l}; stateAny _ state; }; ClockGenSimple: Rosemary.EvalProc = { state: ClockState _ NARROW[stateAny]; {OPEN state; t0, normTime: INT; state: ClockState _ NARROW[stateAny]; IF state.lastTime=p[time].l THEN RETURN; state.counter _ state.counter+1; t0 _ IF state.initLow THEN state.firstEdge+state.up ELSE state.firstEdge; normTime _ (state.counter-t0+state.up+state.dn) MOD (state.up+state.dn); p[ck].l _ SELECT TRUE FROM state.counter IF state.initLow THEN L ELSE H, normTime< state.dn => L, ENDCASE => H; state.lastTime _ p[time].l; }}; <> StopName: ROPE = Rosemary.Register[roseClassName: "Stop", init: StopInit, evalSimple: StopSimple]; Stop: PUBLIC PROC [] RETURNS [ct: CellType] ~ { ct _ CoreClasses.CreateUnspecified[ name: StopName, public: Wires["ShouldBeFalse", "RosemaryLogicTime"]]; [] _ Rosemary.BindCellType[cellType: ct, roseClassName: StopName]; [] _ CoreFlat.CellTypeCutLabels[ct, logicCutSet]; Ports.InitPorts[ct, l, none, "ShouldBeFalse", "RosemaryLogicTime"]; }; StopState: TYPE = REF StopStateRec; StopStateRec: TYPE = RECORD [ in, time: NAT _ LAST[NAT], lastTime: Ports.Level _ H]; StopInit: Rosemary.InitProc = { state: StopState _ NEW[StopStateRec]; [state.in, state.time] _ Ports.PortIndexes[cellType.public, "ShouldBeFalse", "RosemaryLogicTime"]; state.lastTime _ p[state.time].l; stateAny _ state; }; StopSimple: Rosemary.EvalProc = { state: StopState _ NARROW[stateAny]; {OPEN state; IF p[in].l#L AND p[time].l#lastTime THEN Rosemary.Stop[msg: "User-defined assertion is wrong", data: p, reason: $UserDefined]; lastTime _ p[time].l; }}; <> RomName: ROPE = Rosemary.Register[roseClassName: "Rom", init: RomInit, evalSimple: RomSimple]; RomRep: TYPE = ARRAY [0..10) OF INT; -- a hack Rom: PROC [n, b: NAT, v: RomRep] RETURNS [ct: CellType] ~ { a: NAT _ BitOps.NBits[n]; ct _ CoreClasses.CreateUnspecified[name: RomName, public: Wires[Seq["ad", a], Seq["out", b]]]; CoreProperties.PutCellTypeProp[ct, $value, NEW[RomRep _ v]]; [] _ Rosemary.BindCellType[cellType: ct, roseClassName: RomName]; [] _ CoreFlat.CellTypeCutLabels[ct, logicCutSet]; Ports.InitPorts[ct, ls, none, "ad"]; Ports.InitPorts[ct, ls, drive, "out"]; }; RomState: TYPE = REF RomStateRec; RomStateRec: TYPE = RECORD [ ad, out: NAT _ LAST[NAT], val: ARRAY [0..10) OF Ports.LevelSequence]; RomInit: Rosemary.InitProc = { state: RomState _ NEW[RomStateRec]; val: RomRep _ NARROW[CoreProperties.GetCellTypeProp[cellType, $value], REF RomRep]^; b: NAT; [state.ad, state.out] _ Ports.PortIndexes[cellType.public, "ad", "out"]; b _ p[state.out].ls.size; FOR i: NAT IN [0..10) DO state.val[i] _ NEW[Ports.LevelSequenceRec[b]]; Ports.LCToLS[val[i], state.val[i]]; ENDLOOP; stateAny _ state; }; RomSimple: Rosemary.EvalProc = { state: RomState _ NARROW[stateAny]; IF LogicUtils.HasX[p[state.ad].ls] THEN Ports.SetLS[p[state.out].ls, X] ELSE {ad: CARD _ Ports.LSToC[p[state.ad].ls]; Ports.CopyLS[from: state.val[ad], to: p[state.out].ls] }; }; <> <<-- These cutsets are used by Rosemary>> logicCutSet: PUBLIC ROPE _ "Logic"; -- for standard cells macroCutSet: PUBLIC ROPE _ "LogicMacro"; -- for composite cells (e.g. adder, counter, ...) <<-- These belong in Sch, but Sch must be redone, so in the mean time...>> RoseProbeProp: ATOM _ $RoseProbe; -- only value: $Yes SetObjectPort: PUBLIC PROC [cx: Sisyph.Context, initType: Ports.LevelType _ b, initDrive: Ports.Drive _ none] = { Sisyph.Eval[cx, "coreProps _ CoreProperties.PutProp[coreProps, $PortData, NEW[Ports.PortDataRec _ [ type: initType, drive: initDrive]]]"]; }; SetObjectTesterDrive: PUBLIC PROC [cx: Sisyph.Context, initDrive: Ports.Drive _ none] = { Sisyph.Eval[cx, "coreProps _ CoreProperties.PutProp[coreProps, $PortTesterDrive, NEW[Ports.Drive _ initDrive]]"]; }; LogicTest: RosemaryUser.TestProc ~ { logicTime: NAT _ Ports.PortIndex[cellType.public, "RosemaryLogicTime"]; p[logicTime].b _ TRUE; p[logicTime].d _ drive; DO p[logicTime].b _ NOT p[logicTime].b; Eval[]; ENDLOOP; }; ExtractSelectedObjAndRunRosemary: PROC [comm: CDSequencer.Command] = { globalNames: Sisyph.ROPES _ Sisyph.GetGlobalNames[Sisyph.Create[comm.design]]; <<-- a wire is innocent until proven guilty>> UnnamedOrGlobal: PROC [wire: Wire] RETURNS [BOOL] ~ { name: ROPE = CoreOps.GetShortWireName[wire]; RETURN [name=NIL OR RopeList.Memb[globalNames, name]]; }; Unconnected: PROC [wire: Wire] RETURNS [BOOL] ~ { RETURN [CoreProperties.GetWireProp[wire, Static.staticCutSetProp]#NIL]; }; NotBus: PROC [wire: Wire] RETURNS [BOOL] ~ { FOR i: NAT IN [0..wire.size) DO -- Skipped if wire is atomic IF wire.elements[i].size#0 THEN RETURN[TRUE]; ENDLOOP; RETURN [FALSE]; }; WorthGraphing: CoreOps.EachWireProc ~ { SELECT TRUE FROM UnnamedOrGlobal[wire] => RETURN [subWires: FALSE]; -- don't even consider sons Unconnected[wire] => RETURN [subWires: FALSE]; -- don't even consider sons NotBus[wire] => RETURN [subWires: TRUE]; -- will have interesting sons ENDCASE => graphWires _ CONS[NEW [CoreFlat.FlatWireRec _ [wire: wire]], graphWires]; }; AtomicsInGraph: PROC [wire: Wire] ~ { graphWires _ CONS[NEW[CoreFlat.FlatWireRec _ [flatCell: CoreFlat.rootCellType, wire: wire]], graphWires]; }; logicVdd, logicGnd: NAT; graphWires: CoreFlat.FlatWires _ NIL; root, cellType: CellType; internal: Core.WireSeq; [root: root, cell: cellType] _ SinixOps.SelectedCellType[comm.design, Sisyph.mode]; IF root=NIL THEN RETURN; -- Extraction ended in error, message already printed <<-- Let's make sure we have something to simulate>> IF cellType.class#CoreClasses.recordCellClass THEN Error["I can't simulate this thing"]; <<-- Find out which wires to display: top-level only>> internal _ NARROW[cellType.data, CoreClasses.RecordCellType].internal; [] _ CoreOps.VisitWireSeq[internal, WorthGraphing]; <<-- Prepare the cell for simulation>> logicVdd _ Ports.PortIndex[cellType.public, "Vdd"]; logicGnd _ Ports.PortIndex[cellType.public, "Gnd"]; [] _ Rosemary.SetFixedWire[cellType.public[logicVdd], H]; [] _ Rosemary.SetFixedWire[cellType.public[logicGnd], L]; [] _ RosemaryUser.TestProcedureViewer[ cellType: cellType, testButtons: LIST["Logic Test"], name: CoreOps.GetCellTypeName[cellType], displayWires: graphWires, graphWires: graphWires, cutSet: CoreFlat.CreateCutSet[labels: IF CoreProperties.GetCellTypeProp[from: cellType, prop: $Simulation]=$Fast THEN LIST[macroCutSet, logicCutSet] ELSE LIST[logicCutSet]]]; }; myDefaultGlobalNames: Sisyph.ROPES = LIST ["Vdd", "Gnd", "RosemaryLogicTime"]; Sisyph.defaultGlobalNames _ myDefaultGlobalNames; <<-- Entry goes in Sisyph Menu>> CDMenus.ImplementEntryCommand[menu: $OtherProgramMenu, entry: "Sisyph Extract and Rosemary", p: ExtractSelectedObjAndRunRosemary, key: $CoreRosemaryExtractSelectedObjAndRunRosemary]; RosemaryUser.RegisterTestProc["Logic Test", LogicTest]; END.