CacheOpsImpl:
CEDAR
PROGRAM
IMPORTS Atom, Basics, FileNames,
IO, Rope, QuadIO
EXPORTS CacheOps =
BEGIN OPEN CacheOps;
VMPageRef: TYPE = REF VMPage;
VMPage:
TYPE =
RECORD [
vAddr: Dragon.Word,
memAccessProtect, dirty: BOOL,
data: ARRAY [0..PageSize) OF Dragon.Word
];
VMObRef: TYPE = REF VMOb;
VMOb:
TYPE =
RECORD [
firstFreeCycle: INT ← 0,
caches: LIST OF CacheObRef ← NIL,
pages: LIST OF VMPageRef ← NIL
];
CacheObRef: TYPE = REF CacheOb;
CacheOb:
TYPE =
RECORD [
vm: VMObRef ← NIL,
accesses, writes, misses, pageMisses, dirtyVictimWrites, mapFaults: INT ← 0,
victim: NAT ← 0,
lastLineTransportAddress: Dragon.Word ← 0,
firstCycleAfterLastLineTransport: INT ← 0,
firstFreeCycle: INT ← 0,
lines: SEQUENCE nLines: NAT OF CacheLine
];
CacheLine:
TYPE =
RECORD [
addr: Dragon.Word ← 0,
dirty, sharedMaster, valid: BOOL ← FALSE
];
defaultFile: Rope.ROPE ← "CacheDefault.quad";
GetVM:
PROC [ mem:
REF
ANY ←
NIL ]
RETURNS [ vm: VMObRef ] =
BEGIN
vmra: REF ANY;
IF defaultVM =
NIL
THEN
BEGIN
fullFileName: Rope.
ROPE ← FileNames.FileWithSearchRules
[defaultFile, NIL, FALSE, TRUE, NIL].fullPath;
defaultVM ← NewVirtualMemory[];
VirtualMemoryFromFile[defaultVM, fullFileName];
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;
cor.accesses ← cor.writes ← cor.misses ← cor.pageMisses ← cor.dirtyVictimWrites ← cor.mapFaults ← 0;
cor.firstCycleAfterLastLineTransport ← cor.firstFreeCycle ← 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;
TransportOrderAdvance:
PROC [first, next: [0..WordsPerLine)]
RETURNS [advance: [0..WordsPerLine]] =
BEGIN
advance ← (
SELECT first
FROM
0 => (
SELECT next
FROM
0 => 3, 1=> 2, 2=> 1, 3 => 0, ENDCASE => ERROR),
1 => (
SELECT next
FROM
0 => 2, 1=> 3, 2=> 0, 3 => 1, ENDCASE => ERROR),
2 => (
SELECT next
FROM
0 => 1, 1=> 0, 2=> 3, 3 => 2, ENDCASE => ERROR),
3 => (
SELECT next
FROM
0 => 0, 1=> 1, 2=> 2, 3 => 3, ENDCASE => ERROR),
ENDCASE => ERROR);
END;
Access:
PUBLIC
PROC [ c: Cache, address: Dragon.Word, purpose: AccessPurpose ← read, cycleNow:
INT ← 0 ]
RETURNS [ data: Dragon.Word, rejectCycles:
NAT, mapFault, memAccessProtect:
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.lastLineTransportAddress/WordsPerLine) = (address/WordsPerLine)
AND cor.firstCycleAfterLastLineTransport > cycleNow
AND cycleNow > 0
THEN
-- this line's transport may not yet be finished -- MAX[cor.firstCycleAfterLastLineTransport-TransportOrderAdvance[address MOD WordsPerLine, cor.lastLineTransportAddress MOD WordsPerLine]-cycleNow, 0] ELSE 0;
EXIT;
END;
REPEAT
FINISHED =>
-- not a cache hit, will result in MBus operation
BEGIN
addrPage: Dragon.Word = address - (address MOD PageSize);
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 cor.lines[line].addr-addrPage 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.mapFaults ← cor.mapFaults+1;
RETURN[data: 0, rejectCycles: RejectCycles[cor, cycleNow, cycles-3 -- just dirty victim write (if any) followed by mapping -- ], mapFault: TRUE, memAccessProtect: FALSE];
END;
END;
ENDLOOP;
cycles ← RejectCycles[cor, cycleNow, cycles+3]-3;
.. allows additional 3 cycles for remaining 3 words of quadword
cor.lastLineTransportAddress ← address;
cor.firstCycleAfterLastLineTransport ← cor.firstFreeCycle;
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, mapFault: FALSE, memAccessProtect: page.memAccessProtect];
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;
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, memAccessProtect, dirty, mapped:
BOOL ] =
BEGIN
cor: CacheObRef = NARROW[c];
page: VMPageRef ← FindVMPage[vm: cor.vm, address: address, allowNIL: NOT mapped];
SELECT
TRUE
FROM
mapped =>
BEGIN
page.memAccessProtect ← memAccessProtect;
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, memAccessProtect, dirty, mapped:
BOOL ] =
BEGIN
FOR addr: Dragon.Word ← startAddress, addr+PageSize
WHILE addr<=endAddress
DO
SetFlags[c, addr, memAccessProtect, dirty, mapped];
ENDLOOP;
END;
GetFlags:
PUBLIC
PROC [ c: Cache, address: Dragon.Word]
RETURNS [ memAccessProtect, dirty, mapped:
BOOL ] =
BEGIN
cor: CacheObRef = NARROW[c];
page: VMPageRef ← FindVMPage[vm: cor.vm, address: address, allowNIL: TRUE];
IF page=NIL THEN RETURN[memAccessProtect: FALSE, dirty: FALSE, mapped: FALSE]
ELSE RETURN[memAccessProtect: page.memAccessProtect, 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),
memAccessProtect: 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 ← NIL;
s ← FS.StreamOpen[fileName ! FS.Error =>
{IF error.group = user THEN {Signal[error.explanation]; CONTINUE }}];
VirtualMemoryFromStream[vm, s];
IF s#NIL THEN s.Close[];
END;
VirtualMemoryFromFile:
PUBLIC
PROC [ m: VirtualMemory, fileName: Rope.
ROPE ] =
BEGIN
vm: VMObRef = GetVM[m];
mem: QuadIO.Memory ← QuadIO.ReadFile[fileName];
vm.pages ← NIL;
vm.firstFreeCycle ← 0;
FOR i:
CARD
IN [0..mem.wds.size)
DO
memWord: QuadIO.MemWord ← mem.wds^[i];
page: VMPageRef = FindVMPage[vm: vm, address: memWord.add/4];
page.data[(memWord.add/4)-page.vAddr] ← memWord.data;
ENDLOOP;
FOR c:
LIST
OF CacheObRef ← vm.caches, c.rest
WHILE c#
NIL
DO
[] ← NewCache[c.first] ENDLOOP;
END;
Signal:
SIGNAL[msg: Rope.
ROPE] =
CODE;
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 => ERROR VMFileFormat;
tokenSINGLE =>
BEGIN
c: CHARACTER = token[0];
SELECT c FROM
'| => EXIT; -- alternative EOF
': => -- 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
$MemAccessProtect, $ReadOnly => page.memAccessProtect ← 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
$MemAccessProtect => page.memAccessProtect ← 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 => NULL; -- ERROR VMFileFormat;
ENDLOOP;
END; -- of InitializeFromStream
vm: VMObRef = GetVM[m];
vm.pages ← NIL;
vm.firstFreeCycle ← 0;
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[" $MemAccessProtect"];
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;
lastCache: PUBLIC Cache ← NIL;
defaultVM, lastVM: PUBLIC VirtualMemory ← NIL;
END.