-- RTOSImpl.Mesa
-- last edit by Paul Rovner, December 17, 1982 8:48 am

DIRECTORY
CachedSpace USING[Handle],
CedarSnapshot USING[Register, After],
Directory USING[Lookup],
Environment USING[wordsPerPage, Long],
File USING [read, write, Capability, nullCapability, GetSize],
Heap USING [Create],
PrincOps USING [GlobalFrameHandle, NullGlobalFrame, FrameCodeBase],
PrincOpsRuntime USING [GetFrame, GFT, GFTItem],
RTFlags USING [checking],
RTOS USING [EVRange, CodeMatch],
RTQuanta USING[PagesPerQuantum, QuantumCount, QuantumIndex],
RTSponge USING [Enable, Disable],
RTZones USING [MapPtrZf, mzVacant],
SDDefs USING [SD, sGFTLength],
Space USING [Create, CreateUniformSwapUnits, nullHandle, InsufficientSpace,
defaultWindow, Delete, GetWindow, GetHandle, Handle, Kill,
LongPointer, Map, PageNumber, PageCount, PageFromLongPointer,
mds, virtualMemory, GetAttributes, WindowOrigin, DeleteSwapUnits],
SpecialSpace: TYPE USING [CreateForCode, MakeResident, CreateAligned],
UnsafeStorage USING [NewUZone],
Volume USING[InsufficientSpace];

RTOSImpl: MONITOR
IMPORTS CedarSnapshot, Directory, File, Heap, PrincOpsRuntime, RTSponge,
RTZones, Space, SpecialSpace, UnsafeStorage, Volume

EXPORTS RTOS
= BEGIN OPEN RTQuanta;

PageSize: CARDINAL = Environment.wordsPerPage;
GlobalFrameHandle: TYPE = PrincOps.GlobalFrameHandle;
NullGlobalFrame: GlobalFrameHandle = PrincOps.NullGlobalFrame;
EVRange: TYPE = RTOS.EVRange;

--Public signals
InsufficientVM: PUBLIC SIGNAL = CODE;
--Public variables
UZHandle: TYPE = LONG POINTER TO UZObject;

UZObject: TYPE = MACHINE DEPENDENT RECORD [
procs(0:0..31): LONG POINTER TO UZProcs
];

UZProcs: TYPE = MACHINE DEPENDENT RECORD [
new(0): PROC[self: UZHandle, size: CARDINAL] RETURNS[LONG POINTER],
free(1): PROC[self: UZHandle, object: LONG POINTER]
];

DummySequenceType: TYPE = RECORD[seq: SEQUENCE length: CARDINAL OF UNSPECIFIED];
shzProcs: UZProcs ← [new: SHZNew, free: SHZFree];
shzObject: UZObject ← [procs: @shzProcs];
SHZNew: PROC[self: UZHandle, size: CARDINAL] RETURNS[LONG POINTER] = {
size ← size - SIZE[DummySequenceType];
IF allocStarted
THEN RETURN[cedarHeapZone.NEW[DummySequenceType[size]]]
ELSE RETURN[pilotHeapZone.NEW[DummySequenceType[size]]];
};

SHZFree: ENTRY PROC[self: UZHandle, object: LONG POINTER] =
{IF RTZones.MapPtrZf[object] = RTZones.mzVacant
THEN pilotHeapZone.FREE[@object]
ELSE cedarHeapZone.FREE[@object]};

fszProcs: UZProcs ← [new: FSZNew, free: FSZFree];
fszObject: UZObject ← [procs: @fszProcs];
FSZNew: PROC[self: UZHandle, size: CARDINAL] RETURNS[LONG POINTER] = {
RETURN[GetDataPagesFromNewSpace[(size + PageSize - 1)/PageSize]];
};


FSZFree: ENTRY PROC[self: UZHandle, object: LONG POINTER] =
{space: Space.Handle;
WHILE checkPointing DO WAIT finishedCheckpointing ENDLOOP;
space ← UnRavelUSUs[Space.GetHandle[Space.PageFromLongPointer[object]]];
IF SpaceInCedarVM[space]
THEN RemoveFromCedarVMSpaces[space]
ELSE {Space.Kill[space];
Space.Delete[space];
nSpaces ← nSpaces - 1}};

ppzProcs: UZProcs ← [new: PPZNew, free: NIL];
ppzObject: UZObject ← [procs: @ppzProcs];
PPZNew: PROC[self: UZHandle, size: CARDINAL] RETURNS[LONG POINTER] = {
RETURN[GetPermanentDataPages[(size + PageSize - 1)/PageSize]];
};

FreeableSpaceZone: PUBLIC UNCOUNTED ZONE ← LOOPHOLE[LONG[@fszObject]];
PermanentPageZone: PUBLIC UNCOUNTED ZONE ← LOOPHOLE[LONG[@ppzObject]];

PrivateHeapZone: PUBLIC UNCOUNTED ZONE ← LOOPHOLE[LONG[@shzObject]];

pilotHeapZone: UNCOUNTED ZONE;
cedarHeapZone: UNCOUNTED ZONE;

--Other parameters
nSpaces: CARDINAL ← 0; -- # of spaces used thru this module
SwapUnitSize: CARDINAL = 4; -- for data quanta
largeSwapUnitSize: CARDINAL = 16; -- for larger stuff, e.g. the reference-count table
allocStarted: BOOLEAN ← FALSE;

discardedSpaces: ARRAY [1..maxNDiscardedSpaces] OF Space.Handle ← ALL[Space.nullHandle];
maxNDiscardedSpaces: CARDINAL = 30;
nDiscarded: [0..maxNDiscardedSpaces] ← 0;
spaceLost: BOOLEAN ← FALSE;

nextCedarVMFilePage: CARDINAL ← 0;
cedarVMFilePages: LONG INTEGER ← 0;
cedarVMFile: File.Capability ← File.nullCapability;

cedarVMSpaces: SDHandle ← NIL;
cedarVMSpaceCache: SDHandle ← NIL;
SDHandle: TYPE = LONG POINTER TO SDRec;
SDRec: TYPE = RECORD[space: Space.Handle, next: SDHandle, firstCedarVMPage, nPages: NAT];

checkPointing: BOOLEAN ← FALSE;
finishedCheckpointing: CONDITION;

--Public procedures

UnRavelUSUs: PUBLIC PROC[space: Space.Handle] RETURNS[Space.Handle] =
{ DO parent: Space.Handle;
mapped: BOOLEAN;
IF space = Space.mds OR space = Space.virtualMemory THEN ERROR;
[parent: parent, mapped: mapped] ← Space.GetAttributes[space];
IF mapped THEN EXIT;
space ← parent;
ENDLOOP;
RETURN[space]};

NotifyAllocatorReady: PUBLIC PROC =
{cedarHeapZone ← UnsafeStorage.NewUZone[initialSize: 100000B--words--];
allocStarted ← TRUE};

IsAllocatorReady: PUBLIC PROC RETURNS[BOOLEAN] =
{RETURN[allocStarted]};


-- PROCs for allocating blocks of data pages

SpaceInCedarVM: PUBLIC PROC[sh: Space.Handle] RETURNS[BOOLEAN] =
{file: File.Capability;
sh ← UnRavelUSUs[sh];
file ← Space.GetWindow[sh].file;
RETURN[cedarVMFilePages>0 AND file = cedarVMFile]};

GetPermanentDataPages: PUBLIC ENTRY PROC[nPages: CARDINAL,
createUniformSwapUnits: BOOLEAN ← TRUE]
RETURNS[LONG POINTER] =
{ ENABLE UNWIND => NULL;
spH: Space.Handle;
WHILE checkPointing DO WAIT finishedCheckpointing ENDLOOP;
nPages ← ((nPages+PagesPerQuantum-1)/PagesPerQuantum)*PagesPerQuantum;

spH ← FindCedarVMSpace[nPages];
IF spH = Space.nullHandle
THEN {spH ← SpecialSpace.CreateAligned[nPages, Space.virtualMemory, PagesPerQuantum];
IF cedarVMFilePages>0 AND nPages <= (cedarVMFilePages-nextCedarVMFilePage)
THEN {window: Space.WindowOrigin = [file: cedarVMFile,
base: nextCedarVMFilePage];
nextCedarVMFilePage ← nextCedarVMFilePage + nPages;
Space.Map[spH, window ! UNWIND => Space.Delete[spH]];
InsertInCedarVMSpaces[spH, window.base, nPages]}
ELSE Space.Map[spH, Space.defaultWindow ! UNWIND => Space.Delete[spH]];
nSpaces ← nSpaces + 1};
IF createUniformSwapUnits AND nPages > largeSwapUnitSize
THEN Space.CreateUniformSwapUnits[largeSwapUnitSize, spH ! UNWIND => Space.Delete[spH]];
RETURN[Space.LongPointer[spH]]};

GetCollectibleQuanta: PUBLIC ENTRY PROC[desired, needed: QuantumCount]
RETURNS[qi: QuantumIndex, qc: QuantumCount] =
{ OPEN Space;
ENABLE UNWIND => NULL;
space: Handle;

WHILE checkPointing DO WAIT finishedCheckpointing ENDLOOP;

space ← FindCedarVMSpace[needed*PagesPerQuantum, TRUE];

IF space = Space.nullHandle THEN
{qc ← desired;
WHILE cedarVMFilePages>0
AND desired*PagesPerQuantum > (cedarVMFilePages-nextCedarVMFilePage)
AND needed*PagesPerQuantum <= (cedarVMFilePages-nextCedarVMFilePage)
DO qc ← desired ← MAX[needed, desired/2] ENDLOOP;

{space ← SpecialSpace.CreateAligned[size: qc*PagesPerQuantum,
parent: virtualMemory,
alignment: PagesPerQuantum
! Space.InsufficientSpace =>
IF INTEGER[available] >= INTEGER[needed*PagesPerQuantum]
THEN {qc ← available/PagesPerQuantum; RETRY}
ELSE GOTO insufficientVM];
EXITS insufficientVM => RETURN WITH ERROR InsufficientVM};

IF qc*PagesPerQuantum > SwapUnitSize
THEN CreateUniformSwapUnits[SwapUnitSize, space];
IF cedarVMFilePages>0
AND qc*PagesPerQuantum <= (cedarVMFilePages-nextCedarVMFilePage)
THEN {window: Space.WindowOrigin = [file: cedarVMFile, base: nextCedarVMFilePage];
nextCedarVMFilePage ← nextCedarVMFilePage + qc*PagesPerQuantum;
Space.Map[space, window
! Volume.InsufficientSpace => {Space.Delete[space];
ERROR InsufficientVM}];
InsertInCedarVMSpaces[space, window.base, qc*PagesPerQuantum]}
ELSE Space.Map[space, Space.defaultWindow
! Volume.InsufficientSpace => {Space.Delete[space]; ERROR InsufficientVM}];
nSpaces ← nSpaces + 1}
ELSE -- space # Space.nullHandle
qc ← Space.GetAttributes[space].size/PagesPerQuantum;

IF RTFlags.checking
AND LOOPHOLE[space, CachedSpace.Handle].page MOD PagesPerQuantum # 0
THEN ERROR;
qi ← LOOPHOLE[space, CachedSpace.Handle].page/PagesPerQuantum;
RETURN[qi, qc]};

GetDataPagesFromNewSpace: PUBLIC ENTRY PROC[nPages: CARDINAL,
createUniformSwapUnits: BOOLEAN ← TRUE]
RETURNS[LONG POINTER] =
{ ENABLE UNWIND => NULL;
spH: Space.Handle;

WHILE checkPointing DO WAIT finishedCheckpointing ENDLOOP;
nPages ← ((nPages+PagesPerQuantum-1)/PagesPerQuantum)*PagesPerQuantum;

spH ← FindCedarVMSpace[nPages];
IF spH = Space.nullHandle
THEN {spH ← SpecialSpace.CreateAligned[size: nPages,
parent: Space.virtualMemory,
alignment: PagesPerQuantum];
IF cedarVMFilePages>0 AND nPages <= (cedarVMFilePages-nextCedarVMFilePage)
THEN {window: Space.WindowOrigin = [file: cedarVMFile, base: nextCedarVMFilePage];
nextCedarVMFilePage ← nextCedarVMFilePage + nPages;
Space.Map[spH, window ! UNWIND => Space.Delete[spH]];
InsertInCedarVMSpaces[spH, window.base, nPages]}
ELSE Space.Map[spH, Space.defaultWindow ! UNWIND => Space.Delete[spH]];
nSpaces ← nSpaces + 1};
IF createUniformSwapUnits AND nPages > largeSwapUnitSize
THEN Space.CreateUniformSwapUnits[largeSwapUnitSize, spH ! UNWIND => Space.Delete[spH]];
RETURN[Space.LongPointer[spH]]};

-- used in RTBasesImpl for GetSubspaceQuanta (for NewCollectibleSubspace)
GetQuantaFromNewSpace: PUBLIC ENTRY PROC[nQ: QuantumCount,
createUniformSwapUnits: BOOLEAN ← TRUE]
RETURNS[qi: QuantumIndex] =
{ OPEN Space;
ENABLE UNWIND => NULL;
space: Handle;

WHILE checkPointing DO WAIT finishedCheckpointing ENDLOOP;
space ← SpecialSpace.CreateAligned[nQ*PagesPerQuantum, virtualMemory, PagesPerQuantum
! Space.InsufficientSpace => ERROR InsufficientVM];
IF createUniformSwapUnits AND nQ*PagesPerQuantum > SwapUnitSize
THEN CreateUniformSwapUnits[SwapUnitSize, space];
Map[space, defaultWindow
! Volume.InsufficientSpace => {Space.Delete[space]; ERROR InsufficientVM}];
nSpaces ← nSpaces + 1;
qi ← LOOPHOLE[space, CachedSpace.Handle].page/PagesPerQuantum;
RETURN[qi]};

GetDataPagesForGCTables: PUBLIC ENTRY PROC RETURNS[LONG POINTER] =
-- get it on a 64K boundary
{ OPEN Space;
np: PageCount ← 256;
spHs: Handle; --swappable space
spHp: Handle; --pinned space
spH: Handle;

WHILE checkPointing DO WAIT finishedCheckpointing ENDLOOP;
spH ← SpecialSpace.CreateForCode[np, virtualMemory
! InsufficientSpace => ERROR InsufficientVM];
spHp← Space.Create[1, spH, 0]; -- first page is a space by itself
spHs← Space.Create[np-1, spH, 1]; -- the rest
IF cedarVMFilePages>0 AND 1 <= (cedarVMFilePages-nextCedarVMFilePage)
THEN {window: Space.WindowOrigin = [file: cedarVMFile, base: nextCedarVMFilePage];
nextCedarVMFilePage ← nextCedarVMFilePage + 1;
Space.Map[spHp, window
! Volume.InsufficientSpace => {Space.Delete[spH];
ERROR InsufficientVM}];
InsertInCedarVMSpaces[spHp, window.base, 1]}
ELSE Space.Map[spHp, Space.defaultWindow
! Volume.InsufficientSpace => {Space.Delete[spH];
ERROR InsufficientVM}];

SpecialSpace.MakeResident[spHp];

IF np-1 > largeSwapUnitSize
THEN Space.CreateUniformSwapUnits[largeSwapUnitSize, spHs
! UNWIND => Space.Delete[spH]];
IF cedarVMFilePages>0 AND np-1 <= (cedarVMFilePages-nextCedarVMFilePage)
THEN {window: Space.WindowOrigin = [file: cedarVMFile, base: nextCedarVMFilePage];
nextCedarVMFilePage ← nextCedarVMFilePage + np-1;
Space.Map[spHs, window
! Volume.InsufficientSpace =>
{Space.Delete[spH];
ERROR InsufficientVM}];
InsertInCedarVMSpaces[spHs, window.base, np-1]}
ELSE Space.Map[spHs, Space.defaultWindow
! Volume.InsufficientSpace => {Space.Delete[spH];
ERROR InsufficientVM}];
nSpaces ← nSpaces + 3;
RETURN[LongPointer[spH]]};

FindCedarVMSpace: INTERNAL PROC[np: Space.PageCount, minimum: BOOLEAN ← FALSE]
RETURNS[Space.Handle] =
{ prev: SDHandle ← NIL;
FOR p: SDHandle ← cedarVMSpaceCache, p.next UNTIL p = NIL
DO IF (IF minimum THEN (np <= p.nPages) ELSE (np = p.nPages))
THEN {p.space ← SpecialSpace.CreateAligned[size: p.nPages,
parent: Space.virtualMemory,
alignment: PagesPerQuantum
! ANY => CONTINUE];
IF p.space = Space.nullHandle THEN RETURN[Space.nullHandle];
nSpaces ← nSpaces + 1;
IF prev = NIL
THEN cedarVMSpaceCache ← p.next
ELSE prev.next ← p.next;
p.next ← cedarVMSpaces;
cedarVMSpaces ← p;
Space.Map[p.space, [file: cedarVMFile, base: p.firstCedarVMPage]];
Space.Kill[p.space];
RETURN[p.space]}
ELSE prev ← p;
ENDLOOP;
RETURN[Space.nullHandle]
};

InsertInCedarVMSpaces: INTERNAL PROC[space: Space.Handle, firstPage, nPages: NAT] =
{ space ← UnRavelUSUs[space];
Space.Kill[space];
cedarVMSpaces ← pilotHeapZone.NEW[SDRec ← [space: space,
next: cedarVMSpaces,
firstCedarVMPage: firstPage,
nPages: nPages]]};

CheckpointCedarVM: ENTRY PROC[p: PROC[Space.Handle]] =
{ ENABLE UNWIND => NULL;
FOR sdh: SDHandle ← cedarVMSpaces, sdh.next UNTIL sdh = NIL
DO p[sdh.space] ENDLOOP;
RTSponge.Disable[]; --acquire the sponge.
checkPointing ← TRUE};

RollbackCedarVM: ENTRY PROC[after: CedarSnapshot.After] =
{ RTSponge.Enable[]; -- release the sponge.
checkPointing ← FALSE;
BROADCAST finishedCheckpointing};

RemoveFromCedarVMSpaces: INTERNAL PROC[space: Space.Handle] =
{ prev: SDHandle ← NIL;
FOR p: SDHandle ← cedarVMSpaces, p.next UNTIL p = NIL
DO IF p.space = space
THEN {IF prev = NIL
THEN cedarVMSpaces ← p.next
ELSE prev.next ← p.next;
Space.DeleteSwapUnits[space];
p.next ← cedarVMSpaceCache;
cedarVMSpaceCache ← p;
nSpaces ← nSpaces - 1;
Space.Kill[p.space];
Space.Delete[p.space];
p.space ← Space.nullHandle;
RETURN}
ELSE prev ← p;
ENDLOOP;
ERROR};

DeleteSpace: PUBLIC ENTRY PROC[space: Space.Handle] =
{ ENABLE UNWIND => NULL;
WHILE checkPointing DO WAIT finishedCheckpointing ENDLOOP;
IF SpaceInCedarVM[space]
THEN RemoveFromCedarVMSpaces[UnRavelUSUs[space]]
ELSE {nSpaces ← nSpaces - 1;
Space.Kill[space];
Space.Delete[space]}};

-- PROCs for dealing with frames
EnumerateGlobalFrames: PUBLIC PROC[proc: PROC[GlobalFrameHandle] RETURNS[BOOLEAN]]
RETURNS[GlobalFrameHandle] =
{ FOR i: CARDINAL IN [1..SDDefs.SD[SDDefs.sGFTLength]] DO
item: PrincOpsRuntime.GFTItem ← PrincOpsRuntime.GFT[LOOPHOLE[i]];
frame: GlobalFrameHandle ← PrincOpsRuntime.GetFrame[item];
IF frame # NullGlobalFrame AND item.epbias = 0 THEN
{IF proc[frame] THEN RETURN[frame]};
ENDLOOP;
RETURN[NullGlobalFrame]};


-- PROCs for dealing with RTProcesses

SameCode: PUBLIC PROC [f1, f2: GlobalFrameHandle] RETURNS [RTOS.CodeMatch] =
{ fcb1, fcb2: PrincOps.FrameCodeBase;
fcb1 ← f1.code;
fcb2 ← f2.code;
fcb1.out ← fcb2.out ← FALSE;
RETURN[IF fcb1 = fcb2 THEN identical ELSE different]};

EstablishCedarVMFile: PUBLIC PROC[fc: File.Capability] =
{ IF cedarVMFile # File.nullCapability THEN ERROR;
cedarVMFile ← fc;
IF cedarVMFile # File.nullCapability
THEN cedarVMFilePages ← File.GetSize[cedarVMFile]};

-- shortcuts

PageFromLongPointer: PROC[lp: LONG POINTER] RETURNS [page: Space.PageNumber] =
INLINE
{ OPEN LOOPHOLE[lp, num Environment.Long];
RETURN[highbits*Environment.wordsPerPage+lowbits/Environment.wordsPerPage]};



-- START HERE


EstablishCedarVMFile[Directory.Lookup[fileName: "CedarVM.DontDeleteMe",
permissions: File.read + File.write
! ANY => CONTINUE]];

pilotHeapZone ← Heap.Create[initial: 10--pages--,
parent: Space.Create[100, Space.virtualMemory],
increment: 10,
swapUnit: 1];

CedarSnapshot.Register[CheckpointCedarVM, RollbackCedarVM];

END.