-- MemoryImpl.mesa
-- Last changed by Doug Wyatt, October 1, 1980 1:26 AM

DIRECTORY
Memory,
InlineDefs USING [LowHalf],
SegmentDefs USING [PageNumber, BankIndex, Banks, memConfig,
DataSegmentHandle, DataSegmentType, DefaultMDSBase, DefaultXMBase,
MakeDataSegment, HardDown, LongDataSegmentAddress],
SystemDefs USING [AllocateHeapNode, FreeHeapNode];

MemoryImpl: PROGRAM
IMPORTS InlineDefs,SegmentDefs,SystemDefs
EXPORTS Memory = {

MemoryError: PUBLIC SIGNAL = CODE;

-- Form of an MDSZone (= MDSHandle)
MDSHandle: TYPE = POINTER TO MDSObject;
MDSObject: TYPE = MACHINE DEPENDENT RECORD [
procs(0:0..15): POINTER TO MDSProcs,
data(1:0..15): UNSPECIFIED
];
MDSProcs: TYPE = MACHINE DEPENDENT RECORD [
alloc(0): PROC[self: MDSHandle, size: CARDINAL] RETURNS[POINTER],
free(1): PROC[self: MDSHandle, object: POINTER]
];

-- Form of an UNCOUNTED ZONE (= ZHandle)
ZHandle: TYPE = LONG POINTER TO ZObject;
ZObject: TYPE = MACHINE DEPENDENT RECORD [
procs(0:0..31): LONG POINTER TO ZProcs,
data(2:0..31): LONG UNSPECIFIED
];
ZProcs: TYPE = MACHINE DEPENDENT RECORD [
alloc(0): PROC[self: ZHandle, size: CARDINAL] RETURNS[LONG POINTER],
free(1): PROC[self: ZHandle, object: LONG POINTER]
];

-- A zone interface to the Mesa System heap

MDSAlloc: PROC[self: MDSHandle, size: CARDINAL] RETURNS[POINTER] = {
RETURN[SystemDefs.AllocateHeapNode[size]];
};
MDSFree: PROC[self: MDSHandle, object: POINTER] = {
SystemDefs.FreeHeapNode[object];
};
mdsprocs: MDSProcs ← [alloc: MDSAlloc, free: MDSFree];
mdsobject: MDSObject ← [procs: @mdsprocs, data: 0];
mdshandle: MDSHandle = @mdsobject;
mds: PUBLIC MDSZone ← LOOPHOLE[mdshandle];

long: PUBLIC BOOLEAN ← (SELECT SegmentDefs.memConfig.AltoType FROM
D0,Dorado => TRUE,
ENDCASE => FALSE);

-- Uncounted Zones

-- An interface to the system heap for the Alto

heapProcs: ZProcs ← [alloc: HeapAlloc, free: HeapFree];
heapObject: ZObject ← [procs: @heapProcs, data: 0];
heapZone: UNCOUNTED ZONE = LOOPHOLE[LONG[@heapObject]];

nodes: CARDINAL←0;

HeapAlloc: PROC[self: ZHandle, size: CARDINAL] RETURNS[LONG POINTER] = {
nodes←nodes+1;
RETURN[SystemDefs.AllocateHeapNode[size]];
};

HeapFree: PROC[self: ZHandle, object: LONG POINTER] = {
nodes←nodes-1;
SystemDefs.FreeHeapNode[InlineDefs.LowHalf[object]];
};


zbase: SegmentDefs.PageNumber ← IF long THEN SegmentDefs.DefaultXMBase
ELSE SegmentDefs.DefaultMDSBase;

-- A permanent zone for allocating the zone objects themselves

GetPages: PROC[pages: CARDINAL, type: SegmentDefs.DataSegmentType]
RETURNS[LONG POINTER] = {
OPEN SegmentDefs;
seg: DataSegmentHandle←MakeDataSegment[
base: zbase, pages: pages, info: HardDown];
seg.type←type; RETURN[LongDataSegmentAddress[seg]];
};

permPtr: LONG POINTER←NIL;
permWords: CARDINAL←0;
permType: SegmentDefs.DataSegmentType=100B;
pageSize: CARDINAL=256; -- AltoDefs.PageSize

permProcs: ZProcs ← [alloc: PermAlloc, free: PermFree];
permObject: ZObject ← [procs: @permProcs, data: 0];
perm: UNCOUNTED ZONE = LOOPHOLE[LONG[@permObject]];

PermAlloc: PROC[self: ZHandle, size: CARDINAL] RETURNS[LONG POINTER] = {
p: LONG POINTER←permPtr;
IF permWords<size THEN {
pages: CARDINAL=(size+pageSize-1)/pageSize;
p←GetPages[pages,permType];
permWords←pages*pageSize;
};
permPtr←p+size; permWords←permWords-size;
RETURN[p];
};
PermFree: PROC[self: ZHandle, object: LONG POINTER] = { ERROR };

pagesPerBank: CARDINAL = 256; -- AltoDefs.PagesPerMDS

BankIndex: TYPE = SegmentDefs.BankIndex;

Pointer: TYPE = MACHINE DEPENDENT RECORD [
page(0:0..7): [0..pagesPerBank),
word(0:8..15): [0..pageSize),
high(1:0..11): [0..7777B], -- should be zero
bank(1:12..15): BankIndex
];

maxZones: CARDINAL=256;
ZoneIndex: TYPE = [0..maxZones);
NodeSize: TYPE = [0..256); -- may not exceed pageSize

PageEntry: TYPE = RECORD[zi: ZoneIndex, size: NodeSize];
nullPage: PageEntry = [0,0];
BankTable: TYPE = PACKED ARRAY[0..pagesPerBank] OF PageEntry;
BankTableRef: TYPE = LONG POINTER TO BankTable;

bankTables: ARRAY BankIndex OF BankTableRef ← ALL[NIL];

InitMemory: PROC = {
IF long THEN {
banks: SegmentDefs.Banks=LOOPHOLE[SegmentDefs.memConfig.banks];
FOR b: BankIndex IN BankIndex DO
IF banks[b] THEN {
bankTables[b]←perm.NEW[BankTable ← ALL[nullPage]];
};
ENDLOOP;
zones←perm.NEW[ZoneTable];
};
};

ZoneInfo: TYPE = RECORD [
z: ZDataRef ← NIL,
name: STRING ← NIL,
held,free: CARDINAL ← 0
];

ZoneTable: TYPE = ARRAY ZoneIndex OF ZoneInfo;
zones: LONG POINTER TO ZoneTable←NIL;
nzones: CARDINAL←0;

ZData: TYPE = RECORD [
vec: VecRef,
zi: ZoneIndex
];
ZDataRef: TYPE = LONG POINTER TO ZData;

Node: TYPE = RECORD[link: NodeRef];
NodeRef: TYPE = LONG POINTER TO Node;
Vec: TYPE = ARRAY NodeSize OF NodeRef;
VecRef: TYPE = LONG POINTER TO Vec;

minSize: CARDINAL = SIZE[Node];

GetMoreNodes: PROC[z: ZDataRef, size: CARDINAL] = {
zi: ZoneIndex = z.zi;
info: LONG POINTER TO ZoneInfo=@zones[zi];
p: LONG POINTER=GetPages[1,permType+zi];
ptr: Pointer=LOOPHOLE[p];
list: NodeRef←z.vec[size];
node: NodeRef←p;
n: CARDINAL=pageSize/size;
THROUGH [0..n) DO
node.link←list; list←node; node←node+size;
ENDLOOP;
z.vec[size]←list;
info.held←info.held+n;
info.free←info.free+n;
bankTables[ptr.bank][ptr.page]←[zi: zi, size: size];
};

words: LONG INTEGER←0;

AllocNode: PROC[z: ZDataRef, size: NodeSize]
RETURNS[p: NodeRef] = INLINE {
info: LONG POINTER TO ZoneInfo=@zones[z.zi];
hptr: LONG POINTER TO NodeRef=@z.vec[size];
WHILE (p←hptr↑)=NIL DO GetMoreNodes[z,size] ENDLOOP;
hptr↑←p.link; info.free←info.free-1;
words←words+size;
RETURN[p];
};

FreeNode: PROC[z: ZDataRef, node: NodeRef, size: NodeSize] = INLINE {
info: LONG POINTER TO ZoneInfo=@zones[z.zi];
hptr: LONG POINTER TO NodeRef=@z.vec[size];
node.link←hptr↑; hptr↑←node; info.free←info.free+1;
words←words-size;
};

ZAlloc: PROC[self: ZHandle, size: CARDINAL] RETURNS[LONG POINTER] = {
z: ZDataRef=self.data;
p: NodeRef←NIL;
IF size<minSize THEN size←minSize;
IF size<=LAST[NodeSize] THEN p←AllocNode[z,size]
ELSE SIGNAL MemoryError; -- requested node size too large
RETURN[p];
};

ZFree: PROC[self: ZHandle, object: LONG POINTER] = {
z: ZDataRef=self.data;
p: Pointer=LOOPHOLE[object];
IF p.high=0 THEN {
table: BankTableRef=bankTables[p.bank];
IF table#NIL THEN {
entry: PageEntry=table[p.page];
IF entry.zi=z.zi THEN {
FreeNode[z,object,entry.size];
}
ELSE SIGNAL MemoryError; -- pointer not owned by this zone
}
ELSE SIGNAL MemoryError; -- pointer in disabled bank
}
ELSE SIGNAL MemoryError; -- pointer has nonzero high part
};

zprocs: ZProcs ← [alloc: ZAlloc, free: ZFree];

NewZone: PUBLIC PROC[name: STRING] RETURNS[UNCOUNTED ZONE] = {
IF long THEN {
IF nzones<maxZones THEN {
zi: ZoneIndex = nzones;
info: LONG POINTER TO ZoneInfo = @zones[zi];
vec: VecRef = perm.NEW[Vec ← ALL[NIL]];
z: ZDataRef = perm.NEW[ZData ← [vec: vec, zi: zi]];
nzones←nzones+1; info.z←z; info.name←name;
RETURN[LOOPHOLE[perm.NEW[ZObject ← [procs: @zprocs, data: z]]]];
}
ELSE ERROR MemoryError; -- too many zones
}
ELSE RETURN[heapZone];
};

-- Initialization
InitMemory[];

}.