content: module Platform.Run32 where
  import System.IO
  import System.Environment
  import System.Exit
  import Data.Int
  import Data.List
  import Data.Word
  import Utility.Utility
  import Spec.Machine
  import Platform.Minimal32
  import Platform.MMIO
  import Utility.Elf
  import qualified Spec.CSRField as Field
  import Spec.CSRFile
  import Spec.Decode
  import Spec.Execute
  import Utility.MapMemory
  import Control.Monad.Trans
  import Control.Monad.Trans.State
  import qualified Data.Map as S
  import Debug.Trace
  import Numeric (showHex, readHex)
  
  processLine :: String -> (Int, [(Int, Word8)]) -> (Int, [(Int, Word8)])
  processLine ('@':xs) (p, l) = ((fst $ head $ readHex xs) * 4, l)
  processLine s (p, l) = (p + 4, l ++ (zip [p..] $ splitWord (fst $ head $ readHex s :: Word32)))
  
  readHexFile :: FilePath -> IO [(Int, Word8)]
  readHexFile f = do
    h <- openFile f ReadMode
    helper h (0, [])
    where helper h l = do
            s <- hGetLine h
            done <- hIsEOF h
            if (null s)
              then return $ snd l
              else if done
                   then return $ snd $ processLine s l
                   else helper h (processLine s l)
  
  checkInterrupt :: IO Bool
  checkInterrupt = do
    ready <- hReady stdin
    if ready then do
      c <- hLookAhead stdin
      if c == '!' then do
        _ <- getChar
        _ <- getChar
        return True
      else return False
    else return False
  
  helper :: Maybe Int32 -> IOState Minimal32 Int32
  helper maybeToHostAddress = do
    toHostValue <- case maybeToHostAddress of
      Nothing -> return 0 -- default value
      Just toHostAddress -> loadWord Execute toHostAddress
    if toHostValue /= 0
      then do
        -- quit running
        if toHostValue == 1
          then trace "PASSED" (return 0)
          else trace ("FAILED " ++ (show $ quot toHostValue 2)) (return 1)
      else do
        pc <- getPC
        inst <- loadWord Fetch pc
        if inst == 0x6f -- Stop on infinite loop instruction.
          then do
              cycles <- getCSRField Field.MCycle
              trace ("Cycles: " ++ show cycles) (return ())
              instret <- getCSRField Field.MInstRet
              trace ("Insts: " ++ show instret) (return ())
              getRegister 10
          else do
          setPC (pc + 4)
          pc <- getPC
          execute (decode RV32IM $ (fromIntegral:: Int32 -> MachineInt) inst)
          interrupt <- liftIO checkInterrupt
          if interrupt then do
            -- Signal interrupt by setting MEIP high.
            setCSRField Field.MEIP 1
          else return ()
          commit
          helper maybeToHostAddress
  
  runProgram :: Maybe Int32 -> Minimal32 -> IO (Int32, Minimal32)
  runProgram maybeToHostAddress = runStateT (helper maybeToHostAddress)
  
  readProgram :: String -> IO (Maybe Int32, [(Int, Word8)])
  readProgram f = do
    if ".hex" `isSuffixOf` f
      then do
      mem <- readHexFile f
      return (Nothing, mem)
      else do
      mem <- readElf f
      maybeToHostAddress <- readElfSymbol "tohost" f
      return (fmap (fromIntegral:: Word64 -> Int32) maybeToHostAddress, mem)
  
  runFile :: String -> IO Int32
  runFile f = do
    (maybeToHostAddress, mem) <- readProgram f
    let c = Minimal32 { registers = (take 31 $ repeat 0),
                        csrs = (resetCSRFile 32),
                        pc = (fromIntegral:: Word32 -> Int32) (0x80000000 :: Word32),
                        nextPC = 0,
                        privMode = Machine,
                        mem = MapMemory { bytes = S.fromList mem, reservation = Nothing } } in
      fmap fst $ runProgram maybeToHostAddress c
  
  runFiles :: [String] -> IO Int32
  runFiles (file:files) = do
      myreturn <- runFile file
      putStr (file ++ ": " ++ (show myreturn) ++ "\n")
      othersreturn <- runFiles files
      if myreturn /= 0
          then return myreturn
          else return othersreturn
  runFiles [] = return 0
  
  main :: IO ()
  main = do
    args <- getArgs
    retval <- case args of
      [] -> do
        putStr "ERROR: this program expects one or more elf files as command-line arguments\n"
        return 1
      [file] -> runFile file
      files -> runFiles files
    exitWith (if retval == 0 then ExitSuccess else ExitFailure $ (fromIntegral:: Int32 -> Int) retval)
  