--File IntVM.mesa
-- Updated November 26, 1979 8:42 PM by MN
--June 23, 1980 12:12 PM

DIRECTORY

-- HighByte doesn’t work
InlineDefs: FROM "InlineDefs" USING [LongNumber, BITOR, LowByte, BITSHIFT, COPY],

StringDefs: FROM "StringDefs" USING [AppendNumber, AppendString],

ParserErrorDefs: FROM "ParserErrorDefs" USING [Report, ErrorType],

IntVMDefs: FROM "IntVMDefs",

SystemDefs: FROM "SystemDefs" USING [AllocateResidentPages, FreePages],

ovD: FROM "OverviewDefs" USING [ErrorCode, ok, diskFull, diskError],

crD: FROM "CoreDefs" USING
[DMSUser, UFileHandle, UFilename, DMSName, Password,
OpenFile, --DeleteFile,--
ReadPages, WritePages];

IntVM: PROGRAM IMPORTS SystemDefs, crD, ParserErrorDefs, InlineDefs, StringDefs
EXPORTS IntVMDefs =

BEGIN OPEN IntVMDefs;

-- Virtual storage package for use by ParserStorage.mesa. Provides routines to allocate and free blocks in a large virtual memory.

VMFull: PUBLIC ERROR = CODE;

VMFile: crD.UFileHandle ← NIL;
MaxAddr: LONG CARDINAL = 77777777B;-- max number of pages - 1 in VM
PageSize: CARDINAL = 256;-- in words, rewrite SepAddr if this is changed
MaxLength: LONG CARDINAL = MaxAddr-3;-- free block length
SmallestBlock: CARDINAL = 4;-- smallest block allocated

nBuffers: CARDINAL = 5;
PTEntry: TYPE = RECORD[
PN: CARDINAL,--page number
Written: BOOLEAN];-- dirty bit
PTable: ARRAY [0..nBuffers) OF PTEntry;
Buffers: ARRAY [0..nBuffers) OF POINTER TO UNSPECIFIED;
NextOut: [0..nBuffers);-- the next page to get thrown out
remainder: VMAddr;-- the first free word of VM

InitVM: PUBLIC PROCEDURE RETURNS [BOOLEAN] =
BEGIN OPEN crD, ovD;
i: CARDINAL;
buffers: POINTER = SystemDefs.AllocateResidentPages[nBuffers];
Code: ErrorCode;
IF VMFile=NIL THEN
BEGIN
[Code,VMFile] ← OpenFile[
DMSUser[name:DMSName[name:""],
password:Password[password:""]],
UFilename[filename: "IntVM.scratch$"],
update];
IF Code # ok THEN
BEGIN OPEN StringDefs;
s: STRING ← [50];
AppendString[s,"InitVM Error Opening IntVM.scratch$: "];
AppendNumber[s,Code,10];
ParserErrorDefs.Report[s, Advisory];
RETURN[FALSE];
END;
END;
FOR i IN [0..nBuffers) DO
PTable[i].PN ← i;
PTable[i].Written ← FALSE;
Buffers[i] ← buffers + i*PageSize; --Buffers[0] is handle on entire buffer region (used in deallocating)
ENDLOOP;
NextOut ← 0;-- next page to throw out
remainder ← 0;
PutLong[remainder,MaxLength];-- set up remainder of storage
RETURN [TRUE];
END;

FinishVM: PUBLIC PROCEDURE RETURNS [BOOLEAN]=
BEGIN
SystemDefs.FreePages[Buffers[0]]; --This frees all the buffers
--removed to avoid suspected bug causing lost pages[] ← crD.DeleteFile[VMFile];
RETURN[TRUE];
END;

-- free block format:
--length of free block (32 bits), including the 4 header words
--next free block (32 bits)

--inuse block:
--length (16 bits) excluding the header word
--data 0
--...

AllocateBlock: PUBLIC PROCEDURE [size: CARDINAL] RETURNS [VMAddr] =
BEGIN
ans: VMAddr;-- bookeeping pointers into VM
length: CARDINAL;

IF size = 177777B THEN
ParserErrorDefs.Report["IntVM.AllocateBlock: Block Too Big", FatalInternal];
-- will fail for block of 2↑16-1
length ← 1 + MAX[SmallestBlock,size];
-- find a free block that is long enough
--FOR Cur ← Free, Next UNTIL length <= (CurLen←GetLong[Cur]) DO
--Prev ← Cur;
--IF (Next ← GetLong[Cur+2]) = NilVMAddr THEN ERROR VMFull[];
--ENDLOOP;
ans ← MakeNewBlock[length];
PutWord[ans,length-1];
RETURN [ans+1];
END;

-- create a block of size size from the remainder of storage, return pointer to first word
MakeNewBlock: PROCEDURE [size: CARDINAL] RETURNS [VMAddr] =
BEGIN
ans: VMAddr;
curLen: LONG CARDINAL ← GetLong[remainder];

IF size <= curLen THEN
BEGIN
ans ← remainder;
remainder ← remainder + size;-- next free block
PutLong[remainder,curLen-size];-- update free block length
RETURN[ans];
END
ELSE
ERROR VMFull[];
END;

FreeBlock: PUBLIC PROCEDURE [block: VMAddr] =
BEGIN
NULL;
END;

-- Put and Get word quantities from VM.
PutWord: PUBLIC PROCEDURE [where: VMAddr, val: UNSPECIFIED] =
BEGIN
Page, Offset: CARDINAL;
Ptr: POINTER TO UNSPECIFIED;
i : CARDINAL;

[Page,Offset] ← SepAddr[where];
Ptr ← Buffers[i ← FetchPage[Page]];
PTable[i].Written ← TRUE;
(Ptr+Offset)↑ ← val;
END;

GetWord: PUBLIC PROCEDURE [where: VMAddr] RETURNS [UNSPECIFIED] =
BEGIN
Page, Offset: CARDINAL;
Ptr: POINTER TO UNSPECIFIED;

[Page,Offset] ← SepAddr[where];
Ptr ← Buffers[FetchPage[Page]];
RETURN[(Ptr+Offset)↑];
END;

-- Put and Get long quantities from VM.
PutLong: PUBLIC PROCEDURE [where: VMAddr, val: LONG UNSPECIFIED] =
BEGIN
x: InlineDefs.LongNumber;
x.lu ← val;
PutWord[where,x.lowbits];
PutWord[where+1,x.highbits];
END;

GetLong: PUBLIC PROCEDURE [where: VMAddr] RETURNS [LONG UNSPECIFIED] =
BEGIN
x: InlineDefs.LongNumber;
x.lowbits ← GetWord[where];
x.highbits ← GetWord[where+1];
RETURN[x.lu];
END;

-- Put and Get block quantities from VM.
PutBlock: PUBLIC PROCEDURE [src: POINTER TO UNSPECIFIED, dest: VMAddr, size: CARDINAL] =
BEGIN
i: CARDINAL;
page, offset: CARDINAL;
[page,offset] ← SepAddr[dest];
IF (offset+size) < PageSize THEN
BEGIN
Ptr: POINTER TO UNSPECIFIED;
Ptr ← Buffers[i ← FetchPage[page]];
PTable[i].Written ← TRUE;
InlineDefs.COPY[src,size,Ptr+offset];
END
ELSE
FOR i IN [0..size) DO PutWord[LOOPHOLE[dest+i,VMAddr],(src+i)↑]; ENDLOOP;
END;

GetBlock: PUBLIC PROCEDURE [src: VMAddr, dest: POINTER TO UNSPECIFIED, size: CARDINAL] =
BEGIN
i: CARDINAL;
page, offset: CARDINAL;
[page,offset] ← SepAddr[src];
IF (offset+size) < PageSize THEN
BEGIN
Ptr: POINTER TO UNSPECIFIED;
Ptr ← Buffers[FetchPage[page]];
InlineDefs.COPY[Ptr+offset,size,dest];
END
ELSE
FOR i IN [0..size) DO (dest+i)↑ ← GetWord[LOOPHOLE[src+i,VMAddr]]; ENDLOOP;
END;




-- Private Procedures

-- Bring a page into core if it isn’t already in
FetchPage: PROCEDURE [Page: CARDINAL] RETURNS [[0..nBuffers)] =
BEGIN
Ans: [0..nBuffers);
FOR Ans IN [0..nBuffers) DO
IF PTable[Ans].PN = Page THEN RETURN[Ans];
ENDLOOP;
Ans ← BufferToGo[];-- find a page to throw out
OutPage[Ans];-- away it goes
InPage[Page,Ans];-- get the one we want
RETURN[Ans];
END;

-- Paging algorithm
BufferToGo: PROCEDURE RETURNS [[0..nBuffers)] =
BEGIN
i: [0..nBuffers);

i ← NextOut;
NextOut ← (NextOut+1) MOD nBuffers;
RETURN[i];
END;

-- Put a page on backing store
OutPage: PROCEDURE [BufNo: [0..nBuffers)] =
BEGIN
Code: ovD.ErrorCode;

IF NOT PTable[BufNo].Written THEN RETURN;

IF (Code←crD.WritePages[Buffers[BufNo],2*PageSize,
PTable[BufNo].PN,VMFile]) # ovD.ok THEN
BEGIN OPEN ParserErrorDefs;
SELECT Code FROM
ovD.diskFull => Report["IntVM.OutPage Error - Disk Full", FatalInternal];
ovD.diskError => Report["IntVM.OutPage Error - Disk Error", FatalInternal];
ENDCASE =>
BEGIN OPEN StringDefs;
s: STRING ← [40];
AppendString[s,"IntVM.OutPage Error: "];
AppendNumber[s,Code,10];
Report[s, FatalInternal];
END;
RETURN;
END;
END;

-- Retrieve a page from backing store
InPage: PROCEDURE [Page: CARDINAL,BufNo: [0..nBuffers)] =
BEGIN
Code: ovD.ErrorCode;
Bytes: CARDINAL;
[Code,Bytes] ← crD.ReadPages[Buffers[BufNo],2*PageSize,Page,VMFile];
IF Code # ovD.ok THEN
BEGIN OPEN StringDefs;
s: STRING ← [40];
AppendString[s,"IntVM.InPage Error: "];
AppendNumber[s,Code,10];
ParserErrorDefs.Report[s, FatalInternal];
RETURN;
END;
PTable[BufNo] ← PTEntry[
PN: Page,
Written: FALSE];
END;

-- split a VMAddr into page and offset
SepAddr: PROCEDURE [n: VMAddr] RETURNS [CARDINAL, CARDINAL] =
BEGIN OPEN InlineDefs;
x: LongNumber;
x.lc ← n;

IF x.lc > MaxAddr THEN
BEGIN
ParserErrorDefs.Report["IntVM.SepAddr: Range Error", FatalInternal];
RETURN[0,0];
END
ELSE
RETURN[BITOR[BITSHIFT[LowByte[x.highbits],8],BITSHIFT[x.lowbits,-8]],
LowByte[x.lowbits]];

END;

END.