XlPrivateResourcesImpl.mesa
Copyright Ó 1989, 1990, 1991 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, August 15, 1989 10:19:14 am PDT
Christian Jacobi, August 19, 1992 3:35 pm PDT
DIRECTORY
Basics32, CardTab, IO, Rope, Xl, XlPrivateResources;
XlPrivateResourcesImpl:
CEDAR
MONITOR
LOCKS c
USING c: Connection
IMPORTS Basics32, CardTab, Xl
EXPORTS Xl, XlPrivateResources ~
BEGIN OPEN Xl, XlPrivateResources;
ResourceStuffRep: PUBLIC TYPE = ResourceStuffRec;
ResourceStuffRec:
TYPE =
RECORD [
base: CARD32,
mask: CARD32,
increment: CARD32,
alloc: CARD32 ¬ 0,
freeList: REF PieceRec ¬ NIL,
attachments: CardTab.Ref ¬ NIL
];
pieceCount: NAT = 64;
PieceRec:
TYPE =
RECORD [
--invariant: only first PieceRec of free list may have used=0
a: ARRAY [0..pieceCount) OF ID ¬ ALL[0],
used: NAT ¬ 0,
next: REF PieceRec ¬ NIL
];
InitPrivateResources:
PUBLIC
PROC [c: Connection, resourceIdBase, resourceIdMask:
CARD32] = {
resources:
REF ResourceStuffRec ¬
NEW[ResourceStuffRec ¬ [
base: resourceIdBase,
mask: resourceIdMask,
increment: Basics32.BITAND[resourceIdMask, CARD32.LAST-(resourceIdMask-1)],
alloc: 0,
attachments: CardTab.Create[]
]];
c.resourceStuff ¬ resources;
};
MarkDead:
PUBLIC
PROC [c: Connection] = {
resources: REF ResourceStuffRec ~ c.resourceStuff;
IF resources#
NIL
THEN {
resources.freeList ¬ NIL;
IF resources.attachments#NIL THEN CardTab.Erase[resources.attachments]
};
};
NewResourceID:
PUBLIC
--INTERNAL--
PROC [c: Connection]
RETURNS [id:
ID] = {
MakeResourceID:
PROC [resources:
REF ResourceStuffRec]
RETURNS [
ID] =
INLINE {
IF resources.alloc = resources.mask THEN ERROR; -- out of ids; it is ok to wedge the connection
resources.alloc ¬ resources.alloc + resources.increment;
RETURN [Basics32.BITOR[resources.alloc, resources.base]];
};
resources: REF ResourceStuffRec ~ c.resourceStuff;
free: REF PieceRec ¬ resources.freeList;
IF free#NIL AND free.used=0 THEN free ¬ free.next;
IF free#NIL AND free.used>0 THEN {free.used ¬ free.used-1; RETURN [free.a[free.used]]};
RETURN [MakeResourceID[resources]];
};
InternalFreeResourceID:
PUBLIC
--INTERNAL--
PROC [c: Connection, id:
ID] = {
IF Xl.Alive[c]
AND ValidID[c, id]
THEN {
resources: REF ResourceStuffRec ~ c.resourceStuff;
free: REF PieceRec ¬ resources.freeList;
IF free=
NIL
OR free.used>=pieceCount
THEN {
free ¬ NEW[PieceRec ¬ [next: resources.freeList]];
resources.freeList ¬ free
};
free.a[free.used] ¬ id; free.used ¬ free.used+1;
};
};
EntryFreeResourceID:
PUBLIC
ENTRY
PROC [c: Connection, id:
ID] = {
InternalFreeResourceID[c, id];
};
ValidID:
PUBLIC
PROC [c: Connection, id:
ID]
RETURNS [
BOOL] = {
resources: REF ResourceStuffRec ~ c.resourceStuff;
RETURN [(id#0) AND (Basics32.BITAND[(CARD32.LAST-resources.mask), id-resources.base]=0)];
};
Attach:
PUBLIC
PROC [c: Connection, id:
ID, ref:
REF] = {
Attaches a ref to an id.
Note: Do not forget to call Detach before freeing resource.
resources: REF ResourceStuffRec ~ c.resourceStuff;
[] ¬ CardTab.Store[resources.attachments, id, ref];
};
Detach:
PUBLIC PROC [c: Connection, id:
ID] = {
Undo of Attach.
resources: REF ResourceStuffRec ~ c.resourceStuff;
[] ¬ CardTab.Delete[resources.attachments, id];
};
Fetch:
PUBLIC PROC [c: Connection, id:
ID]
RETURNS [ref:
REF] = {
Fetches attached ref
resources: REF ResourceStuffRec ~ c.resourceStuff;
ref ¬ CardTab.Fetch[resources.attachments, id].val;
};
END.