LogicRosemaryImpl.mesa
Copyright Ó 1986, 1987 by Xerox Corporation. All rights reserved.
Created by: Louis Monier December 30, 1986 7:40:13 pm PST
Last Edited by: Louis Monier October 30, 1987 5:54:05 pm PST
Last Edited by: Ross May 22, 1987 5:12:47 pm PDT
Last Edited by: McCreight June 4, 1987 11:13:00 am PDT
Jean-Marc Frailong May 1, 1988 3:58:43 pm PDT
Bertrand Serlet June 10, 1987 4:47:40 pm PDT
Pradeep Sindhu July 20, 1987 4:54:36 pm PDT
McCreight March 19, 1987 1:12:54 pm PST
Hoel, February 20, 1987 6:11:31 pm PST
Barth, June 5, 1987 10:38:02 am PDT
This package provides the basic user-interface for interactive simulation using Rosemary, and a set of primitives: clock generator, oracle, rom, ... These primitives must be used for simulation only and do not produce any layout.
DIRECTORY CD, CDEnvironment, CDSequencer, CDSequencerExtras, Core, CoreCDUser, CoreClasses, CoreCreate, CoreFlat, CoreOps, CoreProperties, FileNames, FileViewerOps, FS, IO, Logic, LogicUtils, Ports, RopeList, Rosemary, RosemaryUser, Sisyph, Static, SymTab, TerminalIO;
LogicRosemaryImpl:
CEDAR
PROGRAM
IMPORTS CDEnvironment, CDSequencerExtras, CoreCDUser, CoreClasses, CoreCreate, CoreFlat, CoreOps, CoreProperties, FileNames, FileViewerOps, FS, IO, LogicUtils, Ports, RopeList, Rosemary, RosemaryUser, Sisyph, Static, SymTab, TerminalIO
EXPORTS Logic
= BEGIN OPEN LogicUtils, CoreCreate;
Oracle
oracleBindings: SymTab.Ref ← SymTab.Create[];
-- oracle name -> file name; default is oracle name=file name
SetOracleFileName:
PUBLIC
PROC [id, fileName:
ROPE] ~ {
Called from the interpreter by a user to bind a new file to an oracle
[] ← SymTab.Store[oracleBindings, id, fileName];
};
GetOracleFileName:
PUBLIC
PROC [id:
ROPE]
RETURNS [fileName:
ROPE]~ {
Called from the interpreter by a user to find out which file is bound to an oracle
ref: REF ← SymTab.Fetch[oracleBindings, id].val;
RETURN[IF ref=NIL THEN id ELSE NARROW[ref]];
};
OracleRoseClass: ROPE = RoseClass["Oracle", OracleInit, OracleSimple];
Oracle:
PUBLIC
PROC [in, out, name:
ROPE, log:
BOOL ←
FALSE]
RETURNS [ct: CellType] = {
-- 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: wire, levelType: l, driveType: aggregate, initDrive: driveLevel]
ELSE [] ← Ports.InitPort[wire: wire, levelType: ls, driveType: separate, initDrive: driveLevel];
CoreProperties.PutWireProp[wire, oracleValueProp, oracleValueProp]; --non-NIL
-- 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: ROPE = "Oracle";
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: "Oracle", public: Wires["CK", inWire, outWire]];
CoreProperties.PutCellTypeProp[ct, $oracle, name];
CoreProperties.PutCellTypeProp[ct, $log, NEW[BOOL ← log]];
SimulateGate[ct, OracleRoseClass];
Ports.InitPorts[ct, l, none, "CK"];
};
OracleState: TYPE = REF OracleStateRec;
OracleStateRec:
TYPE =
RECORD [
oracleName: ROPE ← NIL, -- entry in `oracleBindings' table
clk, in, out: NAT ← LAST[NAT],
inWire, outWire: Wire,
stopAfterOneRun: BOOL ← FALSE,
maxNbCycle: INT ← 0,
log: BOOL,
prevClk: Ports.Level ← L,
sLog: IO.STREAM ← NIL,
cycle: INT ← -1
];
OracleInit: Rosemary.InitProc = {
state: OracleState ← IF oldStateAny=NIL THEN NEW[OracleStateRec] ELSE NARROW[oldStateAny];
clk, in, out: NAT ← LAST[NAT];
id: ROPE ← NARROW[CoreProperties.GetCellTypeProp[cellType, $oracle]];
log: BOOL ← NARROW[CoreProperties.GetCellTypeProp[cellType, $log], REF BOOL]^;
path: LIST OF ROPE = LIST [CDEnvironment.GetWorkingDirectory[]];
state.oracleName ← FileNames.FileWithSearchRules[root: GetOracleFileName[id], defaultExtension: ".oracle", requireExtension: FALSE, requireExact: TRUE, 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];
state.log ← log;
state.prevClk ← L;
IF log THEN state.sLog ← FS.StreamOpen[IO.PutFR["///Temp/%g.bugs", IO.rope[id]], $create];
state.cycle ← -1;
stateAny ← state;
};
-- Wrong value during the simulation
OracleSimple: Rosemary.EvalProc = {
Mismatch:
PROC [shouldBe, is:
ROPE, index:
CARD] ~ {
msg: ROPE = IO.PutFR["At %g expected %g but received %g", IO.int[index], IO.rope[shouldBe], IO.rope[is]];
IF state.log THEN IO.PutF[state.sLog, "%g\n", IO.rope[msg]]
ELSE {
TerminalIO.PutF["Oracle %g : %g\n", IO.rope[state.oracleName], IO.rope[msg]];
PointAt[state.oracleName, index];
SIGNAL Ports.CheckError[msg];
};
};
-- bit-wise comparison; if L or H, check; if X, ignore
Compare:
PROC [wire: Wire, cycle:
CARD, p: Ports.Port] ~ {
LevelToRope:
PROC [level: Ports.Level]
RETURNS [r:
ROPE] ~ {
r ← SELECT level FROM L => "L", H => "H", ENDCASE => "X";
};
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 {
value: Value ← NARROW[ref, Values][cycle];
IF wire.size=0
THEN {
-- atomic wire check
IF value.ls[0]#X AND value.ls[0]#p.l THEN Mismatch[LevelToRope[value.ls[0]], LevelToRope[p.l], value.filePosition];
}
ELSE
FOR i:
NAT
IN [0..value.ls.size)
DO
-- level sequence check
IF value.ls[i]=X OR value.ls[i]=p.ls[i] THEN LOOP;
Mismatch[Ports.LSToRope[value.ls], Ports.LSToRope[p.ls], value.filePosition];
EXIT; -- to catch error at most once per level sequence
ENDLOOP;
};
};
-- 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 {
value: Value ← NARROW[ref, Values][cycle];
IF wire.size=0
THEN {
-- special case for atomic
p.l ← value.ls[0];
p.d ← IF p.l=X THEN none ELSE drive;
}
ELSE {
Ports.CopyLS[from: value.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-going transition
state.cycle ← (state.cycle+1) MOD state.maxNbCycle;
};
IF state.cycle=-1 THEN RETURN;
-- put values on "out" ports for current cycle
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
THEN
SELECT
TRUE
FROM
state.log
AND state.stopAfterOneRun =>
{
IO.Close[state.sLog];
Rosemary.Stop[msg: "Oracle completed; look at ///Temp/*.bugs"];
};
state.log
AND ~state.stopAfterOneRun =>
IO.PutF[state.sLog, "Processed the file entirely at cycle %g\n", IO.int[state.cycle]];
~state.log
AND state.stopAfterOneRun =>
Rosemary.Stop[msg: "Oracle completed successfully", reason: $Oracle];
ENDCASE => NULL;
};
IF curClk#X THEN state.prevClk ← curClk;
};
PointAt:
PROC [oracleName:
ROPE, index:
CARD] = {
FileViewerOps.OpenSource[fileName: oracleName, index: index, chars: 1];
};
Bug: ERROR [msg: ROPE] = CODE;
CrashAndPointTo:
PROC [oracleName, msg:
ROPE, index:
CARD] = {
PointAt[oracleName, index];
Bug[msg];
};
oracleValueProp: ATOM = $OracleValueProp; -- of type Values
Values: TYPE = REF ValuesRec;
ValuesRec:
TYPE =
RECORD[seq:
SEQUENCE size:
NAT
OF Value];
used during simulation
Value: TYPE = REF ValueRec;
ValueRec:
TYPE =
RECORD[
ls: Ports.LevelSequence ← NIL, -- if atomic wire, use ls[0]
filePosition: CARD ← 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] ~ {
[] ← IO.SkipWhitespace[source]; -- important if there is a | in initial comments
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];
IN ['a .. 'f] => Ports.LCToLS[ORD[c]-ORD['a]+10, h];
'X, '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]];
};
Clock Generator
ClockGenRoseClass: ROPE = RoseClass["ClockGen", ClockGenInit, ClockGenSimple];
ClockGen:
PUBLIC
PROC [up, dn, firstEdge:
INT, initLow:
BOOL]
RETURNS [ct: CellType] ~ {
ct ← CoreClasses.CreateUnspecified[name: "ClockGen",
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]];
CoreProperties.PutCellTypeProp[ct, $DAUserIgnoreForSelection, $Exists];
SimulateGate[ct, ClockGenRoseClass];
Ports.InitPorts[ct, l, none, "RosemaryLogicTime"]; Ports.InitPorts[ct, l, drive, "Clock"];
};
ClockState: TYPE = REF ClockStateRec;
ClockStateRec:
TYPE =
RECORD [
ck, time: NAT ← LAST[NAT],
up, dn, firstEdge: INT,
initLow: BOOL,
counter: INT ← 0,
lastTime: Ports.Level ← X];
ClockGenInit: Rosemary.InitProc = {
state: ClockState ← IF oldStateAny=NIL THEN NEW[ClockStateRec] ELSE NARROW[oldStateAny];
infinity: INT ← LAST[INT]/4; -- to avoid overflow
[state.ck, state.time] ← Ports.PortIndexes[cellType.public, "Clock", "RosemaryLogicTime"];
state.initLow ← NARROW[CoreProperties.GetCellTypeProp[cellType, $initLow], REF BOOL]^;
state.up ← NARROW[CoreProperties.GetCellTypeProp[cellType, $up], REF INT]^;
state.dn ← NARROW[CoreProperties.GetCellTypeProp[cellType, $dn], REF INT]^;
state.firstEdge ← NARROW[CoreProperties.GetCellTypeProp[cellType, $firstEdge], REF INT]^;
state.counter ← 0;
IF state.up=-1 THEN state.up ← infinity;
IF state.dn=-1 THEN state.dn ← infinity;
IF state.firstEdge=-1 THEN state.firstEdge ← infinity;
state.lastTime ← X;
stateAny ← state;
};
ClockGenSimple: Rosemary.EvalProc = {
state: ClockState ← NARROW[stateAny];
{OPEN state;
t0, normTime: INT;
pt: Ports.Level = p[time].l;
state: ClockState ← NARROW[stateAny];
IF pt=X THEN {p[ck].l ← X; RETURN};
IF pt#state.lastTime THEN 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<state.firstEdge => IF state.initLow THEN L ELSE H,
normTime< state.dn => L,
ENDCASE => H;
state.lastTime ← p[time].l;
}};
Assertion Checking
StopRoseClass: ROPE = RoseClass["Stop", StopInit, StopSimple];
Stop:
PUBLIC
PROC []
RETURNS [ct: CellType] ~ {
ct ← CoreClasses.CreateUnspecified[name: "Stop",
public: Wires["ShouldBeFalse", "RosemaryLogicTime"]];
SimulateGate[ct, StopRoseClass];
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 ← IF oldStateAny=NIL THEN NEW[StopStateRec] ELSE NARROW[oldStateAny];
[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=H AND p[time].l#lastTime THEN Rosemary.Stop[msg: "User-defined assertion is wrong", data: p, reason: $UserDefined];
lastTime ← p[time].l;
}};
Utilities
-- 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 are the user-interface version for use as CutSet property
fast: PUBLIC CoreFlat.CutSet ← CoreFlat.CreateCutSet[labels: LIST ["DPMacro", "FSM", "LogicMacro", "Memory", "Logic"]];
macro: PUBLIC CoreFlat.CutSet ← CoreFlat.CreateCutSet[labels: LIST ["LogicMacro", "Memory", "Logic"]];
gate: PUBLIC CoreFlat.CutSet ← CoreFlat.CreateCutSet[labels: LIST ["Logic"]];
transistors: PUBLIC CoreFlat.CutSet ← NIL;
temporaryClockEvalHack:
BOOL ←
TRUE;
GetBool:
PROC [ct: CellType, prop:
ATOM, default:
BOOL]
RETURNS [
BOOL] ~ {
Read a boolean property from a CT with the specified default
rb: REF BOOL ← NARROW [CoreProperties.GetCellTypeProp[ct, prop]];
RETURN [IF rb=NIL THEN default ELSE rb^];
};
-- This is the engine that exercices oracle simulations
LogicTest: RosemaryUser.TestProc ~ {
-- Wires have no memory unless the $Memory property is set to $Yes (the only recognized value).
logicTime: NAT = Ports.PortIndex[cellType.public, "RosemaryLogicTime"];
memory: BOOL = GetBool[cellType, $Memory, FALSE];
p[logicTime].b ← TRUE;
p[logicTime].d ← drive;
DO
ENABLE Rosemary.Stop =>
IF reason=$BoolWireHasX
THEN
REJECT
ELSE {
TerminalIO.PutF["Simulation completed; msg: %g; reason %g\n", IO.rope[msg], IO.atom[reason]];
EXIT};
p[logicTime].b ← NOT p[logicTime].b;
IF temporaryClockEvalHack THEN Eval[memory: memory, clockEval: TRUE];
Eval[memory: memory, clockEval: FALSE];
ENDLOOP;
};
ObsoleteCode: SIGNAL ~ CODE;
RunRosemary:
PUBLIC
PROC [cellType: CellType, design:
CD.Design, cutSet: CoreFlat.CutSet ←
NIL]
RETURNS [tester: RosemaryUser.Tester]= {
globalNames: Sisyph.ROPES ← Sisyph.GetGlobalNames[Sisyph.Create[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: INT;
graphWires: CoreFlat.FlatWires ← NIL;
internal: Core.WireSeq;
-- Let's make sure we have something to simulate
TerminalIO.PutF["*** WARNING\n***\tLogic.RunRosemary is now obsolete.\n ***\tUse DAUser.RunRosemary instead.\n***\n"];
SIGNAL ObsoleteCode;
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 ← CoreOps.GetWireIndex[cellType.public, "Vdd"]; -- -1 means not found
logicGnd ← CoreOps.GetWireIndex[cellType.public, "Gnd"];
IF logicVdd#-1 THEN [] ← Rosemary.SetFixedWire[cellType.public[logicVdd], H];
IF logicGnd#-1 THEN [] ← Rosemary.SetFixedWire[cellType.public[logicGnd], L];
IF cutSet=
NIL
THEN {
-- If cutset not specified, build it from cell type property $Simulation
labels: LIST OF ROPE;
SELECT CoreProperties.GetCellTypeProp[from: cellType, prop: $Simulation]
FROM
$Fast => labels ← LIST [macroCutSet, logicCutSet]; -- macros & gates
$Transistors => labels ← NIL; -- transistor level
ENDCASE => labels ← LIST [logicCutSet]; -- gate level
cutSet ← CoreFlat.CreateCutSet[labels: labels];
tester ← RosemaryUser.TestProcedureViewer[
cellType: cellType,
testButtons: LIST["Logic Test"],
name: CoreOps.GetCellTypeName[cellType],
displayWires: graphWires,
graphWires: graphWires,
recordDeltas: GetBool[cellType, $RecordDeltas, TRUE],
cutSet: cutSet];
};
ExtractSelectedObjAndRunRosemary:
PROC [comm: CDSequencer.Command] = {
EachCellType: CoreCDUser.EachRootCellTypeProc ~ {
cutSet: CoreFlat.CutSet;
IF root=NIL THEN RETURN;
cutSet ← NARROW[CoreProperties.GetCellTypeProp[root, $CutSet]];
[] ← RunRosemary[root, comm.design, cutSet];
};
TerminalIO.PutF["*** Warning: this command is going to disappear. Use <SPACE-F> menu instead. Note that this will require some changes to your cells to put the right properties for Rosemary.\n"];
[] ← CoreCDUser.EnumerateSelectedCellTypes[comm.design, EachCellType, Sisyph.mode];
};
-- Entry goes in Sisyph Menu
CDSequencerExtras.RegisterCommand[key: $CoreRosemaryExtractSelectedObjAndRunRosemary, proc: ExtractSelectedObjAndRunRosemary, queue: doQueue];
RosemaryUser.RegisterTestProc["Logic Test", LogicTest];
END.