
<<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>>
<<>>
    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] };
    <<VM Allocation>>
        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 ] ~ {
            };
    <<Map Description>>
    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 [
            <<fword low>>
                realPageHiLo: [0..3H], -- 2 bits
                trash: BOOL,
                realPageLo: [0..1FFFH], -- 13 bits
            <<fword high>>
                flags: Flags,
                nonCachable: BOOL,
                interrupt: BOOL,
                task: BYTE,
                <<realPageHi: [0..1FH], -- 5 bits, crosses byte & word boundary>>
                realPageHiHi: [0..7H] -- 3 bits
            ];

        <<located at real address: SparcSoftcard.mapWindowBaseWord16!>>
        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
            ];
    <<Map Abstraction>>
        currentMapWindow: NAT _ 0FFH; -- not a valid value
        SetMapWindow: INTERNAL PROC [ index: NAT ] ~ {
            <<IF ( index >= nMapRawWindows ) THEN ERROR;>>
            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];
            };
    <<Real Memory Management>>
        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 ] ~ {
            <<I'm willing to assert that the (linear) cost is reasonable for this situation!>>
            runTail: CARD32 ~ interval.firstPage + interval.pages;
            SELECT TRUE FROM
                ( runTail = rmFreeList.firstPage ) => {
                    <<rmFreeList.nextRunTail _ rmFreeList.nextRunTail; -- not altered!>>
                    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.nextRunTail _ prev.nextRunTail; -- not altered!>>
                            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[];
        }.