-- Fsp.Mesa Edited by Sandman on August 1, 1980 10:08 AM
-- Copyright Xerox Corporation 1979, 1980
DIRECTORY
AltoDefs USING [PageSize],
FSPDefs USING [
BlockSize, Deallocator, FreeNodePointer, NodeHeader, NodePointer, ZoneHeader,
ZoneOverhead, ZonePointer],
InlineDefs USING [COPY],
NucleusOps USING [],
ProcessDefs USING [InitializeMonitor],
SegmentDefs USING [
DataSegmentAddress, DataSegmentHandle, DefaultMDSBase, HardDown, HeapDS,
MakeDataSegment, VMtoDataSegment],
Storage USING [FreePages, PagesForWords],
StringDefs USING [WordsForString],
SystemDefs USING [];
FSP: MONITOR LOCKS z.lock USING z: ZonePointer
IMPORTS InlineDefs, ProcessDefs, SegmentDefs, StringDefs, Storage
EXPORTS FSPDefs, NucleusOps, Storage, SystemDefs
SHARES FSPDefs =PUBLIC
BEGIN OPEN FSPDefs; -- Mesa Free Storage Package --
-- A set of procedures to manage allocation within a zone.
-- Coalescing of free nodes occurs during allocation; all
-- free nodes following a candidate node are merged before
-- any space is allocated. The logic is derived from a
-- BCPL program by E. M. McCreight and was suggested by an
-- exercise in Knuth Volume I, p. 453 #19
UsedNodeSize: PRIVATE BlockSize = SIZE[inuse NodeHeader];
FreeNodeSize: PRIVATE BlockSize = SIZE[free NodeHeader];
ZoneHeaderSize: PRIVATE BlockSize = SIZE[ZoneHeader];
ZoneTooSmall: ERROR [POINTER] = CODE;
ZoneTooLarge: ERROR [POINTER] = CODE;
DoNothingDeallocate: Deallocator = BEGIN NULL END;
MakeZone: PROCEDURE [base: POINTER, length: BlockSize]
RETURNS [z: ZonePointer] =
BEGIN RETURN[MakeNewZone[base, length, DoNothingDeallocate]]; END;
MakeNewZone: PROCEDURE [
base: POINTER, length: BlockSize, deallocate: Deallocator]
RETURNS [z: ZonePointer] =
BEGIN
fn: FreeNodePointer;
an: POINTER TO inuse NodeHeader;
IF length < ZoneHeaderSize + FreeNodeSize + UsedNodeSize THEN
ERROR ZoneTooSmall[base];
IF CARDINAL[length] > CARDINAL[LAST[BlockSize]] THEN ERROR ZoneTooLarge[base];
z ← base; -- set up the bulk of the zone as a large free block.
fn ← base + ZoneHeaderSize;
fn↑ ← NodeHeader[
length: length - (ZoneHeaderSize + UsedNodeSize),
extension: free[fwdp: @z.node, backp: @z.node]];
-- set up allocated node (smallest possible) at end of block.
an ← base + (length - UsedNodeSize);
an↑ ← NodeHeader[length: UsedNodeSize, extension: inuse[]];
-- set up the zone header
z↑ ← ZoneHeader[
rover: fn, lock:, restOfZone: NIL, length: length, deallocate: deallocate,
threshold: FreeNodeSize, checking: FALSE,
node: NodeHeader[length: 0, extension: free[fwdp: fn, backp: fn]]];
ProcessDefs.InitializeMonitor[@z.lock];
RETURN
END;
AddToZone: PROCEDURE [z: ZonePointer, base: POINTER, length: BlockSize] =
BEGIN AddToNewZone[z, base, length, DoNothingDeallocate]; END;
AddToNewZone: ENTRY PROCEDURE [
z: ZonePointer, base: POINTER, length: BlockSize, deallocate: Deallocator] =
BEGIN
newz: ZonePointer;
firstnew, lastnew: FreeNodePointer;
ValidateZone[z ! UNWIND => NULL];
newz ← MakeNewZone[base, length, deallocate]; -- splice the zones together
firstnew ← newz.node.fwdp;
lastnew ← newz.node.backp;
z.node.backp.fwdp ← firstnew;
firstnew.backp ← z.node.backp;
lastnew.fwdp ← @z.node;
z.node.backp ← lastnew; -- make newz head an empty list
newz.node.fwdp ← newz.node.backp ← @newz.node;
newz.restOfZone ← z.restOfZone;
z.restOfZone ← newz;
IF z.checking THEN CheckZone[z ! UNWIND => NULL];
RETURN
END;
InvalidZone: ERROR [POINTER] = CODE; -- zone header looks fishy
ValidateZone: PRIVATE PROCEDURE [z: ZonePointer] =
BEGIN
SELECT TRUE FROM
(z.node.length # 0),
((@z.node + z.length - UsedNodeSize).length # UsedNodeSize),
(z.node.fwdp.backp # @z.node OR z.node.backp.fwdp # @z.node) =>
ERROR InvalidZone[z];
ENDCASE;
RETURN
END;
NodeLoop: ERROR [ZonePointer] = CODE;
CheckZone: PRIVATE PROCEDURE [z: ZonePointer] =
BEGIN
node: FreeNodePointer;
count: INTEGER;
ValidateZone[z];
count ← (LAST[BlockSize] - FIRST[BlockSize])/FreeNodeSize + 1;
node ← @z.node;
DO
CheckNode[z, node, FALSE];
IF (count ← count - 1) < 0 THEN ERROR NodeLoop[z];
IF (node ← node.fwdp) = @z.node THEN EXIT;
ENDLOOP;
RETURN
END;
InvalidNode: ERROR [POINTER] = CODE; -- node appears damaged
CheckNode: PRIVATE PROCEDURE [
z: ZonePointer, node: NodePointer, free: BOOLEAN] =
BEGIN
OP: TYPE = ORDERED POINTER;
p: OP;
zone: ZonePointer;
FOR zone ← z, zone.restOfZone UNTIL zone = NIL DO
p ← LOOPHOLE[zone, OP];
IF LOOPHOLE[node, OP] IN [p..p + zone.length) THEN EXIT;
REPEAT FINISHED => GOTO error;
ENDLOOP;
WITH node SELECT FROM free => IF free THEN ERROR; ENDCASE;
DO
WITH node SELECT FROM
inuse => IF length = UsedNodeSize THEN EXIT; -- end of zone
free =>
BEGIN
IF fwdp.backp # node OR backp.fwdp # node THEN GO TO error;
IF length = 0 AND node # @z.node THEN GO TO error;
END;
ENDCASE;
node ← node + node.length;
IF node.state # inuse THEN EXIT;
ENDLOOP;
RETURN
EXITS
error =>
BEGIN z.checking ← FALSE; ERROR InvalidNode[node + UsedNodeSize]; END;
END;
NoRoomInZone: SIGNAL [ZonePointer] = CODE;
MakeNode: PROCEDURE [z: ZonePointer, n: BlockSize] RETURNS [POINTER] =
BEGIN
node: NodePointer;
IF INTEGER[n] < 0 THEN ERROR ZoneTooSmall[z];
n ← MAX[n + UsedNodeSize, FreeNodeSize];
WHILE (node ← GetNode[z, n]) = NIL DO SIGNAL NoRoomInZone[z]; ENDLOOP;
-- try again if RESUMEd from the signal
RETURN[node]
END;
GetNode: PRIVATE ENTRY PROCEDURE [z: ZonePointer, n: BlockSize]
RETURNS [POINTER] =
BEGIN
rover: FreeNodePointer ← z.rover;
node, neighbour: NodePointer;
nodelength, nl: BlockSize;
IF z.checking THEN CheckZone[z ! UNWIND => NULL];
DO
nodelength ← rover.length;
FOR neighbour ← rover + nodelength, neighbour + nl DO
WITH neighbour SELECT FROM
inuse => EXIT;
free =>
BEGIN -- coalesce
IF (nl ← length) = 0 THEN EXIT; -- end of zone
fwdp.backp ← backp;
backp.fwdp ← fwdp;
z.rover ← rover; -- in case neighbor was z.rover
nodelength ← nodelength + nl;
END;
ENDCASE;
ENDLOOP;
IF nodelength >= n THEN
BEGIN
IF (nl ← (nodelength - n)) > MAX[FreeNodeSize, z.threshold] THEN
BEGIN -- split the block
rover.length ← nl;
node ← rover + nl;
nodelength ← n;
z.rover ← rover;
node↑ ← NodeHeader[nodelength, inuse[]];
RETURN[node + UsedNodeSize]
END
ELSE
BEGIN
rover.fwdp.backp ← rover.backp;
z.rover ← rover.backp.fwdp ← rover.fwdp;
node ← rover;
node↑ ← NodeHeader[nodelength, inuse[]];
RETURN[node + UsedNodeSize]
END;
END;
rover.length ← nodelength;
IF (rover ← rover.fwdp) = z.rover THEN EXIT;
ENDLOOP;
RETURN[NIL];
END;
FreeNode: ENTRY PROCEDURE [z: ZonePointer, p: POINTER] =
BEGIN
IF z.checking THEN
BEGIN
CheckZone[z ! UNWIND => NULL];
CheckNode[z, p - UsedNodeSize, TRUE ! UNWIND => NULL];
END;
FreeThisNode[z, p ! UNWIND => NULL];
RETURN
END;
FreeThisNode: PRIVATE PROCEDURE [z: ZonePointer, p: POINTER] =
BEGIN
node: NodePointer = p - UsedNodeSize;
WITH node SELECT FROM
free => ERROR InvalidNode[p];
ENDCASE => node↑ ← NodeHeader[node.length, free[@z.node, z.node.backp]];
WITH n: node SELECT FROM free => z.node.backp ← n.backp.fwdp ← @n; ENDCASE;
RETURN
END;
SplitNode: ENTRY PROCEDURE [z: ZonePointer, p: POINTER, n: BlockSize] =
BEGIN
node: NodePointer = p - UsedNodeSize;
lastpart: NodePointer;
t: BlockSize;
IF z.checking THEN
BEGIN
CheckZone[z ! UNWIND => NULL];
CheckNode[z, node, TRUE ! UNWIND => NULL];
END;
n ← MAX[n + UsedNodeSize, FreeNodeSize];
WITH node SELECT FROM
free => RETURN WITH ERROR InvalidNode[p];
ENDCASE =>
IF (t ← node.length - n) >= MAX[FreeNodeSize, z.threshold] THEN
BEGIN
lastpart ← node + n;
lastpart↑ ← NodeHeader[t, inuse[]];
FreeThisNode[z, lastpart + UsedNodeSize ! UNWIND => NULL];
node.length ← n;
END;
RETURN
END;
NodeSize: PROCEDURE [p: POINTER] RETURNS [BlockSize] =
BEGIN
node: NodePointer = p - UsedNodeSize;
WITH node SELECT FROM
free => ERROR InvalidNode[p];
ENDCASE => RETURN[length - UsedNodeSize];
END;
PruneZone: ENTRY PROCEDURE [z: ZonePointer] RETURNS [BOOLEAN] =
BEGIN
didit: BOOLEAN ← FALSE;
rest: ZonePointer;
zone: ZonePointer ← z;
prev: ZonePointer ← z;
node: NodePointer;
nl: BlockSize;
FOR zone ← z.restOfZone, rest UNTIL zone = NIL DO
rest ← zone.restOfZone;
IF zone.deallocate # DoNothingDeallocate THEN
FOR node ← LOOPHOLE[zone + ZoneHeaderSize, NodePointer], node + nl DO
WITH node SELECT FROM
inuse =>
BEGIN
IF length = UsedNodeSize THEN
BEGIN -- end of zone
FreeZone[zone ! UNWIND => NULL];
didit ← TRUE;
prev.restOfZone ← rest;
END
ELSE prev ← zone;
EXIT
END;
free => nl ← length;
ENDCASE;
ENDLOOP;
ENDLOOP;
z.rover ← z.node.fwdp; -- reset rover incase in a freed zone
RETURN[didit];
END;
FreeZone: PRIVATE PROCEDURE [zone: ZonePointer] =
BEGIN
node: NodePointer;
nl: BlockSize;
FOR node ← LOOPHOLE[zone + ZoneHeaderSize, NodePointer], node + nl DO
WITH node SELECT FROM
inuse => EXIT; -- end of zone
free => BEGIN nl ← length; backp.fwdp ← fwdp; fwdp.backp ← backp; END;
ENDCASE;
ENDLOOP;
zone.deallocate[zone];
END;
-- DestroyZone is not an entry procedure since the monitorlock will be
-- gone when we try to exit the procedure
DestroyZone: PROCEDURE [z: ZonePointer] =
BEGIN
rest: ZonePointer;
IF z = TheHeap THEN RETURN;
FOR z ← z, rest UNTIL z = NIL DO
rest ← z.restOfZone; z.deallocate[z]; ENDLOOP;
END;
-- management of the heap
TheHeap: PRIVATE ZonePointer;
LargeNode: CARDINAL = 150;
HeapZone: PROCEDURE RETURNS [ZonePointer] = BEGIN RETURN[TheHeap] END;
Node, AllocateHeapNode: PROCEDURE [nwords: CARDINAL] RETURNS [p: POINTER] =
BEGIN OPEN Storage;
IF INTEGER[nwords] < 0 THEN ERROR ZoneTooSmall[TheHeap];
IF nwords + UsedNodeSize > LargeNode THEN
BEGIN
p ← GetMorePages[PagesForWords[nwords + UsedNodeSize]];
p↑ ← NodeHeader[length: nwords + UsedNodeSize, extension: inuse[]];
RETURN[p + 1]
END;
p ← MakeNode[
TheHeap, nwords !
NoRoomInZone =>
BEGIN
Expand[PagesForWords[nwords + ZoneOverhead + UsedNodeSize]];
RESUME
END];
RETURN
END;
Expand: PROCEDURE [pages: CARDINAL] =
BEGIN OPEN Storage;
AddToNewZone[
z: TheHeap, base: GetMorePages[pages], length: pages*AltoDefs.PageSize,
deallocate: FreePages];
END;
GetMorePages: PROCEDURE [pages: CARDINAL] RETURNS [POINTER] =
BEGIN OPEN SegmentDefs;
seg: DataSegmentHandle ← MakeDataSegment[DefaultMDSBase, pages, HardDown];
seg.type ← HeapDS;
RETURN[DataSegmentAddress[seg]];
END;
Free, FreeHeapNode: PROCEDURE [p: POINTER] =
BEGIN OPEN SegmentDefs;
pp: POINTER;
IF p = NIL THEN RETURN;
IF LOOPHOLE[(pp ← p - 1), POINTER TO inuse NodeHeader].length > LargeNode AND
DataSegmentAddress[VMtoDataSegment[pp]] = pp THEN {
Storage.FreePages[pp]; RETURN};
FreeNode[TheHeap, p];
RETURN
END;
String, AllocateHeapString: PROCEDURE [nchars: CARDINAL] RETURNS [s: STRING] =
BEGIN
s ← AllocateHeapNode[StringDefs.WordsForString[nchars]];
s↑ ← StringBody[length: 0, maxlength: nchars, text:];
RETURN[s]
END;
FreeString, FreeHeapString: PROCEDURE [s: STRING] = LOOPHOLE[Free];
CopyString: PROCEDURE [s: STRING, longer: CARDINAL ← 0] RETURNS [STRING] =
BEGIN
ns: STRING;
IF s = NIL THEN RETURN[IF longer = 0 THEN NIL ELSE String[longer]];
ns ← AllocateHeapString[s.length + longer];
InlineDefs.COPY[from: @s.text, to: @ns.text, nwords: (s.length + 1)/2];
ns.length ← s.length;
RETURN[ns];
END;
ExpandString: PROCEDURE [s: POINTER TO STRING, longer: CARDINAL ← 0] =
BEGIN
ns: STRING;
IF s↑ = NIL THEN {IF longer # 0 THEN s↑ ← String[longer]; RETURN};
ns ← AllocateHeapString[s.maxlength + longer];
InlineDefs.COPY[from: @s.text, to: @ns.text, nwords: (s.length + 1)/2];
ns.length ← s.length;
FreeHeapString[s↑];
s↑ ← ns;
END;
PruneHeap, Prune: PROCEDURE RETURNS [BOOLEAN] =
BEGIN RETURN[PruneZone[TheHeap]] END;
-- initialization code
TheHeap ← MakeNewZone[GetMorePages[2], 2*AltoDefs.PageSize, Storage.FreePages];
END.