aarch64 haskell: implement lookupFrame
This is a bit speculative since the C is not there yet, but I think it's a good candidate, esp turning the VMPageSize parameters into Int, because that will save the C from converting it back and forth. Signed-off-by: Gerwin Klein <gerwin.klein@proofcraft.systems>
This commit is contained in:
parent
06acbdb742
commit
33f060e249
|
@ -129,9 +129,17 @@ isPageTablePTE :: PTE -> Bool
|
||||||
isPageTablePTE (PageTablePTE {}) = True
|
isPageTablePTE (PageTablePTE {}) = True
|
||||||
isPageTablePTE _ = False
|
isPageTablePTE _ = False
|
||||||
|
|
||||||
|
isPagePTE :: PTE -> Bool
|
||||||
|
isPagePTE (PagePTE {}) = True
|
||||||
|
isPagePTE _ = False
|
||||||
|
|
||||||
|
-- FIXME AARCH64: replace name with whatever ppns will be called
|
||||||
-- only used on non-toplevel tables
|
-- only used on non-toplevel tables
|
||||||
|
pteAddr :: PTE -> PAddr
|
||||||
|
pteAddr pte = ptePPN pte `shiftL` ptBits False
|
||||||
|
|
||||||
getPPtrFromHWPTE :: PTE -> PPtr PTE
|
getPPtrFromHWPTE :: PTE -> PPtr PTE
|
||||||
getPPtrFromHWPTE pte = ptrFromPAddr (ptePPN pte `shiftL` ptBits False)
|
getPPtrFromHWPTE pte = ptrFromPAddr $ pteAddr pte
|
||||||
|
|
||||||
-- how many bits there are left to be translated at a given level (0 = bottom
|
-- how many bits there are left to be translated at a given level (0 = bottom
|
||||||
-- level). This counts the bits the levels below the current one translate, so
|
-- level). This counts the bits the levels below the current one translate, so
|
||||||
|
@ -178,8 +186,15 @@ lookupPTSlotFromLevel level ptPtr vPtr = do
|
||||||
lookupPTSlot :: PPtr PTE -> VPtr -> Kernel (Int, PPtr PTE)
|
lookupPTSlot :: PPtr PTE -> VPtr -> Kernel (Int, PPtr PTE)
|
||||||
lookupPTSlot = lookupPTSlotFromLevel maxPTLevel
|
lookupPTSlot = lookupPTSlotFromLevel maxPTLevel
|
||||||
|
|
||||||
lookupFrame :: PPtr PTE -> VPtr -> Kernel (Maybe (VMPageSize, PAddr))
|
lookupFrame :: PPtr PTE -> VPtr -> Kernel (Maybe (Int, PAddr))
|
||||||
lookupFrame _ _ = error "FIXME AARCH64: TODO"
|
lookupFrame vspaceRoot vPtr = do
|
||||||
|
(bitsLeft, ptePtr) <- lookupPTSlot vspaceRoot vPtr
|
||||||
|
pte <- getObject ptePtr
|
||||||
|
if isPagePTE pte
|
||||||
|
then return $ Just (bitsLeft, pteAddr pte)
|
||||||
|
else return Nothing
|
||||||
|
|
||||||
|
{- Page Table Modification -}
|
||||||
|
|
||||||
{- Handling Faults -}
|
{- Handling Faults -}
|
||||||
|
|
||||||
|
@ -499,11 +514,11 @@ labelToFlushType label = case invocationType label of
|
||||||
ArchInvocationLabel ARMPageUnify_Instruction -> Unify
|
ArchInvocationLabel ARMPageUnify_Instruction -> Unify
|
||||||
_ -> error "Should never be called without a flush invocation"
|
_ -> error "Should never be called without a flush invocation"
|
||||||
|
|
||||||
pageBase :: (Num a, Bits a) => a -> VMPageSize -> a
|
pageBase :: (Num a, Bits a) => a -> Int -> a
|
||||||
pageBase vaddr size = vaddr .&. (complement $ mask (pageBitsForSize size))
|
pageBase vaddr size = vaddr .&. (complement $ mask size)
|
||||||
|
|
||||||
-- proof assertion only
|
-- proof assertion only
|
||||||
checkValidMappingSize :: VMPageSize -> Kernel ()
|
checkValidMappingSize :: Int -> Kernel ()
|
||||||
checkValidMappingSize _ = return ()
|
checkValidMappingSize _ = return ()
|
||||||
|
|
||||||
decodeRISCVFrameInvocationMap :: PPtr CTE -> ArchCapability -> VPtr -> Word ->
|
decodeRISCVFrameInvocationMap :: PPtr CTE -> ArchCapability -> VPtr -> Word ->
|
||||||
|
@ -639,8 +654,8 @@ decodeVSpaceRootInvocation label args cap@(PageTableCap { capPTTopLevel = True }
|
||||||
let baseEnd = pageBase (VPtr end - 1) (fst frameInfo)
|
let baseEnd = pageBase (VPtr end - 1) (fst frameInfo)
|
||||||
when (baseStart /= baseEnd) $
|
when (baseStart /= baseEnd) $
|
||||||
throw $ RangeError start $ fromVPtr $ baseStart +
|
throw $ RangeError start $ fromVPtr $ baseStart +
|
||||||
mask (pageBitsForSize (fst frameInfo))
|
mask (fst frameInfo)
|
||||||
let offset = start .&. mask (pageBitsForSize (fst frameInfo))
|
let offset = start .&. mask (fst frameInfo)
|
||||||
let pStart = snd frameInfo + toPAddr offset
|
let pStart = snd frameInfo + toPAddr offset
|
||||||
return $ InvokeVSpaceRoot $ VSpaceRootFlush {
|
return $ InvokeVSpaceRoot $ VSpaceRootFlush {
|
||||||
vsFlushType = labelToFlushType label,
|
vsFlushType = labelToFlushType label,
|
||||||
|
|
Loading…
Reference in New Issue