Inital Commit. Mostly working
This commit is contained in:
660
src/Main.elm
Normal file
660
src/Main.elm
Normal file
@ -0,0 +1,660 @@
|
||||
--module Main exposing (Model, Msg, update, view, init)
|
||||
|
||||
|
||||
port module Main exposing (..)
|
||||
|
||||
import Browser
|
||||
import Html exposing (Html, button, div, h1, p, text)
|
||||
import Html.Attributes as HAttr exposing (class, classList, value)
|
||||
import Html.Events exposing (onClick)
|
||||
import Html.Lazy exposing (lazy)
|
||||
import Tuple
|
||||
import Array exposing (get)
|
||||
|
||||
|
||||
|
||||
-- Note that general Stuff is at the end of the document
|
||||
-- PORTS
|
||||
|
||||
|
||||
port sendUUpdate : String -> Cmd msg
|
||||
|
||||
|
||||
port sendRamUpdate : String -> Cmd msg
|
||||
|
||||
|
||||
port recieveLocalSession : (String -> msg) -> Sub msg
|
||||
|
||||
|
||||
type alias PC =
|
||||
{ ram : List Int
|
||||
, dataBus : Int
|
||||
, addressBus : Int
|
||||
, instructionReg : Int
|
||||
, programmCounter : Int
|
||||
, uCounter : Int
|
||||
, accumulator : Int
|
||||
}
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ pc : PC
|
||||
, uCode : List (Maybe UAction)
|
||||
, autoscroll : Bool
|
||||
}
|
||||
|
||||
|
||||
type UAction
|
||||
= ActAccumulator2DataBus
|
||||
| ActAccumulatorDecrement
|
||||
| ActAccumulatorIncrement
|
||||
| ActDataBus2Accumulator
|
||||
| ActDataBus2InstructionReg
|
||||
| ActDataBus2Ram
|
||||
| ActInstructionReg2AddressBus
|
||||
| ActInstructionReg2ProgrammCounter
|
||||
| ActInstructionReg2UCounter
|
||||
| ActProgrammCounterIncrement
|
||||
| ActRam2DataBus
|
||||
| ActResetUCounter
|
||||
| ActProgrammCounter2AddressBus
|
||||
|
||||
|
||||
uCodeDescriptions : List ( UAction, String )
|
||||
uCodeDescriptions =
|
||||
[ ( ActAccumulator2DataBus, "Acc -> DataBus" )
|
||||
, ( ActAccumulatorDecrement, "Acc --" )
|
||||
, ( ActAccumulatorIncrement, "Acc ++" )
|
||||
, ( ActDataBus2Accumulator, "DataBus -> Acc" )
|
||||
, ( ActDataBus2InstructionReg, "DataBus -> InstReg" )
|
||||
, ( ActDataBus2Ram, "DataBus -> Ram" )
|
||||
, ( ActInstructionReg2AddressBus, "InstReg -> AddrBus" )
|
||||
, ( ActInstructionReg2ProgrammCounter, "InstReg -> ProgCount" )
|
||||
, ( ActInstructionReg2UCounter, "InstReg -> µCounter" )
|
||||
, ( ActProgrammCounterIncrement, "ProgCounter ++" )
|
||||
, ( ActRam2DataBus, "Ram -> DataBus" )
|
||||
, ( ActResetUCounter, "µCounter = 0" )
|
||||
, ( ActProgrammCounter2AddressBus, "ProgCounter -> AddrBus" )
|
||||
]
|
||||
|
||||
|
||||
uCodeMaps : List ( UAction, PC -> PC )
|
||||
uCodeMaps =
|
||||
[ ( ActAccumulator2DataBus, actAccumulator2DataBus )
|
||||
, ( ActAccumulatorDecrement, actAccumulatorDecrement )
|
||||
, ( ActAccumulatorIncrement, actAccumulatorIncrement )
|
||||
, ( ActDataBus2Accumulator, actDataBus2Accumulator )
|
||||
, ( ActDataBus2InstructionReg, actDataBus2InstructionReg )
|
||||
, ( ActDataBus2Ram, actDataBus2Ram )
|
||||
, ( ActInstructionReg2AddressBus, actInstructionReg2AddressBus )
|
||||
, ( ActInstructionReg2ProgrammCounter, actInstructionReg2ProgrammCounter )
|
||||
, ( ActInstructionReg2UCounter, actInstructionReg2UCounter )
|
||||
, ( ActProgrammCounterIncrement, actProgrammCounterIncrement )
|
||||
, ( ActRam2DataBus, actRam2DataBus )
|
||||
, ( ActResetUCounter, actResetUCounter )
|
||||
, ( ActProgrammCounter2AddressBus, actProgrammCounter2AddressBus )
|
||||
]
|
||||
|
||||
|
||||
initialRam : List Int
|
||||
initialRam =
|
||||
[ 100005 -- 000 -- LoadA #005
|
||||
, 300000 -- 001 -- IncA
|
||||
, 200005 -- 002 -- StoreA #005
|
||||
, 400000 -- 003 -- JMP #000
|
||||
, 0 -- 004
|
||||
, 5 -- 005
|
||||
, 0 -- 006
|
||||
, 0 -- 007
|
||||
, 0 -- 008
|
||||
, 0 -- 009
|
||||
, 0 -- 010
|
||||
]
|
||||
|
||||
|
||||
initialPC : PC
|
||||
initialPC =
|
||||
PC
|
||||
initialRam
|
||||
0
|
||||
0
|
||||
0
|
||||
0
|
||||
0
|
||||
0
|
||||
|
||||
|
||||
initialUCodes : List (Maybe UAction)
|
||||
initialUCodes =
|
||||
[ Just ActProgrammCounter2AddressBus -- 000
|
||||
, Just ActRam2DataBus -- 001
|
||||
, Just ActDataBus2InstructionReg -- 002
|
||||
, Just ActProgrammCounterIncrement -- 003
|
||||
, Just ActInstructionReg2UCounter -- 004
|
||||
, Nothing -- 005
|
||||
, Nothing
|
||||
, Nothing
|
||||
, Nothing
|
||||
, Nothing -- 009
|
||||
|
||||
-- 010 LOADA
|
||||
, Just ActInstructionReg2AddressBus -- 010
|
||||
, Just ActRam2DataBus -- 011
|
||||
, Just ActDataBus2Accumulator -- 012
|
||||
, Just ActResetUCounter -- 013
|
||||
, Nothing -- 014
|
||||
, Nothing
|
||||
, Nothing
|
||||
, Nothing
|
||||
, Nothing
|
||||
, Nothing -- 019
|
||||
|
||||
-- 020 STOA
|
||||
, Just ActAccumulator2DataBus -- 020
|
||||
, Just ActInstructionReg2AddressBus -- 021
|
||||
, Just ActDataBus2Ram -- 022
|
||||
, Just ActResetUCounter -- 023
|
||||
, Nothing --024
|
||||
, Nothing
|
||||
, Nothing
|
||||
, Nothing
|
||||
, Nothing
|
||||
, Nothing -- 029
|
||||
|
||||
-- 030 INCA
|
||||
, Just ActAccumulatorIncrement -- 030
|
||||
, Just ActResetUCounter -- 031
|
||||
, Nothing -- 032
|
||||
, Nothing
|
||||
, Nothing
|
||||
, Nothing
|
||||
, Nothing
|
||||
, Nothing
|
||||
, Nothing
|
||||
, Nothing -- 039
|
||||
|
||||
-- 040 JMP
|
||||
, Just ActInstructionReg2ProgrammCounter -- 040
|
||||
, Just ActResetUCounter -- 041
|
||||
, Nothing -- 042
|
||||
, Nothing
|
||||
, Nothing
|
||||
, Nothing
|
||||
, Nothing
|
||||
, Nothing
|
||||
, Nothing
|
||||
, Nothing -- 049
|
||||
]
|
||||
|
||||
|
||||
type Msg
|
||||
= MsgUCycleStep
|
||||
| MsgInstructionStep
|
||||
| MsgReset
|
||||
| MsgAutoscrollUpdate
|
||||
| MsgManualStep UAction
|
||||
| MsgLocalSessionRecieve String
|
||||
|
||||
|
||||
update : Msg -> Model -> ( Model, Cmd Msg )
|
||||
update msg model =
|
||||
case msg of
|
||||
MsgUCycleStep ->
|
||||
( uStepPC model
|
||||
, sendUUpdate "uCycle updated"
|
||||
)
|
||||
|
||||
MsgInstructionStep ->
|
||||
( model, Cmd.none )
|
||||
|
||||
MsgReset ->
|
||||
( { model | pc = { initialPC | ram = model.pc.ram } }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
MsgLocalSessionRecieve message_in ->
|
||||
( model, Cmd.none )
|
||||
|
||||
MsgManualStep action ->
|
||||
let
|
||||
instruction = getAction action
|
||||
in
|
||||
( { model | pc = instruction model.pc}
|
||||
, Cmd.none )
|
||||
|
||||
MsgAutoscrollUpdate ->
|
||||
( { model | autoscroll = not model.autoscroll }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
|
||||
|
||||
-- Practically a part of uStepPC but sepeated for manual mode
|
||||
getAction : UAction -> (PC -> PC)
|
||||
getAction uAction =
|
||||
let
|
||||
possible_instructions =
|
||||
List.filter (\s -> Tuple.first s == uAction) uCodeMaps
|
||||
in
|
||||
case List.head possible_instructions of
|
||||
Just ( name, instruction ) ->
|
||||
instruction
|
||||
_ ->
|
||||
(\s -> s)
|
||||
|
||||
|
||||
uStepPC : Model -> Model
|
||||
uStepPC model =
|
||||
let
|
||||
uCounter =
|
||||
model.pc.uCounter
|
||||
|
||||
may_instruction : Maybe (Maybe UAction)
|
||||
may_instruction =
|
||||
valueAt uCounter model.uCode
|
||||
in
|
||||
case may_instruction of
|
||||
Just (Just action) ->
|
||||
let
|
||||
possible_instructions =
|
||||
List.filter (\s -> Tuple.first s == action) uCodeMaps
|
||||
in
|
||||
case List.head possible_instructions of
|
||||
Just ( name, instruction ) ->
|
||||
let
|
||||
old_pc =
|
||||
model.pc
|
||||
|
||||
new_pc =
|
||||
{ old_pc | uCounter = old_pc.uCounter + 1 }
|
||||
in
|
||||
{ model | pc = instruction new_pc }
|
||||
|
||||
_ ->
|
||||
let
|
||||
old_pc =
|
||||
model.pc
|
||||
|
||||
new_pc =
|
||||
{ old_pc | uCounter = 0 }
|
||||
in
|
||||
{ model | pc = new_pc }
|
||||
|
||||
_ ->
|
||||
model
|
||||
|
||||
|
||||
view : Model -> Html Msg
|
||||
view model =
|
||||
lazy viewPC model
|
||||
|
||||
|
||||
viewPC : Model -> Html Msg
|
||||
viewPC model =
|
||||
div
|
||||
[ class "pc" ]
|
||||
[ div [ class "controls", class "grid-fullwidth" ]
|
||||
[ button [ onClick MsgUCycleStep ] [ text "µZyklus" ]
|
||||
, button [ onClick MsgInstructionStep ] [ text "Instruction" ]
|
||||
, button [ onClick MsgReset ] [ text "Reset PC" ]
|
||||
, div
|
||||
[ classList
|
||||
[ ("checker", True)
|
||||
, ("button", True)
|
||||
, ("checked", model.autoscroll) ]
|
||||
, onClick MsgAutoscrollUpdate
|
||||
]
|
||||
[ Html.input
|
||||
[ HAttr.type_ "checkbox"
|
||||
, HAttr.id "enableScrolling"
|
||||
, HAttr.checked model.autoscroll
|
||||
, onClick MsgAutoscrollUpdate
|
||||
]
|
||||
[]
|
||||
, Html.label
|
||||
[ HAttr.for "enableScrolling" ]
|
||||
[ text "Automatisch zum Eintrag Scrollen" ]
|
||||
]
|
||||
]
|
||||
, div [ class "grid-fullwidth" ] [ lazy viewAddressBus model ]
|
||||
, lazy viewRam model
|
||||
, lazy viewCu model
|
||||
, lazy viewAlu model
|
||||
, div [ class "grid-fullwidth" ] [ lazy viewDataBus model ]
|
||||
]
|
||||
|
||||
|
||||
viewRam : Model -> Html Msg
|
||||
viewRam model =
|
||||
div [ class "section", class "ram" ]
|
||||
[ h1 [ class "header" ] [ text "RAM" ]
|
||||
, div [ class "arrow", class "down", class "top"] [ div [] [] , div [] [] ]
|
||||
, div [ class "scroller" ]
|
||||
[ Html.table [ class "" ]
|
||||
[ Html.thead [ class "head" ]
|
||||
[ Html.tr []
|
||||
[ Html.th [ class "address" ] [ text "Addr" ]
|
||||
, Html.th [] [ text "Value" ]
|
||||
]
|
||||
]
|
||||
, lazy viewRamContent model
|
||||
]
|
||||
]
|
||||
, div [ class "arrow", class "down"]
|
||||
[ div [ class "button" ]
|
||||
[ Html.a [ onClick (MsgManualStep ActRam2DataBus) ] [ text "Ram -> DataBus" ]]
|
||||
, div [] []
|
||||
]
|
||||
, div [ class "arrow", class "up"]
|
||||
[ div [ class "button" ]
|
||||
[ Html.a [ onClick (MsgManualStep ActDataBus2Ram) ] [ text "DataBus -> Ram" ]]
|
||||
, div [] []
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
viewRamContent : Model -> Html Msg
|
||||
viewRamContent model =
|
||||
let
|
||||
indexedRam =
|
||||
List.indexedMap Tuple.pair model.pc.ram
|
||||
|
||||
ram2table : ( Int, Int ) -> Html Msg
|
||||
ram2table entry =
|
||||
let
|
||||
id =
|
||||
Tuple.first entry
|
||||
|
||||
val =
|
||||
Tuple.second entry
|
||||
in
|
||||
Html.tr
|
||||
[ classList [ ( "current", id == model.pc.addressBus ) ] ]
|
||||
[ Html.td [ class "num" ] [ text (String.fromInt id) ]
|
||||
, Html.td [ class "num " ] [ text (String.fromInt val) ]
|
||||
]
|
||||
in
|
||||
Html.tbody [] (List.map ram2table indexedRam)
|
||||
|
||||
|
||||
viewCu : Model -> Html Msg
|
||||
viewCu model =
|
||||
div [ class "section", class "cu" ]
|
||||
[ div [ class "arrow", class "up", class "top"]
|
||||
[ div [ class "button" ]
|
||||
[ Html.a [ onClick (MsgManualStep ActInstructionReg2AddressBus)] [ text "InstR -> AddrB" ]]
|
||||
, div [] []
|
||||
]
|
||||
, h1 [ class "header" ] [ text "Control Unit" ]
|
||||
, p []
|
||||
[ text
|
||||
("Programm Counter: "
|
||||
++ String.fromInt model.pc.programmCounter
|
||||
)
|
||||
]
|
||||
, p []
|
||||
[ text
|
||||
("Instruction Register: "
|
||||
++ String.fromInt model.pc.instructionReg
|
||||
)
|
||||
]
|
||||
, p []
|
||||
[ text
|
||||
("µCode Counter: "
|
||||
++ String.fromInt model.pc.uCounter
|
||||
)
|
||||
]
|
||||
, div [ class "scroller" ]
|
||||
[ viewCuUCode model
|
||||
]
|
||||
, div [ class "arrow", class "up"]
|
||||
[ div [ class "button" ]
|
||||
[ Html.a [ onClick (MsgManualStep ActDataBus2InstructionReg) ] [ text "DB -> InstR" ]]
|
||||
, div [] []
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
viewCuUCode : Model -> Html Msg
|
||||
viewCuUCode model =
|
||||
Html.table []
|
||||
[ Html.thead [ class "head" ]
|
||||
[ Html.tr []
|
||||
[ Html.th [ class "address" ] [ text "Addr" ]
|
||||
, Html.th [] [ text "Code" ]
|
||||
]
|
||||
]
|
||||
, lazy viewCuUCodeContent model
|
||||
]
|
||||
|
||||
|
||||
viewCuUCodeContent : Model -> Html Msg
|
||||
viewCuUCodeContent model =
|
||||
let
|
||||
indexedList =
|
||||
List.indexedMap Tuple.pair model.uCode
|
||||
|
||||
list2table : ( Int, Maybe UAction ) -> Html Msg
|
||||
list2table may_t =
|
||||
let
|
||||
id =
|
||||
Tuple.first may_t
|
||||
|
||||
may_code =
|
||||
Tuple.second may_t
|
||||
in
|
||||
case may_code of
|
||||
Just code ->
|
||||
let
|
||||
possibleDescriptions : List ( UAction, String )
|
||||
possibleDescriptions =
|
||||
List.filter (\s -> Tuple.first s == code) uCodeDescriptions
|
||||
|
||||
codeDescription =
|
||||
case List.head possibleDescriptions of
|
||||
Just ( _, description ) ->
|
||||
description
|
||||
|
||||
_ ->
|
||||
"Idk what this is"
|
||||
in
|
||||
Html.tr
|
||||
[ classList [ ( "current", id == model.pc.uCounter ) ] ]
|
||||
[ Html.td [ class "num" ] [ text (String.fromInt id) ]
|
||||
, Html.td [] [ text codeDescription ]
|
||||
]
|
||||
|
||||
Nothing ->
|
||||
Html.tr [ class "empty" ]
|
||||
[ Html.td [ class "num" ] [ text (String.fromInt id) ]
|
||||
, Html.td [] [ text "Empty" ]
|
||||
]
|
||||
in
|
||||
Html.tbody [] (List.map list2table indexedList)
|
||||
|
||||
|
||||
viewAlu : Model -> Html Msg
|
||||
viewAlu model =
|
||||
div [ class "section", class "alu" ]
|
||||
[ h1 [ class "header" ] [ text "ALU" ]
|
||||
, p [] [ text ("Accumulator: " ++ String.fromInt model.pc.accumulator) ]
|
||||
, div [ class "arrow", class "up"]
|
||||
[ div [ class "button" ]
|
||||
[ Html.a [ onClick (MsgManualStep ActDataBus2Accumulator)] [ text "DB -> ALU" ]]
|
||||
, div [] []
|
||||
]
|
||||
, div [ class "arrow", class "down"]
|
||||
[ div [ class "button" ]
|
||||
[ Html.a [ onClick (MsgManualStep ActAccumulator2DataBus)] [ text "ALU -> DB" ]]
|
||||
, div [] []
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
viewDataBus : Model -> Html Msg
|
||||
viewDataBus model =
|
||||
div [ class "databus" ]
|
||||
[ Html.span [ class "label" ] [ text "Databus" ]
|
||||
, Html.span [] [ text (String.fromInt model.pc.dataBus) ]
|
||||
]
|
||||
|
||||
|
||||
viewAddressBus : Model -> Html Msg
|
||||
viewAddressBus model =
|
||||
div [ class "addressbus" ]
|
||||
[ Html.span [ class "label" ] [ text "Addressbus" ]
|
||||
, Html.span [] [ text (String.fromInt model.pc.addressBus) ]
|
||||
]
|
||||
|
||||
|
||||
|
||||
-- END VIEWERS
|
||||
-- ACTIONS
|
||||
|
||||
|
||||
actRam2DataBus : PC -> PC
|
||||
actRam2DataBus pc =
|
||||
let
|
||||
ab =
|
||||
pc.addressBus
|
||||
|
||||
db =
|
||||
valueAtInt ab pc.ram
|
||||
in
|
||||
{ pc | dataBus = db }
|
||||
|
||||
|
||||
actDataBus2InstructionReg : PC -> PC
|
||||
actDataBus2InstructionReg pc =
|
||||
{ pc | instructionReg = pc.dataBus }
|
||||
|
||||
|
||||
actResetUCounter : PC -> PC
|
||||
actResetUCounter pc =
|
||||
{ pc | uCounter = 0 }
|
||||
|
||||
|
||||
actInstructionReg2UCounter : PC -> PC
|
||||
actInstructionReg2UCounter pc =
|
||||
-- Remove last 5 digits as they are address
|
||||
-- Multiply by ten, because every instruction is 10 uCodes long
|
||||
{ pc | uCounter = pc.instructionReg // 100000 * 10 }
|
||||
|
||||
|
||||
actInstructionReg2AddressBus : PC -> PC
|
||||
actInstructionReg2AddressBus pc =
|
||||
-- Only bring last 5 digits to AB, because the rest is opcode
|
||||
{ pc | addressBus = pc.instructionReg - pc.instructionReg // 100000 * 100000 }
|
||||
|
||||
|
||||
actInstructionReg2ProgrammCounter : PC -> PC
|
||||
actInstructionReg2ProgrammCounter pc =
|
||||
-- Only bring last 5 digits to AB, because the rest is opcode
|
||||
{ pc | programmCounter = pc.instructionReg - pc.instructionReg // 100000 * 100000 }
|
||||
|
||||
|
||||
actProgrammCounterIncrement : PC -> PC
|
||||
actProgrammCounterIncrement pc =
|
||||
{ pc | programmCounter = pc.programmCounter + 1 }
|
||||
|
||||
|
||||
actProgrammCounter2AddressBus : PC -> PC
|
||||
actProgrammCounter2AddressBus pc =
|
||||
{ pc | addressBus = pc.programmCounter }
|
||||
|
||||
|
||||
actDataBus2Accumulator : PC -> PC
|
||||
actDataBus2Accumulator pc =
|
||||
{ pc | accumulator = pc.dataBus }
|
||||
|
||||
|
||||
actAccumulator2DataBus : PC -> PC
|
||||
actAccumulator2DataBus pc =
|
||||
{ pc | dataBus = pc.accumulator }
|
||||
|
||||
|
||||
actAccumulatorIncrement : PC -> PC
|
||||
actAccumulatorIncrement pc =
|
||||
{ pc | accumulator = pc.accumulator + 1 }
|
||||
|
||||
|
||||
actAccumulatorDecrement : PC -> PC
|
||||
actAccumulatorDecrement pc =
|
||||
{ pc | accumulator = pc.accumulator - 1 }
|
||||
|
||||
|
||||
actDataBus2Ram : PC -> PC
|
||||
actDataBus2Ram pc =
|
||||
let
|
||||
newRam =
|
||||
changeAt pc.addressBus pc.dataBus pc.ram
|
||||
in
|
||||
{ pc | ram = newRam }
|
||||
|
||||
|
||||
|
||||
-- END ACTIONS
|
||||
-- HELPERS
|
||||
|
||||
|
||||
valueAtInt : Int -> List Int -> Int
|
||||
valueAtInt n l =
|
||||
case valueAt n l of
|
||||
Just a ->
|
||||
a
|
||||
|
||||
Nothing ->
|
||||
0
|
||||
|
||||
|
||||
valueAt : Int -> List a -> Maybe a
|
||||
valueAt n l =
|
||||
List.head (List.drop n l)
|
||||
|
||||
|
||||
changeAt : Int -> Int -> List Int -> List Int
|
||||
changeAt pos newVal list =
|
||||
let
|
||||
before =
|
||||
List.take pos list
|
||||
|
||||
after =
|
||||
List.drop (pos + 1) list
|
||||
|
||||
len =
|
||||
List.length list
|
||||
in
|
||||
if pos > len then
|
||||
let
|
||||
before2 =
|
||||
List.append before (List.repeat (pos - len) 0)
|
||||
in
|
||||
List.append before2 (newVal :: after)
|
||||
|
||||
else
|
||||
List.append before (newVal :: after)
|
||||
|
||||
|
||||
|
||||
-- END HELPERS
|
||||
-- GENERAL
|
||||
|
||||
|
||||
subscriptions : Model -> Sub Msg
|
||||
subscriptions model =
|
||||
recieveLocalSession MsgLocalSessionRecieve
|
||||
|
||||
|
||||
init : () -> ( Model, Cmd Msg )
|
||||
init flags =
|
||||
( Model initialPC initialUCodes True, Cmd.none )
|
||||
|
||||
|
||||
main : Program () Model Msg
|
||||
main =
|
||||
Browser.element
|
||||
{ init = init
|
||||
, view = view
|
||||
, update = update
|
||||
, subscriptions = subscriptions
|
||||
}
|
||||
Reference in New Issue
Block a user