CoreIOImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Barth, May 6, 1986 1:40:59 pm PDT
DIRECTORY Convert, Core, CoreClasses, CoreIO, CoreOps, CoreProperties, FS, HashTable, IO, Rope;
CoreIOImpl: CEDAR PROGRAM
IMPORTS Convert, CoreOps, CoreProperties, FS, HashTable, IO, Rope
EXPORTS CoreIO
SHARES Core
= BEGIN OPEN CoreIO;
CoreWriteProcProp: ATOM = $CoreWriteProc;
CoreReadProcProp: ATOM = $CoreReadProc;
classRegistry: HashTable.Table ← HashTable.Create[equal: HashTable.RopeEqual, hash: HashTable.HashRope];
Cell Type IO
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 ← HashTable.Create[];
h.ropeIDTab ← HashTable.Create[equal: HashTable.RopeEqual, hash: HashTable.HashRope];
WriteCellType[h, cellType];
};
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.stream ← FS.StreamOpen[fileName];
h.cellTypeIDTab ← HashTable.Create[equal: HashTable.RopeEqual, hash: HashTable.HashRope];
h.ropeIDTab ← HashTable.Create[equal: HashTable.RopeEqual, hash: HashTable.HashRope];
cellType ← ReadCellType[h];
};
WriteCellType: PROC [h: Handle, cellType: Core.CellType] = {
cellTypeID: ROPENARROW[HashTable.Fetch[h.cellTypeIDTab, cellType].value];
IF cellTypeID=NIL THEN {
wireIDTab: HashTable.Table ← HashTable.Create[];
classWrite: REF ClassWriteProc ← NARROW[CoreProperties.GetCellClassProp[from: cellType.class, prop: CoreWriteProcProp]];
cellTypeID ← Rope.Cat["C", Convert.RopeFromInt[from: h.nextCellTypeID, base: 16, showRadix: FALSE]];
IF NOT HashTable.Insert[h.cellTypeIDTab, cellType, cellTypeID] THEN ERROR;
h.nextCellTypeID ← h.nextCellTypeID + 1;
WriteID[h, cellTypeID];
[] ← WriteWire[h, wireIDTab, 0, cellType.public];
WriteProperties[h, cellType.properties];
WriteRope[h, cellType.class.name];
classWrite^[h, cellType, wireIDTab];
}
ELSE WriteID[h, cellTypeID];
};
ReadCellType: PROC [h: Handle] RETURNS [cellType: Core.CellType] = {
cellTypeID: ROPE ← ReadID[h];
cellType ← NARROW[HashTable.Fetch[h.cellTypeIDTab, cellTypeID].value];
IF cellType=NIL THEN {
wireIDTab: HashTable.Table ← HashTable.Create[equal: HashTable.RopeEqual, hash: HashTable.HashRope];
className: ROPE;
classRead: REF ClassReadProc;
cellType ← NEW[Core.CellTypeRec];
IF NOT HashTable.Insert[h.cellTypeIDTab, cellTypeID, cellType] THEN ERROR;
cellType.public ← ReadWire[h, wireIDTab];
cellType.properties ← ReadProperties[h];
className ← ReadRope[h];
cellType.class ← NARROW[HashTable.Fetch[classRegistry, className].value];
classRead ← NARROW[CoreProperties.GetCellClassProp[from: cellType.class, prop: CoreReadProcProp]];
classRead^[h, cellType, wireIDTab];
};
};
WriteWire: PROC [h: Handle, wireIDTab: HashTable.Table, nextWireID: INT, wire: Core.Wire] RETURNS [newNextWireID: INT] = {
wireID: ROPENARROW[HashTable.Fetch[wireIDTab, wire].value];
newNextWireID ← nextWireID;
IF wireID=NIL THEN {
wireID ← Rope.Cat["W", Convert.RopeFromInt[from: newNextWireID, base: 16, showRadix: FALSE]];
IF NOT HashTable.Insert[wireIDTab, wire, wireID] THEN ERROR;
newNextWireID ← newNextWireID + 1;
WriteID[h, wireID];
WriteInt[h, wire.size];
WriteProperties[h, wire.properties];
FOR w: NAT IN [0..wire.size) DO
newNextWireID ← WriteWire[h, wireIDTab, newNextWireID, wire[w]];
ENDLOOP;
}
ELSE WriteID[h, wireID];
};
ReadWire: PROC [h: Handle, wireIDTab: HashTable.Table] RETURNS [wire: Core.Wire] = {
wireID: ROPE ← ReadID[h];
wire ← NARROW[HashTable.Fetch[wireIDTab, wireID].value];
IF wire=NIL THEN {
wireSize: NAT ← ReadInt[h];
wire ← NEW[Core.WireRec[wireSize]];
IF NOT HashTable.Insert[wireIDTab, wireID, wire] THEN ERROR;
wire.properties ← ReadProperties[h];
FOR w: NAT IN [0..wire.size) DO
wire[w] ← ReadWire[h, wireIDTab];
ENDLOOP;
};
};
WriteProperties: PROC [h: Handle, properties: Core.Properties] = {
propCount: INT ← 0;
FOR props: Core.Properties ← properties, props.rest UNTIL props=NIL DO
propCount ← propCount + 1;
ENDLOOP;
WriteInt[h, propCount];
FOR props: Core.Properties ← properties, props.rest UNTIL props=NIL DO
propKey: ATOMNARROW[props.first.key];
propWrite: REF PropWriteProc ← NARROW[CoreProperties.GetProp[from: CoreProperties.FetchProperties[propKey], prop: CoreWriteProcProp]];
IO.PutF[h.stream, "%g ", IO.atom[propKey]];
IF propWrite=NIL THEN WITH props.first.val SELECT FROM
r: ROPE => {WriteID[h, "R"]; WriteRope[h, r]};
i: REF INT => {WriteID[h, "I"]; IO.PutF[h.stream, "%g ", IO.int[i^]]};
n: REF NAT => {WriteID[h, "N"]; IO.PutF[h.stream, "%g ", IO.int[n^]]};
a: ATOM => {WriteID[h, "A"]; IO.PutF[h.stream, "%g ", IO.atom[a]]};
ENDCASE => ERROR
ELSE propWrite^[h, propKey, props.first.val];
ENDLOOP;
};
ReadProperties: PROC [h: Handle] RETURNS [properties: Core.Properties ← NIL] = {
propCount: INT ← ReadInt[h];
FOR c: INT IN [0..propCount) DO
key: ATOMIO.GetAtom[h.stream];
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["I", type] => NEW[INTIO.GetInt[h.stream]],
Rope.Equal["N", type] => NEW[INTIO.GetInt[h.stream]],
Rope.Equal["A", type] => IO.GetAtom[h.stream],
ENDCASE => ERROR;
}
ELSE val ← propRead^[h, key];
properties ← CONS[[key, val], properties];
ENDLOOP;
};
WriteID: PROC [h: Handle, id: ROPE] = {
IO.PutRope[h.stream, id];
IO.PutRope[h.stream, " "];
};
ReadID: PROC [h: Handle] RETURNS [id: ROPE] = {
id ← IO.GetID[h.stream];
};
WriteRope: PROC [h: Handle, rope: ROPE] = {
ropeID: ROPENARROW[HashTable.Fetch[h.ropeIDTab, rope].value];
IF ropeID=NIL THEN {
ropeID ← Rope.Cat["r", Convert.RopeFromInt[from: h.nextRopeID, base: 16, showRadix: FALSE]];
IF NOT HashTable.Insert[h.ropeIDTab, rope, ropeID] THEN ERROR;
h.nextRopeID ← h.nextRopeID + 1;
WriteID[h, ropeID];
IO.PutF[h.stream, "%g ", IO.refAny[rope]];
}
ELSE WriteID[h, ropeID];
};
ReadRope: PROC [h: Handle] RETURNS [rope: ROPE] = {
ropeID: ROPE ← ReadID[h];
rope ← NARROW[HashTable.Fetch[h.ropeIDTab, ropeID].value];
IF rope=NIL THEN {
rope ← IO.GetRopeLiteral[h.stream];
IF NOT HashTable.Insert[h.ropeIDTab, ropeID, rope] THEN ERROR;
};
};
WriteInt: PROC [h: Handle, val: INT] = {
IO.PutF[h.stream, "%g ", IO.int[val]];
};
ReadInt: PROC [h: Handle] RETURNS [int: INT] = {
int ← IO.GetInt[h.stream];
};
IO Registration
RegisterClass: PUBLIC PROC [class: Core.CellClass, write: ClassWriteProc, read: ClassReadProc] = {
CoreProperties.PutCellClassProp[class, CoreWriteProcProp, NEW[ClassWriteProc ← write]];
CoreProperties.PutCellClassProp[class, CoreReadProcProp, NEW[ClassReadProc ← read]];
[] ← HashTable.Store[classRegistry, class.name, class];
};
RegisterProperty: PUBLIC PROC [prop: ATOM, write: PropWriteProc, read: PropReadProc] = {
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];
};
END.