FunsimToCoreImpl.Mesa
Last munged by Mike Spreitzer on March 10, 1987 1:44:17 pm PST
Last tweaked by Mike Spreitzer on November 30, 1988 9:10:55 am PST
DIRECTORY Atom, Core, CoreClasses, CoreCreate, CoreOps, CoreProperties, FS, FunsimToCore, IO, PartialOrders, Process, RefTab, RefTabExtras, Rope, ViewerClasses, ViewerIO;
FunsimToCoreImpl:
CEDAR
PROGRAM
IMPORTS Atom, CoreClasses, CoreCreate, CoreOps, CoreProperties, FS, IO, PartialOrders, Process, RefTab, RefTabExtras, Rope, ViewerIO
EXPORTS FunsimToCore
= BEGIN OPEN CCl: CoreClasses, CCr: CoreCreate, CO: CoreOps, CP: CoreProperties, FunsimToCore;
LORA: TYPE = LIST OF REF ANY;
InstanceList: TYPE = LIST OF CCl.CellInstance;
Binding: TYPE = RECORD [formal, actual: ROPE];
behaviorProp: ATOM = CP.RegisterProperty[$Behavior];
creatorProp: ATOM = CP.RegisterProperty[$Creator];
autoArrayProp: ATOM = CP.RegisterProperty[$AutoArrays];
arrayStyleProp: ATOM = CP.RegisterProperty[$ArrayStyle];
componentsProp: ATOM = CP.RegisterUnprintableProperty[$Components];
privateNetsProp: ATOM = CP.RegisterUnprintableProperty[$PrivateNets];
dirProp: ATOM = CP.RegisterProperty[$FunsimPortDirection];
widthProp: ATOM = CP.RegisterProperty[$FunsimNodeWidth];
initProp: ATOM = CP.RegisterProperty[$FunsimNodeInitialValue];
log: IO.STREAM ← NIL;
logV: ViewerClasses.Viewer ← NIL;
before, after: INT ← noIndex;
cellTypes, widthHints, unusedWidthHints, sequencedCellTypes: Table;
counts: Counts;
noIndex: INT = LAST[INT];
Bitch:
PROC [fmt:
ROPE, v1, v2, v3, v4, v5:
IO.Value ← [null[]]] = {
IF logV=NIL OR logV.destroyed THEN {log ← ViewerIO.CreateViewerStreams["FunsimToCore log"].out; logV ← ViewerIO.GetViewerFromStream[log]};
IF before # noIndex OR after # noIndex THEN log.PutF["[%g..%g] ", [integer[before]], [integer[after]]];
log.PutF[Rope.Cat[fmt, "\n"], v1, v2, v3, v4, v5];
};
BitchL:
PROC [fmt:
ROPE, vl:
LIST
OF
IO.Value] = {
IF logV=NIL OR logV.destroyed THEN {log ← ViewerIO.CreateViewerStreams["FunsimToCore log"].out; logV ← ViewerIO.GetViewerFromStream[log]};
IF before # noIndex OR after # noIndex THEN log.PutF["[%g..%g] ", [integer[before]], [integer[after]]];
log.PutFL[Rope.Cat[fmt, "\n"], vl];
};
callOrder:
PUBLIC PartialOrder;
Greatest is root of design; leaves are small.
Convert:
PUBLIC
PROC [fromFileName:
ROPE]
RETURNS [rt: Table, cs: Counts] = {
from: IO.STREAM ← FS.StreamOpen[fromFileName, read];
FindOrder:
PROC [key, val:
REF
ANY]
RETURNS [quit:
BOOLEAN ←
FALSE]
--RefTab.EachPairAction-- = {
cellType: Core.CellType = NARROW[val];
componentsL: LORA = NARROW[CP.GetCellTypeProp[cellType, componentsProp]];
IF componentsL # NIL THEN FindOrderInComponents[componentsL, cellType];
};
MakeInsides:
PROC [rank:
INT, elt:
REF
ANY, v: PartialOrders.Vertex]
--PartialOrders.Consumer-- = {
cellType: Core.CellType ~ NARROW[elt];
componentsL: LORA ~ NARROW[CP.GetCellTypeProp[cellType, componentsProp]];
privateNetsL: LORA ~ NARROW[CP.GetCellTypeProp[cellType, privateNetsProp]];
isLeaf: BOOL ~ CP.GetCellTypeProp[cellType, behaviorProp] # NIL;
isntLeaf: BOOL ~ componentsL#NIL OR privateNetsL#NIL;
IF isLeaf = isntLeaf THEN ERROR;
IF isLeaf
THEN MakeLeaf[cellType]
ELSE MakeComposite[cellType, IF privateNetsL#NIL THEN privateNetsL ELSE LIST[$PrivateNets], componentsL];
};
Bitch["\nConverting %g", [rope[fromFileName]]];
callOrder ← PartialOrders.Create[];
cellTypes ← RefTab.Create[hash: RefTabExtras.HashRopeCaseless, equal: RefTabExtras.EqualRopeCaseless];
sequencedCellTypes ← RefTab.Create[hash: RefTabExtras.HashRopeCaseless, equal: RefTabExtras.EqualRopeCaseless];
counts ← [];
{first: LORA ~ NARROW[from.GetRefAny[]];
SELECT first.first
FROM
$CellType => {widthHints ← unusedWidthHints ← NIL; from.SetIndex[0]};
$WidthHints => GrokWidthHints[first];
ENDCASE => ERROR};
FOR i:
INT ← from.SkipWhitespace[], from.SkipWhitespace[]
WHILE
NOT from.EndOf[]
DO
cellTypeName: ROPE;
cellType: Core.CellType =
NEW [Core.CellTypeRec ← [
class: NIL,
public: NIL,
data: NIL,
properties: NIL
]];
cellTypeL: LORA;
before ← from.GetIndex[];
cellTypeL ← NARROW[from.GetRefAny[]];
after ← from.GetIndex[];
IF Length[cellTypeL] < 2 THEN {Bitch["Malformed CellType form: %g", [refAny[cellTypeL]]]; LOOP};
IF cellTypeL.first # $CellType THEN {Bitch["CellType keyword missing"]; LOOP};
counts.totalCellTypes ← counts.totalCellTypes + 1;
cellTypeName ← ToName[cellTypeL.rest.first];
[] ← CO.SetCellTypeName[cellType, cellTypeName];
IF NOT cellTypes.Insert[cellTypeName, cellType] THEN Bitch["CellType %g multiply defined", [rope[cellTypeName]]];
SetOV[cellType, callOrder.Insert[cellType]];
FOR assns:
LORA ← cellTypeL.rest.rest, assns.rest
WHILE assns #
NIL
DO
assn: LORA = NARROW[assns.first];
a: ATOM = NARROW[assn.first];
SELECT a
FROM
$AutoArrays => CP.PutCellTypeProp[cellType, autoArrayProp, $TRUE];
$PublicNets => GrokPublicNets[assn.rest, cellType];
$PrivateNets => CP.PutCellTypeProp[cellType, a, assn];
componentsProp => {
CP.PutCellTypeProp[cellType, a, assn];
counts.composites ← counts.composites + 1;
};
behaviorProp => {
val: ROPE = ToName[assn.rest.first];
CP.PutCellTypeProp[cellType, a, val];
counts.leaves ← counts.leaves + 1;
};
creatorProp => {
val: ROPE = ToName[assn.rest.first];
CP.PutCellTypeProp[cellType, a, val];
};
ENDCASE => {
Bitch["Unrecognized section: %g", [atom[a]]];
CP.PutCellTypeProp[cellType, a, assn.rest];
};
ENDLOOP;
ENDLOOP;
from.Close[];
before ← after ← noIndex;
[] ← cellTypes.Pairs[FindOrder];
callOrder.Enumerate[increasing, NIL, MakeInsides];
RETURN [cellTypes, counts];
};
GrokWidthHints:
PROC [lora:
LORA] ~ {
widthHints ← RefTab.Create[hash: RefTabExtras.HashRopeCaseless, equal: RefTabExtras.EqualRopeCaseless];
unusedWidthHints ← RefTab.Create[hash: RefTabExtras.HashRopeCaseless, equal: RefTabExtras.EqualRopeCaseless];
FOR lora ← lora.rest, lora.rest
WHILE lora #
NIL
DO
term: LORA ~ NARROW[lora.first];
IF term.rest.rest # NIL THEN ERROR;
IF NOT widthHints.Insert[ToName[term.first], term.rest.first] THEN ERROR;
IF NOT unusedWidthHints.Insert[ToName[term.first], $T] THEN ERROR;
ENDLOOP;
lora ← lora;
};
ovProp:
ATOM =
CP.RegisterProperty[$FunsimCallOrderVertex,
CP.Props[[CP.propPrint, CP.PropDontPrint]]];
SetOV:
PROC [ct: Core.CellType, v: PartialOrders.Vertex] = {
CP.PutCellTypeProp[ct, ovProp, v]};
GetOV:
PROC [ct: Core.CellType]
RETURNS [v: PartialOrders.Vertex] = {
v ← PartialOrders.NarrowToVertex[CP.GetCellTypeProp[ct, ovProp]]};
FindOrderInComponents:
PROC [assn:
LORA, cellType: Core.CellType] = {
cellTypeName: ROPE = CO.GetCellTypeName[cellType];
IF assn.first # componentsProp THEN ERROR;
FOR elts:
LORA ← assn.rest, elts.rest
WHILE elts #
NIL
DO
elt: LORA = NARROW[elts.first];
instanceName: ROPE = ToName[elt.first];
subTypeName: ROPE = ToName[elt.rest.first];
subType: Core.CellType = NARROW[cellTypes.Fetch[subTypeName].val];
IF subType = NIL THEN Bitch["CellType %g undefined (instance %g in CellType %g)", [rope[subTypeName]], [rope[instanceName]], [rope[cellTypeName]]];
callOrder.Relate[lesser: GetOV[subType], greater: GetOV[cellType]];
ENDLOOP;
assn ← assn;
};
leafClass: Core.CellClass ←
NEW [Core.CellClassRec ← [
name: "FunsimLeaf",
layersProps: FALSE]];
GrokPublicNets:
PROC [assn:
LORA, cellType: Core.CellType] = {
cellTypeName: ROPE = CO.GetCellTypeName[cellType];
autoArrays: BOOL ~ AutoArrays[cellType];
len: INT = Length[assn];
public: Core.WireSeq = NEW [Core.WireRec[len]];
j: INT ← 0;
IF cellType.public # NIL THEN Bitch["Redefinition of public wire of cell Type %g", [rope[cellTypeName]]];
FOR elts:
LORA ← assn, elts.rest
WHILE elts #
NIL
DO
elt: LORA = NARROW[elts.first];
wireName: ROPE = ToName[elt.first];
direction: ATOM = NARROW[elt.rest.first];
oldIndex: INT = WSLookup[public, wireName];
IF oldIndex # notFound THEN {Bitch["Public wire %g duplicates some other in cell type %g", [rope[wireName]], [rope[cellTypeName]]]; LOOP};
IF autoArrays # (elt.rest.rest#NIL) THEN ERROR;
public.elements[j] ← CO.CreateWire[name: wireName, props: CP.Props[[dirProp, direction]]];
IF autoArrays
THEN {
CP.PutWireProp[public.elements[j], arrayStyleProp, elt.rest.rest.first];
CP.PutWireProp[public.elements[j], widthProp, refOne];
};
j ← j + 1;
ENDLOOP;
cellType.public ← public;
};
refOne: REF INT ~ NEW [INT ← 1];
MakeLeaf:
PROC [cellType: Core.CellType] = {
behaviorID: ROPE = NARROW[CP.GetCellTypeProp[cellType, behaviorProp]];
IF behaviorID = NIL OR cellType.data # NIL THEN ERROR;
cellType.class ← leafClass;
cellType.data ← behaviorID;
};
MakeComposite:
PROC [cellType: Core.CellType, privates, components:
LORA] ~ {
cellTypeName: ROPE = CO.GetCellTypeName[cellType];
lenI: INT ~ Length[privates]-1 + cellType.public.size;
lenC: INT ~ Length[components]-1;
internal: Core.WireSeq ~ NEW [Core.WireRec[lenI]];
recordCellType: CCl.RecordCellType ~ NEW [CCl.RecordCellTypeRec[lenC]];
i: INT ← 0;
IF privates.first # privateNetsProp OR components.first # componentsProp THEN ERROR;
IF CP.GetCellTypeProp[cellType, behaviorProp] # NIL THEN ERROR;
IF cellType.data # NIL THEN ERROR;
recordCellType.internal ← internal;
cellType.data ← recordCellType;
cellType.class ← CCl.recordCellClass;
FOR i ← 0, i+1
WHILE i < cellType.public.size
DO
internal[i] ← cellType.public[i] ← SetWidth[cellType.public[i], NIL, cellType];
ENDLOOP;
FOR elts:
LORA ← privates.rest, elts.rest
WHILE elts #
NIL
DO
elt: LORA = NARROW[elts.first];
wireName: ROPE = ToName[elt.first];
oldIndex: INT = WSLookup[internal, wireName];
IF oldIndex # notFound THEN {Bitch["Internal wire %g duplicates some other in cell type %g", [rope[wireName]], [rope[cellTypeName]]]; LOOP};
internal[i] ← SetWidth[
CO.CreateWire[name: wireName, props: CP.Props[[initProp, elt.rest.rest.first]]],
NARROW[elt.rest.first],
cellType];
i ← i + 1;
ENDLOOP;
IF i # lenI THEN ERROR;
i ← 0;
FOR elts:
LORA ← components.rest, elts.rest
WHILE elts #
NIL
DO
elt: LORA = NARROW[elts.first];
instanceName: ROPE = ToName[elt.first];
subTypeName: ROPE = ToName[elt.rest.first];
subType: Core.CellType = NARROW[cellTypes.Fetch[subTypeName].val];
IF subType #
NIL
THEN {
ci: CCl.CellInstance = CCl.SetCellInstanceName[
NEW [CCl.CellInstanceRec ← [
actual: NEW [Core.WireRec[subType.public.size]],
type: subType
]],
instanceName
];
recordCellType.instances[i] ← ci;
FillinActuals[elt.rest.rest, ci, cellType];
EnsureConformance[ci, cellType];
}
ELSE ERROR;
i ← i + 1;
ENDLOOP;
};
SetWidth:
PROC [wire: Core.Wire, width:
REF
INT, cellType: Core.CellType]
RETURNS [ww: Core.Wire] ~ {
name: ROPE ~ CO.GetShortWireName[wire];
IF width=
NIL
THEN {
width ← NARROW[widthHints.Fetch[name].val];
IF unusedWidthHints.Delete[name] AND (width=NIL) THEN ERROR;
};
IF width=NIL THEN Bitch["No width hint for %g (in %g)", [rope[name]], [rope[CO.GetCellTypeName[cellType]]]];
IF CP.GetWireProp[wire, widthProp] # NIL THEN ERROR;
CP.PutWireProp[wire, widthProp, width];
IF width=NIL OR width^=1 THEN RETURN [wire];
ww ← CCr.Seq[size: width^];
ww.properties ← wire.properties;
};
FillinActuals:
PROC [actualsL:
LORA, ci: CCl.CellInstance, cellType: Core.CellType] = {
cellTypeName: ROPE = CO.GetCellTypeName[cellType];
subTypeName: ROPE = CO.GetCellTypeName[ci.type];
instanceName: ROPE = CCl.GetCellInstanceName[ci];
recordCellType: CCl.RecordCellType = NARROW[cellType.data];
aLen: INT = Length[actualsL];
style: {positional, sameName, impossible};
nSpec, nMatch, nDiff: INT ← 0;
someMatch: BOOL ← FALSE;
matches, diffs: ROPE ← NIL;
counts.totalInstances ← counts.totalInstances + 1;
FOR as:
LORA ← actualsL, as.rest
WHILE as #
NIL
DO
binding: Binding = ToBinding[as.first];
formalName: ROPE = binding.formal;
actualName: ROPE = binding.actual;
publicIndex: INT ← WSLookup[ci.type.public, IF formalName # NIL THEN formalName ELSE actualName];
internalIndex: INT ← WSLookup[recordCellType.internal, actualName];
SELECT
TRUE
FROM
formalName # NIL => nSpec ← nSpec + 1;
publicIndex = notFound => {nDiff ← nDiff + 1; diffs ← diffs.Cat[" ", actualName]};
ENDCASE => {nMatch ← nMatch + 1; matches ← matches.Cat[" ", actualName]};
IF internalIndex = notFound
THEN {
AddPublic[cellType, actualName, callOrder.IsSource[GetOV[cellType], decreasing]];
internalIndex ← WSLookup[recordCellType.internal, actualName];
};
IF formalName #
NIL
THEN {
IF publicIndex = notFound
THEN {
Bitch[
"Couldn't find %g.%g: %g[%g: %g, ...]",
[rope[cellTypeName]],
[rope[instanceName]],
[rope[subTypeName]],
[rope[formalName]],
[rope[actualName]]
];
}
ELSE {
ci.actual[publicIndex] ← recordCellType.internal[internalIndex];
};
};
ENDLOOP;
IF nSpec + nMatch + nDiff # aLen THEN ERROR;
SELECT
TRUE
FROM
nSpec+nMatch = aLen => style ← sameName;
aLen = ci.actual.size AND nDiff#0 => style ← positional;
ENDCASE => style ← impossible;
SELECT style
FROM
positional => {
j: INT ← 0;
counts.positional ← counts.positional + 1;
Bitch[
"%g%gPositional for %g.%g: %g",
[rope[IF aLen > 5 THEN "*" ELSE ""]],
[rope[IF nMatch#0 THEN "!" ELSE ""]],
[rope[cellTypeName]],
[rope[instanceName]],
[rope[subTypeName]]
];
FOR as:
LORA ← actualsL, as.rest
WHILE as #
NIL
DO
binding: Binding = ToBinding[as.first];
formalName: ROPE = binding.formal;
actualName: ROPE = binding.actual;
IF formalName=
NIL
THEN {
internalIndex: INT = WSLookup[recordCellType.internal, actualName];
ci.actual[j] ← recordCellType.internal[internalIndex];
};
j ← j + 1;
ENDLOOP;
FOR ai:
INT
IN [0 .. ci.actual.size)
DO
IF ci.actual[ai] =
NIL
THEN {
Bitch["%g.%g:%g[%g] missing",
[rope[cellTypeName]],
[rope[instanceName]],
[rope[subTypeName]],
[rope[CO.GetShortWireName[ci.type.public[ai]]]]
];
EXIT;
};
ENDLOOP;
ci ← ci;
};
sameName => {
counts.sameName ← counts.sameName + 1;
FOR j:
INT
IN [0 .. ci.actual.size)
DO
IF ci.actual[j] =
NIL
THEN {
actualName: ROPE = CO.GetShortWireName[ci.type.public[j]];
internalIndex: INT ← WSLookup[recordCellType.internal, actualName];
IF internalIndex = notFound
THEN {
AddPublic[cellType, actualName, callOrder.IsSource[GetOV[cellType], decreasing]];
internalIndex ← WSLookup[recordCellType.internal, actualName];
};
ci.actual[j] ← recordCellType.internal[internalIndex];
};
ci ← ci;
ENDLOOP;
ci ← ci;
};
impossible => {
data:
ROPE =
IO.PutFR[
"aLen=%g, public.size=%g, nMatch=%g, nDiff=%g%g",
[integer[aLen]],
[integer[ci.actual.size]],
[integer[nMatch]],
[integer[nDiff]],
[rope[
IF nMatch#0
AND nDiff#0
THEN
IO.PutFR[
", matches=(%g), diffs=(%g))",
[rope[matches]],
[rope[diffs]]
]
ELSE ""
]]
];
Bitch[
"Can't fill in actuals on instance %g in %g because [%g]",
[rope[instanceName]],
[rope[cellTypeName]],
[rope[data]]
];
};
ENDCASE => ERROR;
ci ← ci;
};
AddPublic:
PROC [cellType: Core.CellType, wireName:
ROPE, notPublic:
BOOL] = {
cellTypeName: ROPE = CO.GetCellTypeName[cellType];
recordCellType: CCl.RecordCellType = NARROW[cellType.data];
oldInternal: Core.Wire = recordCellType.internal;
newInternal: Core.Wire = NEW [Core.WireRec[oldInternal.size+1]];
newWire: Core.Wire ~ SetWidth[CO.CreateWire[name: wireName, props: NIL], NIL, cellType];
Bitch["Inferring %g wire %g in CellType %g", [rope[IF notPublic THEN "internal" ELSE "public"]], [rope[wireName]], [rope[cellTypeName]]];
FOR i: INT ← 0, i+1 WHILE i < oldInternal.size DO newInternal[i] ← oldInternal[i] ENDLOOP;
newInternal[oldInternal.size] ← newWire;
recordCellType.internal ← newInternal;
IF notPublic THEN RETURN;
{
oldPublic: Core.Wire = cellType.public;
newPublic: Core.Wire = NEW [Core.WireRec[oldPublic.size+1]];
FOR i: INT ← 0, i+1 WHILE i < oldPublic.size DO newPublic[i] ← oldPublic[i] ENDLOOP;
newPublic[oldPublic.size] ← newWire;
cellType.public ← newPublic;
RETURN}};
AddPrivate:
PROC [cellType: Core.CellType, wire: Core.Wire] = {
cellTypeName: ROPE = CO.GetCellTypeName[cellType];
wireName: ROPE ~ CO.GetShortWireName[wire];
recordCellType: CCl.RecordCellType = NARROW[cellType.data];
oldInternal: Core.Wire = recordCellType.internal;
newInternal: Core.Wire = NEW [Core.WireRec[oldInternal.size+1]];
i: INT ← 0;
Bitch["Inferring private wire %g in CellType %g", [rope[wireName]], [rope[cellTypeName]]];
FOR i ← 0, i+1 WHILE i < oldInternal.size DO newInternal[i] ← oldInternal[i] ENDLOOP;
newInternal.elements[oldInternal.size] ← wire;
recordCellType.internal ← newInternal;
};
EnsureConformance:
PROC [ci: CCl.CellInstance, parent: Core.CellType] ~ {
autoArrays: BOOL ~ AutoArrays[ci.type];
count: INT ← 1;
nSeq: INT ← 0;
IF ci.actual.size # ci.type.public.size THEN ERROR;
FOR i:
NAT
IN [0 .. ci.actual.size)
DO
a: Core.Wire ~ ci.actual[i];
p: Core.Wire ~ ci.type.public[i];
aSize: INT ~ IF a.size>1 THEN a.size ELSE IF a.size=0 THEN 1 ELSE ERROR;
aw: REF INT ~ NARROW[CP.GetWireProp[a, widthProp]];
pw: REF INT ~ NARROW[CP.GetWireProp[p, widthProp]];
IF aw=NIL OR aSize # aw^ THEN ERROR;
IF autoArrays
THEN {
constant:
BOOL ~
SELECT
CP.GetWireProp[p, arrayStyleProp]
FROM
$c => TRUE,
$a => FALSE,
ENDCASE => ERROR;
IF NOT constant THEN nSeq ← nSeq+1;
SELECT
TRUE
FROM
constant =>
IF aw^ # pw^
THEN BitchL["Constant mismatch in %g: %g (is %g) <-> (%g:%g).%g (is %g)",
LIST[
[rope[CO.GetCellTypeName[parent]]],
[rope[CO.GetShortWireName[a]]],
[integer[aw^]],
[rope[CCl.GetCellInstanceName[ci]]],
[rope[CO.GetCellTypeName[ci.type]]],
[rope[CO.GetShortWireName[p]]],
[integer[pw^]]
]];
aw^ = 1 => NULL;
count=1 => count ← aw^;
count#aw^ => Bitch["Disagreement (%g vs %g) on count for %g.%g:%g", [integer[count]], [integer[aw^]], [rope[CO.GetCellTypeName[parent]]], [rope[CCl.GetCellInstanceName[ci]]], [rope[CO.GetCellTypeName[ci.type]]]];
ENDCASE => NULL;
}
ELSE {
SELECT
TRUE
FROM
pw=NIL => ci.type.public[i] ← SetWidth[p, aw, ci.type];
pw#
NIL =>
IF aw^#pw^
THEN {
BitchL["Mismatch in %g: %g (is %g) <-> (%g:%g).%g (is %g)",
LIST[
[rope[CO.GetCellTypeName[parent]]],
[rope[CO.GetShortWireName[a]]],
[integer[aw^]],
[rope[CCl.GetCellInstanceName[ci]]],
[rope[CO.GetCellTypeName[ci.type]]],
[rope[CO.GetShortWireName[p]]],
[integer[pw^]]
]];
};
ENDCASE => ERROR;
};
ENDLOOP;
IF autoArrays
AND count#1
THEN {
baseType: Core.CellType ~ ci.type;
arrayType: Core.CellType ~ GetArrayType[baseType, count, nSeq];
IF arrayType.public.size # ci.actual.size THEN ERROR;
ci.type ← arrayType;
callOrder.Relate[lesser: GetOV[arrayType], greater: GetOV[parent]];
FOR i:
NAT
IN [0 .. arrayType.public.size)
DO
constant:
BOOL ~
SELECT
CP.GetWireProp[baseType.public[i], arrayStyleProp]
FROM
$c => TRUE,
$a => FALSE,
ENDCASE => ERROR;
a: Core.Wire ~ ci.actual[i];
p: Core.Wire ~ arrayType.public[i];
aSize: INT ~ IF a.size>1 THEN a.size ELSE IF a.size=0 THEN 1 ELSE ERROR;
pSize: INT ~ IF p.size>1 THEN p.size ELSE IF p.size=0 THEN 1 ELSE ERROR;
IF NOT Rope.Equal[CO.GetShortWireName[baseType.public[i]], CO.GetShortWireName[arrayType.public[i]]] THEN ERROR;
IF (NOT constant) AND pSize#count THEN ERROR;
SELECT
TRUE
FROM
aSize = pSize => NULL;
constant => NULL--we've already complained--;
aSize#1 => NULL--we've already complained--;
aSize=1 => {
arrayedWire: Core.Wire ~ GetArrayWire[a, count, parent];
ci.actual[i] ← arrayedWire;
};
ENDCASE => ERROR;
ENDLOOP;
};
};
GetArrayType:
PROC [baseType: Core.CellType, count, nSeq:
INT]
RETURNS [arrayType: Core.CellType] ~ {
baseName: ROPE ~ CO.GetCellTypeName[baseType];
arrayName: ROPE ~ IO.PutFR["%g*%g", [rope[baseName]], [integer[count]]];
arrayType ← NARROW[cellTypes.Fetch[arrayName].val];
IF arrayType =
NIL
THEN {
seq: CCl.SequenceCellType ~
NEW [CCl.SequenceCellTypeRec ← [
base: baseType,
count: count,
sequence: NEW [CCl.SequenceSetRec[nSeq]]
]];
n: NAT ← 0;
FOR i:
NAT
IN [0 .. baseType.public.size)
DO
constant:
BOOL ~
SELECT
CP.GetWireProp[baseType.public[i], arrayStyleProp]
FROM
$c => TRUE,
$a => FALSE,
ENDCASE => ERROR;
IF
NOT constant
THEN {
seq.sequence[n] ← i;
n ← n+1;
};
ENDLOOP;
IF n # nSeq THEN ERROR;
arrayType ← CCl.CreateSequence[seq, arrayName];
IF NOT cellTypes.Insert[arrayName, arrayType] THEN ERROR;
[] ← sequencedCellTypes.Store[baseName, baseType];
{v: PartialOrders.Vertex ~ callOrder.Insert[arrayType];
SetOV[arrayType, v];
callOrder.Relate[lesser: GetOV[baseType], greater: v];
}};
{seq: CCl.SequenceCellType ~ NARROW[arrayType.data];
IF seq.base # baseType OR seq.count # count THEN ERROR;
}};
GetArrayWire:
PROC [base: Core.Wire, count:
INT, parent: Core.CellType]
RETURNS [array: Core.Wire] ~ {
baseName: ROPE ~ CO.GetShortWireName[base];
arrayName: ROPE ~ IO.PutFR["%g*%g", [rope[baseName]], [integer[count]]];
record: CCl.RecordCellType ~ NARROW[parent.data];
index: INT ~ WSLookup[record.internal, arrayName];
IF base.size # 0 THEN ERROR;
IF index # notFound THEN RETURN [record.internal[index]];
array ← CCr.Seq[arrayName, count, base];
AddPrivate[parent, array];
};
AutoArrays:
PROC [ct: Core.CellType]
RETURNS [
BOOL] ~ {
RETURN [
SELECT
CP.GetCellTypeProp[ct, autoArrayProp]
FROM
$TRUE => TRUE,
NIL => FALSE,
ENDCASE => ERROR]};
notFound: INT = LAST[INT];
WSLookup:
PROC [wire: Core.Wire, name:
ROPE]
RETURNS [index:
INT] = {
FOR index ← 0, index + 1
WHILE index < wire.size
DO
IF wire[index] # NIL AND CO.GetShortWireName[wire[index]].Equal[name, FALSE] THEN RETURN;
ENDLOOP;
index ← notFound;
};
ToBinding:
PROC [ra:
REF
ANY]
RETURNS [b: Binding] = {
WITH ra
SELECT
FROM
lora:
LORA => {
IF Length[lora] # 2
THEN Bitch["Binding %g not of length 2", [refAny[lora]]]
ELSE {
b.formal ← ToName[lora.first];
b.actual ← ToName[lora.rest.first];
};
};
ENDCASE => b ← [NIL, ToName[ra]];
ra ← ra;
};
ToName:
PROC [ra:
REF
ANY]
RETURNS [rope:
ROPE] = {
WITH ra
SELECT
FROM
a: ATOM => rope ← Atom.GetPName[a];
r: ROPE => rope ← r;
ENDCASE => Bitch["Not a name: %g", [refAny[ra]]];
ra ← ra;
};
ToInt:
PROC [ra:
REF
ANY]
RETURNS [int:
INT] = {
WITH ra
SELECT
FROM
ri: REF INT => int ← ri^;
ENDCASE => Bitch["Not an INT: %g", [refAny[ra]]];
ra ← ra;
};
Length:
PROC [list:
LORA]
RETURNS [length:
INT] = {
length ← 0;
FOR list ← list, list.rest WHILE list # NIL DO length ← length + 1 ENDLOOP;
length ← length;
};
GetPriority:
PROC
RETURNS [Process.Priority]
~ {RETURN [Process.GetPriority[]]};
GetProcess:
PROC
RETURNS [
UNSAFE
PROCESS]
~ {RETURN [Process.GetCurrent[]]};
END.