1027 lines
29 KiB
Elm
1027 lines
29 KiB
Elm
--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 as HEvent exposing (onClick, onInput)
|
|
import Html.Lazy exposing (lazy)
|
|
import Tuple
|
|
import Array exposing (get)
|
|
import Html exposing (address)
|
|
import Json.Encode as JE
|
|
import Json.Decode as JD
|
|
import Html.Events exposing (targetValue)
|
|
|
|
modelVersion = 1
|
|
|
|
-- Note that general Stuff is at the end of the document
|
|
-- PORTS
|
|
|
|
|
|
port sendUUpdate : String -> Cmd msg
|
|
|
|
|
|
port localStorageSend : String -> Cmd msg
|
|
|
|
|
|
port localStorageRecieve : (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 UAction
|
|
, autoscroll : Bool
|
|
}
|
|
|
|
|
|
type UAction
|
|
= ActAccumulator2DataBus
|
|
| ActAccumulatorDecrement
|
|
| ActAccumulatorIncrement
|
|
| ActDataBus2Accumulator
|
|
| ActDataBus2InstructionReg
|
|
| ActDataBus2Ram
|
|
| ActInstructionReg2AddressBus
|
|
| ActInstructionReg2ProgrammCounter
|
|
| ActInstructionReg2UCounter
|
|
| ActProgrammCounterIncrement
|
|
| ActRam2DataBus
|
|
| ActResetUCounter
|
|
| ActProgrammCounter2AddressBus
|
|
| ActNothing
|
|
|
|
|
|
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" )
|
|
, ( ActNothing, "Empty" )
|
|
]
|
|
|
|
uCodeIds : List ( UAction, String )
|
|
uCodeIds =
|
|
[ ( ActAccumulator2DataBus, "acc2db" )
|
|
, ( ActAccumulatorDecrement, "accDec" )
|
|
, ( ActAccumulatorIncrement, "accInc" )
|
|
, ( ActDataBus2Accumulator, "db2acc" )
|
|
, ( ActDataBus2InstructionReg, "db2ir" )
|
|
, ( ActDataBus2Ram, "db2ram" )
|
|
, ( ActInstructionReg2AddressBus, "ir2ab" )
|
|
, ( ActInstructionReg2ProgrammCounter, "ir2pc" )
|
|
, ( ActInstructionReg2UCounter, "ir2uc" )
|
|
, ( ActProgrammCounterIncrement, "pcInc" )
|
|
, ( ActRam2DataBus, "ram2db" )
|
|
, ( ActResetUCounter, "ucReset" )
|
|
, ( ActProgrammCounter2AddressBus, "pc2ab" )
|
|
, ( ActNothing, "n" )
|
|
]
|
|
|
|
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 )
|
|
, ( ActNothing, (\s -> s))
|
|
]
|
|
|
|
|
|
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 UAction
|
|
initialUCodes =
|
|
[ ActProgrammCounter2AddressBus -- 000
|
|
, ActRam2DataBus -- 001
|
|
, ActDataBus2InstructionReg -- 002
|
|
, ActProgrammCounterIncrement -- 003
|
|
, ActInstructionReg2UCounter -- 004
|
|
, ActNothing -- 005
|
|
, ActNothing
|
|
, ActNothing
|
|
, ActNothing
|
|
, ActNothing -- 009
|
|
|
|
-- 010 LOADA
|
|
, ActInstructionReg2AddressBus -- 010
|
|
, ActRam2DataBus -- 011
|
|
, ActDataBus2Accumulator -- 012
|
|
, ActResetUCounter -- 013
|
|
, ActNothing -- 014
|
|
, ActNothing
|
|
, ActNothing
|
|
, ActNothing
|
|
, ActNothing
|
|
, ActNothing -- 019
|
|
|
|
-- 020 STOA
|
|
, ActAccumulator2DataBus -- 020
|
|
, ActInstructionReg2AddressBus -- 021
|
|
, ActDataBus2Ram -- 022
|
|
, ActResetUCounter -- 023
|
|
, ActNothing --024
|
|
, ActNothing
|
|
, ActNothing
|
|
, ActNothing
|
|
, ActNothing
|
|
, ActNothing -- 029
|
|
|
|
-- 030 INCA
|
|
, ActAccumulatorIncrement -- 030
|
|
, ActResetUCounter -- 031
|
|
, ActNothing -- 032
|
|
, ActNothing
|
|
, ActNothing
|
|
, ActNothing
|
|
, ActNothing
|
|
, ActNothing
|
|
, ActNothing
|
|
, ActNothing -- 039
|
|
|
|
-- 040 JMP
|
|
, ActInstructionReg2ProgrammCounter -- 040
|
|
, ActResetUCounter -- 041
|
|
, ActNothing -- 042
|
|
, ActNothing
|
|
, ActNothing
|
|
, ActNothing
|
|
, ActNothing
|
|
, ActNothing
|
|
, ActNothing
|
|
, ActNothing -- 049
|
|
]
|
|
|
|
|
|
type Msg
|
|
= MsgUCycleStep
|
|
| MsgInstructionStep
|
|
| MsgReset
|
|
| MsgAutoscrollUpdate
|
|
| MsgManualStep UAction
|
|
| MsgRamEditAddress Int String
|
|
| MsgRamEditInstr Int String
|
|
| MsgRamAddBelow
|
|
| MsgCuEditAction Int String
|
|
| MsgCuAddBelow
|
|
| MsgCuInstrRegEdit String
|
|
| MsgCuUCounterEdit String
|
|
| MsgCuProgCounterEdit String
|
|
| MsgEditAddressBus String
|
|
| MsgEditDataBus String
|
|
| MsgAluEdit String
|
|
| MsgLocalSessionExport
|
|
| MsgLocalSessionRecieve String
|
|
|
|
|
|
update : Msg -> Model -> ( Model, Cmd Msg )
|
|
update msg model =
|
|
let
|
|
updateModel new_model =
|
|
( new_model, cmdUpdateLocalStorage new_model)
|
|
in
|
|
|
|
case msg of
|
|
MsgUCycleStep ->
|
|
( uStepPC model
|
|
, cmdSenduUpdate model
|
|
)
|
|
|
|
MsgInstructionStep ->
|
|
( model, Cmd.none )
|
|
|
|
MsgReset ->
|
|
updateModel { model | pc = { initialPC | ram = model.pc.ram } }
|
|
|
|
MsgManualStep action ->
|
|
let
|
|
instruction = getAction action
|
|
in
|
|
updateModel { model | pc = instruction model.pc}
|
|
|
|
MsgRamEditAddress addr may_int ->
|
|
case String.toInt may_int of
|
|
Just int ->
|
|
let
|
|
(inst,_) = seperateInstructionsEntry ( valueAtInt addr model.pc.ram )
|
|
new_val = inst * 100000 + int
|
|
old_pc = model.pc
|
|
new_pc = { old_pc | ram = (changeAtInt addr new_val old_pc.ram) }
|
|
in
|
|
updateModel { model | pc = new_pc }
|
|
_ -> (model, Cmd.none)
|
|
|
|
MsgRamEditInstr addr may_int ->
|
|
case String.toInt may_int of
|
|
Just int ->
|
|
let
|
|
(_,address) = seperateInstructionsEntry ( valueAtInt addr model.pc.ram )
|
|
new_val = int * 100000 + address
|
|
old_pc = model.pc
|
|
new_pc = { old_pc | ram = (changeAtInt addr new_val old_pc.ram) }
|
|
in
|
|
updateModel { model | pc = new_pc }
|
|
_ -> ( model, Cmd.none )
|
|
|
|
MsgRamAddBelow ->
|
|
let
|
|
old_pc = model.pc
|
|
new_pc = {old_pc | ram = old_pc.ram ++ [0]}
|
|
in
|
|
updateModel {model | pc = new_pc}
|
|
|
|
MsgCuEditAction addr may_action ->
|
|
case string2uAction may_action of
|
|
Just action ->
|
|
let
|
|
newCode = changeAtUCode addr action model.uCode
|
|
in
|
|
updateModel { model | uCode = newCode }
|
|
_ -> ( model, Cmd.none )
|
|
|
|
MsgCuAddBelow ->
|
|
updateModel {model | uCode = model.uCode ++ [ ActNothing ]}
|
|
|
|
MsgCuInstrRegEdit text ->
|
|
case String.toInt text of
|
|
Just int ->
|
|
let old_pc = model.pc
|
|
new_pc = { old_pc | instructionReg = int }
|
|
in
|
|
updateModel { model | pc = new_pc }
|
|
_ -> ( model, Cmd.none )
|
|
|
|
MsgCuProgCounterEdit text ->
|
|
case String.toInt text of
|
|
Just int ->
|
|
let old_pc = model.pc
|
|
new_pc = { old_pc | programmCounter = int }
|
|
in
|
|
updateModel { model | pc = new_pc }
|
|
_ -> ( model, Cmd.none )
|
|
|
|
MsgCuUCounterEdit text ->
|
|
case String.toInt text of
|
|
Just int ->
|
|
let old_pc = model.pc
|
|
new_pc = { old_pc | uCounter = int }
|
|
in
|
|
( { model | pc = new_pc }, cmdSenduUpdate model )
|
|
_ -> ( model, Cmd.none )
|
|
|
|
MsgEditAddressBus text ->
|
|
case String.toInt text of
|
|
Just int ->
|
|
let old_pc = model.pc
|
|
new_pc = { old_pc | addressBus = int }
|
|
in
|
|
( { model | pc = new_pc }, cmdSenduUpdate model )
|
|
_ -> ( model, Cmd.none )
|
|
|
|
MsgEditDataBus text ->
|
|
case String.toInt text of
|
|
Just int ->
|
|
let old_pc = model.pc
|
|
new_pc = { old_pc | dataBus = int }
|
|
in
|
|
updateModel { model | pc = new_pc }
|
|
_ -> ( model, Cmd.none )
|
|
|
|
MsgAluEdit text ->
|
|
case String.toInt text of
|
|
Just int ->
|
|
let old_pc = model.pc
|
|
new_pc = { old_pc | accumulator = int }
|
|
in
|
|
updateModel { model | pc = new_pc }
|
|
_ -> ( model, Cmd.none )
|
|
|
|
MsgAutoscrollUpdate ->
|
|
updateModel { model | autoscroll = not model.autoscroll }
|
|
|
|
MsgLocalSessionExport ->
|
|
( model, cmdUpdateLocalStorage model )
|
|
|
|
MsgLocalSessionRecieve message_in ->
|
|
case decodeModel message_in of
|
|
Just new_model ->
|
|
( new_model , Cmd.none )
|
|
_ -> ( model, 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 UAction
|
|
may_instruction =
|
|
valueAt uCounter model.uCode
|
|
in
|
|
case may_instruction of
|
|
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
|
|
|
|
|
|
encodeModel : Model -> String
|
|
encodeModel model =
|
|
JE.object
|
|
[ ( "model-version", JE.int modelVersion )
|
|
, ( "pc"
|
|
, JE.object
|
|
[ ("addressBus", JE.int model.pc.addressBus )
|
|
, ("dataBus", JE.int model.pc.dataBus )
|
|
, ("instructionReg", JE.int model.pc.instructionReg )
|
|
, ("programmCounter", JE.int model.pc.programmCounter )
|
|
, ("uCounter", JE.int model.pc.uCounter )
|
|
, ("accumulator", JE.int model.pc.accumulator )
|
|
, ("ram", JE.list JE.int model.pc.ram)
|
|
]
|
|
)
|
|
, ( "uCode", JE.list JE.string (List.map uAction2String model.uCode) )
|
|
, ( "autoscroll", JE.bool model.autoscroll )
|
|
]
|
|
|> JE.encode 0
|
|
|
|
|
|
decodeModel : String -> Maybe Model
|
|
decodeModel text =
|
|
let
|
|
error2maybe err =
|
|
case err of
|
|
Ok val -> Just val
|
|
_ -> Nothing
|
|
|
|
uCodeDecoder =
|
|
JD.map
|
|
(\s -> Maybe.withDefault ActNothing <| string2uAction s )
|
|
(JD.string)
|
|
in
|
|
text
|
|
|> JD.decodeString
|
|
( JD.map3
|
|
Model
|
|
( JD.field "pc"
|
|
( JD.map7
|
|
PC
|
|
(JD.field "ram" (JD.list JD.int))
|
|
(JD.field "dataBus" JD.int)
|
|
(JD.field "addressBus" JD.int)
|
|
(JD.field "instructionReg" JD.int)
|
|
(JD.field "programmCounter" JD.int)
|
|
(JD.field "uCounter" JD.int)
|
|
(JD.field "accumulator" JD.int)
|
|
)
|
|
)
|
|
( JD.field "uCode" (JD.list uCodeDecoder) )
|
|
( JD.field "autoscroll" JD.bool )
|
|
)
|
|
|> error2maybe
|
|
|
|
cmdUpdateLocalStorage : Model -> Cmd Msg
|
|
cmdUpdateLocalStorage model =
|
|
localStorageSend (encodeModel model)
|
|
|
|
cmdSenduUpdate : Model -> Cmd Msg
|
|
cmdSenduUpdate model =
|
|
Cmd.batch
|
|
[ cmdUpdateLocalStorage model
|
|
, sendUUpdate "update"
|
|
]
|
|
|
|
-- VIEWERS
|
|
|
|
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 "Autoscroll" ]
|
|
]
|
|
, button [ onClick MsgLocalSessionExport ] [ text "Export" ]
|
|
]
|
|
, 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
|
|
|
|
(instruction, address) = seperateInstructionsEntry val
|
|
in
|
|
Html.tr
|
|
[ classList [ ( "current", id == model.pc.addressBus ) ] ]
|
|
[ Html.td [ class "num" ] [ text (addLeadingZero id 3) ]
|
|
, Html.td [ class "num " ]
|
|
[ Html.input
|
|
[ HAttr.type_ "number"
|
|
, HAttr.value (addLeadingZero instruction 3)
|
|
, onInput (MsgRamEditInstr id)
|
|
, class "ram-entry"
|
|
, class "instruction"
|
|
]
|
|
[]
|
|
, Html.input
|
|
[ HAttr.type_ "number"
|
|
, HAttr.value (addLeadingZero address 5)
|
|
, onInput (MsgRamEditAddress id)
|
|
, class "ram-entry"
|
|
, class "address"
|
|
]
|
|
[]
|
|
]
|
|
]
|
|
in
|
|
Html.tbody []
|
|
((List.map ram2table indexedRam)
|
|
++
|
|
[ Html.tr []
|
|
[ Html.td [] []
|
|
, Html.td []
|
|
[ button
|
|
[ onClick MsgRamAddBelow ]
|
|
[ text "Add Entry"]
|
|
]
|
|
]
|
|
]
|
|
)
|
|
|
|
|
|
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 [] []
|
|
]
|
|
, div [ class "arrow", class "up", class "top", class "arrow2"]
|
|
[ div [ class "button" ]
|
|
[ Html.a [ onClick (MsgManualStep ActProgrammCounter2AddressBus)] [ text "ProgCounter -> AddrB" ]]
|
|
, div [] []
|
|
]
|
|
, h1 [ class "header" ] [ text "Control Unit" ]
|
|
, p []
|
|
[ div [class "input-row"]
|
|
[ Html.label [ HAttr.for "cu-progcounter" ] [ text "Programm Counter:" ]
|
|
, Html.input
|
|
[ HAttr.type_ "number"
|
|
, HAttr.id "cu-progcounter"
|
|
, value (addLeadingZero model.pc.programmCounter 3)
|
|
, onInput MsgCuProgCounterEdit
|
|
] []
|
|
]
|
|
|
|
, div [class "input-row"]
|
|
[ Html.label [ HAttr.for "cu-instrReg" ] [ text "Instruction Register:" ]
|
|
, Html.input
|
|
[ HAttr.type_ "number"
|
|
, HAttr.id "cu-instrReg"
|
|
, value (addLeadingZero model.pc.instructionReg 8)
|
|
, onInput MsgCuInstrRegEdit
|
|
] []
|
|
]
|
|
|
|
, div [class "input-row"]
|
|
[ Html.label [ HAttr.for "cu-uCounter" ] [ text "µCode Counter:" ]
|
|
, Html.input
|
|
[ HAttr.type_ "number"
|
|
, HAttr.id "cu-uCounter"
|
|
, value (addLeadingZero model.pc.uCounter 4)
|
|
, onInput MsgCuUCounterEdit
|
|
] []
|
|
]
|
|
|
|
]
|
|
, 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, UAction ) -> Html Msg
|
|
list2table t =
|
|
let
|
|
id =
|
|
Tuple.first t
|
|
|
|
code =
|
|
Tuple.second t
|
|
in
|
|
Html.tr
|
|
[ classList [ ( "current", id == model.pc.uCounter ), ("empty", code == ActNothing) ] ]
|
|
[ Html.td [ class "num" ] [ text (addLeadingZero id 4) ]
|
|
, Html.td [] [ viewCuInstrSelect id code ]
|
|
]
|
|
|
|
in
|
|
Html.tbody []
|
|
((List.map list2table indexedList)
|
|
++
|
|
[ Html.tr []
|
|
[ Html.td [] []
|
|
, Html.td []
|
|
[ button
|
|
[ onClick MsgCuAddBelow ]
|
|
[ text "Add Entry"]
|
|
]
|
|
]
|
|
]
|
|
)
|
|
|
|
viewCuInstrSelect : Int -> UAction -> Html Msg
|
|
viewCuInstrSelect id current =
|
|
let
|
|
info2option (action, info) =
|
|
Html.option
|
|
[ HAttr.selected (action == current)
|
|
, HAttr.value (uAction2String action) ]
|
|
[ text info ]
|
|
listOptions = List.map info2option uCodeDescriptions
|
|
in
|
|
Html.select
|
|
[ HEvent.on "change" ( JD.map (MsgCuEditAction id) selectCuValueDecoder) ]
|
|
listOptions
|
|
|
|
|
|
viewAlu : Model -> Html Msg
|
|
viewAlu model =
|
|
div [ class "section", class "alu" ]
|
|
[ h1 [ class "header" ] [ text "ALU" ]
|
|
, p []
|
|
[ Html.label [ HAttr.for "alu-accumulator" ] [ text "Accumulator:" ]
|
|
, Html.input
|
|
[ HAttr.type_ "number"
|
|
, HAttr.id "alu-accumulator"
|
|
, value (addLeadingZero model.pc.accumulator 8)
|
|
, onInput MsgAluEdit
|
|
] []
|
|
|
|
]
|
|
, 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 []
|
|
[ Html.input
|
|
[ HAttr.type_ "number"
|
|
, value (addLeadingZero model.pc.dataBus 8)
|
|
, onInput MsgEditDataBus
|
|
] []
|
|
]
|
|
]
|
|
|
|
|
|
viewAddressBus : Model -> Html Msg
|
|
viewAddressBus model =
|
|
div [ class "addressbus" ]
|
|
[ Html.span [ class "label" ] [ text "Addressbus" ]
|
|
, Html.span []
|
|
[ Html.input
|
|
[ HAttr.type_ "number"
|
|
, value (addLeadingZero model.pc.addressBus 3)
|
|
, onInput MsgEditAddressBus
|
|
] []
|
|
]
|
|
]
|
|
|
|
|
|
viewInstrEntry : Int -> Html Msg
|
|
viewInstrEntry i =
|
|
let
|
|
(instruction, address) = seperateInstructionsEntry i
|
|
in
|
|
text ( (addLeadingZero instruction 3) ++ " " ++ (addLeadingZero address 5) )
|
|
|
|
|
|
|
|
|
|
|
|
-- 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 =
|
|
-- Multiply by ten, because every instruction is 10 uCodes long
|
|
let
|
|
(instruction, address) = seperateInstructionsEntry pc.instructionReg
|
|
in
|
|
{ pc | uCounter = instruction * 10}
|
|
|
|
|
|
actInstructionReg2AddressBus : PC -> PC
|
|
actInstructionReg2AddressBus pc =
|
|
let
|
|
(instruction, address) = seperateInstructionsEntry pc.instructionReg
|
|
in
|
|
{ pc | addressBus = address }
|
|
|
|
|
|
actInstructionReg2ProgrammCounter : PC -> PC
|
|
actInstructionReg2ProgrammCounter pc =
|
|
let
|
|
(instruction, address) = seperateInstructionsEntry pc.instructionReg
|
|
in
|
|
|
|
{ pc | programmCounter = address }
|
|
|
|
|
|
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 =
|
|
changeAtInt 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)
|
|
|
|
|
|
changeAtInt : Int -> Int -> List Int -> List Int
|
|
changeAtInt pos newVal list =
|
|
changeAt pos newVal 0 list
|
|
|
|
|
|
changeAtUCode : Int -> UAction -> List UAction -> List UAction
|
|
changeAtUCode pos newVal list =
|
|
changeAt pos newVal ActNothing list
|
|
|
|
changeAt : Int -> a -> a ->List a -> List a
|
|
changeAt pos newVal default 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) default)
|
|
in
|
|
List.append before2 (newVal :: after)
|
|
|
|
else
|
|
List.append before (newVal :: after)
|
|
|
|
|
|
addLeadingZero : Int -> Int -> String
|
|
addLeadingZero number length =
|
|
let
|
|
num_str = String.fromInt number
|
|
in
|
|
if number < 10 then
|
|
(String.fromList (List.repeat (length - 1) '0') ) ++ num_str
|
|
else if number < 100 then
|
|
(String.fromList (List.repeat (length - 2) '0') ) ++ num_str
|
|
else if number < 1000 then
|
|
(String.fromList (List.repeat (length - 3) '0') ) ++ num_str
|
|
else if number < 10000 then
|
|
(String.fromList (List.repeat (length - 4) '0') ) ++ num_str
|
|
else if number < 100000 then
|
|
(String.fromList (List.repeat (length - 5) '0') ) ++ num_str
|
|
else if number < 1000000 then
|
|
(String.fromList (List.repeat (length - 6) '0') ) ++ num_str
|
|
else if number < 10000000 then
|
|
(String.fromList (List.repeat (length - 7) '0') ) ++ num_str
|
|
else if number < 100000000 then
|
|
(String.fromList (List.repeat (length - 8) '0') ) ++ num_str
|
|
else
|
|
num_str
|
|
|
|
seperateInstructionsEntry : Int -> (Int, Int)
|
|
seperateInstructionsEntry i =
|
|
let
|
|
instruction = i // 100000
|
|
address = i - instruction*100000
|
|
in
|
|
(instruction, address)
|
|
|
|
|
|
uAction2String : UAction -> String
|
|
uAction2String action =
|
|
let
|
|
filtered_list = List.filter (\s -> Tuple.first s == action) uCodeIds
|
|
in
|
|
case List.head filtered_list of
|
|
Just (_,info) -> info
|
|
Nothing -> "IDK"
|
|
|
|
string2uAction : String -> Maybe UAction
|
|
string2uAction msg =
|
|
let
|
|
filtered_list = List.filter (\s -> Tuple.second s == msg) uCodeIds
|
|
in
|
|
case List.head filtered_list of
|
|
Just (action,_) -> Just action
|
|
_ -> Nothing
|
|
|
|
|
|
selectCuValueDecoder : JD.Decoder String
|
|
selectCuValueDecoder =
|
|
JD.field "target" ( JD.field "value" JD.string)
|
|
|
|
-- END HELPERS
|
|
-- GENERAL
|
|
|
|
|
|
subscriptions : Model -> Sub Msg
|
|
subscriptions model =
|
|
localStorageRecieve 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
|
|
}
|