DIRECTORY
Alloc: TYPE USING [
Base, BaseSeq, Index, Limit, maxForBits, Notifier, OrderedIndex, pagesForBits,
Selector, TableInfo],
PrincOpsUtils: TYPE USING [LongCOPY],
VM: TYPE 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};

}.

Xfile AllocImpl.mesa
last modified by Sweet, 19-Aug-81 12:15:12
last modified by Satterthwaite, December 10, 1982 11:56 am
Last Edited by: Maxwell, August 11, 1983 11:29 am
Last Edited by: Paul Rovner, October 12, 1983 10:52 am

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
�Ê
ü˜Jš
œ™Jš
œ*™*Jš
œ:™:J™1J™6J™š
Ïk	˜	šœ�œ
�œ˜Jš
œN˜NJ˜—Jšœ�œ
�œ˜%Jš�œ�œ
�œ^˜lJ˜—š	œ�œ
�œ�œ
�œ
˜/Jš�œ�œ
˜Jš�œ
˜Jš�œ˜J˜Jš
œ™˜Jšœ�œ�œ˜ J˜š	œ�œ
�œ�	œ
�œ˜.Jšœ	�œ
˜Jšœ�œ
˜Jšœ
�œ
˜Jšœ�œ
˜#Jšœ�œ	˜Jšœ�œ
˜Jšœ�œ
˜Jšœ�œ	˜Jšœ�œ
˜Jšœ	�œ
˜J˜—Jš
œ	�œ�œ�œ	�œ
�œ
�œ˜:Jšœ�œ�œ
�œ
˜Jšœ
�œ�œ�œ	�œ
�œ˜8Jš
œ
�œ�œ�œ	�œ
�œ
�œ˜>Jšœ
�œ�œ�œ	�œ
�œ˜>J˜—Jš
œ™˜Jšœ	�œ
�œ �œ
˜:Jšœ
�œ
�œ�œ	�œ�œ
˜VJ˜J˜—Jš
œ™˜š
Ïnœ�œ
�œ
�œ$�œ
˜EJš�œ˜Jš�œ
�œ�œ
˜Jšœ�œ�œ
˜Jšœ4�œ�œ˜FJš�œ
�œ�œ
�œ
�œ
�œ˜3Jš
œ˜J˜—š
ž
œ�œ
�œ$�œ�œ˜dJšœ�œ˜Jšœ�œ	Ïc.˜Qš�œ�œ˜!Jš�œ"�œ
�œ˜AJ˜—J˜Jš�œ�œ˜%J˜J˜——Jš
œ™˜š	œ�œ�œ
�	œ
�œ˜(Jšœ�œ
˜J˜$J˜J˜J˜—Jš	œ�œ�œ
�œ�œ˜9Jšœ �œ
˜&J˜Jšœ
�œ�œ
˜$šœ
�œ�œ˜J˜Jšœ�œ
˜Jšœ�œ	�œ
�œ	˜1J˜—š
žœ�œ
�œ
�œ�œ˜IJš�œ˜Jš�œ
�œ�œ˜J˜"J˜J˜
Jš�œ�œ
�œ
�œ˜5Jšœ�œ
�œ˜Jš
�˜š�œ�œ*�œ˜;Jšœ�œ˜(J˜Jš�œ�œ'�œ
�œ	˜O—J˜.Jš�œ�œ
�œ
�œ˜'Jšœ?�œ
�œ
˜Qš
�˜˜Jš
œB™Bš�œ�œ
�œ+�˜?Jšœ�œ˜%J˜"š�œ�˜J˜J˜J˜	Jš�œ
˜—J˜'Jš�œ
˜—Jš
œ0™0J˜.Jš�œ�œ
�œ˜@—Jšœ	�œ
˜—Jš�œ
˜Jšœ�œ
˜Jš�œ˜J˜—šž
œ
˜Jš�œ
�œ�œ�œ˜IJš�œ˜J˜Jšœ
�œ
˜Jšœ�œ
˜Jš
�˜Jš�œ&�œ
�œ
�œ
˜<Jš
œ™š
�˜J˜š�œ �œ�œ�˜EJ˜*J˜*J˜1JšœŸ˜/Jš�œ
˜—š�œ�˜˜Jš�œ�œ˜6š�œ˜J˜4J˜%—J˜Jš�œ
�œ˜
—šœ	�œ˜Jšœ.�œ
�œ˜;—Jš�œ
˜—Jš�œ#�œ
�œ
�œ
˜9Jš�œ
˜—š
�˜Jšœ	�œ
˜J˜—Jš�œ
˜Jš�œ˜J˜—šž	œ�œ
�œ
�œ˜Jšœ�œ˜=Jš�œ
�œ�œ˜J˜"J˜Jšœ�œ˜Jš�œ�œ
�œ
�œ˜5Jšœ�œ
�œ˜*š�œ�œ*�œ˜:Jšœ�œ˜(J˜$J˜Jš
œ6™6JšœŸ˜9—Jš�œ&˜*J˜—šžœ�œ
�œ˜Jšœ/�œ˜<Jšœ�œ˜Jšœ�œ
�œ˜*Jš�œ �œ.˜Tš�œ˜J˜J˜J˜J˜J˜—Jšœ
�œ˜J˜J˜——Jš
œ™˜šžœ�œ
�œ
�œ�œ�œ�œ!˜†
J˜—Jš
œ™J˜Jšœ�œŸ˜4J˜šž	œ�œ
�œ0˜HJšœ
�œ�œ˜.š�œ�œ˜%Jšœ�œ�œ˜,Jšœ�œ�œ,˜EJšœ�œ�œ˜,Jšœ�œ
�œ�œ"˜AJšœ�œ˜!š�œ	�œ�œ˜!Jšœ�œ
�œ�œ"˜AJšœ�œ�œ˜1Jš
œ;˜;Jš�œ˜—Jš
œ˜Jšœ�œ˜(Jš
œ˜Jš
œ˜J˜——Jš
œ)™)J˜šžœ�œ
�œ˜Jšœ	�
œ
�œ
�œ
�œ!�œ˜KJš�œ˜Jšœ�œ�œ
˜šœ�œ˜J˜#Jšœ�œ
˜#Jšœ�œ˜Jšœ�œ˜Jšœ�œ˜Jšœ�œ˜Jšœ�œ˜Jšœ	�œ˜—Jš�œ�œ
�œ
˜'š
�œ�œ
�œ
�œ�œ˜DJ˜——šž	œ�œ2˜Ašœ�œ�œ	�œ
�˜(Jš�œ˜"Jš�œ˜Jš�œ�œ
˜—Jšœ�œ˜%š�œ�œ!�œ
˜8Jš�œ˜—J˜J˜&Jšœ�œ
˜Jš�œ�œ�œ �œ
˜Hš�œ˜Jšœ�œ˜Jšœ�œ
�œ+˜GJ˜——šž
œ�œ
�œ
�œ2˜OJš�œ
�œ�œ˜Jš�œ�œ�œ
�œ˜;J˜J˜J˜—šžœ�œ
�œ
�œ˜*Jš�œ
�œ�œ˜Jš�œ�œ
�œ�œ�œ
�œ
˜>J˜š�œ�œ
�œ�˜$Jš�œ�œ�œ
�œ˜2Jš�œ
˜—Jš
œ˜J˜—šžœ�œ
�œ
�œ˜(Jš�œ
�œ�œ˜š�œ�œ
�œ�œ
˜%J˜
J˜Jš�œ
˜—š
œ˜J˜——šžœ�œ
�œ
�œ˜Jšœ0�œ˜=Jš�œ
�œ�œ˜J˜"Jš�œ�œ
�œ
�œ˜5Jšœ�œ˜J˜J˜J˜J˜—šž
œ�œ
�œ
�œ!˜>Jš�œ
�œ�œ
˜Jšœ�œ˜J˜—š
žœ�œ
�œ
�œ$�œ˜HJš�œ
�œ�œ˜Jš�œ�œ4˜PJš�œ
�œ˜*J˜—šž
œ�œ
�œ
�œ!˜>Jšœ�œ�œ˜1J˜—šžœ�œ
�œ!˜BJ˜"š�œ�œ
�œ˜J˜Jš
�œ�œ
�œ�œ#�œ˜QJ˜J˜———Jš
œ™˜Jšœ�œ�œ/˜HJšœ�œ�œ˜)J˜šž	œ�œ
�œ
�œ ˜<Jš�œ
�œ�œ˜Jšœ�œ3˜MJ˜Jš
œ˜J˜—šž
œ�œ
�œ
�œ ˜=Jš�œ
�œ�œ˜š�œ�œ
�œ˜J˜#Jš�œ�œ˜.š�œ˜J˜š
�˜J˜J˜Jš�œ�œ
�œ
�œ
˜Jš�œ�œ
�˜Jš�œ
˜—J˜—Jšœ�œ
˜Jš
œ˜—š
œ˜J˜——šžœ�œ
�œ˜/š�œ,�œ�œ
�˜?Jšœ�œ˜J˜——J˜J˜———…—&"6v