-- Cedar Remote Debugging: cache of client pages

-- WVMCache.mesa

-- Andrew Birrell April 22, 1983 9:53 am

DIRECTORY
Booting    USING[ Bootee, Switches ],
DeviceTypes  USING[ sa4000 ],
PilotDisk   USING[ Label ],
PilotLoadStateFormat USING[ BcdTable, ConfigIndex, LoadStateObject, ModuleTable ],
Rope     USING[ Equal, ROPE ],
RTStorageOps  USING[ NewObject ],
WorldVM   USING[ Address, CopyRead, Incarnation, Read, ShortAddress ],
WorldVMExtra  USING[ ],
WVMPrivate;

WVMCache: MONITOR
IMPORTS Rope, RTStorageOps, WorldVM, WVMPrivate
EXPORTS WorldVM, WorldVMExtra, WVMPrivate =

BEGIN

WorldType: TYPE = { none, local, other, remote };

WorldObject: PUBLIC TYPE = RECORD[
name: Rope.ROPE,
incarnation: WorldVM.Incarnation ← FIRST[WorldVM.Incarnation],
lock: NAT ← 0,
state: { creating, created, bad } ← creating,
running: BOOLEAN ← TRUE,
maplog: WVMPrivate.MapLog ← NIL,
patchTable: WorldVM.Address ← 0,
loadState: REF PilotLoadStateFormat.LoadStateObject ← NIL,
loadStateValid: BOOL ← FALSE,
mdsBase: WorldVM.Address ← onlyMDS,
foo: SELECT type: WorldType FROM
none => NULL,
local => NULL,
other => NULL,
remote => [host: WVMPrivate.Machine]
ENDCASE];

World: TYPE = REF WorldObject;

onlyMDS: WorldVM.Address = --TEMP kludge-- 400000B;

universe: LIST OF World ← NIL;
localName: Rope.ROPE = "Local";
otherName: Rope.ROPE = "Outload";
created: CONDITION;

EntryFindWorld: ENTRY PROC[type: WorldType, name: Rope.ROPE, host: WVMPrivate.Machine]
RETURNS[new: World] =
-- Delicately arranged not to talk to the world inside our monitor --
BEGIN
ENABLE UNWIND => NULL;
FOR w: LIST OF World ← universe, w.rest UNTIL w = NIL
DO IF w.first.type = type
AND ( WITH ww: w.first SELECT FROM
remote => Rope.Equal[w.first.name, name, FALSE] AND ww.host = host,
ENDCASE => TRUE )
THEN BEGIN
WHILE w.first.state = creating DO WAIT created ENDLOOP;
IF w.first.state = bad THEN w.first.state ← creating;
RETURN[w.first];
END;
ENDLOOP;
SELECT type FROM
local => new ← NEW[WorldObject ← [name: name, foo: local[] ]];
other => new ← NEW[WorldObject ← [name: name, foo: other[] ]];
remote => new ← NEW[WorldObject ← [name: name, foo: remote[host] ]];
ENDCASE => ERROR;
universe ← CONS[rest: universe, first: new];
END;

localWorld: World ← NIL;
otherWorld: World ← NIL;

EntryFindLocal: ENTRY PROC RETURNS[World] = INLINE
-- This is only an optimisation --
{ RETURN[localWorld] };

GetWorld: PUBLIC PROC[where: Rope.ROPE] RETURNS[world: World] =
BEGIN
EndCreation: ENTRY PROC = INLINE
BEGIN
BROADCAST created;
SELECT type FROM
local => localWorld ← world;
other => otherWorld ← world;
ENDCASE => NULL;
END;
host: WVMPrivate.Machine;
type: WorldType;
SELECT TRUE FROM
Rope.Equal[where, localName, FALSE] => type ← local;
Rope.Equal[where, otherName, FALSE] => type ← other;
ENDCASE => { type ← remote; host ← WVMPrivate.LocateRemote[where] };
world ← EntryFindWorld[type, where, host];
IF world.state = creating
THEN -- we're responsible for doing the work. --
BEGIN
ENABLE UNWIND => { world.state ← bad; EndCreation[] };
IF world.type = other
THEN WVMPrivate.LocateOther[]; -- causes outload, boot; returns after inload --
GetMaplog[world];
EndRun[world];
world.state ← created;
EndCreation[];
END;
END;

OtherWorld: PUBLIC PROC RETURNS[world: World] =
{ RETURN[ GetWorld[otherName] ] };

LocalWorld: PUBLIC PROC RETURNS[world: World] =
{ IF (world ← EntryFindLocal[]) = NIL THEN world ← GetWorld[localName] };

none: World ← NIL;

NoWorld: PUBLIC ENTRY PROC RETURNS[world: World] =
BEGIN
ENABLE UNWIND => NULL;
IF none = NIL THEN none ← NEW[WorldObject ←
[name: "NoWorld", running: FALSE, foo: none[]]];
RETURN[none]
END;

InvalidateWorld: PUBLIC ENTRY PROC[world: World] =
BEGIN
ENABLE UNWIND => NULL;
IF world = NIL THEN RETURN WITH ERROR BadWorld[];
world^ ← [name: "InvalidWorld", running: world.running, foo: none[]];
END;

CurrentIncarnation: PUBLIC ENTRY PROC[world: World]
RETURNS[WorldVM.Incarnation] =
BEGIN
ENABLE UNWIND => NULL;
IF world = NIL THEN RETURN WITH ERROR BadWorld[];
RETURN[world.incarnation]
END;

WorldName: PUBLIC ENTRY PROC[world: World] RETURNS[ Rope.ROPE ] =
BEGIN
ENABLE UNWIND => NULL;
IF world = NIL THEN RETURN WITH ERROR BadWorld[];
RETURN[ world.name ]
END;

PatchTable: PUBLIC ENTRY PROC[world: World] RETURNS[WorldVM.Address] =
BEGIN
ENABLE UNWIND => NULL;
IF world = NIL THEN RETURN WITH ERROR BadWorld[];
RETURN[world.patchTable]
END;

loadStateRead: CONDITION;

Loadstate: PUBLIC ENTRY PROC[world: World]
RETURNS[ REF PilotLoadStateFormat.LoadStateObject ] =
BEGIN
ENABLE UNWIND => NULL;
IF world = NIL THEN RETURN WITH ERROR BadWorld[];
IF world.type = local THEN RETURN WITH ERROR BadWorld[];
UNTIL world.loadStateValid DO WAIT loadStateRead ENDLOOP;
RETURN[ world.loadState ]
END;

ValidLoadstate: ENTRY PROC[world: World] =
BEGIN
ENABLE UNWIND => NULL;
world.loadStateValid ← TRUE;
BROADCAST loadStateRead;
END;

-- Per-world synchronization. Public may call Lock and Unlock to freeze debuggee
-- during access to debuggee data structures. StartRun and EndRun prevent running
-- while locked, locking while running, and running while running.

unlocked: CONDITION;

Lock: PUBLIC ENTRY PROC[world: World] =
BEGIN
ENABLE UNWIND => NULL;
IF world = NIL THEN RETURN WITH ERROR BadWorld[];
WHILE world.running DO WAIT unlocked ENDLOOP;
world.lock ← world.lock+1;
END;

Unlock: PUBLIC ENTRY PROC[world: World] =
BEGIN
ENABLE UNWIND => NULL;
IF world = NIL THEN RETURN WITH ERROR BadWorld[];
world.lock ← world.lock-1; BROADCAST unlocked;
END;

StartRun: PUBLIC ENTRY PROC[world: World] =
BEGIN
-- Ensures that world isn't running for someone else, isn't
-- locked, and has no pages in cache --
waited: BOOLEAN ← FALSE;
IF world = NIL THEN RETURN WITH ERROR BadWorld[];
DO FlushWorld[world];
WHILE world.lock > 0 OR world.running
DO waited ← TRUE; WAIT unlocked ENDLOOP;
IF NOT waited THEN EXIT; -- else we may need to flush again --
waited ← FALSE;
ENDLOOP;
world.loadStateValid ← FALSE;
world.running ← TRUE; -- gives us exclusive access to the world --
world.incarnation ← world.incarnation+1;
world.maplog ← NIL;
END;

EndRun: ENTRY PROC[world: World] =
BEGIN
IF world = NIL THEN RETURN WITH ERROR BadWorld[];
world.running ← FALSE; BROADCAST unlocked;
END;

Go: PUBLIC PROC[world: World] =
BEGIN
StartRun[world];
BEGIN
ENABLE UNWIND => EndRun[world];
WITH w: world SELECT FROM
remote => WVMPrivate.GoRemote[w.host];
other => WVMPrivate.GoOther[]; -- causes outload, client inload --
none => ERROR BadWorld[];
local => NULL;
ENDCASE => ERROR;
GetMaplog[world];
END;
EndRun[world];
END;

SwapAndBoot: PUBLIC SAFE PROC[boot: Booting.Bootee, switches: Booting.Switches] = TRUSTED
BEGIN
ENABLE UNWIND => NULL;
IF otherWorld # NIL
THEN BEGIN
StartRun[otherWorld];
WVMPrivate.ReallySwapAndBoot[boot, switches];
GetMaplog[otherWorld ! UNWIND => EndRun[otherWorld]];
EndRun[otherWorld];
END
ELSE WVMPrivate.ReallySwapAndBoot[boot, switches];
END;

GetMaplog: PROC[world: World] =
BEGIN
ENABLE UNWIND => NULL;
IF NOT world.running THEN ERROR;
SELECT world.type FROM
local =>
world.patchTable ← WVMPrivate.LocalPatchTable[];
other, remote =>
BEGIN
lsAddr: WorldVM.Address;
world.maplog ← NIL;
world.maplog ← WVMPrivate.CreateMapLog[world];
[ world.patchTable, lsAddr ] ← WVMPrivate.ReadMapLog[world, world.maplog];
GetLoadState[world, lsAddr];
END;
ENDCASE => NULL;
END;

GetLoadState: PROC[world: World, lsAddr: WorldVM.Address] =
BEGIN
-- The compiler won't let me write "PilotLoadStateFormat.LoadStateObject[0]" --
size: CARDINAL =
-- SIZE[PilotLoadStateFormat.LoadStateObject[0]-SIZE[PilotLoadStateFormat.BcdTable[0]] --
--versionident-- SIZE[CARDINAL] +
--nBcds-- SIZE[PilotLoadStateFormat.ConfigIndex] +
--gft-- SIZE[PilotLoadStateFormat.ModuleTable];
lengthAddr: WorldVM.Address = lsAddr + size;
thisLength: CARDINAL = WorldVM.Read[world, lengthAddr];
thisSize: CARDINAL = size + SIZE[PilotLoadStateFormat.BcdTable[thisLength]];
IF world.loadState = NIL OR thisLength # world.loadState.bcds.length
THEN world.loadState ← NARROW[ RTStorageOps.NewObject[
CODE[PilotLoadStateFormat.LoadStateObject], thisSize] ];
WorldVM.CopyRead[world: world,
to: LOOPHOLE[world.loadState,LONG POINTER],
from: lsAddr,
nwords: thisSize];
ValidLoadstate[world];
END;

Long: PUBLIC PROC[world: World, addr: WorldVM.ShortAddress]
RETURNS[WorldVM.Address] =
{ RETURN[ IF addr = 0 THEN 0 ELSE addr + world.mdsBase ] };

GetPage: PUBLIC PROC[world: World, mempage: WVMPrivate.PageNumber,
coreOnly: BOOLEAN]
RETURNS[ data: REF WVMPrivate.PageData, handle: PageHandle ] =
BEGIN
IF world = NIL THEN RETURN WITH ERROR BadWorld[];
handle ← FindPage[world, mempage];
IF handle.where.type = empty
THEN ReadPage[handle !
UNWIND => { PageRead[handle, [empty[]]]; ReleasePage[handle] } ];
data ← handle.data;
IF coreOnly AND handle.where.type # outLd AND handle.where.type # remoteCore
THEN { ReleasePage[handle]; data ← NIL; handle ← NIL };
END;

WriteAndReleasePage: PUBLIC PROC[handle: PageHandle] =
BEGIN
WritePage[handle];
ReleasePage[handle];
END;



-- The page cache itself! --

-- The cache is organized as a hash table with chained overflow and LRU replacement.
-- The hash overflow chains and the LRU chain are doubly linked to ease removal.
-- The hash function is (mempage MOD number of buckets).
-- The number of buckets is approximately twice the number of cache pages.
-- The number of buckets is coprime with such numbers as 128, 256 to avoid clashes.

PageInfo: PUBLIC TYPE = RECORD[
data: REF WVMPrivate.PageData ← NIL,
LRUYounger, LRUOlder, hashNext, hashPrev: PageHandle ← NIL,
users: CARDINAL ← 0,
coming: BOOL ← FALSE, -- whether someone is reading it in --
mempage: WVMPrivate.PageNumber ← 0 -- "0" assumed in "Init" --,
world: World ← NIL,
where: Location ];

Location: TYPE = RECORD[
SELECT type: * FROM
empty => NULL,
outLd => [map: WVMPrivate.MapEntry],
localDisk => [addr: WVMPrivate.DiskAddress],
remoteCore => [map: WVMPrivate.MapEntry],
remoteDisk => [addr: WVMPrivate.DiskAddress,
label: PilotDisk.Label ← NULL],
ENDCASE] ← [empty[]];

PageHandle: TYPE = REF PageInfo;

cachePages: INT = 200;

CacheIndex: TYPE = [0..501);

cache: REF ARRAY CacheIndex OF PageHandle =
NEW[ARRAY CacheIndex OF PageHandle ← ALL[NIL]];

pageReady: CONDITION;

CacheFull: ERROR = CODE;

LRUOld, LRUYoung: PageHandle ← NIL;

hits: INT ← 0; -- number of cache lookup hits --
longSearches: INT ← 0; -- number of times lookup followed overflow chain --
misses: INT ← 0; -- number of cache lookup misses (hits + misses = requests)--
fullBuckets: INT ← 0; -- number of times hash bucket was already occupied when inserting --

FindPage: ENTRY PROC[world: World, mempage: WVMPrivate.PageNumber]
RETURNS[ handle: PageHandle ] =
BEGIN
ENABLE UNWIND => NULL;
hash: CacheIndex = mempage MOD (LAST[CacheIndex]+1);
handle ← cache[hash];
UNTIL handle = NIL
DO IF handle.world = world AND handle.mempage = mempage
THEN BEGIN
hits ← hits + 1;
handle.users ← handle.users+1;
-- Wait if someone else is reading it in for us --
WHILE handle.where.type = empty
DO IF handle.coming
THEN WAIT pageReady
ELSE { handle.coming ← TRUE--we will read it in--; EXIT };
ENDLOOP;
EXIT
END;
longSearches ← longSearches + 1; -- increment for each step along overflow chain --
handle ← handle.hashNext;
ENDLOOP;
IF handle = NIL
THEN -- find and claim victim --
BEGIN
misses ← misses + 1;
handle ← LRUOld;
DO IF handle = NIL THEN ERROR CacheFull[]; -- no victim --
IF handle.users = 0 THEN EXIT;
handle ← handle.LRUYounger;
ENDLOOP;
-- remove from hash chain --
IF handle.hashPrev = NIL
THEN cache[handle.mempage MOD (LAST[CacheIndex]+1)] ← handle.hashNext
ELSE handle.hashPrev.hashNext ← handle.hashNext;
IF handle.hashNext # NIL THEN handle.hashNext.hashPrev ← handle.hashPrev;
-- mark as ours --
handle.where ← [empty[]]; -- cache is always clean --
handle.coming ← TRUE--we will read it in--;
IF handle.data = NIL THEN handle.data ← NEW[WVMPrivate.PageData ← NULL];
handle.users ← 1;
handle.mempage ← mempage;
handle.world ← world;
-- place in hash chain --
IF cache[hash] # NIL
THEN { fullBuckets ← fullBuckets + 1; cache[hash].hashPrev ← handle };
handle.hashNext ← cache[hash];
handle.hashPrev ← NIL;
cache[hash] ← handle;
END;
IF handle # LRUYoung
THEN BEGIN
-- remove from LRU chain --
IF handle.LRUOlder = NIL
THEN LRUOld ← handle.LRUYounger
ELSE handle.LRUOlder.LRUYounger ← handle.LRUYounger;
IF handle.LRUYounger # NIL THEN handle.LRUYounger.LRUOlder ← handle.LRUOlder;
-- add to LRU chain --
IF LRUYoung # NIL THEN LRUYoung.LRUYounger ← handle;
handle.LRUOlder ← LRUYoung;
handle.LRUYounger ← NIL;
LRUYoung ← handle;
END;
-- Return with handle.where.type = empty iff caller should read page in --
END;

Init: ENTRY PROC =
BEGIN
-- Initialise cache with all pages having mempage = 0, so all hash to cache[0]. --
LRUYoung ← LRUOld ← cache[0] ← NEW[PageInfo];
THROUGH [1..cachePages)
DO handle: PageHandle ← NEW[PageInfo];
cache[0].hashPrev ← handle;
handle.hashNext ← cache[0];
handle.hashPrev ← NIL;
cache[0] ← handle;
LRUYoung.LRUYounger ← handle;
handle.LRUOlder ← LRUYoung;
handle.LRUYounger ← NIL;
LRUYoung ← handle;
ENDLOOP;
END;

PageRead: ENTRY PROC[ handle: PageHandle, location: Location] =
{ ENABLE UNWIND => NULL;
handle.where ← location; handle.coming ← FALSE; BROADCAST pageReady };

ReleasePage: PUBLIC ENTRY PROC[handle: PageHandle] =
BEGIN
ENABLE UNWIND => NULL;
handle.users ← handle.users-1;
BROADCAST pageReady; -- for FlushWorld and for FindPage --
END;

FlushWorld: INTERNAL PROC[world: World] =
BEGIN
DO waited: BOOLEAN ← FALSE;
FOR p: CacheIndex IN CacheIndex
DO handle: PageHandle ← cache[p];
DO IF handle = NIL THEN EXIT;
IF handle.world = world OR world = NIL
THEN BEGIN
WHILE handle.users > 0
DO waited ← TRUE; WAIT pageReady ENDLOOP;
handle.world ← NIL; -- must leave handle.memPage intact for hash function --
END;
handle ← handle.hashNext;
ENDLOOP;
ENDLOOP;
IF NOT waited THEN EXIT
-- else loop in case a page was added while we WAIT'ed --
ENDLOOP;
END;



-- Page transfers --

ReadPage: --EXTERNAL-- PROC[handle: PageHandle] =
BEGIN
IF NOT ReadCorePage[handle]
THEN BEGIN
addr: WVMPrivate.DiskAddress ←
WVMPrivate.GetMapLogEntry[handle.world.maplog, handle.mempage];
ReadDiskPage[handle, addr];
END;
END;

BadWorld: PUBLIC ERROR = CODE;

ReadCorePage: --EXTERNAL-- PROC[handle: PageHandle] RETURNS[ok: BOOLEAN] =
BEGIN
ENABLE UNWIND => NULL;
WITH w: handle.world SELECT FROM
none => ERROR BadWorld[];
local => ERROR BadWorld[];
other =>
BEGIN
m: WVMPrivate.MapEntry;
[m, ok] ← WVMPrivate.ReadOtherCore[handle.data, handle.mempage];
IF ok THEN PageRead[ handle, [outLd[m]] ];
END;
remote =>
BEGIN
m: WVMPrivate.MapEntry;
[m, ok] ← WVMPrivate.ReadRemoteCore[w.host, handle.data, handle.mempage];
IF ok THEN PageRead[ handle, [remoteCore[m]] ];
END;
ENDCASE => ERROR;
END;

ReadDiskPage: --EXTERNAL-- PROC[handle: PageHandle, addr: WVMPrivate.DiskAddress] =
BEGIN
ENABLE UNWIND => NULL;
WITH w: handle.world SELECT FROM
none => ERROR BadWorld[];
local => ERROR BadWorld[];
other =>
BEGIN
WVMPrivate.MoveLocalDiskPage[handle.data, read, addr];
PageRead[ handle, [localDisk[addr]] ];
END;
remote =>
BEGIN
label: PilotDisk.Label;
WVMPrivate.ReadRemoteDisk[w.host, handle.data,
DeviceTypes.sa4000, addr, @label];
PageRead[ handle, [remoteDisk[addr,label]] ];
END;
ENDCASE => ERROR;
END;

WritePage: --EXTERNAL-- PROC[handle: PageHandle] =
BEGIN
ENABLE UNWIND => NULL;
Host: PROC RETURNS[ WVMPrivate.Machine] =
BEGIN
WITH w: handle.world SELECT FROM
remote => RETURN[w.host];
ENDCASE => ERROR;
END;
WITH wh: handle.where SELECT FROM
empty => ERROR;
outLd =>
BEGIN
map: WVMPrivate.MapEntry ← wh.map;
IF NOT map.flags.W--riteProtected-- THEN map.flags.D--irty-- ← TRUE;
WVMPrivate.WriteOtherCore[handle.data, handle.mempage, map];
END;
localDisk =>
BEGIN
WVMPrivate.MoveLocalDiskPage[handle.data, write, wh.addr];
END;
remoteCore =>
BEGIN
map: WVMPrivate.MapEntry ← wh.map;
IF NOT map.flags.W--riteProtected-- THEN map.flags.D--irty-- ← TRUE;
WVMPrivate.WriteRemoteCore[Host[], handle.data, handle.mempage, map];
END;
remoteDisk =>
BEGIN
label: PilotDisk.Label ← wh.label;
WVMPrivate.WriteRemoteDisk[Host[], handle.data, DeviceTypes.sa4000,
wh.addr, @label];
END;
ENDCASE => ERROR;
END;

Init[];

END.