CDAtomicObjectsImpl.mesa (part of ChipNDale)
Copyright © 1985 by Xerox Corporation. All rights reserved.
by Christian Jacobi, March 13, 1985 9:49:28 am PST
last edited by Christian Jacobi, April 11, 1985 12:57:25 pm PST
DIRECTORY
CD,
CDAtomicObjects,
CDBasics,
CDCallSpecific,
CDIO,
CDLRUCache,
CDOrient,
RefTab,
Rope,
RuntimeError,
TokenIO;
CDAtomicObjectsImpl: CEDAR MONITOR
IMPORTS CD, CDBasics, CDCallSpecific, CDIO, CDLRUCache, CDOrient, RefTab, RuntimeError, TokenIO
EXPORTS CDAtomicObjects
SHARES CD = --want access technology of ObjectProcs
BEGIN
--This module helps the implementation of a wide class of atomic ChipNDale
--objects, which do not have children and are shared between designs. Despite
--its name this are not the only atomic object classes.
DrawRec: TYPE = CDAtomicObjects.DrawRec;
--RECORD [r: CD.DesignRect, lev: CD.Layer ← CD.highLightError];
DrawList: TYPE = CDAtomicObjects.DrawList;
--LIST OF DrawRec;
AtomicObsPtr: TYPE = CDAtomicObjects.AtomicObsPtr;
--REF AtomicObsRec;
AtomicObsRec: TYPE = CDAtomicObjects.AtomicObsRec;
--RECORD [
-- rList: DrawList←NIL, --do not change directly
-- sList: DrawList←NIL, --do not change directly
-- ir: CD.DesignRect,  --do not change directly
-- data: REFNIL    --for free use by class implementor
-- ];
FillObjectProc: TYPE = CDAtomicObjects.FillObjectProc;
--PROC [ob: CD.ObPtr] RETURNS [mustFail: BOOLFALSE];
--read (and even rewrite) size, layer
--calls IncorporateRect
--do not read or write ir
--rList, sList will be initialized to NIL
------------
classTable: RefTab.Ref = RefTab.Create[41];
ClassEntry: TYPE = RECORD[
tech: CD.Technology,
fillProc: FillObjectProc,
p: REF CD.ObjectProcs←NIL
];
GetClassEntry: PROC [class: ATOM, tech: CD.Technology] RETURNS [ce: REF ClassEntry←NIL] =
INLINE BEGIN
p: REF CD.ObjectProcs = CD.FetchObjectProcs[class, tech];
IF p#NIL THEN ce ← NARROW[ classTable.Fetch[p].val ]
END;
------------
cache1: CDLRUCache.LRUCache = CDLRUCache.Create[size: 37, aequivalenceProc: AequivalenceAO];
cache2: CDLRUCache.LRUCache = CDLRUCache.Create[size: 37, aequivalenceProc: AequivalenceAO];
cache3: CDLRUCache.LRUCache = CDLRUCache.Create[size: 37, aequivalenceProc: AequivalenceAO];
myRectPtr: CD.RectPtr = NEW[CD.RectRecord];
AequivalenceAO: PROC [mySpecific, other: REF ANY] RETURNS [BOOL] = {
--Insider info: mySpecific is already in the cache; other is the one to be inserted
RETURN [~ISTYPE[mySpecific, CD.RectPtr]]
};
------------
CreateAtomicOb: PUBLIC PROC [class: ATOM, size: CD.DesignPosition, tech: CD.Technology, lev: CD.Layer←CD.combined] RETURNS [ob: CD.ObPtr←NIL] =
--NIL if not done
BEGIN
ENABLE UNWIND => NULL;
ce: REF ClassEntry = GetClassEntry[class, tech];
size ← CDBasics.MaxPoint[size, [1, 1]];
IF ce#NIL THEN {
cache: CDLRUCache.LRUCache ← SELECT size.x+size.y FROM
<=30 => cache1, --any minimal size ndiff construct
<=60 => cache2, --any minimal size pdiff construct
ENDCASE => cache3; --long crazy stuff
aop: AtomicObsPtr = NEW[AtomicObsRec ← [ir: CDBasics.empty]];
ob1: CD.ObPtr ← cache.UnusedOrNew[];
ob1.p ← ce.p;
ob1.size ← size;
ob1.layer ← lev;
ob1.specificRef ← aop;
IF ce.fillProc[ob1 ! RuntimeError.UNCAUGHT => GOTO xx].mustFail THEN RETURN [NIL];
ob ← cache.ReplaceByAequivalent[ob1];
--as efficiencyhack, the object is now already in the lru cache, inspite
--of not yet beeing checked.
--If object is bad, however, the technology implementing code is bad, and therefore
--we do not really feel responsible for the design...
IF ob=ob1 THEN TRUSTED { --new entry
--TRUSTED because we LOOPHOLE;
--LOOPHOLE because we change the ob's objectprocs in case the fillProc
--change the p field
IF ~CDBasics.Inside[aop.ir, CDBasics.RectAt[[0, 0], ob.size]]
OR CDBasics.empty=aop.ir
OR (aop.rList=NIL AND aop.sList=NIL) THEN GOTO xx;
--now check if we should change the objectprocs to be more general
IF aop.sList#NIL AND ce.p.drawMe=XDrawAO AND ce.p.quickDrawMe=XDrawAO THEN {
p: REF CD.ObjectProcs = LOOPHOLE[ob.p]; --get rid of readonly
p.drawMe ← p.quickDrawMe ← DrawAO;
};
IF aop.ir#CDBasics.RectAt[[0, 0], ob.size] THEN {
IF aop.ir.x1<0 OR aop.ir.y1<0 OR aop.ir.x2>ob.size.x OR aop.ir.y2>ob.size.y THEN GOTO xx;
IF ce.p.showMeSelected=XShowSelectedAO THEN {
p: REF CD.ObjectProcs = LOOPHOLE[ob.p]; --get rid of readonly
p.showMeSelected ← ShowSelectedAO;
}
};
};
};
EXITS xx => RETURN WITH ERROR
CD.Error[other, "Error in technology, implementing creation of atomic object"];
END;
RegisterAtomicObClass: PUBLIC PROC [class: ATOM,
fillProc: FillObjectProc,
description: Rope.ROPENIL,
tech: CD.Technology←NIL] RETURNS [type: REF CD.ObjectProcs ← NIL] =
--drawMe, quickDrawMe are considered variables and should not
--be changed by class implementor.
BEGIN
ce: REF ClassEntry ← NEW[ClassEntry←[
tech: tech,
fillProc: fillProc
]];
done: BOOL←TRUE;
ce.p ← type ← CD.RegisterObjectType[class, tech ! CD.Error => {done ← FALSE; CONTINUE}];
IF ~done THEN
RETURN WITH ERROR CD.Error[doubleRegistration];
done ← RefTab.Insert[classTable, type, ce];
type.drawMe ← type.quickDrawMe ← XDrawAO;
type.internalRead ← ReadAO;
type.internalWrite ← WriteAO;
type.oldInsideRect ← type.interestRect ← InsideAO;
type.showMeSelected ← XShowSelectedAO;
type.wireTyped ← FALSE;
type.description ← description;
CDCallSpecific.Register[$Lengthen, type, LengthenAO];
END;
Incorporate: PUBLIC PROC [ob: CD.ObPtr, r: CD.DesignRect, lev: CD.Layer,
inside: BOOLTRUE, save: BOOLFALSE] =
BEGIN
aop: AtomicObsPtr = NARROW[ob.specificRef];
IF inside THEN aop.ir ← CDBasics.Surround[aop.ir, r];
IF save THEN aop.sList ← CONS[[r, lev], aop.sList]
ELSE aop.rList ← CONS[[r, lev], aop.rList];
END;
--------------
ReadAO: CD.InternalReadProc --PROC [] RETURNS [ObPtr]-- =
BEGIN
x: INT = TokenIO.ReadInt[];
y: INT = TokenIO.ReadInt[];
code: ATOM = TokenIO.ReadAtom[];
lev: CD.Layer = CDIO.ReadLayer[];
tech: CD.Technology = CDIO.DesignInReadOperation[].technology;
RETURN [ CreateAtomicOb[code, [x, y], tech, lev] ]
END;
WriteAO: CD.InternalWriteProc -- PROC [me: ObPtr] -- =
BEGIN
TokenIO.WriteInt[me.size.x];
TokenIO.WriteInt[me.size.y];
TokenIO.WriteAtom[me.p.objectType];
CDIO.WriteLayer[me.layer];
END;
XDrawAO: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation, pr: CD.DrawRef] =
--faster, hacked routine without saveRects
BEGIN
aop: AtomicObsPtr = NARROW[aptr.ob.specificRef];
FOR p: DrawList ← aop.rList, p.rest WHILE p#NIL DO
pr.drawRect[
CDOrient.MapRect[
itemInCell: p.first.r,
cellSize: aptr.ob.size,
cellInstOrient: orient,
cellInstPos: pos],
p.first.lev,
pr]
ENDLOOP;
END;
DrawAO: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation, pr: CD.DrawRef] =
BEGIN
aop: AtomicObsPtr = NARROW[aptr.ob.specificRef];
FOR p: DrawList ← aop.rList, p.rest WHILE p#NIL DO
pr.drawRect[
CDOrient.MapRect[
itemInCell: p.first.r,
cellSize: aptr.ob.size,
cellInstOrient: orient,
cellInstPos: pos],
p.first.lev,
pr]
ENDLOOP;
FOR p: DrawList ← aop.sList, p.rest WHILE p#NIL DO
pr.saveRect[
CDOrient.MapRect[
itemInCell: p.first.r,
cellSize: aptr.ob.size,
cellInstOrient: orient,
cellInstPos: pos],
p.first.lev,
pr]
ENDLOOP;
END;
ShowSelectedAO: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition,
orient: CD.Orientation, pr: CD.DrawRef] =
BEGIN
aop: AtomicObsPtr = NARROW[aptr.ob.specificRef];
pr.outLineProc[
CDOrient.MapRect[
itemInCell: aop.ir,
cellSize: aptr.ob.size,
cellInstOrient: orient,
cellInstPos: pos],
pr]
END;
XShowSelectedAO: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition,
orient: CD.Orientation, pr: CD.DrawRef] =
BEGIN
pr.outLineProc[CDOrient.RectAt[pos, aptr.ob.size, orient], pr]
END;
InsideAO: PROC [ob: CD.ObPtr] RETURNS [CD.DesignRect] =
BEGIN
RETURN [NARROW[ob.specificRef, AtomicObsPtr].ir]
END;
LengthenAO: CDCallSpecific.CallProc =
--PROC [design: CD.Design, aptr: CD.ApplicationPtr, x: REF]
--RETURNS [done: BOOLTRUE, removeMe: BOOLFALSE, include: CD.ApplicationList←NIL,
--repaintMe: BOOLFALSE, repaintInclude: BOOLFALSE]
BEGIN
ToPosition: PROC [x: REF] RETURNS [p: CD.DesignPosition] =
--y field defaults to lambda, x field defaults to 0
--[0, 0] if not done
BEGIN
IF x=NIL THEN p ← [0, CD.lambda]
ELSE WITH x SELECT FROM
rp: REF CD.DesignPosition => p ← rp^;
rn: REF CD.DesignNumber => p ← [0, rn^];
ENDCASE => p ← [0, 0];
END;
--LengthenAO
amount: CD.DesignPosition = ToPosition[x];
IF amount.y=0 AND amount.x=0 THEN done ← FALSE
ELSE {
sz: CD.DesignPosition ← CDBasics.AddPoints[aptr.ob.size, amount];
new: CD.ObPtr ← CreateAtomicOb[size: sz, class: aptr.ob.p.objectType, lev: aptr.ob.layer, tech: aptr.ob.p.technology];
done ← new#NIL AND new#aptr.ob AND new.size#aptr.ob.size;
IF done THEN {
aptr.ob ← new;
repaintMe ← TRUE;
}
};
END;
END.