DIRECTORY
Basics USING [ HighHalf, HWORD, LongNumber, LowHalf ],
DoveInputOutput USING [ Peek, Poke ],
SparcSoftcard USING [ cPMapWindowIndex, iOPMapWindowIndex, mapEntryHighWord16Offset, mapEntryLowWord16Offset, mapWindowIndexRegisterWord16, mapWindowBaseWord16 ],
SparcSoftcardVM USING [ Flags, Interval, RealInterval, RMFreeList, SegmentType, SparcPageValue ];

SparcSoftcardVMImpl: CEDAR MONITOR
IMPORTS Basics, DoveInputOutput
EXPORTS SparcSoftcardVM ~ {
OPEN SparcSoftcardVM, SparcSoftcard;

MyPeek: PROC [ address: CARD32 ] RETURNS [ word: CARD16 ] ~
INLINE { word _ DoveInputOutput.Peek[address] };
MyPoke: PROC [ address: CARD32, word: CARD16 ] ~
INLINE { DoveInputOutput.Poke[address, word] };
SimpleAllocate: PUBLIC PROC [ count: CARD32 ] RETURNS [ interval: Interval ] ~ {
interval _ [0, 0];
};

Free: PUBLIC PROC [ interval: Interval ] ~ {
};

Pin: PUBLIC PROC [ interval: Interval ] ~ {
};

Unpin: PUBLIC PROC [ interval: Interval ] ~ {
};
nMapRawWindows: CARD16 ~ 32; -- SegmentType X nMapSegmentWindows
nMapSegmentWindows: CARD16 ~ 4;
nMapWindowEntries: CARD16 ~ 800H; -- 8k byte pages / BYTES[MapEntryConcrete]

Map: TYPE ~ ARRAY SegmentType OF MapSegment;
MapSegment: TYPE ~ ARRAY [0..nMapSegmentWindows) OF MapWindow;
MapWindow: TYPE ~ ARRAY [0..nMapWindowEntries) OF MapEntryConcrete;
PiecesForRealPage: PUBLIC PROC [ realPage: CARD32 ]
RETURNS [ realPageHiHi, realPageHiLo, realPageLo: CARD16 ] ~ {
BITS2: CARD16 ~ 4;
BITS3: CARD16 ~ 8;
BITS13: CARD16 ~ 2000H;
realPageHi: CARD16;
realPageHi _ realPage / BITS13;
realPageLo _ realPage MOD BITS13;
realPageHiHi _ realPageHi / BITS2;
realPageHiLo _ realPageHi MOD BITS2;
IF ( realPageHiHi >= BITS3 ) THEN ERROR;
};

RealPageFromPieces: PUBLIC PROC [ realPageHiHi, realPageHiLo, realPageLo: CARD16 ]
RETURNS [ realPage: CARD32 ] ~ {
realPage _ ( ( ( realPageHiHi * 4 ) + realPageHiLo ) * 2000H ) + realPageLo;
};

PiecesForVirtualPage: PUBLIC PROC [ virtualPage: CARD32 ]
RETURNS [ mapSegment: CARD16, mapWindow: CARD16, mapOffset: CARD16 ] ~ {
mapWindow _ virtualPage / nMapWindowEntries;
mapOffset _ virtualPage MOD nMapWindowEntries;
mapSegment _ mapWindow / nMapSegmentWindows;
IF ( mapWindow >= nMapRawWindows ) THEN ERROR;
};

MapEntryConcrete: TYPE ~ MACHINE DEPENDENT RECORD [
realPageHiLo: [0..3H], -- 2 bits
trash: BOOL,
realPageLo: [0..1FFFH], -- 13 bits
flags: Flags,
nonCachable: BOOL,
interrupt: BOOL,
task: BYTE,
realPageHiHi: [0..7H] -- 3 bits
];

FunnyMapWindow: TYPE ~ ARRAY [0..nMapWindowEntries) OF FunnyMapEntry;
FunnyMapEntry: TYPE ~ MACHINE DEPENDENT RECORD [
trash0(0): Basics.HWORD,
trash1(1): Basics.HWORD,
trash2(2): Basics.HWORD,
high(mapEntryHighWord16Offset): CARD16,
trash4(4): Basics.HWORD,
trash5(5): Basics.HWORD,
trash6(6): Basics.HWORD,
low(mapEntryLowWord16Offset): CARD16
];
currentMapWindow: NAT _ 0FFH; -- not a valid value
SetMapWindow: INTERNAL PROC [ index: NAT ] ~ {
IF ( index = currentMapWindow ) THEN RETURN;
currentMapWindow _ index;
MyPoke[mapWindowIndexRegisterWord16, currentMapWindow];
};

GetMapWindow: PUBLIC PROC RETURNS [ index: NAT ] ~ {
index _ currentMapWindow;
};

mapPointer: LONG POINTER TO FunnyMapWindow ~ LOOPHOLE[SparcSoftcard.mapWindowBaseWord16];

SetMap: PUBLIC ENTRY PROC [ mapWindow, mapOffset: CARD16, realPageHiHi, realPageHiLo, realPageLo: CARD32, value: SparcPageValue ] ~ {
ENABLE { UNWIND => NULL };
SetMapWindow[mapWindow];
TRUSTED {
concrete: MapEntryConcrete _ [realPageHiLo, FALSE, realPageLo, value.flags, value.nonCachable, value.interrupt, value.task, realPageHiHi];
high: CARD32 ~ LOOPHOLE[@mapPointer[mapOffset].high];
low: CARD32 ~ LOOPHOLE[@mapPointer[mapOffset].low];
MyPoke[high, Basics.HighHalf[LOOPHOLE[concrete]]];
MyPoke[low, Basics.LowHalf[LOOPHOLE[concrete]]];
};
};

GetMap: PUBLIC ENTRY PROC [ mapWindow, mapOffset: CARD16 ]
RETURNS [ value: SparcPageValue ] ~ {
ENABLE { UNWIND => NULL };
SetMapWindow[mapWindow];
TRUSTED {
high: CARD32 ~ LOOPHOLE[@mapPointer[mapOffset].high];
low: CARD32 ~ LOOPHOLE[@mapPointer[mapOffset].low];
concrete: MapEntryConcrete;
raw: Basics.LongNumber;
realPage: CARD32;
raw.hi _ MyPeek[high];
raw.lo _ MyPeek[low];
concrete _ LOOPHOLE[raw];
realPage _ RealPageFromPieces[concrete.realPageHiHi, concrete.realPageHiLo, concrete.realPageLo];
value _ [concrete.flags, concrete.nonCachable, concrete.interrupt, concrete.task, realPage];
};
};

SetRawPageValue: PUBLIC PROC [ virtualPage: CARD32, value: SparcPageValue ] ~ {
mapSegment: CARD16; mapWindow: CARD16; mapOffset: CARD16;
realPageHiHi: CARD16; realPageHiLo: CARD16; realPageLo: CARD16;
[ mapSegment, mapWindow, mapOffset ] _ PiecesForVirtualPage[virtualPage];
[ realPageHiHi, realPageHiLo, realPageLo ] _ PiecesForRealPage[value.realPage];
SetMap[mapWindow, mapOffset, realPageHiHi, realPageHiLo, realPageLo, value];
};

GetRawPageValue: PUBLIC PROC [ virtualPage: CARD32 ]
RETURNS [ value: SparcPageValue ] ~ {
mapSegment: CARD16; mapWindow: CARD16; mapOffset: CARD16;
[ mapSegment, mapWindow, mapOffset ] _ PiecesForVirtualPage[virtualPage];
value _ GetMap[mapWindow, mapOffset];
};

SetPageValue: PUBLIC PROC [ segment: SegmentType, virtualPage: CARD32,
value: SparcPageValue ] ~ {
mapSegment: CARD16; mapWindow: CARD16; mapOffset: CARD16;
realPageHiHi: CARD16; realPageHiLo: CARD16; realPageLo: CARD16;
[ mapSegment, mapWindow, mapOffset ] _ PiecesForVirtualPage[virtualPage];
SELECT TRUE FROM
( mapSegment = 0 ) =>
{ mapWindow _ ( segment.ORD *  nMapSegmentWindows ) + mapWindow };
( mapSegment = segment.ORD ) => { NULL };
ENDCASE => { ERROR };
[ realPageHiHi, realPageHiLo, realPageLo ] _ PiecesForRealPage[value.realPage];
SetMap[mapWindow, mapOffset, realPageHiHi, realPageHiLo, realPageLo, value];
};

GetPageValue: PUBLIC PROC [ segment: SegmentType, virtualPage: CARD32]
RETURNS [ value: SparcPageValue ] ~ {
mapSegment: CARD16; mapWindow: CARD16; mapOffset: CARD16;
[ mapSegment, mapWindow, mapOffset ] _ PiecesForVirtualPage[virtualPage];
SELECT TRUE FROM
( mapSegment = 0 ) =>
{ mapWindow _ ( segment.ORD *  nMapSegmentWindows ) + mapWindow };
( mapSegment = segment.ORD ) => { NULL };
ENDCASE => { ERROR };
value _ GetMap[mapWindow, mapOffset];
};

cpEntryOffset: CARD32 ~ ( cPMapWindowIndex - iOPMapWindowIndex ) * nMapWindowEntries;

SetCPPageValue: PUBLIC PROC [ virtualPage: CARD32, value: SparcPageValue ] ~ {
SELECT TRUE FROM
( virtualPage < 0C0H ) => { ERROR }; -- 192 * 8k bytes = 1.5MB of cp space
( virtualPage < 1C0H ) => { ERROR }; -- 448 * 8k bytes = 3.5MB of cp space
( virtualPage < 1E0H ) => { ERROR }; -- 480 * 8k bytes = 3.75MB { io region }
( virtualPage >= 200H ) => { ERROR }; -- 512 * 8k bytes of address space
ENDCASE => { NULL };
SetPageValue[$specialIO, virtualPage + cpEntryOffset, value];
};

GetCPPageValue: PUBLIC PROC [ virtualPage: CARD32 ]
RETURNS [ value: SparcPageValue ] ~ {
IF ( virtualPage >= 200H ) THEN ERROR; -- 512 * 8k bytes of address space
value _ GetPageValue[$specialIO, virtualPage + cpEntryOffset];
};
rmFreeList: RMFreeList _ [0, 0, 0];

AllocateRealMemory: PUBLIC PROC [ count: CARD32 ]
RETURNS [ interval: RealInterval ] ~ {
interval.firstPage _ rmFreeList.firstPage;
SELECT TRUE FROM
( count < rmFreeList.runCount ) => {
interval.pages _ count;
rmFreeList.runCount _ rmFreeList.runCount - count;
rmFreeList.firstPage _ rmFreeList.firstPage + count;
};
( rmFreeList.runCount = 0 ) => { ERROR };
ENDCASE => {
interval.pages _ rmFreeList.runCount;
rmFreeList _ ChaseRMFreeList[rmFreeList.nextRunTail];
};
};

ReclaimRealMemory: PUBLIC PROC [ interval: RealInterval ] ~ {
runTail: CARD32 ~ interval.firstPage + interval.pages;
SELECT TRUE FROM
( runTail = rmFreeList.firstPage ) => {
rmFreeList.firstPage _ interval.firstPage;
rmFreeList.runCount _ rmFreeList.runCount + interval.pages;
};
( runTail < rmFreeList.firstPage ) => {
FlushRMFreeList[rmFreeList]; -- commit "rmFreeList" to inaccessible memory
rmFreeList.nextRunTail _ rmFreeList.firstPage + rmFreeList.runCount;
rmFreeList.firstPage _ interval.firstPage;
rmFreeList.runCount _ interval.pages;
};
( rmFreeList.runCount = 0 ) => {
rmFreeList _ [interval.firstPage, interval.pages, 0];
};
( runTail > rmFreeList.firstPage ) => {
prev: RMFreeList;
FOR item: RMFreeList _ ChaseRMFreeList[rmFreeList.nextRunTail], ChaseRMFreeList[item.nextRunTail] WHILE ( runTail > item.firstPage ) DO
prev _ item;
IF ( item.nextRunTail = 0 ) THEN EXIT;
ENDLOOP;
SELECT TRUE FROM
( runTail = prev.firstPage ) => {
prev.firstPage _ interval.firstPage;
prev.runCount _ prev.runCount + interval.pages;
FlushRMFreeList[prev]; -- commit "prev" to inaccessible memory
};
( runTail < prev.firstPage ) => {
FlushRMFreeList[prev]; -- commit "prev" to inaccessible memory
prev.nextRunTail _ prev.firstPage + prev.runCount;
prev.firstPage _ interval.firstPage;
prev.runCount _ interval.pages;
};
( prev.nextRunTail = 0 ) => {
new: RMFreeList _ [interval.firstPage, interval.pages, 0];
FlushRMFreeList[new]; -- commit "new" to inaccessible memory
prev.nextRunTail _ runTail;
};
ENDCASE => { ERROR };
};
ENDCASE => { ERROR };
};

FlushRMFreeList: PUBLIC PROC [ rm: RMFreeList ] ~ {
IF ( rm.nextRunTail = 0 ) THEN RETURN;
};

ChaseRMFreeList: PUBLIC PROC [ runTail: CARD32 ] RETURNS [ rm: RMFreeList ] ~ {
rm _ [0, 0, 0];
};

cpReal: RealInterval; -- pages: [0..2MB)

InitSparcRM: PUBLIC PROC ~ {
allMemory: RealInterval ~ [0, 1024]; -- currently available real memory
ReclaimRealMemory[allMemory];
cpReal _ AllocateRealMemory[256]; -- pre-allocated by daybreak germ
};

InitSparcRM[];
}.

„SparcSoftcardVMImpl.Mesa
Copyright Σ 1988 by Xerox Corporation.  All rights reserved.
Christophe Cuenod September 1, 1988 4:02:08 pm PDT
Bill Jackson (bj) July 5, 1988 2:01:27 pm PDT

VM Allocation
Map Description

fword low
fword high
realPageHi: [0..1FH], -- 5 bits, crosses byte & word boundary
located at real address: SparcSoftcard.mapWindowBaseWord16!
Map Abstraction
IF ( index >= nMapRawWindows ) THEN ERROR;
Real Memory Management
I'm willing to assert that the (linear) cost is reasonable for this situation!
rmFreeList.nextRunTail _ rmFreeList.nextRunTail; -- not altered!
prev.nextRunTail _ prev.nextRunTail; -- not altered!
Κ.˜–

"Cedar" styleš
œ™Icode–

"Cedar" style™<Jš
œ2™2Kš
œ-™-J™—š
Οk	˜	Kšœœ
œ˜6Kšœœ˜%Kšœœ
˜’
KšœœL˜aK˜—šΟnœœ
˜"Kšœ˜Kšœ˜Kšœ ˜$K–

"cedar" style˜Kšžœœœœ	œœ*˜lKš
žœœœœœ)˜`
headš
Οz
™
š
žœœ
œ
œœ˜PKš
œ˜Kš
œ˜K˜—šžœœ
œ˜,Kš
œ˜K˜—šžœœ
œ˜+Kš
œ˜K˜—šžœœ
œ˜-Kš
œ˜——š
Ÿ™JšœœΟc#˜@Jšœœ˜Jšœœ	 *˜LJ˜Jšœœœ
œ˜,Jšœœœœ˜>Jšœœœœ˜CJ™š
žœœ
œœ+œ˜rJšœœ˜Jšœœ˜Jšœœ	˜Jšœœ
˜Jšœœ
˜Jšœœ
œ
˜!Jšœœ
˜"Jšœœ
œ
˜$Jšœœœ
œ
˜(Jš
œ˜J˜—š
žœœ+œœ
œ˜sJš
œL˜LJš
œ˜J˜—šžœœœœœ
œ
œ˜‚
Jš
œ,˜,Jšœœ˜.Jš
œ,˜,Jšœ!œ
œ
˜.Jš
œ˜J˜—š	œœœ
	œ
œ˜3š
œ	™	Kšœ 	˜ Kšœœ
˜Kšœ 
˜"—š
œ
™
Kš
œ
˜
Kšœ
œ
˜Kšœœ
˜Kšœœ
˜Kšœ '™=Kšœ 	˜—Kš
œ˜K˜—Kš
œ;™;Kšœœœœ˜Eš	œœœ
	œ
œ˜0Kšœœ
˜Kšœœ
˜Kšœœ
˜Kšœ œ
˜'Kšœœ
˜Kšœœ
˜Kšœœ
˜Kšœ˜$Kš
œ˜——š
Ÿ™Kšœœ	 ˜2šžœœ
œ
œ˜.Kšœœ
œ
™*Kšœœ
œ
˜,Kš
œ˜Kš
œ7˜7Kš
œ˜K˜—šžœœ
œ
œ˜4Kš
œ˜Kš
œ˜K˜—Kš	œœ
œ
œœ$˜YK˜š
žœœ
œœ(œ˜…
Kšœœœ˜Kš
œ˜šœ˜	Kšœ,œY˜Š
Kšœœœ˜5Kšœœœ˜3Kšœœ
˜2Kšœœ
˜0Kš
œ˜—K˜K˜—š
žœœ
œœ
œ˜`Kšœœœ˜Kš
œ˜šœ˜	Kšœœœ˜5Kšœœœ˜3Kš
œ˜Kš
œ˜Kšœ
œ
˜Kš
œ˜Kš
œ˜Kšœœ˜Kš
œa˜aKš
œ\˜\Kš
œ˜—K˜K˜—šžœœœ˜OKšœœ
œ
œ
˜9Kšœœœœ
˜?Kš
œI˜IKš
œO˜OKš
œL˜LK˜K˜—šžœœœœ˜ZKšœœ
œ
œ
˜9Kš
œI˜IKš
œ%˜%K˜K˜—šžœœ&œ˜bKšœœ
œ
œ
˜9Kšœœœœ
˜?Kš
œI˜Išœ
œ
˜Kšœ.œ'˜XKšœœœ˜)Kšœœ˜—Kš
œO˜OKš
œL˜LK˜K˜—šžœœ&œ
œ˜lKšœœ
œ
œ
˜9Kš
œI˜Išœ
œ
˜Kšœ.œ'˜XKšœœœ˜)Kšœœ˜—Kš
œ%˜%K˜K˜—KšΟb
œœ@˜UK˜šžœœ
œœ˜Nšœ
œ
˜Kšœœ %˜JKšœœ %˜JKšœœ (˜MKšœœ "˜HKšœœ˜—Kšœ'‘
œ	˜=Kš
œ˜K˜—šžœœœœ˜YKšœœ
œ "˜IKšœ/‘
œ˜>Kš
œ˜——š
Ÿ™Kš
œ#˜#K˜šžœœ
œœ˜XKš
œ*˜*šœ
œ
˜š
œ$˜$Kš
œ˜Kš
œ2˜2Kš
œ4˜4Kš
œ˜—Kšœ!œ˜)šœ˜Kš
œ%˜%Kš
œ5˜5Kš
œ˜——Kš
œ˜K˜—šžœœ˜=K™NKšœ	œ'˜6šœ
œ
˜š
œ'˜'Kšœ1 ™@Kš
œ*˜*Kš
œ;˜;Kš
œ˜—š
œ'˜'Kšœ -˜JKš
œD˜DKš
œ*˜*Kš
œ%˜%Kš
œ˜—š
œ ˜ Kš
œ5˜5Kš
œ˜—š
œ'˜'Kš
œ˜šœ_œ˜‡
Kš
œ˜Kšœœ
œ
˜&Kšœ
˜—šœ
œ
˜š
œ!˜!Kšœ% ™4Kš
œ$˜$Kš
œ/˜/Kšœ '˜>Kš
œ˜—š
œ!˜!Kšœ '˜>Kš
œ2˜2Kš
œ$˜$Kš
œ˜Kš
œ˜—š
œ˜Kš
œ:˜:Kšœ &˜<Kš
œ˜Kš
œ˜—Kšœœ˜—Kš
œ˜—Kšœœ˜—K˜K˜—šžœœ˜3Kšœœ
œ
˜&Kš
œ˜K˜—šžœœœœ˜OKš
œ˜Kš
œ˜K˜—Kšœ ˜(K˜šžœœ˜Kšœ% "˜GKš
œ˜Kšœ" !˜CKš
œ˜K˜——Kš
œ˜Kš
œ˜J˜——…—$Ϊ2Œ