CoreIOImpl.mesa
Copyright Ó 1985, 1987 by Xerox Corporation. All rights reserved.
Barth, April 16, 1987 4:03:41 pm PDT
Bertrand Serlet May 3, 1988 3:16:46 pm PDT
Mike Spreitzer February 27, 1987 2:54:07 pm PST
Louis Monier September 24, 1987 2:51:06 pm PDT
DIRECTORY
Ascii, Atom, CedarProcess, Convert,
Core, CoreClasses, CoreDirectory, CoreIO, CoreOps, CoreProperties,
FS, GList, IO, ProcessProps, RefTab, RefTabExtras, Rope, SymTab;
CoreIOImpl: CEDAR PROGRAM
IMPORTS Atom, CedarProcess, Convert, CoreClasses, CoreOps, CoreProperties, FS, GList, IO, ProcessProps, RefTab, RefTabExtras, Rope, SymTab
EXPORTS CoreIO
= BEGIN OPEN CoreIO;
Prerequisites
coreWriteProcProp: ATOM = $CoreWriteProc;
coreReadProcProp: ATOM = $CoreReadProc;
calledFromDir: Core.ROPENIL;
classRegistry: RefTab.Ref ← RefTab.Create[equal: RefTabExtras.EqualRope, hash: RefTabExtras.HashRope];
PutSpace: PROC [h: Handle] = INLINE {IO.PutChar[h.stream, Ascii.SP]};
Cell Type IO
UnknownProperty: PUBLIC SIGNAL [propKey: ATOM] = CODE;
UnknownCellClass: PUBLIC SIGNAL [class: Core.CellClass] = CODE;
ReportSaveCellType: PUBLIC PROC [cellType: Core.CellType, fileName: ROPENIL] RETURNS [props: LIST OF ATOMNIL, classes: LIST OF Core.CellClass ← NIL] = {
SaveCellType[cellType, fileName !
UnknownProperty => {
IF NOT GList.Member[propKey, props] THEN props ← CONS [propKey, props];
RESUME;
};
UnknownCellClass => {
IF NOT GList.Member[class, classes] THEN classes ← CONS [class, classes];
RESUME;
}];
};
SaveCellType: PUBLIC PROC [cellType: Core.CellType, fileName: ROPENIL] = {
h: Handle ← NEW [HandleRec];
IF fileName=NIL THEN fileName ← Rope.Cat[CoreOps.GetCellTypeName[cellType], ".core"];
h.stream ← FS.StreamOpen[fileName, $create];
h.cellTypeIDTab ← RefTab.Create[];
h.ropeIDTab ← RefTab.Create[equal: RefTabExtras.EqualRope, hash: RefTabExtras.HashRope];
h.atomIDTab ← RefTab.Create[];
WriteCellType[h, cellType];
IO.Close[h.stream];
};
importCellClass: PUBLIC Core.CellClass ← CoreOps.SetClassPrintProc[NEW [Core.CellClassRec ← [name: "Import", recast: RecastImport, layersProps: TRUE]], PrintImport];
ReadFile: PROC [name: Core.ROPE] RETURNS [s: IO.STREAMNIL] ~ {
s ← FS.StreamOpen[fileName: name ! FS.Error => CONTINUE];
IF s=NIL THEN s ← FS.StreamOpen[fileName: name, wDir: calledFromDir];
};
RestoreCellType: PUBLIC PROC [cellName: ROPENIL, fileName: ROPENIL] RETURNS [cellType: Core.CellType] = {
h: Handle ← NEW[HandleRec];
IF fileName=NIL AND cellName=NIL THEN ERROR;
IF fileName=NIL THEN fileName ← Rope.Cat[cellName, ".core"];
h.fileName ← fileName;
h.stream ← ReadFile[fileName];
h.cellTypeIDTab ← RefTab.Create[equal: RefTabExtras.EqualRope, hash: RefTabExtras.HashRope];
h.ropeIDTab ← RefTab.Create[equal: RefTabExtras.EqualRope, hash: RefTabExtras.HashRope];
h.atomIDTab ← RefTab.Create[equal: RefTabExtras.EqualRope, hash: RefTabExtras.HashRope];
[cellType, h.wireIDTab] ← ReadCellTypePublic[h];
cellType.class ← importCellClass;
cellType.data ← h;
};
RecastImport: Core.RecastProc = {
h: Handle ← NARROW [me.data];
me.data ← NIL;
ReadCellTypeRest[h, me, h.wireIDTab];
new ← me;
};
PrintImport: CoreOps.PrintClassProc = {
h: Handle ← NARROW [data];
CoreOps.PrintIndent[indent, out];
IO.PutF[out, "Import of : %g", IO.rope[h.fileName]];
};
WriteImport: ClassWriteProc = {
WriteWireIDPair: HashWriteProc = {
id: ROPENARROW[key];
wire: Core.Wire ← NARROW[value];
WriteID[h, id];
WriteWire[h, wireIDTab, wire];
};
child: Handle ← NARROW [cellType.data];
WriteRope[h, child.fileName];
WriteInt[h, IO.GetIndex[child.stream]];
WriteHashTable[h, child.cellTypeIDTab, WriteCellTypeIDPair];
WriteHashTable[h, child.ropeIDTab, WriteRopeIDPair];
WriteHashTable[h, child.atomIDTab, WriteAtomIDPair];
WriteHashTable[h, child.wireIDTab, WriteWireIDPair];
WriteProperties[h, child.properties];
};
ReadImport: ClassReadProc = {
ReadWireIDPair: HashReadProc = {
key ← ReadID[h];
value ← ReadWire[h, wireIDTab];
};
child: Handle ← NEW[HandleRec];
child.cellType ← NIL; -- I'm not sure what's right here
child.wire ← NIL; -- I'm not sure what's right here
child.fileName ← ReadRope[h];
child.stream ← ReadFile[child.fileName];
IO.SetIndex[child.stream, ReadInt[h]];
child.cellTypeIDTab ← ReadHashTable[h, ReadCellTypeIDPair, RefTabExtras.EqualRope, RefTabExtras.HashRope];
child.ropeIDTab ← ReadHashTable[h, ReadRopeIDPair, RefTabExtras.EqualRope, RefTabExtras.HashRope];
child.atomIDTab ← ReadHashTable[h, ReadAtomIDPair, RefTabExtras.EqualRope, RefTabExtras.HashRope];
child.wireIDTab ← ReadHashTable[h, ReadWireIDPair, RefTabExtras.EqualRope, RefTabExtras.HashRope];
child.properties ← ReadProperties[h];
cellType.data ← child;
};
Library IO
SaveLibrary: PUBLIC PROC [library: CoreDirectory.Library, fileName: ROPE] = {
EachLibraryItem: SymTab.EachPairAction = {
WriteRope[h, key];
WriteCellType[h, NARROW [val]
! UnknownProperty => RESUME; UnknownCellClass => RESUME];
};
h: Handle ← NEW [HandleRec];
fileName ← Rope.Cat[fileName, ".corelib"];
h.stream ← FS.StreamOpen[fileName, $create];
h.cellTypeIDTab ← RefTab.Create[];
h.ropeIDTab ← RefTab.Create[equal: RefTabExtras.EqualRope, hash: RefTabExtras.HashRope];
h.atomIDTab ← RefTab.Create[];
WriteInt[h, SymTab.GetSize[library]];
[] ← SymTab.Pairs[library, EachLibraryItem];
IO.Close[h.stream];
};
RestoreLibrary: PUBLIC PROC [fileName: ROPE] RETURNS [library: CoreDirectory.Library] = {
h: Handle ← NEW[HandleRec];
size: INT;
fileName ← Rope.Cat[fileName, ".corelib"];
h.fileName ← fileName;
h.stream ← ReadFile[fileName];
h.cellTypeIDTab ← RefTab.Create[equal: RefTabExtras.EqualRope, hash: RefTabExtras.HashRope];
h.ropeIDTab ← RefTab.Create[equal: RefTabExtras.EqualRope, hash: RefTabExtras.HashRope];
h.atomIDTab ← RefTab.Create[equal: RefTabExtras.EqualRope, hash: RefTabExtras.HashRope];
size ← ReadInt[h];
library ← SymTab.Create[(size/2)*2+1];
THROUGH [0 .. size) DO
key: ROPE ← ReadRope[h];
cellType: Core.CellType ← ReadCellType[h];
[] ← SymTab.Store[library, key, cellType];
ENDLOOP;
IO.Close[h.stream];
};
IO Registration
RegisterClass: PUBLIC PROC [class: Core.CellClass, write: ClassWriteProc, read: ClassReadProc] RETURNS [sameClass: Core.CellClass] = {
sameClass ← class;
CoreProperties.PutCellClassProp[class, coreWriteProcProp, NEW[ClassWriteProc ← write]];
CoreProperties.PutCellClassProp[class, coreReadProcProp, NEW[ClassReadProc ← read]];
[] ← RefTab.Store[classRegistry, class.name, class];
};
RegisterProperty: PUBLIC PROC [prop: ATOM, write: PropWriteProc, read: PropReadProc] RETURNS [sameProp: ATOM] = {
props: Core.Properties ← CoreProperties.FetchProperties[prop];
props ← CoreProperties.PutProp[props, coreWriteProcProp, NEW[PropWriteProc ← write]];
props ← CoreProperties.PutProp[props, coreReadProcProp, NEW[PropReadProc ← read]];
CoreProperties.StoreProperties[prop, props];
sameProp ← prop;
};
IO Utilities
WriteCellType: PUBLIC PROC [h: Handle, cellType: Core.CellType] = {
cellTypeID: ROPENARROW [RefTab.Fetch[h.cellTypeIDTab, cellType].val];
IF cellTypeID=NIL THEN {
parentCellType: Core.CellType ← h.cellType;
wireIDTab: RefTab.Ref ← RefTab.Create[];
classWrite: REF ClassWriteProc ← NARROW[CoreProperties.GetCellClassProp[from: cellType.class, prop: coreWriteProcProp]];
IF classWrite=NIL THEN {
SIGNAL UnknownCellClass[cellType.class];
cellType ← CoreOps.Recast[cellType];
IF cellType=NIL THEN ERROR;
WriteCellType[h, cellType];
RETURN;
};
cellTypeID ← Rope.Cat["C", Convert.RopeFromInt[from: RefTab.GetSize[h.cellTypeIDTab], base: 16, showRadix: FALSE]];
IF NOT RefTab.Insert[h.cellTypeIDTab, cellType, cellTypeID] THEN ERROR;
h.cellType ← cellType;
WriteID[h, cellTypeID];
WriteWire[h, wireIDTab, cellType.public];
WriteProperties[h, cellType.properties];
WriteRope[h, cellType.class.name];
classWrite^[h, cellType, wireIDTab];
h.cellType ← parentCellType;
}
ELSE WriteID[h, cellTypeID];
};
ReadCellType: PUBLIC PROC [h: Handle] RETURNS [cellType: Core.CellType] = {
wireIDTab: RefTab.Ref ← NIL;
parentCellType: Core.CellType ← h.cellType;
[cellType, wireIDTab] ← ReadCellTypePublic[h];
IF wireIDTab#NIL THEN ReadCellTypeRest[h, cellType, wireIDTab];
h.cellType ← parentCellType;
};
ReadCellTypePublic: PUBLIC PROC [h: Handle] RETURNS [cellType: Core.CellType, wireIDTab: RefTab.Ref] = {
cellTypeID: ROPE ← ReadID[h];
IF Rope.Fetch[cellTypeID]#'C THEN ERROR;
cellType ← NARROW[RefTab.Fetch[h.cellTypeIDTab, cellTypeID].val];
IF cellType=NIL THEN {
cellType ← NEW[Core.CellTypeRec];
IF NOT RefTab.Insert[h.cellTypeIDTab, cellTypeID, cellType] THEN ERROR;
h.cellType ← cellType;
wireIDTab ← RefTab.Create[equal: RefTabExtras.EqualRope, hash: RefTabExtras.HashRope];
cellType.public ← ReadWire[h, wireIDTab];
cellType.properties ← ReadProperties[h];
};
};
ReadCellTypeRest: PUBLIC PROC [h: Handle, cellType: Core.CellType, wireIDTab: RefTab.Ref] = {
className: ROPE ← ReadRope[h];
classRead: REF ClassReadProc ← NIL;
cellType.class ← NARROW[RefTab.Fetch[classRegistry, className].val];
classRead ← NARROW[CoreProperties.GetCellClassProp[from: cellType.class, prop: coreReadProcProp]];
classRead^[h, cellType, wireIDTab];
};
WriteWire: PUBLIC PROC [h: Handle, wireIDTab: RefTab.Ref, wire: Core.Wire] = {
wireID: ROPENARROW[RefTab.Fetch[wireIDTab, wire].val];
IF wireID=NIL THEN {
parentWire: Core.Wire ← h.wire;
wireID ← Rope.Cat["W", Convert.RopeFromInt[from: RefTab.GetSize[wireIDTab], base: 16, showRadix: FALSE]];
IF NOT RefTab.Insert[wireIDTab, wire, wireID] THEN ERROR;
WriteID[h, wireID];
WriteInt[h, wire.size];
h.wire ← wire;
WriteProperties[h, wire.properties];
FOR w: NAT IN [0 .. wire.size) DO
WriteWire[h, wireIDTab, wire[w]];
ENDLOOP;
h.wire ← parentWire;
}
ELSE WriteID[h, wireID];
};
ReadWire: PUBLIC PROC [h: Handle, wireIDTab: RefTab.Ref] RETURNS [wire: Core.Wire] = {
wireID: ROPE ← ReadID[h];
IF Rope.Fetch[wireID]#'W THEN ERROR;
wire ← NARROW[RefTab.Fetch[wireIDTab, wireID].val];
IF wire=NIL THEN {
parentWire: Core.Wire ← h.wire;
wireSize: NAT ← ReadInt[h];
wire ← NEW[Core.WireRec[wireSize]];
IF NOT RefTab.Insert[wireIDTab, wireID, wire] THEN ERROR;
h.wire ← wire;
wire.properties ← ReadProperties[h];
FOR w: NAT IN [0 .. wire.size) DO
wire[w] ← ReadWire[h, wireIDTab];
ENDLOOP;
h.wire ← parentWire;
};
};
WriteProperties: PUBLIC PROC [h: Handle, properties: Core.Properties] = {
propCount: INT ← 0;
CedarProcess.CheckAbort[];
FOR props: Core.Properties ← properties, props.rest UNTIL props=NIL DO
propKey: ATOMNARROW[props.first.key];
propVal: REF ANY ← props.first.val;
propWrite: REF PropWriteProc ← NARROW[CoreProperties.GetProp[from: CoreProperties.FetchProperties[propKey], prop: coreWriteProcProp]];
IF propWrite#NIL OR ISTYPE[propVal, ROPE] OR ISTYPE[propVal, LIST OF ROPE] OR ISTYPE[propVal, REF INT] OR ISTYPE[propVal, REF NAT] OR ISTYPE[propVal, ATOM] OR ISTYPE[propVal, REF REAL] OR ISTYPE[propVal, REF BOOL] THEN propCount ← propCount + 1;
ENDLOOP;
WriteInt[h, propCount];
FOR props: Core.Properties ← properties, props.rest UNTIL props=NIL DO
StartProp: PROC [type: ROPE] = {
WriteAtom[h, propKey];
IF type#NIL THEN WriteID[h, type];
};
propKey: ATOMNARROW[props.first.key];
propWrite: REF PropWriteProc ← NARROW[CoreProperties.GetProp[from: CoreProperties.FetchProperties[propKey], prop: coreWriteProcProp]];
IF propWrite=NIL THEN WITH props.first.val SELECT FROM
r: ROPE => {StartProp["r"]; WriteRope[h, r]};
lor: LIST OF ROPE => {StartProp["lor"]; WriteListOfRope[h, lor]};
i: REF INT => {StartProp["i"]; WriteInt[h, i^]};
n: REF NAT => {StartProp["n"]; WriteInt[h, n^]};
a: ATOM => {StartProp["a"]; WriteAtom[h, a]};
real: REF REAL => {StartProp["real"]; WriteReal[h, real^]};
rb: REF BOOL => {StartProp["rb"]; WriteBool[h, rb^]};
ENDCASE => SIGNAL UnknownProperty[propKey]
ELSE {StartProp[NIL]; propWrite^[h, propKey, props.first.val]};
ENDLOOP;
};
ReadProperties: PUBLIC PROC [h: Handle] RETURNS [properties: Core.Properties ← NIL] = {
propCount: INT ← ReadInt[h];
CedarProcess.CheckAbort[];
FOR c: INT IN [0..propCount) DO
key: ATOM ← ReadAtom[h];
val: REF ANY;
propRead: REF PropReadProc ← NARROW[CoreProperties.GetProp[from: CoreProperties.FetchProperties[key], prop: coreReadProcProp]];
IF propRead=NIL THEN {
type: ROPE ← ReadID[h];
val ← SELECT TRUE FROM
Rope.Equal["r", type] => ReadRope[h],
Rope.Equal["lor", type] => ReadListOfRope[h],
Rope.Equal["i", type] => NEW[INT ← ReadInt[h]],
Rope.Equal["n", type] => NEW[NAT ← ReadInt[h]],
Rope.Equal["a", type] => ReadAtom[h],
Rope.Equal["real", type] => NEW[REAL ← ReadReal[h]],
Rope.Equal["rb", type] => NEW[BOOL ← ReadBool[h]],
ENDCASE => ERROR UnknownProperty[Atom.MakeAtom[type]];
}
ELSE val ← propRead^[h, key];
properties ← CONS [[key, val], properties];
ENDLOOP;
};
WriteID: PUBLIC PROC [h: Handle, id: ROPE] = {
IO.PutRope[h.stream, id]; PutSpace[h];
};
ReadID: PUBLIC PROC [h: Handle] RETURNS [id: ROPE] = {
id ← IO.GetID[h.stream];
};
WriteAtom: PUBLIC PROC [h: Handle, atom: ATOM] = {
atomID: ROPENARROW[RefTab.Fetch[h.atomIDTab, atom].val];
IF atomID=NIL THEN {
atomID ← Rope.Cat["A", Convert.RopeFromInt[from: RefTab.GetSize[h.atomIDTab], base: 16, showRadix: FALSE]];
IF NOT RefTab.Insert[h.atomIDTab, atom, atomID] THEN ERROR;
WriteID[h, atomID];
IO.Put1[h.stream, IO.atom[atom]]; PutSpace[h];
}
ELSE WriteID[h, atomID];
};
ReadAtom: PUBLIC PROC [h: Handle] RETURNS [atom: ATOM] = {
atomID: ROPE ← ReadID[h];
IF Rope.Fetch[atomID]#'A THEN ERROR;
atom ← NARROW[RefTab.Fetch[h.atomIDTab, atomID].val];
IF atom=NIL THEN {
atom ← IO.GetAtom[h.stream];
IF NOT RefTab.Insert[h.atomIDTab, atomID, atom] THEN ERROR;
};
};
doubleQuote: CHAR = '";
backSlash: CHAR = '\\;
doubleQuoteRope: ROPE = Rope.FromChar[doubleQuote];
WriteRope: PUBLIC PROC [h: Handle, rope: ROPE] = {
ropeID: ROPENARROW[RefTab.Fetch[h.ropeIDTab, rope].val];
IF ropeID=NIL THEN {
ropeID ← Rope.Cat["R", Convert.RopeFromInt[from: RefTab.GetSize[h.ropeIDTab], base: 16, showRadix: FALSE]];
IF NOT RefTab.Insert[h.ropeIDTab, rope, ropeID] THEN ERROR;
WriteID[h, ropeID];
IO.PutChar[h.stream, doubleQuote];
we cannot use IO.PutF that truncates long ropes, and we have to beware of "!
WHILE NOT Rope.IsEmpty[rope] DO
index: INT ← Rope.Find[rope, doubleQuoteRope];
IF index<0
THEN {IO.PutRope[h.stream, rope]; rope ← NIL}
ELSE {
IO.PutRope[h.stream, rope, 0, index];
IO.PutChar[h.stream, backSlash];
IO.PutChar[h.stream, doubleQuote];
rope ← Rope.Substr[rope, index+1];
};
ENDLOOP;
IO.PutChar[h.stream, doubleQuote];
PutSpace[h];
}
ELSE WriteID[h, ropeID];
};
ReadRope: PUBLIC PROC [h: Handle] RETURNS [rope: ROPE] = {
ropeID: ROPE ← ReadID[h];
IF Rope.Fetch[ropeID]#'R THEN ERROR;
rope ← NARROW[RefTab.Fetch[h.ropeIDTab, ropeID].val];
IF rope=NIL THEN {
rope ← IO.GetRopeLiteral[h.stream];
IF NOT RefTab.Insert[h.ropeIDTab, ropeID, rope] THEN ERROR;
};
};
WriteListOfRope: PUBLIC PROC [h: Handle, ropes: LIST OF ROPE] = {
count: INT ← 0;
FOR rl: LIST OF ROPE ← ropes, rl.rest UNTIL rl=NIL DO
count ← count + 1;
ENDLOOP;
WriteInt[h, count];
FOR rl: LIST OF ROPE ← ropes, rl.rest UNTIL rl=NIL DO
WriteRope[h, rl.first];
ENDLOOP;
};
ReadListOfRope: PUBLIC PROC [h: Handle] RETURNS [ropes: LIST OF ROPE] = {
count: INT ← ReadInt[h];
lor: LIST OF ROPENIL;
FOR c: INT IN [0..count) DO
lor ← CONS[ReadRope[h], lor];
ENDLOOP;
FOR rl: LIST OF ROPE ← lor, rl.rest UNTIL rl=NIL DO
ropes ← CONS[rl.first, ropes];
ENDLOOP;
};
WriteInt: PUBLIC PROC [h: Handle, int: INT] = {
We use Put1 instead of PutF to be faster.
IO.Put1[h.stream, IO.int[int]]; PutSpace[h];
};
ReadInt: PUBLIC PROC [h: Handle] RETURNS [int: INT] = {
int ← IO.GetInt[h.stream];
};
WriteReal: PUBLIC PROC [h: Handle, real: REAL] = {
IO.Put1[h.stream, IO.real[real]]; PutSpace[h];
};
ReadReal: PUBLIC PROC [h: Handle] RETURNS [real: REAL] = {
real ← IO.GetReal[h.stream];
};
WriteBool: PUBLIC PROC [h: Handle, bool: BOOL] = {
WriteInt[h, IF bool THEN 1 ELSE 0];
};
ReadBool: PUBLIC PROC [h: Handle] RETURNS [bool: BOOL] = {
bool ← ReadInt[h]#0;
};
WriteHashTable: PUBLIC PROC [h: Handle, table: RefTab.Ref, eachPair: HashWriteProc] = {
HashPair: RefTab.EachPairAction = {
eachPair[h, key, val];
};
WriteInt[h, RefTab.GetSize[table]];
IF RefTab.Pairs[table, HashPair] THEN ERROR;
};
ReadHashTable: PUBLIC PROC [h: Handle, eachPair: HashReadProc, equal: RefTab.EqualProc ← NIL, hash: RefTab.HashProc ← NIL] RETURNS [table: RefTab.Ref] = {
table ← RefTab.Create[equal: equal, hash: hash];
THROUGH [1..ReadInt[h]] DO
key, value: REF ANYNIL;
[key, value] ← eachPair[h];
IF NOT RefTab.Insert[table, key, value] THEN ERROR;
ENDLOOP;
};
WriteCellTypeIDPair: PUBLIC HashWriteProc = {
id: ROPENARROW[key];
cellType: Core.CellType ← NARROW[value];
WriteID[h, id];
WriteCellType[h, cellType];
};
ReadCellTypeIDPair: PUBLIC HashReadProc = {
key ← ReadID[h];
value ← ReadCellType[h];
};
WriteRopeIDPair: PUBLIC HashWriteProc = {
id: ROPENARROW[key];
rope: ROPENARROW[value];
WriteID[h, id];
WriteRope[h, rope];
};
ReadRopeIDPair: PUBLIC HashReadProc = {
key ← ReadID[h];
value ← ReadRope[h];
};
WriteAtomIDPair: PUBLIC HashWriteProc = {
id: ROPENARROW[key];
atom: ATOMNARROW[value];
WriteID[h, id];
WriteAtom[h, atom];
};
ReadAtomIDPair: PUBLIC HashReadProc = {
key ← ReadID[h];
value ← ReadAtom[h];
};
Cell Class IO
WriteRecordCell: ClassWriteProc = {
rct: CoreClasses.RecordCellType ← NARROW[cellType.data];
WriteInt[h, rct.size];
WriteWire[h, wireIDTab, rct.internal];
FOR in: NAT IN [0..rct.size) DO
instance: CoreClasses.CellInstance ← rct[in];
WriteWire[h, wireIDTab, instance.actual];
WriteProperties[h, instance.properties];
WriteCellType[h, instance.type];
ENDLOOP;
};
ReadRecordCell: ClassReadProc = {
rct: CoreClasses.RecordCellType ← NEW[CoreClasses.RecordCellTypeRec[ReadInt[h]]];
rct.internal ← ReadWire[h, wireIDTab];
FOR in: NAT IN [0..rct.size) DO
instance: CoreClasses.CellInstance ← NEW[CoreClasses.CellInstanceRec];
rct[in] ← instance;
instance.actual ← ReadWire[h, wireIDTab];
instance.properties ← ReadProperties[h];
instance.type ← ReadCellType[h];
ENDLOOP;
cellType.data ← rct;
};
WriteTransistor: ClassWriteProc = {
tran: CoreClasses.Transistor ← NARROW[cellType.data];
WriteID[h, CoreClasses.transistorTypeNames[tran.type]];
};
ReadTransistor: ClassReadProc = {
tran: CoreClasses.Transistor ← NEW[CoreClasses.TransistorRec];
type: ROPE ← ReadID[h];
FOR t: CoreClasses.TransistorType IN CoreClasses.TransistorType DO
IF Rope.Equal[CoreClasses.transistorTypeNames[t], type] THEN {
tran.type ← t;
EXIT;
};
REPEAT FINISHED => ERROR;
ENDLOOP;
cellType.data ← tran;
};
WriteUnspecified: ClassWriteProc = {};
ReadUnspecified: ClassReadProc = {cellType.data ← NIL};
WriteSequence: ClassWriteProc = {
WriteSequenceSet: PROC [set: CoreClasses.SequenceSet] = {
IF set=NIL THEN WriteInt[h, -1]
ELSE {
WriteInt[h, set.length];
FOR i: NAT IN [0..set.length) DO
WriteInt[h, set[i]];
ENDLOOP;
};
};
seq: CoreClasses.SequenceCellType ← NARROW[cellType.data];
WriteCellType[h, seq.base];
WriteInt[h, seq.count];
WriteSequenceSet[seq.sequence];
WriteSequenceSet[seq.flatSequence];
};
ReadSequence: ClassReadProc = {
ReadSequenceSet: PROC RETURNS [set: CoreClasses.SequenceSet ← NIL] = {
length: INT ← ReadInt[h];
IF length >= 0 THEN {
set ← NEW[CoreClasses.SequenceSetRec[length]];
FOR i: NAT IN [0..set.length) DO
set[i] ← ReadInt[h];
ENDLOOP;
};
};
seq: CoreClasses.SequenceCellType ← NEW[CoreClasses.SequenceCellTypeRec];
seq.base ← ReadCellType[h];
seq.count ← ReadInt[h];
seq.sequence ← ReadSequenceSet[];
seq.flatSequence ← ReadSequenceSet[];
cellType.data ← seq;
};
Initialization
[] ← RegisterClass[CoreClasses.recordCellClass, WriteRecordCell, ReadRecordCell];
[] ← RegisterClass[CoreClasses.transistorCellClass, WriteTransistor, ReadTransistor];
[] ← RegisterClass[CoreClasses.unspecifiedCellClass, WriteUnspecified, ReadUnspecified];
[] ← RegisterClass[CoreClasses.sequenceCellClass, WriteSequence, ReadSequence];
[] ← RegisterClass[importCellClass, WriteImport, ReadImport];
calledFromDir ← NARROW[ProcessProps.GetProp[$WorkingDirectory]];
END.
The following is a memorial to not thinking things through first.
restoreProp: ATOM = $CoreRestoreCellType;
CoreProperties.PutCellTypeProp[cellType, restoreProp, fileName];
WriteCellType: PUBLIC PROC [h: Handle, cellType: Core.CellType] = {
cellTypeID: ROPENARROW [RefTab.Fetch[h.cellTypeIDTab, cellType].val];
IF cellTypeID=NIL THEN {
restoreFileName: ROPENARROW[CoreProperties.GetCellTypeProp[cellType, restoreProp]];
IF restoreFileName=NIL THEN {
parentCellType: Core.CellType ← h.cellType;
wireIDTab: RefTab.Ref ← RefTab.Create[];
classWrite: REF ClassWriteProc ← NARROW[CoreProperties.GetCellClassProp[from: cellType.class, prop: coreWriteProcProp]];
IF classWrite=NIL THEN {
SIGNAL UnknownCellClass[cellType.class];
cellType ← CoreOps.Recast[cellType];
IF cellType=NIL THEN ERROR;
WriteCellType[h, cellType];
RETURN;
};
cellTypeID ← Rope.Cat["C", Convert.RopeFromInt[from: RefTab.GetSize[h.cellTypeIDTab], base: 16, showRadix: FALSE]];
IF NOT RefTab.Insert[h.cellTypeIDTab, cellType, cellTypeID] THEN ERROR;
h.cellType ← cellType;
WriteID[h, cellTypeID];
WriteWire[h, wireIDTab, cellType.public];
WriteProperties[h, cellType.properties];
WriteRope[h, cellType.class.name];
classWrite^[h, cellType, wireIDTab];
h.cellType ← parentCellType;
}
ELSE {
cellTypeID ← Rope.Cat["I", Convert.RopeFromInt[from: RefTab.GetSize[h.cellTypeIDTab], base: 16, showRadix: FALSE]];
IF NOT RefTab.Insert[h.cellTypeIDTab, cellType, cellTypeID] THEN ERROR;
WriteID[h, cellTypeID];
WriteRope[h, restoreFileName];
};
}
ELSE WriteID[h, cellTypeID];
};
ReadCellTypePublic: PUBLIC PROC [h: Handle] RETURNS [cellType: Core.CellType, wireIDTab: RefTab.Ref] = {
cellTypeID: ROPE ← ReadID[h];
cellType ← NARROW[RefTab.Fetch[h.cellTypeIDTab, cellTypeID].val];
IF cellType=NIL THEN {
SELECT Rope.Fetch[cellTypeID] FROM
'C => {
cellType ← NEW[Core.CellTypeRec];
IF NOT RefTab.Insert[h.cellTypeIDTab, cellTypeID, cellType] THEN ERROR;
h.cellType ← cellType;
wireIDTab ← RefTab.Create[equal: RefTabExtras.EqualRope, hash: RefTabExtras.HashRope];
cellType.public ← ReadWire[h, wireIDTab];
cellType.properties ← ReadProperties[h];
};
'I => cellType ← RestoreCellType[fileName: ReadRope[h]];
ENDCASE => ERROR;
};
};