save progress before switching to new bus architecture

hs/Fetch.hs

@@ -6,16 +6,15 @@ module Fetch(
   FetchResult(..)) where
 
 import Clash.Prelude
-    ( Eq((==)),
-      KnownNat,
-      Bool(False, True),
-      (!!),
-      Bits(shiftR, (.&.)) )
 import Types(Mem, Addr, Insn)
-import Util(endianSwapWord)
 import Bus(ReadResponse, WriteResponse, read)
 import Bus(Peripherals(..))
-import BusTypes(ReadRequest(..), TransactionSize(..))
+import BusTypes(
+  ReadRequest(..),
+  TransactionSize(..),
+  BusVal(..),
+  BusError(..))
+import Exceptions(Exception(..), exceptionCode, isSynchronousException)
 
 import GHC.IO (IO)
 import GHC.Base (Applicative(pure))
@@ -23,6 +22,9 @@ import GHC.Base (Applicative(pure))
 data FetchResult  = Instruction Insn
                   | Misaligned Addr
 
+data FetchResult1  = Instruction1 Insn
+                   | InstructionException Exception
+
 fetchInstruction :: KnownNat n => Mem n -> Addr -> FetchResult
 fetchInstruction mem addr =
   let
@@ -36,6 +38,16 @@ fetchInstruction mem addr =
       True -> Instruction insn
       False -> Misaligned addr
 
-fetchInstruction1 :: Peripherals -> Addr -> IO ReadResponse
+fetchInstruction1 :: Peripherals -> Addr -> IO FetchResult1
 fetchInstruction1 peripherals addr =
-  read (BusTypes.Request addr BusTypes.SizeFullWord) peripherals
+  do
+    readReasponse <-Bus.read (BusTypes.Request addr BusTypes.SizeFullWord) peripherals
+    case readReasponse of
+      Right (BusFullWord insn) ->
+        pure $ Instruction1 insn
+      Left  UnAligned ->
+        pure $ InstructionException InstructionAddressMisaligned
+      Left  UnMapped ->
+        pure $ InstructionException InstructionAccessFault
+      Right _ ->
+        pure $ InstructionException InstructionAccessFault