VMChunksImpl.mesa
Copyright Ó 1990, 1991 by Xerox Corporation. All rights reserved.
Christian Jacobi, February 7, 1990
Christian Jacobi, July 22, 1992 11:19 am PDT
DIRECTORY
FinalizeOps, VMChunks;
VMChunksImpl:
CEDAR
MONITOR
LOCKS domain
USING domain: Domain
IMPORTS FinalizeOps
EXPORTS VMChunks =
BEGIN OPEN VMChunks;
DomainRep: PUBLIC TYPE = DomainRec;
ChunkRep: PUBLIC TYPE = ChunkClientRec;
Domain: TYPE = REF DomainRec;
DomainRec:
TYPE =
MONITORED
RECORD [
root: REF ChunkRealRec --contains the first address !
];
Chunk: TYPE = REF ChunkClientRec;
ChunkRealRec:
TYPE =
PRIVATE
RECORD [
addr: CARD,
size: CARD,
prev, next: REF ChunkRealRec,
occupied: BOOL ¬ FALSE
];
ChunkClientRec:
TYPE =
RECORD [
c: REF ChunkRealRec,
dom: Domain
];
IsChunk:
PUBLIC
PROC [x:
REF
ANY]
RETURNS [
BOOL] = {
RETURN [x#NIL AND ISTYPE[x, REF ChunkClientRec]]
};
NarrowChunk:
PUBLIC
PROC [x:
REF
ANY]
RETURNS [Chunk] = {
RETURN [NARROW[x, REF ChunkClientRec]]
};
AddressOfChunk:
PUBLIC
PROC [chunk: Chunk]
RETURNS [
CARD] = {
RETURN [chunk.c.addr]
};
SizeOfChunk:
PUBLIC
PROC [chunk: Chunk]
RETURNS [
CARD] = {
RETURN [chunk.c.size]
};
DomainOfChunk:
PUBLIC
PROC [chunk: Chunk]
RETURNS [Domain] = {
RETURN [chunk.dom]
};
CreateDomain:
PUBLIC PROC [startAddress:
CARD, size:
CARD]
RETURNS [d: Domain] = {
InitRoot:
PROC [startAddress:
CARD, size:
CARD]
RETURNS [c:
REF ChunkRealRec] = {
c ¬ NEW[ChunkRealRec];
c.size ¬ size;
c.addr ¬ startAddress;
c.next ¬ c.prev ¬ c;
};
d ¬ NEW[DomainRec];
d.root ¬ InitRoot[startAddress, size];
};
alignRestrict: CARD = 8;--hardest alignment on sparc
NewChunk:
PROC [domain: Domain, c:
REF ChunkRealRec]
RETURNS [ch: Chunk] = {
ch ¬ NEW[ChunkClientRec ¬ [dom: domain, c: c]];
c.occupied ¬ TRUE;
[] ¬ FinalizeOps.EnableFinalization[ch, finalizationQueue]
};
AllocateChunk:
PUBLIC ENTRY
PROC [domain: Domain, size:
CARD]
RETURNS [Chunk] = {
root: REF ChunkRealRec ~ domain.root;
c: REF ChunkRealRec ¬ root;
size ¬ (size+alignRestrict-1)/alignRestrict*alignRestrict;
IF size=0 THEN RETURN [NIL];
--try exact hole
c ¬ root;
DO
IF ~c.occupied AND c.size=size THEN {RETURN[NewChunk[domain, c]]};
c ¬ c.next; IF c=root THEN EXIT;
ENDLOOP;
--try larger hole
c ¬ root;
DO
IF ~c.occupied
AND c.size>size
THEN {
SplitNCreateNext[c, size];
RETURN [NewChunk[domain, c]];
};
c ¬ c.next; IF c=root THEN EXIT;
ENDLOOP;
RETURN [NIL];
};
Free:
ENTRY
PROC [domain: Domain, c:
REF ChunkRealRec] = {
IF ~c.occupied THEN ERROR;
c.occupied ¬ FALSE;
IF ~c.next.occupied THEN JoinNRemoveNext[domain, c];
--order matters! JoinNRemoveNext of c.prev might clubber c
IF ~c.prev.occupied THEN JoinNRemoveNext[domain, c.prev];
};
SplitNCreateNext:
INTERNAL
PROC [c:
REF ChunkRealRec, nbytes:
CARD] = {
new: REF ChunkRealRec ~ NEW[ChunkRealRec];
IF c.occupied OR nbytes>=c.size THEN ERROR; --programming error
new.size ¬ c.size - nbytes;
c.size ¬ nbytes;
new.addr ¬ c.addr + nbytes;
new.next ¬ c.next;
new.prev ¬ c;
c.next.prev ¬ new;
c.next ¬ new;
};
JoinNRemoveNext:
INTERNAL
PROC [domain: Domain, c:
REF ChunkRealRec] = {
root: REF ChunkRealRec ~ domain.root;
remove: REF ChunkRealRec ¬ c.next;
IF remove=root THEN RETURN; --don't !!! memory is not circular
IF c.occupied OR remove.occupied THEN ERROR; --programming error
c.next ¬ remove.next;
remove.next.prev ¬ c;
c.size ¬ c.size+remove.size;
};
finalizationQueue: FinalizeOps.CallQueue ~ FinalizeOps.CreateCallQueue[Finalizor];
Finalizor: FinalizeOps.FinalizeProc = {
chunk: REF ChunkClientRec ~ NARROW[object];
Free[chunk.dom, chunk.c];
};