CacheOpsImpl:
CEDAR
PROGRAM
IMPORTS Atom, Basics, Convert, Cucumber,
FS,
IO, RefText, Rope
EXPORTS CacheOps =
BEGIN OPEN CacheOps;
VMPage:
TYPE =
RECORD [
vAddr: Dragon.Word,
writeProtect, dirty: BOOL,
data: ARRAY [0..PageSize) OF Dragon.Word
];
VMPageRef: TYPE = REF VMPage;
VMOb:
TYPE =
RECORD [
initFromFile: Rope.ROPE ← NIL,
initialized: BOOL ← FALSE,
firstFreeCycle: INT ← 0,
caches: LIST OF CacheObRef ← NIL,
pages: LIST OF VMPageRef ← NIL
];
VMObRef: TYPE = REF VMOb;
CacheLine:
TYPE =
RECORD [
addr: Dragon.Word ← 0,
dirty, sharedMaster, valid: BOOL ← FALSE
];
CacheOb:
TYPE =
RECORD [
vm: VMObRef ← NIL,
accesses, writes, misses, pageMisses, dirtyVictimWrites, pageFaults: INT ← 0,
victim: NAT ← 0,
lastTransportLine: NAT ← 0,
firstFreeCycle: INT ← 0,
lines: SEQUENCE nLines: NAT OF CacheLine
];
CacheObRef: TYPE = REF CacheOb;
GetVM:
PROC [ mem:
REF
ANY ←
NIL ]
RETURNS [ vm: VMObRef ] =
BEGIN
vmra: REF ANY;
IF defaultVM =
NIL
THEN
BEGIN
defaultVM ← NewVirtualMemory[];
VirtualMemoryFromFile[defaultVM, "Default.DragonVM"];
END;
vmra ← defaultVM;
IF mem#
NIL
THEN
WITH mem
SELECT
FROM
pl: Atom.PropList => vmra ← GetVM[Atom.GetPropFromList[propList: pl, prop: $DragonVM]];
lora:
LIST
OF
REF
ANY =>
FOR le:
LIST
OF
REF
ANY ← lora, le.rest
WHILE le#
NIL
DO
vmra ← GetVM[le.first];
IF vmra # defaultVM THEN EXIT;
ENDLOOP;
c: CacheObRef => vmra ← c.vm;
vmor: VMObRef => vmra ← vmor;
rope: Rope.ROPE => vmra ← NewVirtualMemoryFromFile[rope];
text: REF TEXT => vmra ← NewVirtualMemoryFromFile[Rope.FromRefText[text]];
ENDCASE => NULL;
RETURN[NARROW[vmra]];
END;
NewCache:
PUBLIC
PROC [ mem:
REF
ANY ←
NIL, nLines:
NAT ← StdLinesPerCache ]
RETURNS [ c: Cache ] =
BEGIN
cor: CacheObRef ← NIL;
IF mem = NIL THEN mem ← defaultVM;
WITH mem
SELECT
FROM
c: CacheObRef => cor ← c;
ENDCASE =>
BEGIN
vm: VMObRef = GetVM[mem];
cor ← NEW[CacheOb[nLines]];
cor.vm ← vm;
vm.caches ← CONS[cor, vm.caches];
END;
VirtualMemoryFromFile[cor.vm, NIL]; -- initialize the virtual memory
cor.accesses ← cor.writes ← cor.misses ← cor.pageMisses ← cor.dirtyVictimWrites ← cor.pageFaults ← 0;
cor.victim ← 0;
FOR i: NAT IN [0..cor.nLines) DO cor.lines[i] ← [] ENDLOOP;
lastCache ← cor;
cor.vm.firstFreeCycle ← 0;
RETURN[cor];
END;
Access:
PUBLIC
PROC [ c: Cache, address: Dragon.Word, purpose: AccessPurpose ← read, cycleNow:
INT ← 0 ]
RETURNS [ data: Dragon.Word, rejectCycles:
NAT, pageFault, writeProtect:
BOOL ] =
BEGIN
cor: CacheObRef = NARROW[c];
page: VMPageRef = FindVMPage[vm: cor.vm, address: address, allowNIL: TRUE];
cycles: NAT;
cor.accesses ← cor.accesses+1;
FOR line:
NAT
IN [0..cor.nLines)
DO
IF address-cor.lines[line].addr
IN [0..WordsPerLine)
AND cor.lines[line].valid
THEN
BEGIN
cycles ←
IF cor.lastTransportLine = line
AND cycleNow>0
THEN
-- this line's transport may not yet be finished -- MAX[cor.firstFreeCycle-cycleNow, 0] ELSE 0;
EXIT;
END;
REPEAT
FINISHED =>
-- not a cache hit, will result in MBus operation
BEGIN
cycles ← 3;
Read quad = 3 cycles to interesting word
cor.misses ← cor.misses+1;
IF cor.lines[cor.victim].dirty
THEN
BEGIN -- Clean the victim
cycles ← cycles+5; -- Write quad
cor.dirtyVictimWrites ← cor.dirtyVictimWrites+1;
cor.lines[cor.victim].dirty ← FALSE;
END;
FOR line:
NAT
IN [0..cor.nLines)
DO
IF address-cor.lines[line].addr IN [0..PageSize) AND cor.lines[line].valid THEN EXIT;
REPEAT
FINISHED =>
-- not a page hit either
BEGIN
cycles ← cycles+3; -- Map operation .. 2+?
cor.pageMisses ← cor.pageMisses+1;
IF page=
NIL
THEN
BEGIN
cor.pageFaults ← cor.pageFaults+1;
cor.lastTransportLine ← cor.nLines+1; -- don't match
RETURN[data: 0, rejectCycles: RejectCycles[cor, cycleNow, cycles-3 -- just dirty victim write (if any) followed by mapping -- ], pageFault: TRUE, writeProtect: FALSE];
END;
END;
ENDLOOP;
cor.lastTransportLine ← cor.victim;
cycles ← RejectCycles[cor, cycleNow, cycles+3]-3;
.. allows additional 3 cycles for remaining 3 words of quadword
cor.lines[cor.victim] ← [addr: address - (address MOD WordsPerLine), valid: TRUE];
cor.victim ← (cor.victim+1) MOD cor.nLines;
END;
ENDLOOP;
IF page=NIL THEN ERROR; -- cache and VM disagree
RETURN[data: page.data[address-page.vAddr], rejectCycles: cycles, pageFault: FALSE, writeProtect: page.writeProtect];
END;
Write:
PUBLIC
PROC [ c: Cache, address, data: Dragon.Word ] =
BEGIN
cor: CacheObRef = NARROW[c];
page: VMPageRef = FindVMPage[vm: cor.vm, address: address, allowNIL: TRUE];
IF page=NIL THEN ERROR;
cor.vm.initialized ← FALSE;
page.data[address-page.vAddr] ← data;
page.dirty ← TRUE;
cor.writes ← cor.writes+1;
FOR line:
NAT
IN [0..cor.nLines)
DO
IF address-cor.lines[line].addr
IN [0..WordsPerLine)
THEN
{cor.lines[line].dirty ← TRUE; EXIT};
REPEAT
FINISHED => ERROR;
ENDLOOP;
END;
IORead: PUBLIC PROC [ c: Cache, address: Dragon.Word, cycleNow: INT ← 0 ] RETURNS [ data: Dragon.Word, rejectCycles: NAT ] = {RETURN[0, RejectCycles[NARROW[c], cycleNow, 10]]};
IOWrite:
PUBLIC
PROC [ c: Cache, address, data: Dragon.Word, cycleNow:
INT ← 0 ]
RETURNS [ rejectCycles:
NAT ] = {
RETURN[RejectCycles[
NARROW[c], cycleNow, 10]]};
SetFlags:
PUBLIC
PROC [ c: Cache, address: Dragon.Word, writeProtect, dirty, mapped:
BOOL ] =
BEGIN
cor: CacheObRef = NARROW[c];
page: VMPageRef ← FindVMPage[vm: cor.vm, address: address, allowNIL: NOT mapped];
cor.vm.initialized ← FALSE;
SELECT
TRUE
FROM
mapped =>
BEGIN
page.writeProtect ← writeProtect;
page.dirty ← dirty;
END;
page#NIL => UnmapVMPage[vm: cor.vm, page: page];
ENDCASE => NULL;
END;
SetIntervalFlags:
PUBLIC
PROC [ c: Cache, startAddress, endAddress
-- [startAddress..endAddress] -- : Dragon.Word, writeProtect, dirty, mapped:
BOOL ] =
BEGIN
FOR addr: Dragon.Word ← startAddress, addr+PageSize
WHILE addr<=endAddress
DO
SetFlags[c, addr, writeProtect, dirty, mapped];
ENDLOOP;
END;
GetFlags:
PUBLIC
PROC [ c: Cache, address: Dragon.Word]
RETURNS [ writeProtect, dirty, mapped:
BOOL ] =
BEGIN
cor: CacheObRef = NARROW[c];
page: VMPageRef ← FindVMPage[vm: cor.vm, address: address, allowNIL: TRUE];
IF page=NIL THEN RETURN[writeProtect: FALSE, dirty: FALSE, mapped: FALSE]
ELSE RETURN[writeProtect: page.writeProtect, dirty: page.dirty, mapped: TRUE];
END;
FindVMPage:
PROC [ vm: VMObRef, address: Dragon.Word, allowNIL:
BOOL ←
FALSE ]
RETURNS [ page: VMPageRef ] =
BEGIN
FOR p:
LIST
OF VMPageRef ← vm.pages, p.rest
WHILE p#
NIL
DO
IF address
IN [p.first.vAddr..p.first.vAddr+PageSize)
THEN
RETURN[p.first];
ENDLOOP;
IF
NOT allowNIL
THEN
BEGIN
vm.pages ←
CONS[
first:
NEW[VMPage ← [
vAddr: address - (address MOD PageSize),
writeProtect: FALSE,
dirty: FALSE,
data: ALL[0]]],
rest: vm.pages];
RETURN[vm.pages.first];
END;
RETURN[NIL];
END;
UnmapVMPage:
PROC [ vm: VMObRef, page: VMPageRef ] =
BEGIN
IF page=NIL OR vm.pages=NIL THEN ERROR;
IF vm.pages.first=page THEN vm.pages ← vm.pages.rest ELSE
FOR p:
LIST
OF VMPageRef ← vm.pages, p.rest
WHILE p.rest#
NIL
DO
IF page = p.rest.first THEN {p.rest ← p.rest.rest; EXIT};
ENDLOOP;
END;
RejectCycles:
PROC [ cor: CacheObRef, startCycle:
INT, busCycles:
NAT ]
RETURNS [ rej:
NAT ] =
BEGIN
IF startCycle=0 THEN startCycle ← cor.vm.firstFreeCycle;
rej ←
IF busCycles>0
THEN rej ←
MAX[cor.vm.firstFreeCycle-startCycle, 2]+busCycles
ELSE 0;
Bus acq = 2 cycles
cor.vm.firstFreeCycle ← cor.firstFreeCycle ← startCycle+rej;
END;
Parity32:
PUBLIC
PROC [ n: Dragon.Word ]
RETURNS [ odd:
BOOL ] =
{RETURN[Parity16[Basics.LowHalf[n]] # Parity16[Basics.HighHalf[n]]]};
Parity16:
PUBLIC
PROC [ m:
CARDINAL ]
RETURNS [ p:
BOOL ] =
BEGIN
q: CARDINAL = Basics.BITXOR[m, Basics.BITSHIFT[m, -8]];
r: CARDINAL = Basics.BITXOR[q, Basics.BITSHIFT[q, -4]];
s: CARDINAL = Basics.BITXOR[r, Basics.BITSHIFT[r, -2]];
t: CARDINAL = Basics.BITXOR[s, Basics.BITSHIFT[s, -1]];
RETURN [Basics.BITAND[t, 1] # 0];
END;
NewVirtualMemoryFromFile:
PUBLIC
PROC [ fileName: Rope.
ROPE ]
RETURNS [ m: VirtualMemory ] =
{m ← NewVirtualMemory[]; VirtualMemoryFromFile[m, fileName]};
NewVirtualMemory:
PUBLIC
PROC
RETURNS [ m: VirtualMemory ] =
{m ← lastVM ← NEW[VMOb ← []]};
VMFileFormat: PUBLIC ERROR = CODE;
VirtualMemoryFromFile:
PUBLIC
PROC [ m: VirtualMemory, fileName: Rope.
ROPE ] =
BEGIN
vm: VMObRef = GetVM[m];
s: IO.STREAM;
IF fileName = NIL AND (vm.initFromFile = NIL OR vm.initialized) THEN RETURN;
IF fileName # NIL THEN vm.initFromFile ← fileName;
s ← FS.StreamOpen[fileName ! FS.Error => {s ← NIL; CONTINUE}];
IF s#NIL THEN {VirtualMemoryFromStream[vm, s]; s.Close[]};
END;
VirtualMemoryFromStream:
PUBLIC
PROC [ m: VirtualMemory, s:
IO.
STREAM ] =
BEGIN
InitializeFromStream:
PROC [ s:
IO.
STREAM ] =
BEGIN
buffer: REF TEXT = RefText.ObtainScratch[512];
expName: REF TEXT ← RefText.ObtainScratch[512];
expression:
RECORD [
name: ATOM ← NIL,
hasValue: BOOL ← FALSE,
value: Dragon.Word ← 0
];
tokenKind: IO.TokenKind;
token: REF TEXT;
NextLooksLikeExpression:
PROC
RETURNS [
BOOL ] =
{RETURN[(tokenKind IN [tokenDECIMAL..tokenHEX]) OR (tokenKind = tokenSINGLE AND token[0]='-) OR (tokenKind = tokenATOM) OR (tokenKind = tokenID) OR (tokenKind = tokenEOF)]};
GetExpression:
PROC
RETURNS [ valid:
BOOL ] =
BEGIN
valid ← TRUE;
expName.length ← 0;
SELECT
TRUE
FROM
tokenKind
IN [tokenDECIMAL..tokenHEX] =>
BEGIN
expression ← [name: NIL, hasValue: TRUE, value: Convert.CardFromRope[RefText.TrustTextAsRope[token]]];
[tokenKind: tokenKind, token: token] ← IO.GetCedarToken[s, buffer, TRUE];
END;
tokenKind = tokenSINGLE
AND token[0]='- =>
BEGIN
[tokenKind: tokenKind, token: token] ← IO.GetCedarToken[s, buffer, TRUE];
valid ← GetExpression[];
IF NOT expression.hasValue THEN ERROR VMFileFormat;
TRUSTED {expression.value ← LOOPHOLE[-LOOPHOLE[expression.value, INT]]};
END;
tokenKind = tokenID
OR tokenKind = tokenATOM =>
BEGIN
atom: ATOM;
value: REF;
WHILE tokenKind = tokenID
OR tokenKind = tokenATOM
DO
expName ← RefText.Append[to: expName, from: token];
[tokenKind: tokenKind, token: token] ← IO.GetCedarToken[s, buffer, TRUE];
IF tokenKind=tokenSINGLE
AND token[0]='.
THEN
BEGIN
expName ← RefText.AppendChar[to: expName, from: '.];
[tokenKind: tokenKind, token: token] ← IO.GetCedarToken[s, buffer, TRUE];
END
ELSE EXIT;
ENDLOOP;
atom ← Convert.AtomFromRope[RefText.TrustTextAsRope[expName]];
value ← Atom.GetProp[atom: atom, prop: $DragonValue];
expression ← [name: atom, hasValue: value#NIL, value: (IF value#NIL THEN NARROW[value, REF Dragon.Word]^ ELSE 0)];
END;
ENDCASE => valid ← FALSE;
END;
[tokenKind: tokenKind, token: token] ← IO.GetCedarToken[s, buffer, TRUE];
[] ← GetExpression[];
DO
SELECT tokenKind
FROM
tokenEOF => EXIT;
tokenERROR => IF token[0] = '| THEN EXIT -- alternative EOF -- ELSE ERROR VMFileFormat;
tokenSINGLE =>
BEGIN
c: CHARACTER = token[0];
SELECT c
FROM
': =>
-- store words into word addresses
BEGIN
wordAddress: Dragon.Word;
IF NOT expression.hasValue THEN ERROR VMFileFormat;
wordAddress ← expression.value;
[tokenKind: tokenKind, token: token] ← IO.GetCedarToken[s, buffer, TRUE];
WHILE GetExpression[]
AND NextLooksLikeExpression[]
DO
page: VMPageRef = FindVMPage[vm: vm, address: wordAddress];
SELECT expression.name
FROM
$WriteProtect, $ReadOnly => page.writeProtect ← TRUE;
$Dirty => page.dirty ← TRUE;
ENDCASE =>
BEGIN
IF NOT expression.hasValue THEN ERROR VMFileFormat;
page.data[wordAddress-page.vAddr] ← expression.value;
wordAddress ← wordAddress+1;
END;
ENDLOOP;
END;
'/ =>
-- store bytes into byte addresses
BEGIN
byteAddress: Dragon.Word;
IF NOT expression.hasValue THEN ERROR VMFileFormat;
byteAddress ← expression.value;
[tokenKind: tokenKind, token: token] ← IO.GetCedarToken[s, buffer, TRUE];
WHILE GetExpression[]
AND NextLooksLikeExpression[]
DO
page: VMPageRef = FindVMPage[vm: vm, address: byteAddress/4];
SELECT expression.name
FROM
$WriteProtect => page.writeProtect ← TRUE;
$Dirty => page.dirty ← TRUE;
ENDCASE =>
BEGIN
background: Basics.LongNumber;
IF NOT expression.hasValue THEN ERROR VMFileFormat;
background.lc ← page.data[byteAddress/4-page.vAddr];
SELECT byteAddress
MOD 4
FROM
0 => background.hh ← expression.value;
1 => background.hl ← expression.value;
2 => background.lh ← expression.value;
3 => background.ll ← expression.value;
ENDCASE => ERROR;
page.data[byteAddress/4-page.vAddr] ← background.lc;
byteAddress ← byteAddress+1;
END;
ENDLOOP;
END;
'= =>
-- define a symbol
BEGIN
definee: ATOM = expression.name;
IF definee=NIL THEN ERROR VMFileFormat;
[tokenKind: tokenKind, token: token] ← IO.GetCedarToken[s, buffer, TRUE];
IF NOT GetExpression[] THEN ERROR VMFileFormat;
IF NOT expression.hasValue THEN ERROR VMFileFormat;
Atom.PutProp[atom: definee, prop: $DragonValue, val: NEW[Dragon.Word ← expression.value]];
[] ← GetExpression[];
END;
'@ =>
-- indirect to another code file
BEGIN
[tokenKind: tokenKind, token: token] ← IO.GetCedarToken[s, buffer, TRUE];
SELECT tokenKind
FROM
tokenROPE =>
BEGIN
rope: Rope.ROPE = Rope.FromRefText[token];
innerS: IO.STREAM;
innerS ← FS.StreamOpen[rope.Substr[start: 1, len: rope.Length-2] ! FS.Error => {innerS ← NIL; CONTINUE}];
IF innerS#
NIL
THEN
{InitializeFromStream[innerS]; innerS.Close[]};
[tokenKind: tokenKind, token: token] ← IO.GetCedarToken[s, buffer, TRUE];
END;
ENDCASE => ERROR VMFileFormat;
END;
ENDCASE => ERROR VMFileFormat;
END; -- of tokenSingle
ENDCASE => ERROR VMFileFormat;
ENDLOOP;
END; -- of InitializeFromStream
vm: VMObRef = GetVM[m];
vm.pages ← NIL;
vm.initialized ← TRUE;
FOR c:
LIST
OF CacheObRef ← vm.caches, c.rest
WHILE c#
NIL
DO
[] ← NewCache[c.first];
ENDLOOP;
IF s#NIL THEN InitializeFromStream[s];
END;
OutStateRep:
TYPE =
RECORD [
s: IO.STREAM,
lastAddr: Dragon.Word,
wordsThisLine: NAT
];
OutState: TYPE = REF OutStateRep;
VirtualMemoryToStream:
PUBLIC
PROC [ m: VirtualMemory, s:
IO.
STREAM ] =
BEGIN
os: OutState = NEW[OutStateRep ← [s: s, lastAddr: 0, wordsThisLine: 0]];
s.PutRope["--VM\n"];
EnumerateVirtualMemory[m, PrintWord, os];
s.PutRope["|\n"];
END;
PrintWord:
PROC [ addr, data: Dragon.Word, readOnly, dirty:
BOOL ←
FALSE, privateData:
REF ←
NIL ] =
BEGIN
os: OutState = NARROW[privateData];
IF os.wordsThisLine>=8 OR (os.wordsThisLine>0 AND (data=0 OR addr # os.lastAddr+1 OR (addr MOD 256 = 0))) THEN {os.s.PutChar['\n]; os.wordsThisLine ← 0};
IF addr
MOD 256 = 0
OR data # 0
THEN
BEGIN
IF os.wordsThisLine = 0 THEN os.s.PutF["0%xH:", IO.card[addr]];
IF addr
MOD 256 = 0
THEN
BEGIN
IF readOnly THEN os.s.PutRope[" $WriteProtect"];
IF dirty THEN os.s.PutRope[" $Dirty"];
END;
os.s.PutF[" 0%xH", IO.card[data]];
os.wordsThisLine ← os.wordsThisLine+1;
os.lastAddr ← addr;
END;
END;
EnumerateVirtualMemory:
PUBLIC
PROC [ m: VirtualMemory, wdProc:
PROC [ addr, data: Dragon.Word, readOnly, dirty:
BOOL ←
FALSE, privateData:
REF ←
NIL ], privateData:
REF ←
NIL ] =
BEGIN
vm: VMObRef = GetVM[m];
FOR p:
LIST
OF VMPageRef ← vm.pages, p.rest
WHILE p#
NIL
DO
FOR i:
NAT
IN [0..PageSize)
DO
wdProc[addr: p.first.vAddr+i, data: p.first.data[i], privateData: privateData];
ENDLOOP;
ENDLOOP;
END;
cacheHandler: Cucumber.Handler =
NEW[Cucumber.HandlerRep ← [
PartTransfer: RdWriteCacheVM,
PrepareWhole: JustDoVMField,
data: NIL
]];
JustDoVMField:
PROC [ whole:
REF
ANY, where:
IO.
STREAM, direction: Cucumber.Direction, data:
REF
ANY ]
RETURNS [ leaveTheseToMe: Cucumber.SelectorList ←
NIL ]
-- Cucumber.Bracket -- =
{leaveTheseToMe ← LIST[$vm] -- also sends $lines, because it's not too smart -- };
RdWriteCacheVM:
PROC [ whole:
REF
ANY, part: Cucumber.Path, where:
IO.
STREAM, direction: Cucumber.Direction, data:
REF
ANY ]
-- Cucumber.PartTransferProc -- =
BEGIN
cob: CacheObRef = NARROW[whole];
IF cob.vm.caches.first = cob
AND part.first = $vm
THEN
TRUSTED {Cucumber.Transfer[ what: cob.vm, where: where, direction: direction ]};
END;
vmHandler: Cucumber.Handler =
NEW[Cucumber.HandlerRep ← [
PartTransfer: RdWriteVMPages,
PrepareWhole: JustDoCachesAndPagesFields,
data: NIL
]];
JustDoCachesAndPagesFields:
PROC [ whole:
REF
ANY, where:
IO.
STREAM, direction: Cucumber.Direction, data:
REF
ANY ]
RETURNS [ leaveTheseToMe: Cucumber.SelectorList ←
NIL ]
-- Cucumber.Bracket -- =
{leaveTheseToMe ← LIST[$caches, $pages]};
RdWriteVMPages:
PROC [ whole:
REF
ANY, part: Cucumber.Path, where:
IO.
STREAM, direction: Cucumber.Direction, data:
REF
ANY ]
-- Cucumber.PartTransferProc -- =
BEGIN
vm: VMObRef = NARROW[whole];
SELECT part.first
FROM
$pages =>
SELECT direction
FROM
out => VirtualMemoryToStream[vm, where];
in =>
BEGIN
vm.pages ← NIL;
VirtualMemoryFromStream[vm, where];
END;
ENDCASE => ERROR;
ENDCASE => NULL;
END;
RegisterWithCucumber:
PROC =
BEGIN
Cucumber.Register[handler: cacheHandler, type: CODE[CacheOb]];
Cucumber.Register[handler: vmHandler, type: CODE[VMOb]];
END;
lastCache: PUBLIC Cache ← NIL;
defaultVM, lastVM: PUBLIC VirtualMemory ← NIL;
RegisterWithCucumber[];
END.