PipalSisyphImpl.mesa
Copyright Ó 1985, 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
Created by Sindhu and Serlet, November 27, 1985 9:11:39 pm PDT
Pradeep Sindhu June 25, 1987 4:59:16 pm PDT
Barth, October 15, 1986 10:25:34 am PDT
Bertrand Serlet, May 13, 1988 3:29:20 pm PDT
Jean-Marc Frailong December 12, 1987 5:41:02 pm PST
Christian Jacobi, July 15, 1986 6:24:40 pm PDT
Don Curry May 7, 1987 10:30:40 pm PDT
DIRECTORY
Convert,
Core, CoreClasses, CoreOps, CoreProperties,
IO,
Pipal, PipalConnect, PipalCore, PipalIO, PipalMos, PipalSinix, PipalSisyph,
RefTab, Rope, RopeList,
Scheme,
TerminalIO;
PipalSisyphImpl:
CEDAR
PROGRAM
IMPORTS Convert, CoreClasses, CoreOps, CoreProperties, IO, Pipal, PipalConnect, PipalCore, PipalIO, PipalMos, PipalSinix, RefTab, Rope, RopeList, Scheme, TerminalIO
EXPORTS PipalSisyph
SHARES PipalSinix =
BEGIN OPEN PipalSisyph;
Types
Context: TYPE = PipalSinix.Context;
Environment:
TYPE = Scheme.Environment;
All variables have values which are Scheme data types except the ones which are CellTypes, Wire, Wires or ROPES
Any: TYPE = Scheme.Any;
CellType: TYPE = Core.CellType;
Wire: TYPE = Core.Wire;
Wires: TYPE = Core.Wires;
WireSeq: TYPE = Core.WireSeq;
ROPE: TYPE = Core.ROPE;
ROPES: TYPE = LIST OF ROPE;
Object: TYPE = Pipal.Object;
Constants and Variables
defaultGlobalNames: PUBLIC ROPES ← LIST ["Vdd", "Gnd", "RosemaryLogicTime"];
globalNames:
PUBLIC
ROPES ← defaultGlobalNames;
instanceExpressionsProp: PUBLIC ATOM ← $SisyphInstanceExpressions;
objectExpressionsProp:
PUBLIC
ATOM ← $SisyphObjectExpressions;
mode:
PUBLIC PipalSinix.Mode ←
NEW [PipalSinix.ModeRec ← [
decoration: PipalCore.schematicsDecoration,
extractMethod: Pipal.RegisterMethod["SchematicExtraction"],
connectMode: PipalConnect.schematicMode,
extractAnnotationProp: $SisyphExtractProc, -- for the sake of compatibility!
objectEqual: ObjectEqual,
postProcessFused: PostProcessFused
]];
initialEnvironment: Environment = Scheme.NewEnvironmentStructure[];
Context Handling Procedures
This one in Scheme?
IsDefinedTopLevel:
PROC [env: Environment, variable:
ATOM]
RETURNS [
BOOL] = {
values: RefTab.Ref ← NARROW [env.values];
RETURN [RefTab.Fetch[values, variable].found];
};
InternalDefine:
PROC [env: Environment, variable:
ATOM, value: Any] = {
IF IsDefinedTopLevel[env, variable]
THEN SIGNAL ContextProblem["Variable set twice", variable]
ELSE Scheme.DefineVariable[variable, value, env];
};
InternalSet:
PROC [env: Environment, variable:
ATOM, value: Any] = {
IF
NOT IsDefinedTopLevel[env, variable]
THEN SIGNAL ContextProblem["Undefined variable", variable]
ELSE [] ← Scheme.SetVariableValue[variable, value, env];
};
InternalGet:
PROC [env: Environment, variable:
ATOM]
RETURNS [value: Any] = {
value ← Scheme.LookupVariableValue[variable, env];
};
InternalEval:
PROC [env: Environment, expr: Core.
ROPE]
RETURNS [value: Any] = {
value ← Scheme.Eval[Scheme.ReadRope[expr, TRUE], env];
};
InternalDefineEval:
PROC [env: Environment, variable:
ATOM, expr: Core.
ROPE] = {
InternalDefine[env, variable, InternalEval[env, expr]];
};
InternalSetEval:
PROC [env: Environment, variable:
ATOM, expr: Core.
ROPE] = {
InternalSet[env, variable, InternalEval[env, expr]];
};
Checks that a PipalSinix context is of the right form, i.e. a 2-level environement:
- the parent is initialEnvironment, always invariant.
- the current environment contains the few current variables.
Narrow:
PROC [context: Context]
RETURNS [env: Environment] = {
env ← NARROW [context];
IF env.parent=NIL OR env.names#NIL OR env.values=NIL THEN SIGNAL PipalSinix.InternalBug[];
IF env.parent#initialEnvironment THEN SIGNAL PipalSinix.InternalBug[];
};
SchemeToCedar:
PROC [value: Any]
RETURNS [
REF] = {
RETURN [
WITH value
SELECT
FROM
string: Scheme.String => Scheme.RopeFromString[string],
ENDCASE => value];
};
SchemeToCedarInt:
PROC [value: Any]
RETURNS [int:
INT] = {
WITH SchemeToCedar[value]
SELECT
FROM
refInt: REF INT => int ← refInt^;
refNat: REF NAT => int ← refNat^;
ENDCASE => SIGNAL PipalSinix.CallerBug[];
};
CedarToScheme:
PROC [value:
REF]
RETURNS [Any] = {
RETURN [
WITH value
SELECT
FROM
rope: ROPE => Scheme.StringFromRope[rope],
ENDCASE => value];
};
CreateContext:
PUBLIC
PROC
RETURNS [context: Context] = {
env: Environment ←
NEW [Scheme.EnvironmentRep ← [
parent: initialEnvironment, names: NIL, values: RefTab.Create[], mark: 100,
id: Scheme.StringFromRope["PipalSisyph"]
]];
context ← env;
};
NewAssignmentContext:
PROC [context: Context, assignments:
LIST
OF ParsedRope]
RETURNS [Context] = {
env: Environment ← Narrow[context];
new: Environment ← NEW [Scheme.EnvironmentRep ← [parent: env.parent, names: NIL, values: RefTab.Copy[NARROW [env.values]]]];
FOR list:
LIST
OF ParsedRope ← assignments, list.rest
WHILE list#
NIL
DO
InternalSet[new, list.first.variable, InternalEval[env, list.first.expr]];
ENDLOOP;
RETURN [new];
};
NewDeclarationContext:
PROC [context: Context, declarations:
LIST
OF ParsedRope]
RETURNS [Context] = {
env: Environment ← Narrow[context];
new: Environment ← NEW [Scheme.EnvironmentRep ← [parent: env.parent, names: NIL, values: RefTab.Create[]]];
FOR list:
LIST
OF ParsedRope ← declarations, list.rest
WHILE list#
NIL
DO
variable: ATOM ← list.first.variable;
InternalDefine[new, variable, IF IsDefinedTopLevel[env, variable] THEN InternalGet[env, variable] ELSE InternalEval[env.parent, list.first.expr]];
ENDLOOP;
RETURN [new];
};
EvalProperties:
PROC [context: Context, object: Object, properties:
LIST
OF ParsedRope, others:
ROPES, props: Core.Properties]
RETURNS [Core.Properties] = {
FOR list:
LIST
OF ParsedRope ← properties, list.rest
WHILE list#
NIL
DO
key: ATOM ← list.first.variable;
value: REF ← Eval[context, list.first.expr];
oldValue: REF ← CoreProperties.GetProp[props, key];
IF oldValue#NIL AND oldValue#value THEN SIGNAL PipalSinix.FusionPropMismatch[object, key, oldValue, value];
props ← CoreProperties.PutProp[props, key, value];
ENDLOOP;
FOR list:
ROPES ← others, list.rest
WHILE list#
NIL
DO
props ← LayoutProcessName[object, list.first, props];
ENDLOOP;
RETURN [props];
};
Define:
PUBLIC
PROC [context: Context, variable:
ATOM, value:
REF] = {
InternalDefine[Narrow[context], variable, CedarToScheme[value]];
};
Set:
PUBLIC
PROC [context: Context, variable:
ATOM, value:
REF] = {
InternalSet[Narrow[context], variable, CedarToScheme[value]];
};
Get:
PUBLIC
PROC [context: Context, variable:
ATOM]
RETURNS [value:
REF] = {
value ← SchemeToCedar[InternalGet[Narrow[context], variable]];
};
GetInt:
PUBLIC
PROC [context: Context, variable:
ATOM]
RETURNS [value:
INT] = {
value ← SchemeToCedarInt[InternalGet[Narrow[context], variable]];
};
GetAtom:
PUBLIC
PROC [context: Context, variable:
ATOM]
RETURNS [value:
ATOM] = {
value ← NARROW [Get[context, variable]];
};
GetRope:
PUBLIC
PROC [context: Context, variable:
ATOM]
RETURNS [value: Core.
ROPE] = {
value ← NARROW [Get[context, variable]];
};
Eval:
PUBLIC
PROC [context: Context, expr: Core.
ROPE]
RETURNS [value:
REF] = {
ENABLE ANY => SIGNAL InterpreterProblem[context, expr, NIL];
value ← SchemeToCedar[InternalEval[Narrow[context], expr]];
};
DefineEval:
PUBLIC
PROC [context: Context, variable:
ATOM, expr: Core.
ROPE] = {
Define[context, variable, Eval[context, expr]];
};
SetEval:
PUBLIC
PROC [context: Context, variable:
ATOM, expr: Core.
ROPE] = {
Set[context, variable, Eval[context, expr]];
};
Parsing
ParseRope:
PROC [rope:
ROPE]
RETURNS [tokenKind:
IO.TokenKind, token, rest:
ROPE] = {
ENABLE {
IO.Error => GOTO Error;
IO.EndOfStream => GOTO EOF;
};
stream: IO.STREAM ← IO.RIS[rope];
charsSkipped1: INT ← IO.SkipWhitespace[stream];
charsSkipped2: INT;
[tokenKind, token, charsSkipped2] ← IO.GetCedarTokenRope[stream];
rest ← Rope.Substr[rope, charsSkipped1+charsSkipped2+Rope.Length[token]];
EXITS
Error => RETURN [tokenERROR, NIL, NIL];
EOF => RETURN [tokenEOF, NIL, NIL];
};
ParseSatellite:
PUBLIC
PROC [satellite:
ROPE]
RETURNS [variable:
ATOM ←
NIL, char:
CHAR, expr:
ROPE] = {
tokenKind1, tokenKind2: IO.TokenKind; token1, token2: ROPE;
[tokenKind1, token1, expr] ← ParseRope[satellite];
IF tokenKind1#tokenID THEN RETURN [NIL, '!, satellite];
[tokenKind2, token2, expr] ← ParseRope[expr];
IF tokenKind2#tokenSINGLE THEN RETURN [NIL, '!, satellite];
char ← Rope.Fetch[token2];
IF char#'~ AND char#'← AND char#': THEN RETURN [NIL, '!, satellite];
variable ← Convert.AtomFromRope[token1];
};
ParseSatellites:
PUBLIC
PROC [satellites:
ROPES]
RETURNS [declarations, assignments, properties:
LIST
OF ParsedRope ←
NIL, others:
ROPES ←
NIL] = {
WHILE satellites#
NIL
DO
variable: ATOM; char: CHAR; expr: ROPE;
[variable, char, expr] ← ParseSatellite[satellites.first];
IF variable=
NIL
THEN others ←
CONS [satellites.first, others]
ELSE
SELECT char
FROM
'~ => declarations ← CONS [[variable, expr], declarations];
'← => assignments ← CONS [[variable, expr], assignments];
': => properties ← CONS [[variable, expr], properties];
ENDCASE => SIGNAL PipalSinix.InternalBug[];
satellites ← satellites.rest;
ENDLOOP;
};
Context Equality and Caching
EqualRopes:
PUBLIC
PROC [ropes1, ropes2:
ROPES]
RETURNS [
BOOL] = {
FOR r1:
ROPES ← ropes1, r1.rest
WHILE r1#
NIL
DO
IF NOT RopeList.Memb[ropes2, r1.first] THEN RETURN [FALSE];
ENDLOOP;
FOR r2:
ROPES ← ropes2, r2.rest
WHILE r2#
NIL
DO
IF NOT RopeList.Memb[ropes1, r2.first] THEN RETURN [FALSE];
ENDLOOP;
RETURN [TRUE];
};
EqualValues:
PROC [value1, value2:
REF]
RETURNS [
BOOL] = {
Added code to handle the special case of ROPE as well as ROPES
IF value1=value2 THEN RETURN [TRUE];
WITH value1
SELECT
FROM
rr1:
ROPES =>
WITH value2
SELECT
FROM
rr2: ROPES => RETURN [EqualRopes[rr1, rr2]];
ENDCASE => RETURN [FALSE];
r1:
ROPE =>
WITH value2
SELECT
FROM
r2: ROPE => RETURN [Rope.Equal[r1, r2]];
ENDCASE => RETURN [FALSE];
ri1:
REF
INT =>
WITH value2
SELECT
FROM
ri2: REF INT => RETURN [ri1^=ri2^];
ri2: REF NAT => RETURN [ri1^=ri2^];
ENDCASE => RETURN [FALSE];
ri1:
REF
NAT =>
WITH value2
SELECT
FROM
ri2: REF INT => RETURN [ri1^=ri2^];
ri2: REF NAT => RETURN [ri1^=ri2^];
ENDCASE => RETURN [FALSE];
ENDCASE => RETURN [FALSE];
};
This one depends quite heavily on Scheme ...
Returns TRUE iff a is a subset of b
IsSubset:
PROC [a, b: RefTab.Ref]
RETURNS [
BOOL] = {
CheckAbsentInb: RefTab.EachPairAction = {
found: BOOL; bVal: RefTab.Val;
pair1, pair2: Scheme.Pair;
It is a potential parameter. Check if its there in the context and equal
[found, bVal] ← RefTab.Fetch[b, key];
IF NOT found THEN RETURN [TRUE];
IF bVal=val THEN RETURN [FALSE];
pair1 ← NARROW [bVal]; pair2 ← NARROW [val];
IF pair1.car#pair2.car THEN SIGNAL PipalSinix.InternalBug[];
quit ← NOT EqualValues[pair1.cdr, pair2.cdr];
};
RETURN [NOT RefTab.Pairs[a, CheckAbsentInb]];
};
ObjectEqual:
PROC [object: Object, context1, context2: Context]
RETURNS [
BOOL] = {
env1: Environment ← Narrow [context1];
env2: Environment ← Narrow [context2];
table1: RefTab.Ref ← NARROW [env1.values];
table2: RefTab.Ref ← NARROW [env2.values];
IF env1.parent#env2.parent THEN RETURN [FALSE];
RETURN [IsSubset[table1, table2] AND IsSubset[table2, table1]];
};
ExtractProcs
OrNames:
PROC [object: Object, name1, name2:
ROPE]
RETURNS [name:
ROPE ←
NIL] = {
IF name1=NIL THEN RETURN [name2];
IF name2=NIL THEN RETURN [name1];
IF Rope.Equal[name1, name2] THEN RETURN [name1];
SIGNAL PipalSinix.FusionPropMismatch[object, CoreOps.nameProp, name1, name2];
};
LayoutProcessName:
PROC [object: Object, name:
ROPE, props: Core.Properties]
RETURNS [Core.Properties] = {
name ← OrNames[object, name, NARROW [CoreProperties.GetProp[props, CoreOps.nameProp]]];
RETURN [CoreProperties.PutProp[props, CoreOps.nameProp, name]];
};
ExtractSats:
PROC [object: Object, context: Context, satellites:
ROPES, instance:
BOOL]
RETURNS [result:
REF, props: Core.Properties] = {
declarations, assignments, properties: LIST OF ParsedRope; others: ROPES;
[declarations, assignments, properties, others] ← ParseSatellites[satellites];
IF instance
THEN {
IF declarations#NIL THEN SIGNAL PipalSinix.CallerBug[];
IF assignments#NIL THEN context ← NewAssignmentContext[context, assignments];
[result, props] ← PipalSinix.Extract[object, mode, context];
IF result=NIL THEN RETURN;
WITH result
SELECT
FROM
subWire: Wire => {
wire: Wire ← CoreOps.CopyWire[subWire];
PipalCore.PutPort[mode.decoration, wire, object];
wire.properties ← EvalProperties[context, object, properties, others, wire.properties];
result ← wire;
};
subWires: Wires => SIGNAL PipalSinix.CallerBug[]; -- what to do with that name!
subCellType: CellType => props ← EvalProperties[context, object, properties, others, props];
ENDCASE => SIGNAL PipalSinix.InternalBug[];
} ELSE {
IF assignments#NIL THEN SIGNAL PipalSinix.CallerBug[];
IF declarations#NIL THEN context ← NewDeclarationContext[context, assignments];
[result, props] ← PipalSinix.NonCachingExtract[object, mode, context];
IF result=NIL THEN RETURN;
WITH result
SELECT
FROM
subWire: Wire => subWire.properties ← EvalProperties[context, object, properties, others, subWire.properties];
subWires: Wires => SIGNAL PipalSinix.CallerBug[]; -- what to do with that name!
subCellType: CellType =>
subCellType.properties ← EvalProperties[context, object, properties, others, subCellType.properties];
ENDCASE => SIGNAL PipalSinix.InternalBug[];
};
};
ExtractAnnotation: PipalSinix.ExtractProc = {
annotation: Pipal.Annotation = NARROW [object];
SELECT annotation.key
FROM
mode.extractAnnotationProp => {
atom: ATOM = NARROW [annotation.value];
proc: PipalSinix.ExtractProc ← PipalSinix.FetchExtractProc[atom];
IF proc=
NIL
THEN {
TerminalIO.PutF["*** ExtractProc $%g not registered. You must run the program defining it.\n", IO.atom[atom]]; SIGNAL PipalSinix.CallerBug[];
};
[result, props] ← proc[annotation.child, mode, context];
};
Pipal.nameProp => {
name: ROPE ← NARROW [annotation.value];
[result, props] ← PipalSinix.NonCachingExtract[annotation.child, mode, context];
IF result=NIL THEN RETURN;
WITH result
SELECT
FROM
subWire: Wire =>
subWire.properties ← LayoutProcessName[object, name, subWire.properties];
subWires: Wires => SIGNAL PipalSinix.CallerBug[]; -- what to do with that name!
subCellType: CellType =>
subCellType.properties ← LayoutProcessName[object, name, subCellType.properties];
ENDCASE => SIGNAL PipalSinix.InternalBug[];
};
instanceExpressionsProp => [result, props] ← ExtractSats[annotation.child, context, NARROW [annotation.value], TRUE];
objectExpressionsProp => [result, props] ← ExtractSats[annotation.child, context, NARROW [annotation.value], FALSE];
PipalMos.indirectProp => SIGNAL PipalSinix.CallerBug[];
ENDCASE => [result, props] ← PipalSinix.ExtractConnectized[object, mode, context];
};
ExtractStar: PipalSinix.ExtractProc = {
star: PipalMos.Star = NARROW [object];
[result, props] ← ExtractSats[star.master, context, PipalMos.GetNonItalicRopes[star], NOT star.overlayStar];
};
ExtractSchematicIcon: PipalSinix.ExtractProc = {
icon: PipalMos.SchematicIcon ← NARROW [object];
iconCT: CellType ← NARROW [PipalSinix.Extract[icon.child, mode, context].result];
result ←
IF icon.code
THEN Eval[context, icon.expression]
ELSE Extract[icon.expression];
SELECT icon.type
FROM
cell => {
cellType: CellType;
IF result=NIL THEN SIGNAL PipalSinix.CallerBug[];
cellType ← PipalSinix.CreateIcon[NARROW [result]];
PipalCore.PutObject[mode.decoration, cellType, object];
Check public
IF
NOT CheckAndDecorate[object, iconCT.public, cellType.public]
THEN {
TerminalIO.PutF["*** Error: icon public and schematic public do NOT conform\n"];
TerminalIO.PutF["Icon public is:"];
CoreOps.PrintWire[wire: iconCT.public, out: TerminalIO.TOS[], level: LAST [NAT]];
TerminalIO.PutF["\nSchematic public is:"];
CoreOps.PrintWire[wire: cellType.public, out: TerminalIO.TOS[], level: LAST [NAT]];
TerminalIO.PutF["\n"];
ERROR
};
result ← cellType;
};
wire, unnamedWire => {
FlushName: CoreOps.EachWireProc = {[] ← CoreOps.SetShortWireName[wire, NIL]};
resultWire: WireSeq;
IF result=
NIL
THEN {
result ← resultWire ← iconCT.public;
IF icon.type = unnamedWire THEN [] ← CoreOps.VisitWireSeq[resultWire, FlushName];
RETURN;
};
WITH result
SELECT
FROM
wires: Wires => result ← resultWire ← CoreOps.CreateWire[wires];
ww: Wire => {result ← ww; resultWire ← CoreOps.CreateWire[LIST [ww]]};
cellType: CellType => {
IF props#NIL THEN ERROR;
result ← resultWire ← CoreOps.CopyWire[cellType.public];
};
ENDCASE => ERROR;
special case
IF
NOT CheckAndDecorate[object, iconCT.public, resultWire]
THEN {
TerminalIO.PutF["*** Error: icon wire and result wire icon don't conform\n"];
TerminalIO.PutF["Icon wire is:"];
CoreOps.PrintWire[wire: iconCT.public, out: TerminalIO.TOS[], level: LAST [NAT]];
TerminalIO.PutF["\nResult wire is:"];
CoreOps.PrintWire[wire: resultWire, out: TerminalIO.TOS[], level: LAST [NAT]];
TerminalIO.PutF["\n"];
ERROR
};
IF icon.type = unnamedWire THEN [] ← CoreOps.VisitWireSeq[resultWire, FlushName];
};
ENDCASE => SIGNAL PipalSinix.CallerBug[];
};
ExtractSchematicSequence: PipalSinix.ExtractProc = {
seq: PipalMos.SchematicSequence ← NARROW [object];
value: REF INT ← NARROW [Eval[context, seq.repetition]];
count: NAT ← value^;
wholeCT, baseCT, sequence: CellType;
internal, baseActual, basePublic: WireSeq;
baseInst: CoreClasses.RecordCellType;
sequenceWires, flatSequenceWires: Wires ← NIL;
[result, props] ← PipalSinix.Extract[seq.child, mode, context];
IF props#NIL THEN ERROR;
wholeCT ← NARROW [result];
baseInst ← NARROW [wholeCT.data];
internal ← baseInst.internal;
There should be only one subcell
IF baseInst.size#1
THEN {
TerminalIO.PutF["*** ExtractSchematicSequence: Sequence should contain one and only one subcell.\n"];
ERROR};
baseCT ← baseInst[0].type; baseActual ← baseInst[0].actual; basePublic ← baseCT.public;
we check that there is no internal only
FOR i:
NAT
IN [0 .. internal.size)
DO
wire: Wire = internal[i];
name: ROPE ← CoreOps.GetShortWireName[wire];
IF name=NIL THEN name ← "some wire";
IF
NOT CoreOps.RecursiveMember[baseActual, wire]
THEN {
TerminalIO.PutF["*** ExtractSchematicSequence: %g is not connected to subcell.\n", IO.rope[name]];
ERROR};
IF
NOT CoreOps.RecursiveMember[wholeCT.public, wire]
THEN {
TerminalIO.PutF["*** ExtractSchematicSequence: %g is not public.\n", IO.rope[name]];
ERROR};
ENDLOOP;
We compute which wires are going to be sequenced
FOR i:
NAT
IN [0 .. basePublic.size)
DO
IF CoreProperties.GetWireProp[baseActual[i], $Sequence]#
NIL
THEN sequenceWires ← CONS [basePublic[i], sequenceWires];
IF CoreProperties.GetWireProp[baseActual[i], $FlatSequence]#
NIL
THEN flatSequenceWires ← CONS [basePublic[i], flatSequenceWires];
ENDLOOP;
We create the sequence
sequence ← CoreClasses.CreateSequence[
args:
NEW [CoreClasses.SequenceCellTypeRec ← [
base: baseCT, count: count,
sequence: FindPorts[basePublic, sequenceWires],
flatSequence: FindPorts[basePublic, flatSequenceWires]
]],
name: CoreOps.GetCellTypeName[wholeCT], props: props
];
Attention here: we copy only a few selected properties, because it is bad to have designers rely on the way the sequence is obtained (extracting the whole thing, thus gathering properties). Moreover, if we copy all, things like the Sequence information will crap up, thus messing the level above (e.g. if it is a sequence itself).
FOR i:
NAT
IN [0..sequence.public.size)
DO
iconWire: Wire = CoreClasses.CorrespondingActual[baseInst[0], basePublic[i]];
PipalCore.PutPort[PipalCore.schematicsDecoration, sequence.public[i], iconWire];
PipalCore.PutGeometry[PipalCore.schematicsDecoration, sequence.public[i], PipalCore.GetGeometry[PipalCore.schematicsDecoration, iconWire]];
ENDLOOP;
The object decoration!
PipalCore.PutObject[mode.decoration, sequence, object];
result ← sequence;
};
FindPorts:
PROC [basePublic: WireSeq, wires: Wires]
RETURNS [set: CoreClasses.SequenceSet] = {
nats: LIST OF NAT ← NIL;
size: NAT ← 0;
WHILE wires#
NIL
DO
FOR w:
NAT
IN [0 .. basePublic.size)
DO
sequenceName: ROPE ← CoreOps.GetShortWireName[wires.first];
IF wires.first=basePublic[w]
OR (sequenceName#
NIL
AND Rope.Equal[sequenceName, CoreOps.GetShortWireName[basePublic[w]]])
THEN {
nats ← CONS [w, nats]; size ← size + 1;
EXIT};
REPEAT FINISHED => ERROR;
ENDLOOP;
wires ← wires.rest;
ENDLOOP;
set ← NEW [CoreClasses.SequenceSetRec[size]];
FOR i: INT IN [0 .. size) DO set[i] ← nats.first; nats ← nats.rest ENDLOOP;
};
Utilities for the implementation
CheckAndDecorate:
PROC [object: Object, drawnPublic, resultPublic: WireSeq]
RETURNS [ok:
BOOL ←
TRUE] = {
resultToDrawn: RefTab.Ref ← RefTab.Create[]; -- associates resultPublic to drawnPublic
Construct the association by searching in resultPublic for every name found in drawnPublic
FOR i:
NAT
IN [0 .. drawnPublic.size)
DO
EachResultWire: CoreOps.EachWireProc = {
resultName: ROPE ← CoreOps.GetShortWireName[wire];
IF NOT Rope.Equal[resultName, drawnName] THEN RETURN;
IF wire=resultWire THEN RETURN;
IF resultWire#NIL THEN {TerminalIO.PutF["*** Drawn Icon has a wire %g whose name appears more than once in the schematic\n", IO.rope[drawnName]]; quit ← TRUE; ok ← FALSE; RETURN};
resultWire ← wire;
};
drawnWire: Wire ← drawnPublic[i];
drawnName: ROPE ← CoreOps.GetShortWireName[drawnWire];
resultWire: Wire ← NIL;
IF drawnName=NIL THEN {TerminalIO.PutF["*** Drawn Icon has an unnamed wire\n"]; ok ← FALSE; LOOP};
IF CoreOps.VisitWire[resultPublic, EachResultWire] THEN LOOP;
IF resultWire=NIL THEN {TerminalIO.PutF["*** Drawn Icon has wire %g that doesn't correspond to any wire in the schematic\n", IO.rope[drawnName]]; ok ← FALSE; LOOP};
We decorate the resultWire with the pins of drawnWire
PipalCore.PutPort[mode.decoration, resultWire, PipalCore.GetPort[mode.decoration, drawnWire]];
[] ← RefTab.Store[resultToDrawn, resultWire, drawnWire];
ENDLOOP;
Ensure that each resultPublic corresponds to some iconic Wire (apart may be from the wires in globalNames). Warning only for those.
FOR i:
NAT
IN [0 .. resultPublic.size)
DO
resultWire: Wire ← resultPublic[i];
resultName: ROPE ← CoreOps.GetShortWireName[resultWire];
drawnWire: Wire ← NARROW [RefTab.Fetch[resultToDrawn, resultWire].val];
IF resultName=NIL THEN LOOP;
IF drawnWire#NIL THEN LOOP;
IF RopeList.Memb[globalNames, resultName] THEN LOOP;
TerminalIO.PutF["*** Warning: schematic has wire %g that corresponds to no wire in the drawn Icon\n", IO.rope[resultName]];
ENDLOOP;
};
ProcessGlobalName:
PROC [object: Object, fused: RefTab.Ref, instances:
LIST
OF CoreClasses.CellInstance, name:
ROPE] = {
global: Wire;
globals: Wires;
InsertGlobal:
PROC [wire: Wire] = {
IF wire.size#0 THEN SIGNAL GlobalNonAtomic[object, name, wire];
IF NOT CoreOps.Member[globals, wire] THEN globals ← CONS [wire, globals];
};
FindGlobals: CoreOps.EachWirePairProc = {
act: Wire ← PipalSinix.RootWire[fused, actualWire];
actualName: ROPE = CoreOps.GetShortWireName[act];
IF NOT Rope.Equal[CoreOps.GetShortWireName[publicWire], name] THEN RETURN;
IF actualName=NIL OR Rope.Equal[actualName, name] THEN InsertGlobal[act];
};
EachWire:
PROC [wire: Core.Wire] = {
IF Rope.Equal[CoreOps.GetShortWireName[wire], name] THEN InsertGlobal[wire];
};
FOR list:
LIST
OF CoreClasses.CellInstance ← instances, list.rest
WHILE list#
NIL
DO
[] ← CoreOps.VisitBindingSeq[list.first.actual, list.first.type.public, FindGlobals];
ENDLOOP;
[] ← PipalSinix.EnumerateRoots[fused, EachWire];
IF globals=NIL THEN RETURN;
global ← CoreOps.SetShortWireName[globals.first, name];
CoreProperties.PutWireProp[global, $Public, $Public];
globals ← globals.rest;
WHILE globals#
NIL
DO
global ← PipalSinix.StructuredFusion[mode, object, fused, global, globals.first];
globals ← globals.rest;
ENDLOOP;
};
PostProcessFused: PipalSinix.PostProcessProc = {
FOR names:
ROPES ← globalNames, names.rest
WHILE names#
NIL
DO
ProcessGlobalName[object, fused, instances, names.first];
ENDLOOP;
PipalSinix.SchematicsFusionByName[mode, object, context, fused, instances];
};
Scheme Functions
ToCedar:
PROC [primitive: Scheme.Primitive, arg1, arg2, arg3: Any, pl: Scheme.ProperList]
RETURNS [result: Any] = {
result ← SchemeToCedar[arg1];
};
CreateWire:
PROC [primitive: Scheme.Primitive, arg1, arg2, arg3: Any, pl: Scheme.ProperList]
RETURNS [result: Any] = {
result ← CoreOps.CreateWire[];
};
CreateTransistor:
PROC [primitive: Scheme.Primitive, arg1, arg2, arg3: Any, pl: Scheme.ProperList]
RETURNS [result: Any] = {
result ← CoreClasses.CreateTransistor[
SELECT arg1 FROM $ne => nE, $pe => pE, $nd => nD, ENDCASE => ERROR,
SchemeToCedarInt[arg2],
SchemeToCedarInt[arg3]
];
};
Module Initialization
Pipal.PutClassMethod[Pipal.annotationClass, mode.extractMethod, NEW [PipalSinix.ExtractProc ← ExtractAnnotation]];
Pipal.PutClassMethod[PipalMos.starClass, mode.extractMethod, NEW [PipalSinix.ExtractProc ← ExtractStar]];
Pipal.PutClassMethod[PipalMos.schematicIconClass, mode.extractMethod, NEW [PipalSinix.ExtractProc ← ExtractSchematicIcon]];
Pipal.PutClassMethod[PipalMos.schematicSequenceClass, mode.extractMethod,
NEW [PipalSinix.ExtractProc ← ExtractSchematicSequence]];
PipalSinix.schematicsMode ← mode;
Scheme.DefinePrimitive["cedar", 1, FALSE, ToCedar, "converts a Scheme argument to a Cedar argument", initialEnvironment];
Scheme.DefinePrimitive["createwire", 0, FALSE, CreateWire, "creates a Core wire", initialEnvironment];
Scheme.DefinePrimitive["createtransistor", 3, FALSE, CreateTransistor, "creates a Core transistor", initialEnvironment];