-- JaMVM.mesa
-- Written by Martin Newell, February 1979
-- Updated June 12, 1979  4:42 PM by MN
-- Last written by Doug Wyatt, July 14, 1980  11:26 PM
-- Last written by Doug Brotz, June 5, 1981  2:58 PM

-- Virtual memory is paged onto an Alto file system file, using the DMS Core
-- system.	Due to the addressing used in the Core system package, VM
-- addresses are mapped directly onto words in the file i.e. use of VM
-- word n allocates space on the file for VM words [0..n].	A different page
-- transfer package may not make this requirement.
-- VM address 0 maps onto the first word of page 2 (counting from 0) of the
-- file, because page 0 is used by the Alto file system, and page 1 is used
-- by the VM package for restart information.	A simple marching allocator
-- is provided, but it is logically separate from the VM package itself
-- (i.e. the first command can be GetWordVM[...]).

DIRECTORY
	JaMVMDefs: FROM "JaMVMDefs",
	crD: FROM "CoreDefs" USING [
		CloseFile, OpenFile, PageNumber, ReadPages, UFileHandle,
		UFileLength, UFileTruncate, WritePages],
	ovD: FROM "OverviewDefs" USING [
		ErrorCode, ok],
	BitBltDefs: FROM "BitBltDefs" USING [
		AlignedBBTable, BBptr, BBTableSpace, BITBLT],
	InlineDefs: FROM "InlineDefs" USING [
		BITAND, BITOR, BITSHIFT, COPY, HighHalf, LowHalf],
	MiscDefs: FROM "MiscDefs" USING [
		Zero],
	SystemDefs: FROM "SystemDefs" USING [
		AllocateHeapNode, AllocateResidentPages, FreeHeapNode, FreePages];

JaMVM: PROGRAM
IMPORTS SystemDefs,MiscDefs,InlineDefs,BitBltDefs,crD
EXPORTS JaMVMDefs =
BEGIN OPEN InlineDefs;

--*** GLOBALS ***

PageSizeb: CARDINAL = 8; --Must be log2(PageSizew)
PageSizew: CARDINAL = 256; --in words - Must be: 2**PageSizeb
PageSizec: CARDINAL = 512; --in chars - Must be: 2*PageSizew
MaxPages: CARDINAL; --# pages available in VM
MaxWords: LONG POINTER; --Must be MaxPages*PageSizew
Words: LONG POINTER; --# words allocated
Offset: CARDINAL; --# bytes allocated in last Word

-- paging buffers
BufferDesc: TYPE = POINTER TO BufferDescRecord;
BufferDescRecord: TYPE = RECORD[
			page: CARDINAL,
			dirty: BOOLEAN,
			buffer: POINTER,
			next: BufferDesc];
swapBuffer: BufferDesc;
firstBuffer: BufferDesc;
bufferArea: POINTER; -- *DKW*

-- Page table:
PageTableEntry: TYPE = BufferDesc;
nullPageTableEntry: PageTableEntry = NIL;
PageTable: DESCRIPTOR FOR ARRAY OF PageTableEntry;

-- Paging file
uFH: crD.UFileHandle _ NIL;

--*** PROCEDURES ***

InitializeVM: PUBLIC PROCEDURE[filename: STRING, nPages,nbuffers: CARDINAL] =
-- Clear and initialize VM to page from file filename, not to
--	exceed nPages, using nbuffers buffers
	BEGIN
		exists: BOOLEAN = RestartVM[filename, nPages, nbuffers];
		IF exists
		THEN	BEGIN
				IF crD.UFileTruncate[0,0,uFH]#ovD.ok THEN ERROR VMFileProblem;
				Words _ LOOPHOLE[LONG[0]];
				Offset _ 0;
				END;
	END;

RestartVM: PUBLIC PROCEDURE[filename: STRING, nPages,nbuffers: CARDINAL]
						RETURNS[restarted: BOOLEAN] =
-- Restart VM to page from file filename, not to exceed nPages, using
--	 nbuffers buffers
-- Page buffers are allocated off the Heap, and are pointed to by a ring
-- of descriptors, BufferDesc.	swapBuffer points to the element of
-- the list which will be swapped next.	swapBuffer is simply stepped on every
-- swap (see MemAddress).
	BEGIN
		i: CARDINAL;
		bD: BufferDesc;
		lastPage: CARDINAL;
		erc: ovD.ErrorCode;
		buffer: POINTER;
		[erc,uFH] _ crD.OpenFile[["JaM"L,""L,""L], filename, update];
		IF erc#ovD.ok THEN ERROR VMFileProblem;
		swapBuffer _ NIL;
		bufferArea _ SystemDefs.AllocateResidentPages[nbuffers]; -- *DKW*
		buffer _ bufferArea; -- *DKW*
		THROUGH [1..nbuffers]	-- Build list of bD and buffers
		DO	bD _ SystemDefs.AllocateHeapNode[SIZE[BufferDescRecord]];
			bD^ _ [	page: 0,
						dirty: FALSE,
						buffer: buffer,
						next: swapBuffer];
			buffer _ buffer + PageSizew;
			IF swapBuffer=NIL THEN firstBuffer _ bD;
			swapBuffer _ bD;
		ENDLOOP;
		firstBuffer.next _ swapBuffer; --close the ring
-- Initialize page table
		[,lastPage,] _ crD.UFileLength[uFH];
		MaxPages _ MAX[nPages,lastPage];
		MaxWords _ LOOPHOLE[LONG[MaxPages]*LONG[PageSizew]];
		PageTable _ DESCRIPTOR[
			SystemDefs.AllocateResidentPages[
				(MaxPages*SIZE[PageTableEntry]+255)/256],
			MaxPages];
		FOR i IN [0..MaxPages) DO PageTable[i] _ nullPageTableEntry; ENDLOOP;
-- and some other state:
		IF lastPage=0
		THEN	BEGIN	--New file
				restarted _ FALSE;
				Words _ LOOPHOLE[LONG[0]];
				Offset _ 0;
				END
		ELSE	BEGIN	--Old file
				restarted _ TRUE;
				ReadPage[swapBuffer.buffer,0];	--borrow a buffer
				COPY[swapBuffer.buffer,2,@Words];
				Offset _ (swapBuffer.buffer+2)^;
				END;
	END;

FlushVM: PUBLIC PROCEDURE =
-- Write up page buffers and deallocate them
	BEGIN
		bD: BufferDesc;
		nextbD: BufferDesc;
--save state in page "0"
		WriteUpPageBuffer[swapBuffer];	--borrow a buffer
		COPY[@Words,2,swapBuffer.buffer];
		(swapBuffer.buffer+2)^ _ Offset;
		WritePage[swapBuffer.buffer,0];
--write up buffers and deallocate
		-- do swapBuffer LAST, since WriteUpPageBuffer uses it! *DKW*
		FOR bD _ swapBuffer.next, nextbD
		DO	WriteUpPageBuffer[bD];
			nextbD _ bD.next;
			SystemDefs.FreeHeapNode[bD];
			IF bD=swapBuffer THEN EXIT; -- *DKW*
		ENDLOOP;
		-- free the buffer area AFTER the buffers have been written *DKW*
		SystemDefs.FreePages[bufferArea]; -- *DKW*
		IF crD.CloseFile[uFH]#ovD.ok THEN ERROR VMFileProblem;
		uFH _ NIL;
		SystemDefs.FreePages[BASE[PageTable]];
	END;

CheckVM: PUBLIC PROCEDURE =
-- Write up page buffers but don't deallocate them
	BEGIN
		bD: BufferDesc;
		nextbD: BufferDesc;
--save state in page "0"
		WriteUpPageBuffer[swapBuffer];	--borrow a buffer
		COPY[@Words,2,swapBuffer.buffer];
		(swapBuffer.buffer+2)^ _ Offset;
		WritePage[swapBuffer.buffer,0];
--write up buffers
		FOR bD _ swapBuffer, nextbD
		DO	WriteUpPageBuffer[bD];
			nextbD _ bD.next;
			IF nextbD=swapBuffer THEN EXIT;
		ENDLOOP;
	END;

AllocateWordsVM: PUBLIC PROCEDURE[length: CARDINAL]
	RETURNS[location: LONG POINTER] =
-- Increment allocataion pointer by length words
-- AllocateWordsVM[0] aligns on a word boundary
-- Generates VMFull:
	BEGIN
		IF Offset#0
		THEN	BEGIN
				Words _ Words+1;
				Offset _ 0;
		END;
		location _ Words;
		Words _ Words + length;
		IF LOOPHOLE[Words,LONG CARDINAL]>=LOOPHOLE[MaxWords,LONG CARDINAL]
		THEN ERROR VMFull;
	END;

AllocateCharsVM: PUBLIC PROCEDURE[length: CARDINAL]
	RETURNS[location: LONG POINTER, offset: CARDINAL] =
-- Increment allocataion pointer by length chars
-- Generates VMFull:
	BEGIN
		frac: CARDINAL _ Offset+BITAND[length,1];
		location _ Words;
		offset _ Offset;
		Words _ Words + BITSHIFT[length,-1]+BITSHIFT[frac,-1];	--mind overflow!
		Offset _ BITAND[frac,1];
		IF LOOPHOLE[Words,LONG CARDINAL]>=LOOPHOLE[MaxWords,LONG CARDINAL]
		THEN ERROR VMFull;
	END;

GetWordVM: PUBLIC PROCEDURE[VMAddr: LONG POINTER,
	index: CARDINAL] RETURNS[value: WORD] =
-- Get a word from VM address VMAddr+index
-- Generates VMBadPointer:
	BEGIN
		page: CARDINAL;
		addrInPage: CARDINAL;
		[page,addrInPage] _ PageNumber[VMAddr+index];
		RETURN[(MemAddress[page,FALSE] + addrInPage)^];
	END;

GetCharVM: PUBLIC PROCEDURE[VMAddr: LONG POINTER, offset: CARDINAL,
	index: CARDINAL] RETURNS[char: CHARACTER] =
-- Get a character from VM address VMAddr
-- Generates VMBadPointer:
	BEGIN	--wierd arithmetic is to avoid overflow
		frac: CARDINAL _ offset+BITAND[index,1];
		word: WORD _ GetWordVM[VMAddr,BITSHIFT[index,-1]+BITSHIFT[frac,-1]];
		IF BITAND[frac,1]=0
		THEN char _ LOOPHOLE[BITSHIFT[word,-8]]
		ELSE char _ LOOPHOLE[BITAND[word,377B]];
	END;

PutWordVM: PUBLIC PROCEDURE[value: WORD,
	VMAddr: LONG POINTER, index: CARDINAL] =
-- Put value to VM address VMAddr+index
-- Generates VMBadPointer:
	BEGIN
		page: CARDINAL;
		addrInPage: CARDINAL;
		[page,addrInPage] _ PageNumber[VMAddr+index];
		(MemAddress[page,TRUE] + addrInPage)^ _ value;
	END;

PutCharVM: PUBLIC PROCEDURE[char: CHARACTER,
	VMAddr: LONG POINTER, offset: CARDINAL, index: CARDINAL] =
-- Put a character to VM address VMAddr
-- Generates VMBadPointer:
	BEGIN
		frac: CARDINAL _ offset+BITAND[index,1];
		off: CARDINAL _ BITSHIFT[index,-1]+BITSHIFT[frac,-1];
		word: WORD _ GetWordVM[VMAddr,off];
		IF BITAND[frac,1]=0
		THEN word _ BITOR[BITAND[word,377B],BITSHIFT[char,8]]
		ELSE word _ BITOR[BITAND[word,177400B],BITAND[char,377B]];
		PutWordVM[word,VMAddr,off];
	END;

GetWordsVM: PUBLIC PROCEDURE[VMAddr: LONG POINTER,
	realAddr: POINTER, nwords: CARDINAL] =
-- Copy nwords words from VM address VMAddr to actual memory address realAddr
-- Generates VMBadPointer:
	BEGIN
		firstpage,addrInFirstPage: CARDINAL;
		lastpage,addrInLastPage: CARDINAL;
		[firstpage,addrInFirstPage] _ PageNumber[VMAddr];
		[lastpage,addrInLastPage] _ PageNumber[VMAddr+nwords-1];
		IF firstpage=lastpage
		THEN COPY[MemAddress[firstpage,FALSE] + addrInFirstPage,
												 nwords, realAddr]
		ELSE	BEGIN
				r: POINTER _ realAddr;
				page: CARDINAL;
				-- first page
				COPY[MemAddress[firstpage,FALSE] + addrInFirstPage,
						PageSizew-addrInFirstPage, realAddr];
				r _ r + PageSizew-addrInFirstPage;
				-- middle pages
				FOR page IN (firstpage..lastpage)
				DO	COPY[MemAddress[page,FALSE], PageSizew, r];
					r _ r + PageSizew;
				ENDLOOP;
				-- last page
				COPY[MemAddress[lastpage,FALSE], addrInLastPage+1, r];
		END;
	END;

GetCharsVM: PUBLIC PROCEDURE[VMAddr: LONG POINTER, VMOffset: CARDINAL,
	realAddr: POINTER, realOffset: CARDINAL, nchars: CARDINAL] =
-- Copy nchars chars from VM address VMAddr to actual memory address realAddr
-- Generates VMBadPointer:
	BEGIN
		firstpage,addrInFirstPage: CARDINAL;
		lastpage,addrInLastPage: CARDINAL;
		frac: CARDINAL = VMOffset+BITAND[nchars,1];
		nw: CARDINAL = BITSHIFT[nchars,-1]+BITSHIFT[frac+1,-1];
		[firstpage,addrInFirstPage] _ PageNumber[VMAddr];
		[lastpage,addrInLastPage] _ PageNumber[VMAddr+nw-1];
		IF firstpage=lastpage
		THEN ByteBlt[MemAddress[firstpage,FALSE] + addrInFirstPage, VMOffset,
								 nchars, realAddr, realOffset]
		ELSE	BEGIN
				r: POINTER _ realAddr;
				roffset: CARDINAL _ realOffset;
				page: CARDINAL;
				firstnchars: CARDINAL =
					BITSHIFT[PageSizew-addrInFirstPage,1]-VMOffset;
				lastnchars: CARDINAL =
					BITSHIFT[addrInLastPage+1,1]-BITAND[frac,1];
				dc: CARDINAL;
				-- first page
				ByteBlt[MemAddress[firstpage,FALSE] + addrInFirstPage, VMOffset,
							firstnchars, realAddr, realOffset];
				dc _ realOffset + firstnchars;
				r _ r + BITSHIFT[dc,-1];
				roffset _ BITAND[dc,1];
				-- middle pages
				FOR page IN (firstpage..lastpage)
				DO	ByteBlt[MemAddress[page,FALSE], 0, PageSizec, r, roffset];
					r _ r + PageSizew;
				ENDLOOP;
				-- last page
				ByteBlt[MemAddress[lastpage,FALSE], 0, lastnchars, r, roffset];
		END;
	END;

PutWordsVM: PUBLIC PROCEDURE[VMAddr: LONG POINTER,
	realAddr: POINTER, nwords: CARDINAL] =
-- Copy nwords words from actual memory to VM
-- Generates VMBadPointer:
	BEGIN
		firstpage,addrInFirstPage: CARDINAL;
		lastpage,addrInLastPage: CARDINAL;
		[firstpage,addrInFirstPage] _ PageNumber[VMAddr];
		[lastpage,addrInLastPage] _ PageNumber[VMAddr+nwords-1];
		IF firstpage=lastpage
		THEN COPY[realAddr, nwords,
						MemAddress[firstpage,TRUE] + addrInFirstPage]
		ELSE	BEGIN
				r: POINTER _ realAddr;
				page: CARDINAL;
				-- first page
				COPY[realAddr, PageSizew-addrInFirstPage,
						MemAddress[firstpage,TRUE] + addrInFirstPage];
				r _ r + PageSizew-addrInFirstPage;
				-- middle pages
				FOR page IN (firstpage..lastpage)
				DO	COPY[r, PageSizew, MemAddress[page,TRUE]];
					r _ r + PageSizew;
				ENDLOOP;
				-- last page
				COPY[r, addrInLastPage+1, MemAddress[lastpage,TRUE]];
		END;
	END;

PutCharsVM: PUBLIC PROCEDURE[VMAddr: LONG POINTER, VMOffset: CARDINAL,
	realAddr: POINTER, realOffset: CARDINAL, nchars: CARDINAL] =
-- Copy nchars chars from actual memory to VM
-- Generates VMBadPointer:
	BEGIN
		firstpage,addrInFirstPage: CARDINAL;
		lastpage,addrInLastPage: CARDINAL;
		frac: CARDINAL = VMOffset+BITAND[nchars,1];
		nw: CARDINAL = BITSHIFT[nchars,-1]+BITSHIFT[frac+1,-1];
		[firstpage,addrInFirstPage] _ PageNumber[VMAddr];
		[lastpage,addrInLastPage] _ PageNumber[VMAddr+nw-1];
		IF firstpage=lastpage
		THEN ByteBlt[realAddr, realOffset, nchars,
							MemAddress[firstpage,TRUE] + addrInFirstPage, VMOffset]
		ELSE	BEGIN
				r: POINTER _ realAddr;
				roffset: CARDINAL _ realOffset;
				page: CARDINAL;
				firstnchars: CARDINAL =
					BITSHIFT[PageSizew-addrInFirstPage,1]-VMOffset;
				lastnchars: CARDINAL =
					BITSHIFT[addrInLastPage+1,1]-BITAND[frac,1];
				dc: CARDINAL;
				-- first page
				ByteBlt[realAddr, realOffset, firstnchars,
							MemAddress[firstpage,TRUE] + addrInFirstPage, VMOffset];
				dc _ realOffset + firstnchars;
				r _ r + BITSHIFT[dc,-1];
				roffset _ BITAND[dc,1];
				-- middle pages
				FOR page IN (firstpage..lastpage)
				DO	ByteBlt[r, roffset, PageSizec, MemAddress[page,TRUE], 0];
					r _ r + PageSizew;
				ENDLOOP;
				-- last page
				ByteBlt[r, roffset, lastnchars, MemAddress[lastpage,TRUE], 0];
		END;
	END;

-- PRIVATE PROCEDURES --

MemAddress: PROCEDURE [page: CARDINAL, forWrite: BOOLEAN] RETURNS [POINTER] =
--Get memory address of page, swapping etc. as necessary
	BEGIN
		bD: BufferDesc;
		IF page>=MaxPages THEN ERROR VMBadPointer;
		bD _ PageTable[page];
		IF bD=NIL
		THEN	BEGIN	--its not in core
				WriteUpPageBuffer[swapBuffer];
				bD _ swapBuffer;
				ReadPage[bD.buffer,page+1];
				bD.page _ page;
				PageTable[page] _ bD;
				swapBuffer _ swapBuffer.next; --step next swap candidate
				END;
		bD.dirty _ bD.dirty OR forWrite;
		RETURN[bD.buffer];
	END;

WriteUpPageBuffer: PROCEDURE[bD: BufferDesc] =
--Write up page buffer bD
	BEGIN
			IF bD.dirty
			THEN	BEGIN
					WritePage[bD.buffer,bD.page+1];
					bD.dirty _ FALSE;
					END;
			IF PageTable[swapBuffer.page]=swapBuffer --test init case
			THEN	PageTable[swapBuffer.page] _ NIL;
	END;

--The following three procedures depend on the secondary storage device

ReadPage: PROCEDURE [memaddr: POINTER, page: CARDINAL] =
--Read a page to memory address memaddr
	BEGIN
		erc: ovD.ErrorCode;
		bytesRead: CARDINAL;
		[erc,bytesRead] _ crD.ReadPages[memaddr, PageSizec, page, uFH];
		IF erc#ovD.ok THEN ERROR VMFileProblem;
		IF bytesRead=0 THEN MiscDefs.Zero[memaddr,PageSizew];
	END;

WritePage: PROCEDURE [memaddr: POINTER, page: CARDINAL] =
--Write a page from memory address memaddr
	BEGIN
		IF crD.WritePages[memaddr, PageSizec, page, uFH]#ovD.ok
		THEN ERROR VMFileProblem;
	END;

--

PageNumber: PROCEDURE [addr: LONG POINTER]
	RETURNS [pageNum,addrInPage: CARDINAL] =
	-- Returns 16 bit page # and address in page from 24 bits of addr -
	--	specifically for 256 word pages
	BEGIN
		RETURN[BITSHIFT[LowHalf[addr],-8]+BITSHIFT[HighHalf[addr],8],
					BITAND[LowHalf[addr], PageSizew-1]];
	END;

	bbtablespace: BitBltDefs.BBTableSpace;
	BBp: BitBltDefs.BBptr _ BitBltDefs.AlignedBBTable[@bbtablespace];

ByteBlt: PROCEDURE [from: POINTER, fromoffset: [0..1], nbytes: CARDINAL,
	to: POINTER, tooffset: [0..1]] =
	BEGIN OPEN BitBltDefs;
		BBp^ _
		[	pad: 0,
			sourcealt: FALSE,
			destalt: FALSE,					-- TRUE to use alternate memory bank
			sourcetype: block,
			function: replace,
			unused: 0,
			dbca: to,							-- destination BaseCoreAddress
			dbmr: 77777B,						-- destination raster width(in words)
			dlx: BITSHIFT[tooffset,3],	-- destination left x
			dty: 0,								-- destination top y
			dw: BITSHIFT[nbytes,3],
			dh: 1,
			sbca: from,							-- source BaseCoreAddress
			sbmr: 77777B,						-- source raster width(in words)
			slx: BITSHIFT[fromoffset,3],	-- source left x
			sty: 0,								-- source top y
			gray0: 0,							-- four words of "gray"
			gray1: 0,
			gray2: 0,
			gray3: 0];
		BITBLT[BBp];
	END;

HighHalf: PROCEDURE [lp: LONG POINTER] RETURNS [INTEGER] =
	INLINE BEGIN RETURN[InlineDefs.HighHalf[lp]] END;

LowHalf: PROCEDURE [lp: LONG POINTER] RETURNS [INTEGER] =
	INLINE BEGIN RETURN[InlineDefs.LowHalf[lp]] END;

VMBadPointer:	PUBLIC ERROR = CODE;
VMFull:			PUBLIC ERROR = CODE;
VMFileProblem:	PUBLIC ERROR = CODE;


END.

DKW  January 17, 1980  3:10 AM
	bug fixes: see *DKW*

DKW  July 14, 1980  11:25 PM
	uses InlineDefs.HighHalf/LowHalf instead of MACHINE CODE(648)\1456b6B961b12B390b9B1809b7B790b7B451b15B411b15B448b9B306b9B448b9B294b9B483b10B947b10B1411b10B904b10B1399b10B529b17B345b8B312b9B196b10B408b7B812b8B103b7B102b12B23b6B25b13B

DKB  June 5, 1981  2:59 PM
	Updated to Laurel 6 CoreDefs.
	Enhanced FlushVM to free PageTable.
	Allocated bbtable in global frame.