--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.Decode as JD import Html.Events exposing (targetValue) -- 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 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" ) ] 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 | 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 ) 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 ({ model | pc = new_pc } , Cmd.none ) _ -> (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 ({ model | pc = new_pc } , Cmd.none ) _ -> ( model, Cmd.none ) MsgRamAddBelow -> let old_pc = model.pc new_pc = {old_pc | ram = old_pc.ram ++ [0]} in ({model | pc = new_pc}, Cmd.none) MsgCuEditAction addr may_action -> case string2uAction may_action of Just action -> let newCode = changeAtUCode addr action model.uCode in ({ model | uCode = newCode }, Cmd.none) _ -> ( model, Cmd.none ) MsgCuAddBelow -> ( {model | uCode = model.uCode ++ [ ActNothing ]} , Cmd.none ) MsgCuInstrRegEdit text -> case String.toInt text of Just int -> let old_pc = model.pc new_pc = { old_pc | instructionReg = int } in ( { model | pc = new_pc }, Cmd.none ) _ -> ( model, Cmd.none ) MsgCuProgCounterEdit text -> case String.toInt text of Just int -> let old_pc = model.pc new_pc = { old_pc | programmCounter = int } in ( { model | pc = new_pc }, Cmd.none ) _ -> ( 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 }, sendUUpdate "uCycle updated" ) _ -> ( 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 }, sendUUpdate "uCycle updated" ) _ -> ( model, Cmd.none ) MsgEditDataBus text -> case String.toInt text of Just int -> let old_pc = model.pc new_pc = { old_pc | dataBus = int } in ( { model | pc = new_pc }, Cmd.none ) _ -> ( model, Cmd.none ) MsgAluEdit text -> case String.toInt text of Just int -> let old_pc = model.pc new_pc = { old_pc | accumulator = int } in ( { model | pc = new_pc }, Cmd.none ) _ -> ( model, 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 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 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 (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) ] [ 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) uCodeDescriptions 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) uCodeDescriptions 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 = 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 }