--File IntStorage.mesa
--July 31, 1981 3:34 PM by MN

DIRECTORY

ParserTypeDefs: FROM "ParserTypeDefs" USING
[Point, Path, PathLength, RemovePoint, AllocatePath, FreePath, AppendPoint, AllocateUserNode, FreeUserNode],

IntVMDefs: FROM "IntVMDefs",

ParserErrorDefs: FROM "ParserErrorDefs" USING [Report],

IntStorageDefs: FROM "IntStorageDefs";

IntStorage: PROGRAM IMPORTS IntVMDefs, ParserTypeDefs, ParserErrorDefs
EXPORTS IntStorageDefs =

BEGIN OPEN IntStorageDefs;

InitStorage: PUBLIC PROCEDURE RETURNS [BOOLEAN] =
BEGIN
RETURN[IntVMDefs.InitVM[]];
END;

FinishStorage: PUBLIC PROCEDURE RETURNS [BOOLEAN] =
BEGIN
RETURN[IntVMDefs.FinishVM[]];
END;

StoreObject: PUBLIC PROCEDURE [src: Object] RETURNS [ObjectName] =
BEGIN OPEN IntVMDefs, ParserTypeDefs;
ans: ObjectName;

WITH src↑ SELECT FROM
STEntry =>
BEGIN
ans ← AllocateBlock[SIZE[STEntry ObjectRecord]+1];
PutWord[ans,ObjectType[STEntry]];
PutBlock[src,ans+1,SIZE[STEntry ObjectRecord]];
END;
SetNode =>
BEGIN
ans ← AllocateBlock[SIZE[SetNode ObjectRecord]+1];
PutWord[ans,ObjectType[SetNode]];
PutBlock[src,ans+1,SIZE[SetNode ObjectRecord]];
END;
Call =>
BEGIN
ans ← AllocateBlock[SIZE[Call ObjectRecord]+1];
PutWord[ans,ObjectType[Call]];
PutBlock[src,ans+1,SIZE[Call ObjectRecord]];
END;
Box =>
BEGIN
ans ← AllocateBlock[SIZE[Box ObjectRecord]+1];
PutWord[ans,ObjectType[Box]];
PutBlock[src,ans+1,SIZE[Box ObjectRecord]];
END;
MBox =>
BEGIN
ans ← AllocateBlock[SIZE[MBox ObjectRecord]+1];
PutWord[ans,ObjectType[MBox]];
PutBlock[src,ans+1,SIZE[MBox ObjectRecord]];
END;
Flash =>
BEGIN
ans ← AllocateBlock[SIZE[Flash ObjectRecord]+1];
PutWord[ans,ObjectType[Flash]];
PutBlock[src,ans+1,SIZE[Flash ObjectRecord]];
END;
Polygon =>
BEGIN
ans ← AllocateBlock[SIZE[Polygon ObjectRecord]+SIZE[Point]*PathLength[p]+1];
PutWord[ans,ObjectType[Polygon]];
PutBlock[src,ans+1,SIZE[Polygon ObjectRecord]-1];
StorePath[ans+SIZE[Polygon ObjectRecord],p];
END;
Wire =>
BEGIN
ans ← AllocateBlock[SIZE[Wire ObjectRecord]+SIZE[Point]*PathLength[p]+1];
PutWord[ans,ObjectType[Wire]];
PutBlock[src,ans+1,SIZE[Wire ObjectRecord]-1];
StorePath[ans+SIZE[Wire ObjectRecord],p];
END;
User =>
BEGIN
ans ← AllocateBlock[SIZE[User ObjectRecord]+size+1];
PutWord[ans,ObjectType[User]];
PutBlock[src,ans+1,SIZE[User ObjectRecord]-1];
PutBlock[data,ans+SIZE[User ObjectRecord],size];
END;

ENDCASE;

RETURN[ans];
END;

FetchObject: PUBLIC PROCEDURE [src: ObjectName, dest: Object] =
BEGIN OPEN IntVMDefs;

SELECT GetWord[src] FROM
ObjectType[STEntry] =>
GetBlock[src+1,dest,SIZE[STEntry ObjectRecord]];
ObjectType[SetNode] =>
GetBlock[src+1,dest,SIZE[SetNode ObjectRecord]];
ObjectType[Call] =>
GetBlock[src+1,dest,SIZE[Call ObjectRecord]];
ObjectType[Box] =>
GetBlock[src+1,dest,SIZE[Box ObjectRecord]];
ObjectType[MBox] =>
GetBlock[src+1,dest,SIZE[MBox ObjectRecord]];
ObjectType[Flash] =>
GetBlock[src+1,dest,SIZE[Flash ObjectRecord]];
ObjectType[Polygon] =>
BEGIN
GetBlock[src+1,dest,SIZE[Polygon ObjectRecord]-1];
WITH foo : dest↑ SELECT FROM
Polygon => foo.p ← RetrPath[src+SIZE[Polygon ObjectRecord]];
ENDCASE => ParserErrorDefs.Report["Object Mismatch", FatalInternal];
END;
ObjectType[Wire] =>
BEGIN
GetBlock[src+1,dest,SIZE[Wire ObjectRecord]-1];
WITH foo : dest↑ SELECT FROM
Wire => foo.p ← RetrPath[src+SIZE[Wire ObjectRecord]];
ENDCASE => ParserErrorDefs.Report["FetchObject Mismatch", FatalInternal];
END;
ObjectType[User] =>
BEGIN
GetBlock[src+1,dest,SIZE[User ObjectRecord]-1];
WITH foo : dest↑ SELECT FROM
User =>
BEGIN
foo.data ← ParserTypeDefs.AllocateUserNode[foo.size];
GetBlock[src+SIZE[User ObjectRecord],foo.data,foo.size];
END;
ENDCASE => ParserErrorDefs.Report["FetchObject Mismatch", FatalInternal];
END;
ENDCASE;
RETURN;
END;


-- Get rid of the named object.
DeleteObject: PUBLIC PROCEDURE [what: ObjectName] =
BEGIN OPEN IntVMDefs;
FreeBlock[what];
END;

-- Replace, dest with src, they had better be of the same size...
ReplaceObject: PUBLIC PROCEDURE [src: Object, dest: ObjectName] =
BEGIN OPEN IntVMDefs;

IF src.type # GetWord[dest] THEN
BEGIN
ParserErrorDefs.Report["ReplaceObject Mismatch", FatalInternal];
RETURN;
END;

WITH src SELECT FROM
STEntry =>
PutBlock[src,dest+1,SIZE[STEntry ObjectRecord]];
SetNode =>
PutBlock[src,dest+1,SIZE[SetNode ObjectRecord]];
Call =>
PutBlock[src,dest+1,SIZE[Call ObjectRecord]];
Box =>
PutBlock[src,dest+1,SIZE[Box ObjectRecord]];
MBox =>
PutBlock[src,dest+1,SIZE[MBox ObjectRecord]];
Flash =>
PutBlock[src,dest+1,SIZE[Flash ObjectRecord]];
Polygon =>
BEGIN
PutBlock[src,dest+1,SIZE[Polygon ObjectRecord]-1];
StorePath[dest+SIZE[Polygon ObjectRecord],p];
ParserTypeDefs.FreePath[p];
END;
Wire =>
BEGIN
PutBlock[src,dest+1,SIZE[Wire ObjectRecord]-1];
StorePath[dest+SIZE[Wire ObjectRecord],p];
ParserTypeDefs.FreePath[p];
END;
User =>
BEGIN
PutBlock[src,dest+1,SIZE[User ObjectRecord]-1];
PutBlock[data,dest+SIZE[User ObjectRecord],size];
ParserTypeDefs.FreeUserNode[data];
END;

ENDCASE;

END;

-- Private Procedures

-- Stuff a Path
StorePath: PROCEDURE [where: ObjectName, P: ParserTypeDefs.Path] = INLINE
BEGIN OPEN IntVMDefs, ParserTypeDefs;
i: CARDINAL;
lim: CARDINAL ← PathLength[P];
x: Point;
PutWord[where,lim];
FOR i IN [0..lim) DO
[,x] ← RemovePoint[P];
StorePt[where+1+(SIZE[Point]*i),x];
ENDLOOP;
END;

-- Retrieve a Path
RetrPath: PROCEDURE [where: ObjectName] RETURNS [P: ParserTypeDefs.Path] = INLINE
BEGIN OPEN IntVMDefs, ParserTypeDefs;
i: CARDINAL;
lim: CARDINAL;
P ← AllocatePath[];
lim ← GetWord[where];
FOR i IN [0..lim) DO
AppendPoint[P, RetrPt[where+1+(SIZE[Point]*i)]];
ENDLOOP;
END;

StorePt: PROCEDURE [where: ObjectName, pt: ParserTypeDefs.Point] = INLINE
BEGIN OPEN IntVMDefs;
PutLong[where,pt.x];
PutLong[where+2,pt.y];
END;

RetrPt: PROCEDURE [where: ObjectName] RETURNS [pt: ParserTypeDefs.Point] = INLINE
BEGIN OPEN IntVMDefs;
pt.x ← GetLong[where];
pt.y ← GetLong[where+2];
END;

END.