-- 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[];

}.(670)