282 lines
11 KiB
Elm
282 lines
11 KiB
Elm
module CacheSim.View exposing (..)
|
|
import CacheSim.Raw exposing (..)
|
|
import CacheSim.Model exposing (..)
|
|
import CacheSim.Cache exposing (..)
|
|
import CacheSim.AccessView exposing (..)
|
|
import CacheSim.Hierarchy exposing (..)
|
|
import Parser exposing ((|.))
|
|
import Html exposing (Html, Attribute, input, text, div, label, span, h2, h3, table, tr, td, th, p, h1)
|
|
import Html.Attributes exposing (type_, class, value, for, classList, disabled, colspan, hidden)
|
|
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 : Msg -> String -> Html Msg
|
|
basicButton msg s = button [ onClick msg ] s
|
|
|
|
disabledButton : List (Attribute Msg) -> String -> Html Msg
|
|
disabledButton attrs = button (attrs ++ [ disabled True ])
|
|
|
|
dangerButton : String -> Msg -> Html Msg
|
|
dangerButton s m = button [ onClick m, class "btn-danger" ] s
|
|
|
|
primaryButton : String -> Msg -> Html Msg
|
|
primaryButton s m = button [ onClick m, class "btn-primary" ] s
|
|
|
|
secondaryButton : String -> Msg -> Html Msg
|
|
secondaryButton s m = button [ onClick m, class "btn-secondary" ] s
|
|
|
|
maybeButton : Maybe a -> List (Attribute Msg) -> String -> (a -> Msg) -> Html Msg
|
|
maybeButton m attrs s f =
|
|
case m of
|
|
Just v -> button (attrs ++ [ onClick (f v) ]) s
|
|
_ -> disabledButton attrs s
|
|
|
|
resultButton : Result e a -> List (Attribute Msg) -> String -> (a -> Msg) -> Html Msg
|
|
resultButton = maybeButton << Result.toMaybe
|
|
|
|
-- Button wrapper (button group)
|
|
buttonWrapper : List (Html Msg) -> Html Msg
|
|
buttonWrapper = div [ classList [("btn-group", True), ("mb-3", True), ("mr-3", True) ] ]
|
|
|
|
buttonToolbar : List (List (Html Msg)) -> Html Msg
|
|
buttonToolbar ll = div [ class "btn-toolbar" ] <| List.map buttonWrapper ll
|
|
|
|
-- Input with a label
|
|
labeledInput : String -> String -> (String -> Msg) -> Html Msg
|
|
labeledInput s val f =
|
|
div [ class "input-group mb-3" ]
|
|
[ div [ class "input-group-prepend" ]
|
|
[ span [ class "input-group-text" ] [ text s ]
|
|
]
|
|
, input [ value val, type_ "text", class "form-control", onInput f ] []
|
|
]
|
|
|
|
-- Error view
|
|
viewError : Bool -> String -> Html Msg
|
|
viewError hide e = div
|
|
[ classList
|
|
[ ("alert", True)
|
|
, ("alert-danger", True)
|
|
]
|
|
, hidden hide
|
|
] [ text e ]
|
|
|
|
panel : List (Html Msg) -> Html Msg
|
|
panel = div [ classList [("card", True), ("p-3", True), ("mb-3", True) ] ]
|
|
|
|
viewRawCacheModel : Int -> RawCacheModel -> Html Msg
|
|
viewRawCacheModel level rcm =
|
|
let
|
|
updateBlockSize s cm = { cm | blockSize = s}
|
|
updateSetCount s cm = { cm | setCount = s}
|
|
updateSetSize s cm = { cm | setSize = s}
|
|
wrapUpdate f s = ChangeRawModel level (f s)
|
|
|
|
deleteButton = dangerButton "Delete" (DeleteRawModel level)
|
|
|
|
params = div []
|
|
[ labeledInput "Block size (words)" rcm.blockSize (wrapUpdate updateBlockSize)
|
|
, labeledInput "Set count" rcm.setCount (wrapUpdate updateSetCount)
|
|
, labeledInput "Set size" rcm.setSize (wrapUpdate updateSetSize)
|
|
]
|
|
in
|
|
panel
|
|
[ h3 [] [ text <| "L" ++ String.fromInt (level + 1) ++ " Cache" ]
|
|
, buttonWrapper [ deleteButton ]
|
|
, params
|
|
]
|
|
|
|
viewRawCacheModelHierarchy : RawCacheModelHierarchy -> Html Msg
|
|
viewRawCacheModelHierarchy rcmh =
|
|
let
|
|
models = div [ class "cache-model-levels" ]
|
|
<| List.indexedMap viewRawCacheModel rcmh
|
|
translationResult = Result.andThen validateCacheModelHierarchy
|
|
<| translateRawCacheModelHierarchy rcmh
|
|
checkedResult =
|
|
case translationResult of
|
|
Ok h -> if h == [] then Err "Please specify at least one cache level." else Ok h
|
|
Err e -> Err e
|
|
errorHtml =
|
|
case checkedResult of
|
|
Ok _ -> viewError True ""
|
|
Err e -> viewError False e
|
|
|
|
newButton = primaryButton "Add level" CreateRawModel
|
|
useButton = resultButton checkedResult [ class "btn-primary" ] "Start simulation" (UseHierarchy << Just)
|
|
in
|
|
div []
|
|
[ h2 [] [ text "Cache hierarchy" ]
|
|
, errorHtml
|
|
, buttonWrapper [ newButton, useButton ]
|
|
, models
|
|
]
|
|
|
|
viewCache : Int -> Cache -> Html Msg
|
|
viewCache level (cm, cs) =
|
|
let
|
|
slotLabels =
|
|
List.indexedMap (\i _ -> td [] [ text <| String.fromInt i ])
|
|
<| List.repeat cm.setSize ()
|
|
slotLabel = th [ colspan cm.setSize ] [ text "Slot" ]
|
|
allSlotLabels = List.concat <| List.repeat cm.setCount slotLabels
|
|
allSlotsLabel = List.repeat cm.setCount slotLabel
|
|
|
|
setLabels =
|
|
List.indexedMap (\i _ -> td [ colspan cm.setSize ] [ text <| String.fromInt i ])
|
|
<| List.repeat cm.setCount ()
|
|
setLabel = [ th [ colspan <| cm.setSize * cm.setCount ] [ text "Set" ] ]
|
|
setRow set =
|
|
let
|
|
slotHtml s =
|
|
case s of
|
|
Empty -> td [] [ text "" ]
|
|
Used l a -> td [] [ text <| String.fromInt a ]
|
|
in
|
|
List.map slotHtml set
|
|
cacheRow = List.concat <| List.map setRow cs
|
|
cacheTable =
|
|
table [ class "table" ]
|
|
[ tr [ hidden (cm.setCount == 1), class "table-info" ] setLabel
|
|
, tr [ hidden (cm.setCount == 1) ] setLabels
|
|
, tr [ hidden (cm.setSize == 1), class "table-info" ] allSlotsLabel
|
|
, tr [ hidden (cm.setSize == 1) ] allSlotLabels
|
|
, tr [] cacheRow
|
|
]
|
|
|
|
in
|
|
panel
|
|
[ h3 [] [ text <| "L" ++ String.fromInt (level + 1) ++ " Cache" ]
|
|
, cacheTable
|
|
]
|
|
|
|
viewCacheHierarchy : CacheHierarchy -> Html Msg
|
|
viewCacheHierarchy ch =
|
|
let
|
|
levels = div []
|
|
<| List.indexedMap viewCache ch
|
|
in
|
|
levels
|
|
|
|
viewAccessView : Model -> AccessView -> Html Msg
|
|
viewAccessView m av =
|
|
div []
|
|
[ h2 [] [ text "Access Simulation" ]
|
|
, p [] [ text ("Simulating access of address " ++ String.fromInt av.blockAddr) ]
|
|
, buttonToolbar
|
|
[ [ primaryButton "Back" AccessViewBack, primaryButton "Forward" AccessViewForward ]
|
|
, [ dangerButton "Stop" AccessViewCancel ]
|
|
]
|
|
, h3 [] [ text "Access event log" ]
|
|
, viewAccessLog av
|
|
, h3 [] [ text "Current cache state" ]
|
|
, viewCacheHierarchy <| effectiveCacheHierarchy av
|
|
]
|
|
|
|
viewAccessLog : AccessView -> Html Msg
|
|
viewAccessLog av =
|
|
let
|
|
resultSpan r =
|
|
span [ classList [ ("badge", True), ("badge-success", r == Hit), ("badge-danger", r == Miss) ] ]
|
|
[ text <| if r == Hit then "Hit" else "Miss" ]
|
|
downEvent n ae = div [ class "event" ]
|
|
[ text <| "L" ++ String.fromInt (n + 1) ++ " "
|
|
, resultSpan ae.result
|
|
]
|
|
upEvent n ae = div [ class "event" ]
|
|
[ text <| "Updated L" ++ String.fromInt (List.length av.accessEffects - 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)
|
|
in
|
|
div [] events
|
|
|
|
viewAccessInput : Model -> Html Msg
|
|
viewAccessInput m =
|
|
let
|
|
parser =
|
|
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
|
|
errorHtml =
|
|
case checkedResult of
|
|
Ok _ -> viewError True ""
|
|
Err e -> viewError False e
|
|
editHierarchyButton = button [ onClick (UseHierarchy Nothing), class "btn-dark" ] "Edit hierarchy"
|
|
in
|
|
div []
|
|
[ h2 [] [ text "Run access simulation" ]
|
|
, labeledInput "Access byte address" m.accessInput ChangeAccessInput
|
|
, buttonWrapper [ accessButton, editHierarchyButton ]
|
|
, errorHtml
|
|
]
|
|
|
|
viewDescription : Html Msg
|
|
viewDescription =
|
|
div []
|
|
[ h1 [] [ text "Cache simulator" ]
|
|
, p []
|
|
[ text <| "This is a simulator for testing various cache configurations for educational purposes. It allows for the creation of"
|
|
++ " n-way associative caches, and their special cases (direct mapped and fully associative caches)."
|
|
]
|
|
, 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,"
|
|
++ " 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."
|
|
]
|
|
]
|
|
|
|
viewBase : Model -> Html Msg
|
|
viewBase m =
|
|
let
|
|
rawView =
|
|
case m.hierarchy of
|
|
Nothing -> [ viewRawCacheModelHierarchy m.rawHierarchy ]
|
|
Just _ -> []
|
|
accessInputView =
|
|
case (m.hierarchy, m.accessView) of
|
|
(Just _, Nothing) -> [ viewAccessInput m ]
|
|
_ -> []
|
|
cacheView =
|
|
case m.accessView of
|
|
Nothing ->
|
|
Maybe.withDefault []
|
|
<| Maybe.map (List.singleton << viewCacheHierarchy) <| m.hierarchy
|
|
Just _ -> []
|
|
accessView = Maybe.withDefault [] <| Maybe.map (List.singleton << viewAccessView m) <| Maybe.andThen (List.head) <| m.accessView
|
|
remainingAccessView =
|
|
case Maybe.map (\l -> List.length l - 1) m.accessView of
|
|
Just n -> if n <= 0 then [] else
|
|
[ div [ class "alert", class "alert-info" ] [ text <|
|
|
"Simulating more than one access. " ++ (String.fromInt n) ++
|
|
" addresses in queue." ]
|
|
]
|
|
_ -> []
|
|
in
|
|
div [ class "container" ]
|
|
<| [ viewDescription] ++ rawView ++ accessInputView ++ remainingAccessView ++ accessView ++ cacheView
|