Text preview for : BcdAllocator.mesa_Oct77.pdf part of xerox BcdAllocator.mesa Oct77 xerox mesa 3.0_1977 listing BcdAllocator.mesa_Oct77.pdf
Back to : BcdAllocator.mesa_Oct77.p | Home
bcdallOCATOR.mESA 24-0CT-77 21:15:31 Page 1
-- BcdAllocator.Mesa Edited by Sandman on August 23. 1977 10:36 PM
DIRECTORY
InlineDefs: FROM "inlinedefs".
SystemDefs: FROM "systemdeFs".
BcdTableDefs: FROM "bcdtabledefs";
DEFINITIONS FROM BcdTableDefs;
BcdAllocator: PROGRAM
IMPORTS SystemDefs
EXPORTS BcdTableDefs
SHARES BcdTableDefs =
BEGIN
tbasp.: ARRAY TableSelector OF TableBase;
limit: ARRAY TableSelector OF [O .. TableLimit];
top, oldTop: ARRAY TableSelector OF CARDINAL;
tableOpen: BOOLEAN ~ FALSE:
tableOrigin: CARDINAL:
tableLimit: [0 .. TableLimit];
TableOverflow: PUBLIC SIGNAL RETURNS [origin, limit: CARDINAL] CODE:
TableFailure: PUBLIC ERROR [TableSelector] = CODE:
StackAllocateError: PUBLIC SIGNAL [TableSelector] = CODE;
-- stack allocation from subzones
Allocate: PUBLIC PROCEDURE [table: TableSelector. size: CARDINAL] RETURNS [TableIndex]
BEGIN
index: CARDINAL = top[table]:
newtop: CARDINAL = index + size;
IF newtop <= limit[table]
THEN top[table] ~ newtop
ELSE
IF newtop < TableLimit
THEN
BEGIN top[table] ~ newtop: Repack[]
END
ELSE ERROR TableFailure[table]:
RETURN [LOOPHOLE[index, TableIndex]]
END:
ResetTable: PUBLIC PROCEDURE [table: TableSelector]
BEGIN
top[table] ~ oldTop[table] ~ 0:
RETURN
END;
TableBounds: PUBLIC PROCEDURE [table: TableSelector] RETURNS [base: TableBase, size: CARDINAL]
BEGIN
RETURN [tbase[table]. top[table]]
END:
Repack: PROCEDURE =
BEGIN -- Garwick's Repacking algorithm (Knuth, Vol. 1. p. 245)
i: CARDINAL;
j. k. m: [FIRST[TableSelector] .. LAST[TableSelector]+1]:
nTables: CARDINAL = (LAST[TableSeleclor]-FIRST[TableSelector]+1);
sum. inc. delta. remainder: INTEGER;
d: ARRAY TableSelector OF INTEGER:
newBase: ARRAY TableSelector OF TableBase:
sb. db: POINTER;
newOrigin. newLimit: CARDINAL;
sum ~ tableLimit: inc ~ 0;
rOR j TN TableSelector
DO
sum ~ sum - top[j];
inc ~ inc + (d[j] .. rr top[j]>oldTop[j] THEN top[j]-oldTop[j] fL.SE 0);
rNDIOOP;
UNTIL sum )= MIN[lableLimit/ZO. 100B]
DO
[origin:newOrigin., limit:newLimiL]" SIGNAL TableOverflow;
bcdallOCATOR.mESA 24-0CT-77 21:15:31 Page 2
fOR j IN TableSelector
DO
tbase(j] ~ tbase(j] + (newOrigin-tableOrigin);
ENDLOOP;
sum ~ sum + (newLimit-tableLimit);
tableOrigin ~ newOrigin; tableLimit ~ newLimit;
ENDLOOP;
delta ~ sum/(10*nTables);
remainder ~ sum ~ delta*nTables;
newBase(FIRST(TableSelector]] ~ tbase(FIRST(TableSelector]]:
FOR j IN (FIRST(TableSelector] .. LAST[TableSelector]]
DO
newBase[j] ~ newBase[j-l] + top[j-l] + delta +
InlineOefs.LongDiv[
num: Inl ineDefs.LongMult[d[j-l]. remainder].
den:inc];
ENDLOOP;
j ~ FIRST[TableSelector]+l;
UNTIL j > LAST[TableSelector]
DO
SELECT newBase(j] FROM
< tbase(j] =>
BEGIN
InlineDefs.COPY[
from: LOOPHOLE[tbase(j]].
to: LOOPHOLE(newBase[j]].
nwords: MIN(top(j]. limit(j]]]:
tbase[j] ~ newBase(j];
j ~ j+l;
END;
> tbase[j] =>
BEGIN k ~ j+l:
UNTIL k > LAST(TableSelector] OR newBase[k] <= tbase(k]
DO
k ~ k+l:
ENDLOOP;
FOR m D~CREASING IN [j .. k)
DO
sb ~ LOOPHOLE[tbase(m]]; db ~ LOOPHOLE[newBase[m]];
FOR i DECREASING IN [0 .. MIN[top[m]. 1 imit[m]])
DO
(db+i)~ ~ (sb+i)~;
ENDLOOP;
tbase[m] ~ newBase[m];
ENDLOOP;
j ~ k;
END;
ENDCASE =) j ~ j+l;
ENDLOOP;
oldTop .. top;
sum .. tableLimit;
fOR j IN [FIRST[TableSelector] .. LAST[TableSelector]}
DO
1 ilnit[j] .. MIN[LOOPHOLE[tbase[j+l]-tbase[j]. CARDINAL]. TableLimit];
sum ~ sum - limit[j];
ENDLOOP;
limit[LAST[TableSelector]] ~ sum;
UpdateBases[]; RETURN
END:
-- linked list allocation (first subzone)
Chunk: TYPE = MACHINE DEPENDENT RECORD [
free. fil11: BOOLEAN.
sile: [O .. TableLlmit}.
fi112: [0 .. 3].
ft ink: CIndex.
fi113: [0 .. 3].
bLink: CIndex]:
CIndex: Typr = POINHR [O .. TaLJleLimit} TO Chunk:
NullChunkIndex: CIndex = IAST[CIndex]:
bcdall0CATOR.mESA 24-0CT-77 21:15:31 Page 3
chunkRover: CIndex:
GetChunk: PUBLIC PROCEDURE [size: CARDINAL] RETURNS [TableIndex] a
BEGIN
cb: TableBase = tbase[chunktype]:
p, q, next: CIndex:
nodeSize: CARDINAL:
n: INTEGER:
size ~ MAX[size, SIZE[Chunk]]:
BEGIN
IF (p ~ chunkRover) = NullChunkIndex THEN GO TO notFound:
-- search for a chunk to allocate
DO
nodeSize ~ (cb+p).size:
WHILE (next~p+nodeSize) # LOOPHOLE[top[chunktype], CIndex] AND (cb+next).free
DO
(cb+(cb+next).~Link).fLink ~ (cb+next).fLink:
(cb+(cb+next).fLink).bLink ~ (cb+next).bLink:
(cb+p).size ~ nodeSize ~ nodeSize + (cb+next).size;
chunkRover ~ p: -- in case next = chunkRover
ENDLOOP:
SELECT n ~ nodeSize-size FROM
= 0 =>
BEGIN
IF (cb+p).fLink = p
THEN chunkRover ~ NullChunkIndex
ELSE
BEGIN
chunkRover ~ (cb+(cb+p).bLink).fLink ~ (cb+p).fLink:
(cb+(cb+p).fLink).bLink ~ (cb+p).bLink:
END:
q ~ p: GO TO found:
END:
>= SIZE[Chunk] =>
BEGIN
(cb+p).size ~ n; chunkRover ~ p:
q ~ p + n: GO TO found:
END:
ENDCASE:
IF (p ~ (cb+p).fLink) = chunkRover THEN GO TO notFound:
ENDLOOP:
EXITS
found => NULL:
notFound => q ~ Allocate[chunktype, size]:
END:
(tbase[chunktype]+q).free ~ FALSE: RETURN [q]
END:
FreeChunk: PUBLIC PROCEDURE [i: TableIndex. size: CARDINAL]
BEGIN
cb: TableBase = tbase[chunktype]:
p: CIndex = LOOPHOLE[i]:
(cb+p).size ~ MAX[size. SIZE[Chunk]]:
IF chunkRover = NullChunkIndex
THEN chunkRover ~ (cb+p).fLink ~ (cb+p).bLink ~ p
ELSE
BEGIN
(cb+p).fLink ~ (cb+chunkRover).fLink:
(cb+(cb+p).fLink).bLink ~ p:
(cb+p).bLink ~ chunkRover:
(cb+chunkRover).fLink ~ p:
END:
(cb+p).free ~ TRUE: RETURN
END:
-- communication
NotifyNode: TYPE = RECORD [
notifier: TableNotifier.
1 ink: POINTER TO NotifyNode]:
notifyList: POINTER TO NotiryNode:
AddNolify: PUBLIC PROCEDURE [proc: TableNotifier]
BEGIN
bcdall0CATOR.mESA 24-0CT-77 21:16:31 Page 4
p: POINTER TO NotifyNode = SystemDefs.AllocateHeapNode[SIZE[NotifyNode]];
pt ~ [notifier:proc. link:notifyList];
notifyList ~ p;
proc[DESCRIPTOR[tbase]]; RETURN
END;
DropNotify: PUBLIC PROCEDURE [proc: TableNotifier] =
BEGIN
P. q: POINTER TO NotifyNode;
IF notifyList = NIL THEN RETURN;
P ~ notifyList;
IF p.notifier = proc
THEN notifyList ~ p.link
ELSE
BEGIN
DO
q ~ p; P ~ p.link;
IF p = NIL THEN RETURN;
IF p.notifier = proc THEN EXIT
ENDLOOP;
q.link ~ p.link;
END;
SystemDefs.FreeHeapNode[p]; RETURN
END;
UpdateBases: PROCEDURE =
BEGIN
p: POINTER TO NotifyNode;
FOR p ~ notifyList. p.link UNTIL p = NIL
DO
p.notifier[DESCRIPTOR[tbase]];
HJDLOOP;
RETURN
END;
-- initialization. expansion and termination
InitializeTable: PUBLIC PROCEDURE [origin. size: CARDINAL]
BEGIN
d: CARDINAL;
i: TableSelector;
IF tableOpen THEN EraseTable[];
tableOrigin ~ origin; tableLimit ~ size;
d ~ tableLimit/(LAST[TableSelector]-FIRST[TableSelector]+1);
FOR i IN TableSelector
DO
tbaso[i] ~ orlgln; origin ~ origin + d;
limit[i] ~ d; top[i] ~ oldTop[i] ~ 0;
ENDLOOP:
chunkRover ~ NullChunkIndex;
notifyList ~ NIL;
tableOpen ~ TRUE; RETURN
END:
EraseTable: PUBLIC PROCEDURE =
BEGIN
p. q: POINTER TO NotifyNode;
FOR p ~ notifyList. q UNTIL P = NIL
DO
q ~ p.link: SystemDefs.FreeHeapNode[p]:
[NDLOOP:
tableOpen ~ FALSE:
RETURN
END;
END ...