Compare commits
No commits in common. "5a28a554a1a5a9c31f74338cf80c9519f9a5cb47" and "3c0f5d34bf8241a55c4d791bd74170c80cf47ee0" have entirely different histories.
5a28a554a1
...
3c0f5d34bf
|
@ -2,21 +2,15 @@ module CacheSim.AccessView exposing (..)
|
|||
import CacheSim.Cache exposing (..)
|
||||
import CacheSim.Hierarchy exposing (..)
|
||||
|
||||
type AccessPosition = Down Int | Up Int | Preview | End
|
||||
type alias AccessView =
|
||||
{ initialState : CacheHierarchy
|
||||
, blockAddr : BlockAddr
|
||||
, accessEffects : List (AccessEffect Cache)
|
||||
, position : AccessPosition
|
||||
}
|
||||
type AccessPosition = Down Int | Up Int | Done
|
||||
type alias AccessView = (List (AccessEffect Cache), AccessPosition)
|
||||
|
||||
accessPositionForward : Int -> AccessPosition -> AccessPosition
|
||||
accessPositionForward depth av =
|
||||
case av of
|
||||
Down n -> if n == depth - 1 then Up n else Down (n + 1)
|
||||
Up n -> if n == 0 then Preview else Up (n - 1)
|
||||
Preview -> End
|
||||
End -> End
|
||||
Up n -> if n == 0 then Done else Up (n - 1)
|
||||
Done -> Done
|
||||
|
||||
accessPositionBack : Int -> AccessPosition -> AccessPosition
|
||||
accessPositionBack depth av =
|
||||
|
@ -24,43 +18,41 @@ accessPositionBack depth av =
|
|||
Down 0 -> Down 0
|
||||
Down n -> Down (n-1)
|
||||
Up n -> if n == (depth - 1) then Down n else Up (n + 1)
|
||||
Preview -> Up 0
|
||||
End -> Preview
|
||||
Done -> Up 0
|
||||
|
||||
accessPositionDone : AccessPosition -> Bool
|
||||
accessPositionDone av =
|
||||
case av of
|
||||
End -> True
|
||||
Done -> True
|
||||
_ -> False
|
||||
|
||||
accessViewForward : AccessView -> AccessView
|
||||
accessViewForward av = { av | position = accessPositionForward (List.length av.accessEffects) av.position }
|
||||
accessViewForward (l, ap) = (l, accessPositionForward (List.length l) ap)
|
||||
|
||||
accessViewBack : AccessView -> AccessView
|
||||
accessViewBack av = { av | position = accessPositionBack (List.length av.accessEffects) av.position }
|
||||
accessViewBack (l, ap) = (l, accessPositionBack (List.length l) ap)
|
||||
|
||||
accessViewDone : AccessView -> Bool
|
||||
accessViewDone av = accessPositionDone av.position
|
||||
accessViewDone (_, ap) = accessPositionDone ap
|
||||
|
||||
finalCacheHierarchy : AccessView -> CacheHierarchy
|
||||
finalCacheHierarchy av =
|
||||
List.map .output av.accessEffects ++ List.drop (List.length av.accessEffects) av.initialState
|
||||
finalCacheHierarchy : CacheHierarchy -> AccessView -> CacheHierarchy
|
||||
finalCacheHierarchy ch (l, ap) =
|
||||
List.map .output l ++ List.drop (List.length l) ch
|
||||
|
||||
effectiveCacheHierarchy : AccessView -> CacheHierarchy
|
||||
effectiveCacheHierarchy av =
|
||||
|
||||
effectiveCacheHierarchy : CacheHierarchy -> AccessView -> CacheHierarchy
|
||||
effectiveCacheHierarchy c (l, ap) =
|
||||
let
|
||||
finalContents = List.map .output av.accessEffects
|
||||
unaccessed = List.drop (List.length av.accessEffects) av.initialState
|
||||
finalContents = List.map .output l
|
||||
unaccessed = List.drop (List.length l) c
|
||||
notDone =
|
||||
case av.position of
|
||||
Preview -> []
|
||||
End -> []
|
||||
Down _ -> List.take (List.length av.accessEffects) av.initialState
|
||||
Up n -> List.take n av.initialState
|
||||
case ap of
|
||||
Done -> []
|
||||
Down _ -> List.take (List.length l) c
|
||||
Up n -> List.take n c
|
||||
done =
|
||||
case av.position of
|
||||
Preview -> finalContents
|
||||
End -> finalContents
|
||||
case ap of
|
||||
Done -> finalContents
|
||||
Down _ -> []
|
||||
Up n -> List.drop n finalContents
|
||||
in
|
||||
|
|
|
@ -45,13 +45,8 @@ updateAccess li m =
|
|||
case xs of
|
||||
[] -> Ok []
|
||||
(i::t) ->
|
||||
case accessCacheHierarchy (i // 4) c of
|
||||
Ok av ->
|
||||
let
|
||||
newView = { blockAddr = i, accessEffects = av, position = Down 0, initialState = c }
|
||||
in
|
||||
Result.map ((::) newView)
|
||||
<| process (finalCacheHierarchy newView) t
|
||||
case accessCacheHierarchy i c of
|
||||
Ok av -> Result.map ((::) (av, Down 0)) <| process (finalCacheHierarchy c (av, Done)) t
|
||||
Err s -> Err s
|
||||
|
||||
accessResult = Maybe.andThen (\h -> Result.toMaybe <| process h li) m.hierarchy
|
||||
|
@ -64,15 +59,12 @@ updateAccessViewForward : Model -> (Model, Cmd Msg)
|
|||
updateAccessViewForward m =
|
||||
let
|
||||
afterStep = Maybe.map (intMapUpdate 0 accessViewForward) m.accessView
|
||||
newAccessView =
|
||||
(newHierarchy, newAccessView) =
|
||||
case afterStep of
|
||||
Just (result::xs) ->
|
||||
case (result.position, xs) of
|
||||
(End, []) -> Nothing
|
||||
(End, nxs) -> Just nxs
|
||||
_ -> Just (result::xs)
|
||||
as_ -> as_
|
||||
newModel = { m | accessView = newAccessView }
|
||||
Just ((avs, Done)::[]) -> (Maybe.map (\h -> finalCacheHierarchy h (avs, Done)) m.hierarchy, Nothing)
|
||||
Just ((avs, Done)::xs) -> (Maybe.map (\h -> finalCacheHierarchy h (avs, Done)) m.hierarchy, Just xs)
|
||||
as_ -> (m.hierarchy, as_)
|
||||
newModel = { m | accessView = newAccessView, hierarchy = newHierarchy }
|
||||
cmd = Cmd.none
|
||||
in
|
||||
(newModel, cmd)
|
||||
|
|
|
@ -10,31 +10,34 @@ import Html.Attributes exposing (type_, class, value, for, classList, disabled,
|
|||
import Html.Events exposing (onInput, onClick)
|
||||
|
||||
-- Button components, powered by Bootstrap
|
||||
button : List (Attribute Msg) -> String -> Html Msg
|
||||
button attrs s = input ([ type_ "button", value s, class "btn"] ++ attrs) []
|
||||
basicButton : List (Attribute Msg) -> String -> Html Msg
|
||||
basicButton attrs s = input ([ type_ "button", value s, class "btn", class "btn-info" ] ++ attrs) []
|
||||
|
||||
basicButton : Msg -> String -> Html Msg
|
||||
basicButton msg s = button [ onClick msg ] s
|
||||
disabledButton : String -> Html Msg
|
||||
disabledButton = basicButton [ disabled True ]
|
||||
|
||||
disabledButton : List (Attribute Msg) -> String -> Html Msg
|
||||
disabledButton attrs = button (attrs ++ [ disabled True ])
|
||||
advancedButton : List (Attribute Msg) -> String -> Msg -> Html Msg
|
||||
advancedButton attrs s m = basicButton (attrs ++ [ onClick m ]) s
|
||||
|
||||
button : String -> Msg -> Html Msg
|
||||
button s m = basicButton [ onClick m ] s
|
||||
|
||||
dangerButton : String -> Msg -> Html Msg
|
||||
dangerButton s m = button [ onClick m, class "btn-danger" ] s
|
||||
dangerButton = advancedButton [ class "btn-danger" ]
|
||||
|
||||
primaryButton : String -> Msg -> Html Msg
|
||||
primaryButton s m = button [ onClick m, class "btn-primary" ] s
|
||||
primaryButton = advancedButton [ class "btn-primary" ]
|
||||
|
||||
secondaryButton : String -> Msg -> Html Msg
|
||||
secondaryButton s m = button [ onClick m, class "btn-secondary" ] s
|
||||
secondaryButton = advancedButton [ class "btn-secondary" ]
|
||||
|
||||
maybeButton : Maybe a -> List (Attribute Msg) -> String -> (a -> Msg) -> Html Msg
|
||||
maybeButton m attrs s f =
|
||||
maybeButton : Maybe a -> String -> (a -> Msg) -> Html Msg
|
||||
maybeButton m s f =
|
||||
case m of
|
||||
Just v -> button (attrs ++ [ onClick (f v) ]) s
|
||||
_ -> disabledButton attrs s
|
||||
Just v -> button s (f v)
|
||||
_ -> disabledButton s
|
||||
|
||||
resultButton : Result e a -> List (Attribute Msg) -> String -> (a -> Msg) -> Html Msg
|
||||
resultButton : Result e a -> String -> (a -> Msg) -> Html Msg
|
||||
resultButton = maybeButton << Result.toMaybe
|
||||
|
||||
-- Button wrapper (button group)
|
||||
|
@ -102,8 +105,8 @@ viewRawCacheModelHierarchy rcmh =
|
|||
Ok _ -> viewError True ""
|
||||
Err e -> viewError False e
|
||||
|
||||
newButton = primaryButton "Add level" CreateRawModel
|
||||
useButton = resultButton checkedResult [ class "btn-primary" ] "Start simulation" (UseHierarchy << Just)
|
||||
newButton = button "Add level" CreateRawModel
|
||||
useButton = resultButton checkedResult "Use hierarchy" (UseHierarchy << Just)
|
||||
in
|
||||
div []
|
||||
[ h2 [] [ text "Cache hierarchy" ]
|
||||
|
@ -160,21 +163,23 @@ viewCacheHierarchy ch =
|
|||
|
||||
viewAccessView : Model -> AccessView -> Html Msg
|
||||
viewAccessView m av =
|
||||
div []
|
||||
[ h2 [] [ text "Access Simulation" ]
|
||||
, p [] [ text ("Simulating access of address " ++ String.fromInt av.blockAddr) ]
|
||||
, buttonWrapper
|
||||
[ primaryButton "Back" AccessViewBack
|
||||
, primaryButton "Forward" AccessViewForward
|
||||
]
|
||||
, h3 [] [ text "Access event log" ]
|
||||
, viewAccessLog av
|
||||
, h3 [] [ text "Current cache state" ]
|
||||
, viewCacheHierarchy <| effectiveCacheHierarchy av
|
||||
]
|
||||
let
|
||||
currentCache = Maybe.withDefault [] m.hierarchy
|
||||
in
|
||||
div []
|
||||
[ h2 [] [ text "Access Simulation" ]
|
||||
, buttonWrapper
|
||||
[ primaryButton "Back" AccessViewBack
|
||||
, primaryButton "Forward" AccessViewForward
|
||||
]
|
||||
, h3 [] [ text "Access event log" ]
|
||||
, viewAccessLog av
|
||||
, h3 [] [ text "Current cache state" ]
|
||||
, viewCacheHierarchy <| effectiveCacheHierarchy currentCache av
|
||||
]
|
||||
|
||||
viewAccessLog : AccessView -> Html Msg
|
||||
viewAccessLog av =
|
||||
viewAccessLog (aes, ap) =
|
||||
let
|
||||
resultSpan r =
|
||||
span [ classList [ ("badge", True), ("badge-success", r == Hit), ("badge-danger", r == Miss) ] ]
|
||||
|
@ -184,17 +189,14 @@ viewAccessLog av =
|
|||
, resultSpan ae.result
|
||||
]
|
||||
upEvent n ae = div [ class "event" ]
|
||||
[ text <| "Updated L" ++ String.fromInt (List.length av.accessEffects - n)
|
||||
[ text <| "Updated L" ++ String.fromInt (List.length aes - n)
|
||||
]
|
||||
events =
|
||||
case av.position of
|
||||
Preview -> List.indexedMap downEvent av.accessEffects ++
|
||||
(List.indexedMap upEvent av.accessEffects) ++
|
||||
[ div [ class "event" ] [ text "Access complete. Viewing final cache state." ] ]
|
||||
End -> []
|
||||
Down n -> List.indexedMap downEvent <| List.take (n + 1) av.accessEffects
|
||||
Up n -> List.indexedMap downEvent av.accessEffects ++
|
||||
(List.indexedMap upEvent <| List.drop n av.accessEffects)
|
||||
case ap of
|
||||
Done -> []
|
||||
Down n -> List.indexedMap downEvent <| List.take (n + 1) aes
|
||||
Up n -> List.indexedMap downEvent aes ++
|
||||
(List.indexedMap upEvent <| List.drop n aes)
|
||||
in
|
||||
div [] events
|
||||
|
||||
|
@ -202,26 +204,27 @@ viewAccessInput : Model -> Html Msg
|
|||
viewAccessInput m =
|
||||
let
|
||||
parser =
|
||||
Parser.sequence
|
||||
{ start = ""
|
||||
, end = ""
|
||||
, separator = ","
|
||||
, spaces = Parser.spaces
|
||||
, item = Parser.int
|
||||
, trailing = Parser.Optional
|
||||
}
|
||||
Parser.map (List.map (\i -> i // 4)) <|
|
||||
Parser.sequence
|
||||
{ start = ""
|
||||
, end = ""
|
||||
, separator = ","
|
||||
, spaces = Parser.spaces
|
||||
, item = Parser.int
|
||||
, trailing = Parser.Optional
|
||||
}
|
||||
parseErrorToString _ = "Unable to parse input. Please enter a sequence of numbers separated by commas."
|
||||
parseResult = Parser.run (parser |. Parser.end) m.accessInput
|
||||
checkedResult =
|
||||
case parseResult of
|
||||
Ok is -> if is == [] then Err "Please enter at least one number." else Ok is
|
||||
Err e -> Err <| parseErrorToString e
|
||||
accessButton = resultButton checkedResult [ class "btn-primary" ] "Access address" Access
|
||||
accessButton = resultButton checkedResult "Access address" Access
|
||||
errorHtml =
|
||||
case checkedResult of
|
||||
Ok _ -> viewError True ""
|
||||
Err e -> viewError False e
|
||||
editHierarchyButton = secondaryButton "Edit hierarchy" (UseHierarchy Nothing)
|
||||
editHierarchyButton = button "Edit hierarchy" (UseHierarchy Nothing)
|
||||
in
|
||||
div []
|
||||
[ h2 [] [ text "Run access simulation" ]
|
||||
|
@ -241,7 +244,7 @@ viewDescription =
|
|||
, p []
|
||||
[ text <| "To use the simulator, first create a fitting cache configuration by using the \"Add level\" button,"
|
||||
++ " as well as the settings provided by each individual cache level. When the cache is correctly specified, and"
|
||||
++ " no warnings appear, click \"Start simulation\" to load the specified hierarchy and begin simulating. To simulate,"
|
||||
++ " no warnings appear, click \"Use hierarchy\" to load the specified hierarchy and begin simulating. To simulate,"
|
||||
++ " type a block address into the \"Access address\" field, and click \"Access\". This will bring forward the simulation"
|
||||
++ " view, which will allow you to step through the steps of accessing a cache."
|
||||
]
|
||||
|
|
Loading…
Reference in New Issue
Block a user