-- coreMXCode.mesa
DIRECTORY Atom, Convert, Core, CoreClasses, CoreOps, Rope, Scheme;
coreMXCode: CEDAR PROGRAM
IMPORTS Atom, Convert, CoreClasses, CoreOps, Scheme
= BEGIN OPEN Scheme;
SymbolFromRope: PROC [Rope.ROPE] RETURNS [Symbol] ~ Atom.MakeAtom;
RopeFromSymbol: PROC [Symbol] RETURNS [Rope.ROPE] ~ Atom.GetPName;
TheCellInstance: PROC [a: Any] RETURNS [CoreClasses.CellInstance] = {
WITH a SELECT FROM
a: CoreClasses.CellInstance => RETURN [a];
ENDCASE => Complain[a, "not a CoreClasses.CellInstance"];
};
TheRecordCellType: PROC [a: Any] RETURNS [CoreClasses.RecordCellType] = {
WITH a SELECT FROM
a: CoreClasses.RecordCellType => RETURN [a];
ENDCASE => Complain[a, "not a CoreClasses.RecordCellType"];
};
TheCellType: PROC [a: Any] RETURNS [Core.CellType] = {
WITH a SELECT FROM
a: Core.CellType => RETURN [a];
ENDCASE => Complain[a, "not a Core.CellType"];
};
TheCellClass: PROC [a: Any] RETURNS [Core.CellClass] = {
WITH a SELECT FROM
a: Core.CellClass => RETURN [a];
ENDCASE => Complain[a, "not a Core.CellClass"];
};
TheWire: PROC [a: Any] RETURNS [Core.Wire] = {
WITH a SELECT FROM
a: Core.Wire => RETURN [a];
ENDCASE => Complain[a, "not a Core.Wire"];
};
TheProperties: PROC [a: Any] RETURNS [Core.Properties] = {
WITH a SELECT FROM
a: Core.Properties => RETURN [a];
ENDCASE => Complain[a, "not a Core.Properties"];
};
corePrim: PROC [SELF: Primitive, ARG1,ARG2,ARG3: Any, REST: ProperList] RETURNS [result: Any ← unspecified] = {
POP: PROC RETURNS [a: Any ← undefined] = {
IF REST#NIL THEN {a ← REST.car; REST ← NARROW[REST.cdr]}};
DATA: Pair ~ NARROW[SELF.data];
env: Environment ~ NARROW[DATA.cdr];
SELECT NAT[NARROW[DATA.car, REF INT]↑] FROM
22 => {
cellInstance: Any ← ARG1;
result ← TheCellInstance[cellInstance].properties;
};
21 => {
cellInstance: Any ← ARG1;
result ← TheCellInstance[cellInstance].type;
};
20 => {
cellInstance: Any ← ARG1;
result ← TheCellInstance[cellInstance].actual;
};
19 => {
recordCellType: Any ← ARG1;
instance: Any ← ARG2;
result ← TheRecordCellType[recordCellType].instances[TheINT[instance]];
};
18 => {
recordCellType: Any ← ARG1;
result ← MakeFixnum[TheRecordCellType[recordCellType].size];
};
17 => {
recordCellType: Any ← ARG1;
result ← TheRecordCellType[recordCellType].internal;
};
16 => {
result ← currentCellType;
};
15 => {
cellType: Any ← ARG1;
result ← StringFromRope[CoreOps.GetCellTypeName[TheCellType[cellType]]];
};
14 => {
cellType: Any ← ARG1;
result ← CoreOps.ToBasic[TheCellType[cellType]];
};
13 => {
cellType: Any ← ARG1;
result ← TheCellType[cellType].properties;
};
12 => {
cellType: Any ← ARG1;
result ← TheCellType[cellType].data;
};
11 => {
cellType: Any ← ARG1;
result ← TheCellType[cellType].public;
};
10 => {
cellType: Any ← ARG1;
result ← TheCellType[cellType].class;
};
9 => {
result ← CoreClasses.transistorCellClass;
};
8 => {
result ← CoreClasses.recordCellClass;
};
7 => {
cellClass: Any ← ARG1;
result ← TheCellClass[cellClass].properties;
};
6 => {
cellClass: Any ← ARG1;
result ← StringFromRope[TheCellClass[cellClass].name];
};
5 => {
wire: Any ← ARG1;
result ← StringFromRope[CoreOps.GetShortWireName[TheWire[wire]]];
};
4 => {
wire: Any ← ARG1;
child: Any ← ARG2;
result ← TheWire[wire].elements[TheINT[child]];
};
3 => {
wire: Any ← ARG1;
result ← MakeFixnum[TheWire[wire].size];
};
2 => {
wire: Any ← ARG1;
result ← TheWire[wire].properties;
};
1 => {
size: Any ← ARG1;
name: Any ← ARG2;
props: Any ← ARG3;
result ← CoreOps.CreateWires[TheINT[size], IF name#undefined THEN TheROPE[name] ELSE NIL, IF props#undefined THEN TheProperties[props] ELSE NIL];
};
0 => {
int: Any ← ARG1;
result ← StringFromRope[Convert.RopeFromCard[TheINT[int]]];
};
ENDCASE => ERROR
};
coreInit: PROC [env: Environment] = {
DefinePrimitive[name: "cell-instance-properties", nArgs: 1, proc: corePrim, doc: "(cell-instance) cellInstance.properties", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[22], env]];
DefinePrimitive[name: "cell-instance-type", nArgs: 1, proc: corePrim, doc: "(cell-instance) cellInstance.type", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[21], env]];
DefinePrimitive[name: "cell-instance-actual", nArgs: 1, proc: corePrim, doc: "(cell-instance) cellInstance.actual", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[20], env]];
DefinePrimitive[name: "record-cell-type-instance", nArgs: 2, proc: corePrim, doc: "(record-cell-type instance) recordCellType.instances[instance]", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[19], env]];
DefinePrimitive[name: "record-cell-type-size", nArgs: 1, proc: corePrim, doc: "(record-cell-type) recordCellType.size", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[18], env]];
DefinePrimitive[name: "record-cell-type-internal", nArgs: 1, proc: corePrim, doc: "(record-cell-type) recordCellType.internal", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[17], env]];
DefinePrimitive[name: "current-cell-type", nArgs: 0, proc: corePrim, doc: "() return current cell type", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[16], env]];
DefinePrimitive[name: "cell-type-name", nArgs: 1, proc: corePrim, doc: "(cell-type) name of cell type", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[15], env]];
DefinePrimitive[name: "cell-type-to-basic", nArgs: 1, proc: corePrim, doc: "(cell-type) maximal recast of cell-type", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[14], env]];
DefinePrimitive[name: "cell-type-properties", nArgs: 1, proc: corePrim, doc: "(cell-type) cellType.properties", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[13], env]];
DefinePrimitive[name: "cell-type-data", nArgs: 1, proc: corePrim, doc: "(cell-type) cellType.data", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[12], env]];
DefinePrimitive[name: "cell-type-public", nArgs: 1, proc: corePrim, doc: "(cell-type) cellType.public", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[11], env]];
DefinePrimitive[name: "cell-type-class", nArgs: 1, proc: corePrim, doc: "(cell-type) cellType.class", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[10], env]];
DefinePrimitive[name: "transistor-cell-class", nArgs: 0, proc: corePrim, doc: "() transistor cell class", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[9], env]];
DefinePrimitive[name: "record-cell-class", nArgs: 0, proc: corePrim, doc: "() record cell class", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[8], env]];
DefinePrimitive[name: "cell-class-properties", nArgs: 1, proc: corePrim, doc: "(cell-class) cellClass.properties", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[7], env]];
DefinePrimitive[name: "cell-class-name", nArgs: 1, proc: corePrim, doc: "(cell-class) cellClass.name", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[6], env]];
DefinePrimitive[name: "wire-name-short", nArgs: 1, proc: corePrim, doc: "(wire) short wire name", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[5], env]];
DefinePrimitive[name: "wire-child", nArgs: 2, proc: corePrim, doc: "(wire child) wire.elements[child]", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[4], env]];
DefinePrimitive[name: "wire-size", nArgs: 1, proc: corePrim, doc: "(wire) wire.size", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[3], env]];
DefinePrimitive[name: "wire-props", nArgs: 1, proc: corePrim, doc: "(wire) wire.properties", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[2], env]];
DefinePrimitive[name: "create-wires", nArgs: 3, proc: corePrim, doc: "(size [ name ] [ props ]) create a wire", env: env, optional: 2, dotted: FALSE, data: Cons[MakeFixnum[1], env]];
DefinePrimitive[name: "int-to-string", nArgs: 1, proc: corePrim, doc: "(int) convert int to string", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[0], env]];
};
currentCellType: Core.CellType ← NIL;
RegisterInit[coreInit];
END.