DIRECTORY
Alloc USING [Base, BaseSeq, Index, Limit, maxForBits, Notifier, OrderedIndex, pagesForBits, Selector, TableInfo],
PrincOpsUtils USING [LongCopy],
VM USING [AddressForPageNumber, Allocate, Free, Interval, nullInterval, PagesForWords, WordsForPages];

AllocImpl: MONITOR LOCKS h.LOCK USING h: Handle
IMPORTS PrincOpsUtils, VM 
EXPORTS Alloc = {
OPEN Alloc;


Handle: TYPE = REF InstanceData;

InstanceData: PUBLIC TYPE = MONITORED RECORD [
nTables: CARDINAL,
indexBits: CARDINAL,
tileSize: CARDINAL,
notifiers: NotifyChainHandle _ NIL,
bases: REF BaseSeq,
vm: REF SpaceSeq,
chunks: REF ChunkSeq,
top: REF SizeSeq,
limit: REF BoundSeq,
vmPages: REF SizeSeq];

SizeSeq: TYPE = RECORD [SEQUENCE length: NAT OF CARDINAL];
Bound: TYPE = LONG CARDINAL;
BoundSeq: TYPE = RECORD [SEQUENCE length: NAT OF Bound];
SpaceSeq: TYPE = RECORD [SEQUENCE length: NAT OF VM.Interval];
ChunkSeq: TYPE = RECORD [SEQUENCE length: NAT OF ChunkHandle];


Failure: PUBLIC ERROR [h: Handle, table: Selector] = CODE;
Overflow: PUBLIC SIGNAL [h: Handle, table: Selector] RETURNS [extra: CARDINAL] = CODE;



Words: PUBLIC ENTRY PROC [h: Handle, table: Selector, size: CARDINAL]
RETURNS [x: OrderedIndex] = {
ENABLE UNWIND => NULL;
ok: BOOL _ TRUE;
x _ WordsInternal[h, table, size ! Failure => {ok _ FALSE; CONTINUE}];
IF NOT ok THEN RETURN WITH ERROR Failure[h, table];
};

WordsInternal: INTERNAL PROC [h: Handle, table: Selector, size: CARDINAL] RETURNS [OrderedIndex] = {
index: CARDINAL = h.top[table];
newTop: Bound = index.LONG + size; -- could overflow CARDINAL for 16 bit pointers
IF newTop > h.limit[table] THEN {
IF newTop > maxForBits[h.indexBits] THEN ERROR Failure[h, table];
GrowTable[h, table, newTop]}; 
h.top[table] _ newTop;
RETURN [OrderedIndex.FIRST + index]};



Chunk: TYPE = MACHINE DEPENDENT RECORD [
free(0: 0..0): BOOL,
size(0: 1..15): [0..maxForBits[15]],
fLink(1): CIndex,
bLink(2): CIndex];

CIndex: TYPE = Base RELATIVE POINTER [0..Limit) TO Chunk;
nullChunkIndex: CIndex = CIndex.FIRST;

ChunkHandle: TYPE = REF ChunkObject;
ChunkObject: TYPE = RECORD [
chunkRover: CIndex,
firstSmall: CARDINAL,
smallLists: SEQUENCE nSmall: CARDINAL OF CIndex];

GetChunk: PUBLIC ENTRY PROC [h: Handle, size: CARDINAL, table: Selector] 
RETURNS [Index] = {
ENABLE UNWIND => {NULL};
ch: ChunkHandle = h.chunks[table];
cb: Base = h.bases[table];
q: CIndex;
IF ch = NIL THEN RETURN WITH ERROR Failure[h, table];
size _ MAX[size, Chunk.SIZE];
BEGIN
IF size IN [ch.firstSmall..ch.firstSmall+ch.nSmall) THEN { 
offset: CARDINAL = size - ch.firstSmall;
q _ ch.smallLists[offset];
IF q # nullChunkIndex THEN {ch.smallLists[offset] _ cb[q].fLink; GO TO found}};
q _ GetRoverChunk[cb, h.top[table], ch, size];
IF q # nullChunkIndex THEN GO TO found;
q _ WordsInternal[h: h, table: table, size: size ! Failure => {GO TO noneAtEnd}];
EXITS
noneAtEnd => {
FOR s: CARDINAL IN [ch.firstSmall.. ch.firstSmall+ch.nSmall) DO
offset: CARDINAL = s - ch.firstSmall;
r: CIndex _ ch.smallLists[offset];
WHILE r # nullChunkIndex DO
next: CIndex = cb[r].fLink;
FreeRoverChunk[cb, ch, r, s];
r _ next;
ENDLOOP;
ch.smallLists[offset] _ nullChunkIndex;
ENDLOOP;
q _ GetRoverChunk[cb, h.top[table], ch, size];
IF q = nullChunkIndex THEN RETURN WITH ERROR Failure[h, table]};
found => NULL;
END;
h.bases[table][q].free _ FALSE;
RETURN [q]};

GetRoverChunk:
INTERNAL PROC [cb: Base, top: CARDINAL, ch: ChunkHandle, size: CARDINAL] 
RETURNS [Index] = {
p, q, next: CIndex;
nodeSize: INTEGER;
n: INTEGER;
BEGIN
IF (p _ ch.chunkRover) = nullChunkIndex THEN GO TO notFound;
DO
nodeSize _ cb[p].size;
WHILE (next _ p + nodeSize) - CIndex.FIRST # top AND cb[next].free DO
cb[cb[next].bLink].fLink _ cb[next].fLink;
cb[cb[next].fLink].bLink _ cb[next].bLink;
cb[p].size _ nodeSize _ nodeSize + cb[next].size;
ch.chunkRover _ p; -- in case next = chunkRover
ENDLOOP;
SELECT (n _ nodeSize-size) FROM
= 0 => {
IF cb[p].fLink = p THEN ch.chunkRover _ nullChunkIndex
ELSE {
ch.chunkRover _ cb[cb[p].bLink].fLink _ cb[p].fLink;
cb[cb[p].fLink].bLink _ cb[p].bLink};
q _ p;
GO TO found};
>= Chunk.SIZE => {
cb[p].size _ n; ch.chunkRover _ p; q _ p + n; GO TO found};
ENDCASE;
IF (p _ cb[p].fLink) = ch.chunkRover THEN GO TO notFound;
ENDLOOP;
EXITS
found => NULL;
notFound => q _ nullChunkIndex;
END;
RETURN [q]};

FreeChunk: PUBLIC ENTRY PROC [
h: Handle, index: Index, size: CARDINAL, table: Selector] = {
ENABLE UNWIND => {NULL};
ch: ChunkHandle = h.chunks[table];
cb: Base = h.bases[table];
p: CIndex = LOOPHOLE[index];
IF ch = NIL THEN RETURN WITH ERROR Failure[h, table];
cb[p].size _ size _ MAX[size, Chunk.SIZE];
IF size IN [ch.firstSmall..ch.firstSmall+ch.nSmall) THEN {
offset: CARDINAL = size - ch.firstSmall;
cb[p].fLink _ ch.smallLists[offset];
ch.smallLists[offset] _ p;
cb[p].bLink _ nullChunkIndex} -- note, only singly linked
ELSE FreeRoverChunk[cb, ch, index, size]};

FreeRoverChunk: INTERNAL PROC [
cb: Base, ch: ChunkHandle, index: Index, size: CARDINAL] = {
p: CIndex = LOOPHOLE[index];
cb[p].size _ size _ MAX[size, Chunk.SIZE];
IF ch.chunkRover = nullChunkIndex THEN ch.chunkRover _ cb[p].fLink _ cb[p].bLink _ p
ELSE {
rover: CIndex = ch.chunkRover;
cb[p].fLink _ cb[rover].fLink;
cb[cb[p].fLink].bLink _ p;
cb[p].bLink _ rover;
cb[rover].fLink _ p};
cb[p].free _ TRUE};



Bounds: PUBLIC ENTRY PROC [h: Handle, table: Selector] RETURNS [base: Base, size: CARDINAL] = {RETURN [h.bases[table], h.top[table]]};


fileTileSize: CARDINAL = 32; -- must be >= tileSize;

GrowTable: INTERNAL PROC [h: Handle, table: Selector, newTop: Bound] = {
newPages: CARDINAL = VM.PagesForWords[newTop];
IF newPages > h.vmPages[table] THEN {
extra: CARDINAL = SIGNAL Overflow[h, table];
newVMSize: CARDINAL = MIN[maxForBits[h.indexBits], newPages + extra];
newVM: VM.Interval = VM.Allocate[newVMSize];
newVMPointer: LONG POINTER _ VM.AddressForPageNumber[newVM.page];
oldVM: VM.Interval = h.vm[table];
IF oldVM # VM.nullInterval THEN {
oldVMPointer: LONG POINTER = VM.AddressForPageNumber[oldVM.page];
nwords: CARDINAL = VM.WordsForPages[oldVM.count];
PrincOpsUtils.LongCopy[oldVMPointer, nwords, newVMPointer];
VM.Free[oldVM]};
h.vm[table] _ newVM;
h.bases[table] _ LOOPHOLE[newVMPointer];
h.vmPages[table] _ newVMSize;
RunNotifierChain[h]}};


Create: PUBLIC PROC [
weights: DESCRIPTOR FOR ARRAY OF TableInfo, indexBits, tileSize: CARDINAL] 
RETURNS [h: Handle] = {
cnt: CARDINAL = weights.LENGTH;
h _ NEW[InstanceData _ [
nTables: cnt, indexBits: indexBits,
tileSize: tileSize, notifiers: NIL,
bases: NEW[BaseSeq[cnt]],
vm: NEW[SpaceSeq[cnt]],
chunks: NEW[ChunkSeq[cnt]],
top: NEW[SizeSeq[cnt]],
limit: NEW[BoundSeq[cnt]],
vmPages: NEW[SizeSeq[cnt]]]];
IF tileSize >= fileTileSize THEN ERROR;
FOR i: CARDINAL IN [0..cnt) DO InitTable[h, i, weights[i]] ENDLOOP};

InitTable: PROC [h: Handle, table: Selector, info: TableInfo] = {
max: CARDINAL = WITH w: info SELECT FROM
TRUE => pagesForBits[h.indexBits],
FALSE => w.initialVMemPages,
ENDCASE => ERROR;
iPages: CARDINAL _ info.initialPages;
IF iPages > max OR max > pagesForBits[h.indexBits] THEN 
ERROR Failure[h, table];
h.vmPages[table] _ max;
h.top[table] _ 0;  h.limit[table] _ 0;
h.chunks[table] _ NIL;
IF iPages = 0 THEN {h.vm[table] _ VM.nullInterval; h.bases[table] _ NIL}
ELSE {
h.vm[table] _ VM.Allocate[max];
h.bases[table] _ LOOPHOLE[VM.AddressForPageNumber[h.vm[table].page]]}};

ResetTable: PUBLIC ENTRY PROC [h: Handle, table: Selector, info: TableInfo] = {
ENABLE UNWIND => {NULL};
IF h.vm[table] # VM.nullInterval THEN VM.Free[h.vm[table]];
InitTable[h, table, info];
RunNotifierChain[h]};

Destroy: PUBLIC ENTRY PROC [h: Handle] = {
ENABLE UNWIND => {NULL};
FOR i: CARDINAL IN [0..h.nTables) DO h.bases[i] _ NIL ENDLOOP;
RunNotifierChain[h];
FOR i: CARDINAL IN [0..h.nTables) DO
IF h.vm[i] # VM.nullInterval THEN VM.Free[h.vm[i]]
ENDLOOP;
};

Reset: PUBLIC ENTRY PROC [h: Handle] = {
ENABLE UNWIND => {NULL};
FOR i: CARDINAL IN [0..h.nTables) DO 
h.top[i] _ 0;
ResetChunkInternal[h, i];
ENDLOOP;
};

Chunkify: PUBLIC ENTRY PROC [
h: Handle, table: Selector, firstSmall, nSmall: CARDINAL] = {
ENABLE UNWIND => {NULL};
ch: ChunkHandle _ h.chunks[table];
IF ch # NIL THEN RETURN WITH ERROR Failure[h, table];
ch _ NEW[ChunkObject[nSmall]];
ch.firstSmall _ firstSmall;
h.chunks[table] _ ch;
ResetChunkInternal[h, table]};

UnChunkify: PUBLIC ENTRY PROC [h: Handle, table: Selector] = {
ENABLE UNWIND => NULL;
h.chunks[table] _ NIL};

Trim: PUBLIC ENTRY PROC [h: Handle, table: Selector, size: CARDINAL] = {
ENABLE UNWIND => {NULL};
IF size <= h.top[table] THEN {h.top[table] _ size; ResetChunkInternal[h, table]}
ELSE RETURN WITH ERROR Failure[h, table]};

ResetChunk: PUBLIC ENTRY PROC [h: Handle, table: Selector] = {
ResetChunkInternal[h, table ! UNWIND => {NULL}]};

ResetChunkInternal: INTERNAL PROC [h: Handle, table: Selector] = {
ch: ChunkHandle = h.chunks[table];
IF ch # NIL THEN {
ch.chunkRover _ nullChunkIndex;
FOR i: CARDINAL IN [0..ch.nSmall) DO ch.smallLists[i] _ nullChunkIndex ENDLOOP}};



NotifyNode: TYPE = RECORD [notifier: Notifier, link: NotifyChainHandle];
NotifyChainHandle: TYPE = REF NotifyNode;

AddNotify: PUBLIC ENTRY PROC [h: Handle, proc: Notifier] = {
ENABLE UNWIND => {NULL};
p: NotifyChainHandle = NEW[NotifyNode _ [notifier: proc, link: h.notifiers]];
h.notifiers _ p;
proc[h.bases]};

DropNotify: PUBLIC ENTRY PROC [h: Handle, proc: Notifier] = {
ENABLE UNWIND => {NULL};
IF h.notifiers # NIL THEN {
p: NotifyChainHandle _ h.notifiers;
IF p.notifier = proc THEN h.notifiers _ p.link
ELSE {
q: NotifyChainHandle;
DO
q _ p;
p _ p.link;
IF p = NIL THEN RETURN;
IF p.notifier = proc THEN EXIT
ENDLOOP;
q.link _ p.link};
p _ NIL;
};
};

RunNotifierChain: INTERNAL PROC [h: Handle] = {
FOR p: NotifyChainHandle _ h.notifiers, p.link UNTIL p = NIL DO
p.notifier[h.bases] ENDLOOP};

}.

~AllocImpl.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Sweet, 19-Aug-81 12:15:12
Satterthwaite, December 10, 1982 11:56 am
Maxwell, August 11, 1983 11:29 am
Rovner, October 12, 1983 10:52 am
Russ Atkinson (RRA) February 19, 1985 6:05:00 pm PST

types
signals
stack allocation from subzones
linked list allocation
none the right size, no space at the end, and no big ones to split
now all possible merges of free nodes can happen
search for a chunk to allocate
don't set cb[p].free _ TRUE; to avoid coalescing nodes
queries
stack allocation from subzones
initialization, expansion and termination
Notifier stuff
Κ
ϊ˜
codeš
œ™Kšœ
Οm
œ1™<Kš
œ™Kš
œ)™)K™!K™!J™4—K™š
Οk	˜	Kšœžœf˜qKšœžœ˜Kšžœ
žœ^˜fK˜—š	œžœ
žœžœ
žœ
˜/Kšžœžœ
˜Kšžœ
˜Kšžœ˜K˜Kš
œ™˜Kšœžœžœ˜ K˜š	œžœ
žœž	œ
žœ˜.Kšœ	žœ
˜Kšœžœ
˜Kšœ
žœ
˜Kšœžœ
˜#Kšœžœ	˜Kšœžœ
˜Kšœžœ
˜Kšœžœ	˜Kšœžœ
˜Kšœ	žœ
˜K˜—Kš
œ	žœžœžœ	žœ
žœ
žœ˜:Kšœžœžœ
žœ
˜Kšœ
žœžœžœ	žœ
žœ˜8Kš
œ
žœžœžœ	žœ
žœ
žœ˜>Kšœ
žœžœžœ	žœ
žœ˜>K˜—Kš
œ™˜Kšœ	žœ
žœ žœ
˜:Kšœ
žœ
žœžœ	žœžœ
˜VK˜K˜—Kš
œ™˜š
Οnœžœ
žœ
žœ$žœ
˜EKšžœ˜Kšžœ
žœžœ
˜Kšœžœžœ
˜Kšœ4žœžœ˜FKšžœ
žœžœ
žœ
žœ
žœ˜3Kš
œ˜K˜—š
Ÿ
œžœ
žœ$žœžœ˜dKšœžœ˜Kšœžœ	Οc.˜Qšžœžœ˜!Kšžœ"žœ
žœ˜AK˜—K˜Kšžœžœ˜%K˜K˜——Kš
œ™˜š	œžœžœ
ž	œ
žœ˜(Kšœžœ
˜K˜$K˜K˜K˜—Kš	œžœžœ
žœžœ˜9Kšœ žœ
˜&K˜Kšœ
žœžœ
˜$šœ
žœžœ˜K˜Kšœžœ
˜Kšœžœ	žœ
žœ	˜1K˜—š
Ÿœžœ
žœ
žœžœ˜IKšžœ˜Kšžœ
žœžœ˜K˜"K˜K˜
Kšžœžœ
žœ
žœ˜5Kšœžœ
žœ˜Kš
ž˜šžœžœ*žœ˜;Kšœžœ˜(K˜Kšžœžœ'žœ
žœ	˜O—K˜.Kšžœžœ
žœ
žœ˜'Kšœ?žœ
žœ
˜Qš
ž˜˜Kš
œB™Bšžœžœ
žœ+ž˜?Kšœžœ˜%K˜"šžœž˜K˜K˜K˜	Kšžœ
˜—K˜'Kšžœ
˜—Kš
œ0™0K˜.Kšžœžœ
žœ˜@—Kšœ	žœ
˜—Kšžœ
˜Kšœžœ
˜Kšžœ˜K˜—šŸ
œ
˜Kšžœ
žœžœžœ˜IKšžœ˜K˜Kšœ
žœ
˜Kšœžœ
˜Kš
ž˜Kšžœ&žœ
žœ
žœ
˜<Kš
œ™š
ž˜K˜šžœ žœžœž˜EK˜*K˜*K˜1Kšœ ˜/Kšžœ
˜—šžœž˜˜Kšžœžœ˜6šžœ˜K˜4K˜%—K˜Kšžœ
žœ˜
—šœ	žœ˜Kšœ.žœ
žœ˜;—Kšžœ
˜—Kšžœ#žœ
žœ
žœ
˜9Kšžœ
˜—š
ž˜Kšœ	žœ
˜K˜—Kšžœ
˜Kšžœ˜K˜—šŸ	œžœ
žœ
žœ˜Kšœžœ˜=Kšžœ
žœžœ˜K˜"K˜Kšœžœ˜Kšžœžœ
žœ
žœ˜5Kšœžœ
žœ˜*šžœžœ*žœ˜:Kšœžœ˜(K˜$K˜Kš
œ6™6Kšœ ˜9—Kšžœ&˜*K˜—šŸœžœ
žœ˜Kšœ/žœ˜<Kšœžœ˜Kšœžœ
žœ˜*Kšžœ žœ.˜Tšžœ˜K˜K˜K˜K˜K˜—Kšœ
žœ˜K˜K˜——Kš
œ™˜šŸœžœ
žœ
žœžœžœžœ!˜†
K˜—Kš
œ™K˜Kšœžœ ˜4K˜šŸ	œžœ
žœ0˜HKšœ
žœžœ˜.šžœžœ˜%Kšœžœžœ˜,Kšœžœžœ,˜EKšœžœžœ˜,Kšœžœ
žœžœ"˜AKšœžœ˜!šžœ	žœžœ˜!Kšœžœ
žœžœ"˜AKšœžœžœ˜1Kš
œ;˜;Kšžœ˜—Kš
œ˜Kšœžœ˜(Kš
œ˜Kš
œ˜K˜——Kš
œ)™)K˜šŸœžœ
žœ˜Kšœ	ž
œ
žœ
žœ
žœ!žœ˜KKšžœ˜Kšœžœžœ
˜šœžœ˜K˜#Kšœžœ
˜#Kšœžœ˜Kšœžœ˜Kšœžœ˜Kšœžœ˜Kšœžœ˜Kšœ	žœ˜—Kšžœžœ
žœ
˜'š
žœžœ
žœ
žœžœ˜DK˜——šŸ	œžœ2˜Ašœžœžœ	žœ
ž˜(Kšžœ˜"Kšžœ˜Kšžœžœ
˜—Kšœžœ˜%šžœžœ!žœ
˜8Kšžœ˜—K˜K˜&Kšœžœ
˜Kšžœžœžœ žœ
˜Hšžœ˜Kšœžœ˜Kšœžœ
žœ+˜GK˜——šŸ
œžœ
žœ
žœ2˜OKšžœ
žœžœ˜Kšžœžœžœ
žœ˜;K˜K˜K˜—šŸœžœ
žœ
žœ˜*Kšžœ
žœžœ˜Kšžœžœ
žœžœžœ
žœ
˜>K˜šžœžœ
žœž˜$Kšžœžœžœ
žœ˜2Kšžœ
˜—Kš
œ˜K˜—šŸœžœ
žœ
žœ˜(Kšžœ
žœžœ˜šžœžœ
žœžœ
˜%K˜
K˜Kšžœ
˜—š
œ˜K˜——šŸœžœ
žœ
žœ˜Kšœ0žœ˜=Kšžœ
žœžœ˜K˜"Kšžœžœ
žœ
žœ˜5Kšœžœ˜K˜K˜K˜K˜—šŸ
œžœ
žœ
žœ!˜>Kšžœ
žœžœ
˜Kšœžœ˜K˜—š
Ÿœžœ
žœ
žœ$žœ˜HKšžœ
žœžœ˜Kšžœžœ4˜PKšžœ
žœ˜*K˜—šŸ
œžœ
žœ
žœ!˜>Kšœžœžœ˜1K˜—šŸœžœ
žœ!˜BK˜"šžœžœ
žœ˜K˜Kš
žœžœ
žœžœ#žœ˜QK˜K˜———Kš
œ™˜Kšœžœžœ/˜HKšœžœžœ˜)K˜šŸ	œžœ
žœ
žœ ˜<Kšžœ
žœžœ˜Kšœžœ3˜MK˜Kš
œ˜K˜—šŸ
œžœ
žœ
žœ ˜=Kšžœ
žœžœ˜šžœžœ
žœ˜K˜#Kšžœžœ˜.šžœ˜K˜š
ž˜K˜K˜Kšžœžœ
žœ
žœ
˜Kšžœžœ
ž˜Kšžœ
˜—K˜—Kšœžœ
˜Kš
œ˜—š
œ˜K˜——šŸœžœ
žœ˜/šžœ,žœžœ
ž˜?Kšœžœ˜K˜——K˜K˜———…—&6ˆ