module Main (main) where

import Machine
import InstructionSet
import DeepSeq

import Data.Array.IO
import Data.Word
import Data.Bits
import System.IO
import Control.Monad
import CmdlineArgs

import GHC.Base
import GHC.Handle

main :: IO ()
main = do
        (args, nonOpts)  <- parseArgs

--      let ll = getLogLevel opts
--      initLogging ll UseStderr

        file <- case nonOpts of
                    [f] -> return f
                    _   -> error "Missing \"program\" file"        
        case args of
          [DumpInstrs] -> dumpInstrs file
          _            -> readAndExec file

readIntoZeroArray :: FilePath -> IO MachPlatterArray
readIntoZeroArray file = do
        h    <- openFile file ReadMode
        sz   <- fromIntegral `fmap` hFileSize h
        when ((sz `mod` 4) /= 0) $ error "Program size is not a multiple of 32 bits"
        let sz32 = sz `div` 4
        arr  <- newArray (0, sz32 - 1) 0 :: IO (IOUArray UInt32 UInt32)
        getArray32 h arr
        return arr


-- fill a Word32 array directly
getArray32 :: Handle -> IOUArray UInt32 UInt32 -> IO ()
getArray32 h arr = h `seq` arr `seq` go 0
    where
          go :: UInt32 -> IO ()
          go n | n `seq` False = undefined -- strict
               | n >= sz32     = return ()
               | otherwise     = do x <- getWord32 h
                                    writeArray arr n x
                                    go (n+1)
          sz32 = (snd . bounds $ arr) + 1

-- read a Word32 directly
getWord32 :: Handle -> IO UInt32
getWord32 h = h `seq` do
    w1 <- getWord8 h
    w2 <- getWord8 h
    w3 <- getWord8 h
    w4 <- getWord8 h
    return $!! ((fromIntegral w1 `shiftL` 24) .|.
           (fromIntegral w2 `shiftL` 16) .|.
           (fromIntegral w3 `shiftL`  8) .|.
           (fromIntegral w4))
{-# INLINE getWord32 #-}

-- read a Word8
getWord8 :: Handle -> IO Word8
getWord8 h = h `seq` do
    c <- hGetChar h
    return $! (fromIntegral (ord c))
{-# INLINE getWord8 #-}

readAndExec :: FilePath -> IO ()
readAndExec file = do
         zeroArray <- readIntoZeroArray file
         run zeroArray
         return ()

dumpInstrs :: FilePath -> IO ()
dumpInstrs file = do
  zeroArray <- readIntoZeroArray file
  let (lb, ub) = bounds zeroArray
      dumpLoop i 
        | i <= ub = do instr <- (readArray zeroArray i)
                       case decode instr  of 
                         instr' -> putStrLn $ show $ instr'
                       dumpLoop (i+1)
        | otherwise = return ()
  dumpLoop lb