-- TexMem.mesa
-- Mesa 6 version
-- Last changed by Doug Wyatt, September 23, 1980 5:19 PM

DIRECTORY
TexDebugDefs: FROM "TexDebugDefs",
TexMemDefs: FROM "TexMemDefs",
AltoDefs: FROM "AltoDefs" USING[PageSize],
InlineDefs: FROM "InlineDefs" USING [LongCOPY],
SegmentDefs: FROM "SegmentDefs",
StringDefs: FROM "StringDefs",
SystemDefs: FROM "SystemDefs";

TexMem: PROGRAM
IMPORTS InlineDefs,SegmentDefs,StringDefs,SystemDefs
EXPORTS TexMemDefs SHARES TexMemDefs =
BEGIN OPEN TexMemDefs;

DEBUG: BOOLEAN=TexDebugDefs.DEBUG;

MemError: PUBLIC SIGNAL = CODE;

Small: TYPE = RECORD[link: SmallPtr];
SmallPtr: TYPE = POINTER TO Small;
Big: TYPE = RECORD[link: BigPtr, size: CARDINAL];
BigPtr: TYPE = POINTER TO Big;

maxSmallSize: CARDINAL = 12;
SmallSize: TYPE = [0..maxSmallSize];
nSlots: CARDINAL = 13;
Slot: TYPE = [0..nSlots);
SlotPtrVec: TYPE = ARRAY Slot OF SmallPtr;
SlotCountVec: TYPE = ARRAY Slot OF CARDINAL;

SizeMap: TYPE = ARRAY SmallSize OF Slot;
SlotSize: TYPE = ARRAY Slot OF SmallSize;
map: SizeMap ← [0,1,2,3,4,5,6,7,8,9,10,11,12];
slotsize: SlotSize ← [0,1,2,3,4,5,6,7,8,9,10,11,12];

SegHdr: TYPE = RECORD[link: SegPtr, pages: CARDINAL];
SegPtr: TYPE = POINTER TO SegHdr;
segOvhd: CARDINAL = SIZE[SegHdr];

freeptr: POINTER←NIL;
freesize: CARDINAL←0;
biglist: BigPtr←NIL;
slotlist: SlotPtrVec←ALL[NIL];
slotcount: SlotCountVec←ALL[0];
growpages: CARDINAL←0;
growwords: CARDINAL←0;
seglist: SegPtr←NIL;
debug: POINTER TO MemDebugInfo←NIL;

MemDebugInfo: TYPE = RECORD
[
bigNodesUsed,bigWordsUsed: CARDINAL,
slotNodesUsed,slotWordsUsed: SlotCountVec,
strings,stringWords,stringChars: CARDINAL
];

AddMemSeg: PROCEDURE[pages: CARDINAL] =
BEGIN
seg: SegPtr←AllocSeg[pages,TRUE];
seg↑←[link: seglist, pages: pages]; seglist←seg;
freeptr←seg; freesize←WordsForPages[pages];
[]←GetNewNode[SIZE[SegHdr]];
END;

AllocMem: PUBLIC PROCEDURE[size: CARDINAL] RETURNS[p: POINTER] =
BEGIN
IF size>maxSmallSize THEN
BEGIN
IF DEBUG THEN
BEGIN OPEN debug;
bigNodesUsed←bigNodesUsed+1;
bigWordsUsed←bigWordsUsed+size;
END;
RETURN[AllocBig[size]];
END
ELSE RETURN[AllocSmall[size]];
END;

FreeMem: PUBLIC PROCEDURE[p: POINTER, size: CARDINAL] =
BEGIN
IF size>maxSmallSize THEN
BEGIN
IF DEBUG THEN
BEGIN OPEN debug;
bigNodesUsed←bigNodesUsed-1;
bigWordsUsed←bigWordsUsed-size;
END;
FreeBig[p,size];
END
ELSE FreeSmall[p,size];
END;

-- called from both AllocMem and AddNodes, so shouldn’t be INLINE.
AllocBig: PROCEDURE[size: CARDINAL]
RETURNS[POINTER] =
BEGIN
bptr: BigPtr;
pptr: POINTER TO BigPtr;
-- first, try to allocate from big node list
FOR pptr←@biglist,@bptr.link UNTIL (bptr←pptr↑)=NIL
DO
IF bptr.size<size THEN NULL -- too small
ELSE
BEGIN -- take the first fit
pptr↑←bptr.link; -- remove node from the list
FreeUnused[bptr+size,bptr.size-size]; -- return any unused space
RETURN[bptr];
END;
ENDLOOP;
-- no luck with big node list, so take it from new free space
IF freesize<size THEN GrowMem[size];
bptr←GetNewNode[size];
RETURN[bptr];
END;

FreeUnused: PROCEDURE[p: POINTER, size: CARDINAL] =
BEGIN
IF size>maxSmallSize THEN FreeBig[p,size];
-- smaller chunks are lost forever
END;

GetNewNode: PROCEDURE[size: CARDINAL]
RETURNS[POINTER] = INLINE
BEGIN
p: POINTER←freeptr;
IF DEBUG THEN IF size>freesize THEN ERROR MemError;
freeptr←freeptr+size; freesize←freesize-size;
RETURN[p];
END;

FreeBig: PROCEDURE[bptr: BigPtr, size: CARDINAL] = --INLINE--
BEGIN
IF DEBUG THEN IF NOT size>maxSmallSize THEN ERROR MemError;
IF freeptr-size=bptr THEN
BEGIN -- this was the last node allocated from new free space
freeptr←bptr; freesize←freesize+size; -- so free it again
END
ELSE BEGIN bptr↑←[link: biglist, size: size]; biglist←bptr END;
END;

GrowMem: PROCEDURE[size: CARDINAL] = --INLINE--
BEGIN
pages: CARDINAL;
FreeUnused[freeptr,freesize]; -- make remaining space a free node
pages←MAX[growpages,PagesForWords[size+segOvhd]];
AddMemSeg[pages];
-- it should now be true that freesize>=size
END;

AllocSmall: PROCEDURE[size: SmallSize]
RETURNS[POINTER] = --INLINE--
BEGIN
slot: Slot;
sptr: SmallPtr;
IF (sptr←slotlist[slot←map[size]])=NIL THEN sptr←AddNodes[slot];
slotlist[slot]←sptr.link;
IF DEBUG THEN
BEGIN OPEN debug;
slotNodesUsed[slot]←slotNodesUsed[slot]+1;
slotWordsUsed[slot]←slotWordsUsed[slot]+size;
END;
RETURN[sptr];
END;

FreeSmall: PROCEDURE[p: POINTER, size: SmallSize] = --INLINE--
BEGIN
slot: Slot;
PutSmall[p,(slot←map[size])];
IF DEBUG THEN
BEGIN OPEN debug;
slotNodesUsed[slot]←slotNodesUsed[slot]-1;
slotWordsUsed[slot]←slotWordsUsed[slot]-size;
END;
END;

PutSmall: PROCEDURE[sptr: SmallPtr, slot: Slot] = INLINE
BEGIN
sptr↑←[link: slotlist[slot]]; slotlist[slot]←sptr;
END;

maxaddsize: CARDINAL=1000; -- never add more than 1000 words at a time

AddNodes: PROCEDURE[slot: Slot]
RETURNS[SmallPtr] = --INLINE--
BEGIN
size: CARDINAL←slotsize[slot]; -- node size for this slot
new,rem,n,space: CARDINAL;
p: POINTER;
new←MAX[2,slotcount[slot]/2]; -- new nodes to add
new←MIN[new,maxaddsize/size];
rem←new; -- remaining nodes to be allocated
WHILE rem>0
DO
-- If there are nodes on biglist, use them first,
-- then use remaining free space before growing the zone.
space←IF biglist#NIL THEN biglist.size ELSE freesize;
IF space<size THEN n←rem ELSE n←MIN[rem,space/size];
p←AllocBig[n*size]; -- NOT AllocMem (consider n=1!)
THROUGH [0..n) DO PutSmall[p,slot]; p←p+size ENDLOOP;
rem←rem-n;
ENDLOOP;
slotcount[slot]←slotcount[slot]+new;
RETURN[slotlist[slot]];
END;

AllocString: PUBLIC PROCEDURE[len: CARDINAL] RETURNS[STRING] =
BEGIN
size: CARDINAL←StringDefs.WordsForString[len];
s: STRING←AllocMem[size];
s↑←[length: 0, maxlength: len, text: ];
IF DEBUG THEN
BEGIN OPEN debug;
strings←strings+1;
stringWords←stringWords+size;
stringChars←stringChars+len;
END;
RETURN[s];
END;

FreeString: PUBLIC PROCEDURE[s: STRING] =
BEGIN
len: CARDINAL←s.maxlength;
size: CARDINAL←StringDefs.WordsForString[len];
FreeMem[s,size];
IF DEBUG THEN
BEGIN OPEN debug;
strings←strings-1;
stringWords←stringWords-size;
stringChars←stringChars-len;
END;
END;

Zone: TYPE = RECORD
[
freeptr: POINTER,
freesize: CARDINAL,
base: POINTER,
initpages,growpages: CARDINAL,
seglist: ZSegPtr,
refs: CARDINAL,
debug: POINTER TO ZoneDebugInfo
];
ZPtr: TYPE = POINTER TO Zone;

ZSeg: TYPE = RECORD
[
link: ZSegPtr,
base: POINTER,
pages: CARDINAL
];
ZSegPtr: TYPE = POINTER TO ZSeg;

ZoneDebugInfo: TYPE = RECORD
[
totalpages,unused: CARDINAL
];

CreateZone: PUBLIC PROCEDURE[init,grow: CARDINAL]
RETURNS[TexMemDefs.ZonePtr] =
BEGIN
zone: ZPtr←AllocMem[SIZE[Zone]];
base: POINTER←AllocSeg[init,TRUE];
zone↑←[freeptr: base, freesize: WordsForPages[init], base: base,
initpages: init, growpages: grow, seglist: NIL, refs: 0, debug: NIL];
IF DEBUG THEN
BEGIN OPEN zone;
debug←AllocMem[SIZE[ZoneDebugInfo]];
debug↑←[totalpages: init, unused: 0];
END;
RETURN[LOOPHOLE[zone]];
END;

OpenZone: PUBLIC PROCEDURE[zone: TexMemDefs.ZonePtr] =
BEGIN OPEN LOOPHOLE[zone,ZPtr];
refs←refs+1;
END;

CloseZone: PUBLIC PROCEDURE[zone: TexMemDefs.ZonePtr] RETURNS[BOOLEAN] =
BEGIN OPEN LOOPHOLE[zone,ZPtr];
refs←refs-1;
IF refs>0 THEN RETURN[FALSE]
ELSE BEGIN ClearZone[zone]; RETURN[TRUE] END;
END;

GrowZone: PROCEDURE[zone: ZPtr, size: CARDINAL] =
BEGIN OPEN zone;
seg: ZSegPtr←AllocMem[SIZE[ZSeg]];
pages: CARDINAL←MAX[growpages,PagesForWords[size]];
base: POINTER←AllocSeg[pages,FALSE];
seg↑←[link: seglist, base: base, pages: pages]; seglist←seg;
IF DEBUG THEN
BEGIN OPEN debug;
totalpages←totalpages+pages;
unused←unused+freesize;
END;
freeptr←base; freesize←WordsForPages[pages];
END;

Alloc: PUBLIC PROCEDURE[zone: TexMemDefs.ZonePtr, size: CARDINAL]
RETURNS[p: POINTER] =
BEGIN OPEN LOOPHOLE[zone,ZPtr];
IF DEBUG THEN IF refs=0 THEN ERROR MemError;
IF size>freesize THEN GrowZone[LOOPHOLE[zone],size];
p←freeptr; freeptr←freeptr+size; freesize←freesize-size;
RETURN[p];
END;

FreeExtraSegs: PROCEDURE[zone: TexMemDefs.ZonePtr] =
BEGIN OPEN LOOPHOLE[zone,ZPtr];
seg: ZSegPtr;
IF DEBUG THEN IF refs>0 THEN SIGNAL MemError;
UNTIL (seg←seglist)=NIL
DO
seglist←seg.link; FreeSeg[seg.base];
FreeMem[seg,SIZE[ZSeg]];
ENDLOOP;
END;

ClearZone: PROCEDURE[zone: TexMemDefs.ZonePtr] =
BEGIN OPEN LOOPHOLE[zone,ZPtr];
FreeExtraSegs[zone];
freeptr←base; freesize←WordsForPages[initpages];
IF DEBUG THEN
BEGIN OPEN debug;
totalpages←initpages; unused←0;
END;
END;

DestroyZone: PUBLIC PROCEDURE[zone: TexMemDefs.ZonePtr] =
BEGIN OPEN LOOPHOLE[zone,ZPtr];
IF refs>0 THEN SIGNAL MemError;
FreeExtraSegs[zone];
FreeSeg[base];
IF DEBUG THEN FreeMem[debug,SIZE[ZoneDebugInfo]];
FreeMem[zone,SIZE[Zone]];
END;

AllocSeg: PUBLIC PROCEDURE[pages: CARDINAL, resident: BOOLEAN]
RETURNS[base: POINTER] =
BEGIN OPEN SegmentDefs;
RETURN[SegmentAddress[MakeDataSegment[DefaultBase,pages,
IF resident THEN HardUp ELSE HardDown]]];
END;

FreeSeg: PUBLIC PROCEDURE[base: POINTER] =
BEGIN OPEN SegmentDefs;
DeleteDataSegment[VMtoDataSegment[base]];
END;

PagesForWords: PUBLIC PROCEDURE[words: CARDINAL] RETURNS[pages: CARDINAL] =
BEGIN RETURN[SystemDefs.PagesForWords[words]] END;

WordsForPages: PUBLIC PROCEDURE[pages: CARDINAL] RETURNS[words: CARDINAL] =
BEGIN RETURN[AltoDefs.PageSize*pages] END;

PutHighSeg: PUBLIC PROCEDURE[p: POINTER] RETURNS[lp: LONG POINTER] =
BEGIN OPEN SegmentDefs;
seg: DataSegmentHandle←VMtoDataSegment[p];
pages: CARDINAL←seg.pages;
hiseg: DataSegmentHandle←NewDataSegment[DefaultXMBase,pages];
InlineDefs.LongCOPY[
from: LongDataSegmentAddress[seg],
nwords: AltoDefs.PageSize*pages,
to: lp←LongDataSegmentAddress[hiseg]
];
RETURN[lp];
END;

GetHighSeg: PUBLIC PROCEDURE[p: POINTER, lp: LONG POINTER] =
BEGIN OPEN SegmentDefs;
hiseg: DataSegmentHandle←LongVMtoDataSegment[lp];
pages: CARDINAL←hiseg.pages;
seg: DataSegmentHandle←VMtoDataSegment[p];
IF seg.pages#pages THEN ERROR MemError;
InlineDefs.LongCOPY[
from: LongDataSegmentAddress[hiseg],
nwords: AltoDefs.PageSize*pages,
to: LongDataSegmentAddress[seg]
];
DeleteDataSegment[hiseg];
END;


MemInit: PROCEDURE[init,grow: CARDINAL] =
BEGIN
biglist←NIL;
slotlist←ALL[NIL];
slotcount←ALL[0];
growpages←grow; growwords←WordsForPages[growpages]-segOvhd;
seglist←NIL;
AddMemSeg[init];
IF DEBUG THEN
BEGIN
debug←GetNewNode[SIZE[MemDebugInfo]];
debug↑←
[
bigNodesUsed: 0, bigWordsUsed: 0,
slotNodesUsed: ALL[0], slotWordsUsed: ALL[0],
strings: 0, stringWords: 0, stringChars: 0
];
END;
END;

MemInit[100,8];

END.