-- Clean the list and check that they match in size
CleanAndCheck:
PROC [listObj: ListOb, isX:
BOOL]
RETURNS [newListObj: ListOb ←
NIL] =
BEGIN
size, prSize: INT ← -1;
prObj, obj: Object;
IF listObj=NIL THEN RETURN[NIL]; -- the list was NIL
-- Clean the list and compare the sizes
WHILE listObj#
NIL
DO
obj ← listObj.first;
IF obj=NIL THEN {listObj ← listObj.rest; LOOP}; -- skip NIL objects
size ← IF isX THEN CD.InterestSize[obj].y ELSE CD.InterestSize[obj].x; -- obj is garanteed to be non-NIL
newListObj ← CONS [obj, newListObj]; -- build clean list (reversed)
IF prSize<0 THEN {prSize ← size; prObj ← obj; listObj ← listObj.rest; LOOP}; -- first time
IF prSize#size THEN AbutProblem["These two objects do not match\n", isX, prObj, obj];
-- just before looping
prSize ← size; prObj ← obj; listObj ← listObj.rest;
ENDLOOP;
newListObj ← Reverse[newListObj];
END;
AbutX:
PUBLIC
PROC [t1,t2,t3,t4,t5,t6: Object ←
NIL]
RETURNS [obj: Object] =
{listOb: ListOb ← NIL;
RETURN [AbutListX[LIST[t1,t2,t3,t4,t5,t6]]]};
AbutY:
PUBLIC
PROC [t1,t2,t3,t4,t5,t6: Object ←
NIL]
RETURNS [obj: Object] = {
listOb: ListOb ← NIL; RETURN [AbutListY[LIST[t1,t2,t3,t4,t5,t6]]];
};
AbutListX:
PUBLIC
PROC [listOb: ListOb]
RETURNS [obj: Object] = {
listOb ← CleanAndCheck[listOb, TRUE];
obj ← IF listOb=NIL THEN NIL ELSE PWObjects.CreateNewAbutX[listOb];
};
AbutListY:
PUBLIC
PROC [listOb: ListOb]
RETURNS [obj: Object] = {
listOb ← CleanAndCheck[listOb, FALSE];
obj ← IF listOb=NIL THEN NIL ELSE PWObjects.CreateNewAbutY[listOb];
};
Lexico: TYPE = REF LexicoRec;
LexicoRec: TYPE = RECORD [loc: INT, size: INT, layer: CD.Layer];
-- key from data
GetKey: RedBlackTree.GetKey = {
[data: RedBlackTree.UserData] RETURNS [RedBlackTree.Key]
RETURN[data];
};
-- order is: coordinate, size, layer; name is not used
Compare: RedBlackTree.Compare = {
[k: RedBlackTree.Key, data: RedBlackTree.UserData] RETURNS [Basics.Comparison]
key: Lexico ← NARROW[data];
kk: Lexico ← NARROW[k];
SELECT
TRUE
FROM
kk.loc<key.loc => RETURN[less];
kk.loc>key.loc => RETURN[greater];
kk.size<key.size => RETURN[less];
kk.size>key.size => RETURN[greater];
kk.layer<key.layer => RETURN[less];
kk.layer>key.layer => RETURN[greater];
ENDCASE => RETURN[equal]; -- should this be an error???
};
CheckPair:
PROC [t1, t2: Object ←
NIL, isX:
BOOL] =
BEGIN
table1, table2: RedBlackTree.Table;
-- key from Instance
MakeLexico:
PROC[inst: Instance, obj: Object]
RETURNS [Lexico] = {
k: Lexico ←
NEW [LexicoRec ← [
IF isX THEN GetLocation[inst, obj].y ELSE GetLocation[inst, obj].x,
IF isX THEN CDOrient.OrientedSize[inst.ob.size, inst.orientation].y
ELSE CDOrient.OrientedSize[inst.ob.size, inst.orientation].x,
CDSymbolicObjects.GetLayer[inst]]];
RETURN[k];
};
ParseT1: PWPins.InstanceEnumerator = {
[inst: CD.Instance] RETURNS [quit: BOOL ← FALSE]
IF PWPins.GetSide[t1, inst].side=(
IF isX
THEN right
ELSE top)
THEN
{k: Lexico ← MakeLexico[inst, t1]; RedBlackTree.Insert[table1, k, k]};
};
ParseT2: PWPins.InstanceEnumerator = {
-- [inst: CD.Instance] RETURNS [quit: BOOL ← FALSE]
IF PWPins.GetSide[t2, inst].side=(
IF isX
THEN left
ELSE bottom)
THEN
{k: Lexico ← MakeLexico[inst, t2]; RedBlackTree.Insert[table2, k, k]};
};
CheckIfMatch: RedBlackTree.EachNode = {
[data: RedBlackTree.UserData] RETURNS [stop: BOOL ← FALSE]
-- scream if mismatch: this is not a complete test yet!!!
IF RedBlackTree.Lookup[table2,
NARROW[data]]=
NIL
THEN AbutProblem["The pins of these two objects do not match\n", isX, t1, t2];
};
-- create dictionnaries
table1 ← RedBlackTree.Create[GetKey, Compare];
table2 ← RedBlackTree.Create[GetKey, Compare];
-- parse right edge of t1 and left edge of t2, and fill up the dictionnaries
[] ← PWPins.EnumerateEdgePins[t1, ParseT1];
[] ← PWPins.EnumerateEdgePins[t2, ParseT2];
-- find pairs which match by position, size, and layer
RedBlackTree.EnumerateIncreasing[table1, CheckIfMatch];
END;
AbutCheckX:
PUBLIC
PROC [t1,t2,t3,t4,t5,t6: Object ←
NIL]
RETURNS [obj: Object] =
{RETURN [AbutCheckListX[LIST[t1, t2, t3, t4, t5, t6]]]};
AbutCheckY:
PUBLIC
PROC [t1,t2,t3,t4,t5,t6: Object ←
NIL]
RETURNS [obj: Object] =
{RETURN [AbutCheckListY[LIST[t1, t2, t3, t4, t5, t6]]]};
AbutCheckListX:
PUBLIC
PROC [listOb: ListOb]
RETURNS [obj: Object] =
{t1, t2: Object;
saveListOb: ListOb;
listOb ← CleanAndCheck[listOb, FALSE]; -- no more NILs
IF listOb=NIL THEN RETURN[NIL];
saveListOb ← listOb;
t1 ← listOb.first; listOb ← listOb.rest;
WHILE listOb#
NIL
DO
-- check adjacent pairs of edges
t2 ← listOb.first;
CheckPair[t1, t2, TRUE]; -- will raise an error if mismatch
t1 ← t2; listOb ← listOb.rest;
ENDLOOP;
obj ← PWObjects.CreateNewAbutX[saveListOb];
};
AbutCheckListY:
PUBLIC
PROC [listOb: ListOb]
RETURNS [obj: Object] =
{t1, t2: Object;
saveListOb: ListOb;
listOb ← CleanAndCheck[listOb, FALSE]; -- no more NILs
IF listOb=NIL THEN RETURN[NIL];
saveListOb ← listOb;
t1 ← listOb.first; listOb ← listOb.rest;
WHILE listOb#
NIL
DO
t2 ← listOb.first;
CheckPair[t1, t2, FALSE]; -- will raise an error if mismatch
t1 ← t2; listOb ← listOb.rest;
ENDLOOP;
obj ← PWObjects.CreateNewAbutY[saveListOb];
};
-- Arrays and other repetitions, using simple Abut. (other flavors of Abut ???)
MapFunctionX: PUBLIC PROC [function: XYFunction, lx: INT ← 0, ux: INT] RETURNS [new: Object] =
BEGIN
row: ListOb ← NIL;
IF lx>=ux THEN RETURN[NIL];
FOR x:
INT
DECREASING
IN [lx .. ux)
DO
row ← CONS [function[x, 0], row];
ENDLOOP;
RETURN [AbutListX[row]];
END;
MapFunctionY:
PUBLIC
PROC [function: XYFunction, ly:
INT ← 0, uy:
INT]
RETURNS [new: Object] =
BEGIN
row: ListOb ← NIL;
IF ly>=uy THEN RETURN[NIL];
FOR y:
INT
DECREASING
IN [ly .. uy)
DO
row ← CONS [function[0, y], row];
ENDLOOP;
RETURN [AbutListY[row]];
END;
MapFunction:
PUBLIC
PROC [function: XYFunction, lx:
INT ← 0, ux:
INT, ly:
INT ← 0, uy:
INT]
RETURNS [new: Object]=
BEGIN
rows: ListOb ← NIL;
IF lx>=ux OR ly>=uy THEN RETURN[NIL];
FOR y:
INT
DECREASING
IN [ly .. uy)
DO
row: ListOb ← NIL;
make a row
FOR x:
INT
DECREASING
IN [lx .. ux)
DO
row ← CONS [function[x, y], row];
ENDLOOP;
create the object corresponding to the row
rows ← CONS [AbutListX[row], rows];
ENDLOOP;
create the tile corresponding to the set of rows
RETURN [AbutListY[rows]];
END;
MapFunctionIndexPins:
PUBLIC
PROC [function: XYFunction, lx:
INT ← 0, ux:
INT, ly:
INT ← 0, uy:
INT, indexedPins:
ARRAY PWPins.Side
OF
LIST
OF
ROPE ←
ALL [
NIL]]
RETURNS [new: Object] = {
rows: ListOb ← NIL;
IF lx>=ux OR ly>=uy THEN RETURN[NIL];
FOR y:
INT
DECREASING
IN [ly .. uy)
DO
row: ListOb ← NIL;
make a row
FOR x:
INT
DECREASING
IN [lx .. ux)
DO
ob: Object ← function[x, y];
ChangePin: PWPins.ChangePinProc = {
side: PWPins.Side ← PWPins.GetSide[ob, oldPin];
name: ROPE ← CDSymbolicObjects.GetName[oldPin];
IF (
SELECT side
FROM
bottom => y#ly,
right => x#ux-1,
top => y#uy-1,
left => x#lx,
ENDCASE => ERROR) THEN RETURN;
newPin ← PWPins.CopyInstance[oldPin];
IF ~RopeList.Memb[indexedPins[side], name] THEN RETURN;
CDSymbolicObjects.SetName[newPin, IO.PutFR["%g[%g]", IO.rope[name], IO.int[SELECT side FROM bottom, top => x, right, left => y, ENDCASE => ERROR]]];
};
row ← CONS [PWPins.ChangePins[ob, ChangePin], row];
ENDLOOP;
create the object corresponding to the row
rows ← CONS [AbutListX[row], rows];
ENDLOOP;
create the tile corresponding to the set of rows
RETURN [AbutListY[rows]];
};
ArrayX:
PUBLIC
PROC [ob: Object, nx:
INT ← 1]
RETURNS [new: Object] =
BEGIN
row: LIST OF Object ← NIL;
IF nx=0 OR ob=NIL THEN RETURN[NIL];
FOR x:
INT
IN [0 .. nx)
DO
row ← CONS [ob, row];
ENDLOOP;
RETURN [AbutListX[row]];
END;
ArrayY:
PUBLIC
PROC [ob: Object, ny:
INT ← 1]
RETURNS [new: Object] =
BEGIN
row: LIST OF Object ← NIL;
IF ny=0 OR ob=NIL THEN RETURN[NIL];
FOR x:
INT
IN [0 .. ny)
DO
row ← CONS [ob, row];
ENDLOOP;
RETURN [AbutListY[row]];
END;
Array:
PUBLIC
PROC [ob: Object, nx,ny:
INT ← 1]
RETURNS [new: Object] =
{new ← ArrayY[ArrayX[ob, nx], ny];};
-- Other functions
--Fetching a cell from a design
-- Not perfectly safe, because if someone imports a cell, edits it, and imports it again, the version stamp is unchanged, so no conflict is detected.
Get:
PUBLIC
PROC [design: Design, name:
ROPE]
RETURNS [ob: Object] = {
IF design=NIL THEN ERROR;
ob ← CDDirectory.Fetch[design, name].object;
IF ob=NIL THEN {WriteF["Object %g not found in the design.\n", IO.rope[name]]; ERROR};
};
-- Open a design, given a file name
OpenDesign:
PUBLIC
PROC [fileName:
ROPE]
RETURNS [design:
CD.Design] =
BEGIN
-- for now, nothing is checked
CheckProc:
PROC [whereTilesAre:
CD.Design]
RETURNS [
BOOL] =
{RETURN [TRUE]};
design ← CDIO.ReadDesign[fileName, CheckProc];
CDValue.Store[design, $KeepObjects, $KeepObjects]; -- to avoid finalization
END;
CopyRecursive:
PROC [old: Object]
RETURNS [new: Object] = {
new ← CDDirectory.Another[old, NIL, NIL];
IF CDCells.IsCell[old]
THEN {
cellPtr: CD.CellPtr ← NARROW [new.specificRef];
FOR list:
CD.InstanceList ← cellPtr.contents, list.rest
WHILE list#
NIL
DO
list.first.ob ← CopyRecursive[list.first.ob];
ENDLOOP;
};
};
-- Registration of UserProc: this creates the entry "Run MyWondeful generator" in the menu
Register:
PUBLIC
PROC [userProc: UserProc, name:
ROPE] = {
WriteF["Generator program %g %g .\n",
IO.rope[name],
IO.rope[
IF CDGenerate.Register[table: CDGenerate.AssertTable["PatchWork"], key: name, generator: userProc, cache: FALSE] THEN "recorded" ELSE "overwritten"]];
};