runThread :: Logfile -> History -> ThreadId -> Topped AccessNr -> Either String History
runThread logfile hist tid acc =
    unsafePerformIO $ do worker <- getWorker False hist
                         mustBeThawed "runThread" worker
                         (evt', newHist, rs) <- runThreadToEventWorker worker hist tid acc
                         case (evt', rs) of
                           (Nothing, _) ->
                               {- nothing which requires special help -}
                               return $ Right $ appendHistory hist $ HistoryRun tid acc
                           (Just evt, ReplayStateOkay acc') ->
                               if Finite acc' <= acc
                               then do let lp = history_logfile_ptr hist
                                           fixedHist =
                                              case nextRecord logfile lp of
                                                Nothing ->
                                                    error "unexpected end of log when worker thought there was more?"
                                                Just (logrecord, nextLogPtr) ->
                                                    let success = return . Right
                                                        justAdvance = success (advanceLog newHist nextLogPtr, True)
                                                        failed = return . Left
                                                        
                                                        {- Go and process all the populate memory records which come
                                                           after logptr. -}
                                                        processPopMemRecords pphist logptr =
                                                            case nextRecord logfile logptr of
                                                              Just (LogRecord _ (LogMemory ptr contents), nlp) ->
                                                                  processPopMemRecords (setMemory pphist ptr contents) nlp
                                                              _ -> (pphist, logptr)

                                                        {- syscalls which we handle by just re-running them -}
                                                        replaySyscall (LogSyscall sysnr _ _ _ _)
                                                            | sysnr `elem` [10, 11, 12, 13, 14, 158, 273] =
                                                                (runSyscall newHist $ trc_tid evt, nextLogPtr)

                                                        {- syscalls which we handle by just imposing the return value -}
                                                        replaySyscall (LogSyscall sysnr sysres _ _ _)
                                                            | sysnr `elem` [0, 1, 2, 3, 4, 5, 21, 63, 79, 97, 102, 202] =
                                                                (setRegister newHist (trc_tid evt) REG_RAX sysres, nextLogPtr)

                                                        {- syscalls which we handle by re-running and then imposing the
                                                           recorded return value. -}
                                                        replaySyscall (LogSyscall sysnr sysres _ _ _)
                                                            | sysnr `elem` [56, 218] =
                                                            (setRegister (runSyscall newHist $ trc_tid evt) (trc_tid evt) REG_RAX sysres,
                                                             nextLogPtr)

                                                        {- exit_group.  Ignore it and move to the next record, which should
                                                           immediately finish the log. -}
                                                        replaySyscall (LogSyscall 231 _ _ _ _) =
                                                            (newHist, nextLogPtr)

                                                        {- mmap -}
                                                        replaySyscall (LogSyscall 9 sysres _ len prot) =
                                                            let (doneMmapHist, finalLogPtr) =
                                                                    if sysres > 0xffffffffffff8000
                                                                    then {- syscall failed -> just replay the failure -}
                                                                        (newHist, nextLogPtr)
                                                                    else {- syscall succeeded -> have to replay it properly -}
                                                                        let addr = sysres
                                                                            allocMem = allocateMemory newHist addr len (prot .|. 2) {- Turn on write access -}
                                                                            (populateMem, ptrAfterPopulateMem) =
                                                                                processPopMemRecords allocMem nextLogPtr
                                                                            resetProt =
                                                                                if prot .&. 2 == 0
                                                                                then populateMem
                                                                                else setMemoryProtection populateMem addr len prot
                                                                        in (resetProt, ptrAfterPopulateMem)
                                                            in (setRegister doneMmapHist (trc_tid evt) REG_RAX sysres, finalLogPtr)

                                                        replaySyscall (LogSyscall sysnr _ _ _ _) =
                                                            error $ "don't know how to replay syscall " ++ (show sysnr)

                                                        replaySyscall _ = error "replaySyscall called on non-syscall?"

                                                        replaySyscall' x =
                                                            let (h, np) = replaySyscall x
                                                                (h', np') = processPopMemRecords h np
                                                            in advanceLog h' np'
                                                        res =
                                                            case (trc_trc evt, lr_body logrecord) of
                                                              (TraceRdtsc, LogRdtsc tsc) ->
                                                                  success (advanceLog (setTsc newHist tid tsc) nextLogPtr, True)
                                                              (TraceRdtsc, r) ->
                                                                  failed $ "rdtsc event with record " ++ (show r)
                                                              (TraceCalling _, LogClientCall) -> justAdvance
                                                              (TraceCalling n, r) ->
                                                                  failed $ "calling " ++ n ++ " event with record " ++ (show r)
                                                              (TraceCalled _, LogClientReturn) -> justAdvance
                                                              (TraceCalled n, r) ->
                                                                  failed $ "called " ++ n ++ " event with record " ++ (show r)
                                                              (TraceLoad val sz ptr _ _, LogAccess True val' sz' ptr') |
                                                                  sz == sz' && ptr == ptr' && val == val' ->
                                                                  justAdvance
                                                              (TraceLoad _ _ _ _ _, _) | useMemoryRecords ->
                                                                  failed $ "load event " ++ (show evt) ++ " against record " ++ (show logrecord)
                                                              (TraceStore val sz ptr _ _, LogAccess False val' sz' ptr') |
                                                                  sz == sz' && ptr == ptr' && val == val' ->
                                                                  justAdvance
                                                              (TraceStore _ _ _ _ _, _) | useMemoryRecords ->
                                                                  failed $ "store event " ++ (show evt) ++ " against record " ++ (show logrecord)
                                                              (TraceSignal rip signr err va, LogSignal rip' signr' err' va') |
                                                                  and [rip == rip', signr == (fromIntegral signr'), err == err', va == va'] ->
                                                                  justAdvance
                                                              (TraceSignal _ _ _ _, _) ->
                                                                  failed $ "signal event " ++ (show evt) ++ " against record " ++ (show logrecord)
                                                              (TraceSyscall sysnr, LogSyscall sysnr' _ arg1 arg2 arg3) ->
                                                                  Debug.Trace.trace ("validate syscall " ++ (show evt)) $
                                                                  do regs <- getRegistersWorker worker
                                                                     let rdi = getRegister' regs REG_RDI
                                                                         rsi = getRegister' regs REG_RSI
                                                                         rdx = getRegister' regs REG_RDX
                                                                     if rdi == arg1 && rsi == arg2 && rdx == arg3 && sysnr == (fromIntegral sysnr')
                                                                      then return $ Right (replaySyscall' $ lr_body logrecord, True)
                                                                      else failed $ "syscall record " ++ (show logrecord) ++ " against trace event " ++ (show evt) ++ " " ++
                                                                                    (showHex rdi $ " " ++ (showHex rsi $ " " ++ (showHex rdx "")))
                                                              (TraceSyscall _, _) ->
                                                                  failed $ "syscall event " ++ (show evt) ++ " against record " ++ (show logrecord)
                                                              (TraceEnterMonitor, _) -> success (newHist, False)
                                                              (TraceExitMonitor, _) -> success (newHist, False)
                                                              (TraceFootstep _ _ _ _, _) -> success (newHist, False)
                                                              (TraceLoad _ _ _ _ _, _) -> success (newHist, False)
                                                              (TraceStore _ _ _ _ _, _) -> success (newHist, False)
                                                    in do r <- res
                                                          case r of
                                                            Left e -> failed e
                                                            Right (res', checkThread) ->
                                                             if checkThread && trc_tid evt /= lr_tid logrecord
                                                             then failed $ "wrong thread: wanted " ++ (show logrecord) ++ ", got " ++ (show evt)
                                                             else success res'
                                       fixedHist' <- fixedHist
                                       killWorker worker
                                       return $ case fixedHist' of
                                                  Left e -> Left e
                                                  Right fh' ->
                                                      if Finite acc' == acc
                                                      then fixedHist'
                                                      else runThread logfile fh' tid acc
                               else do killWorker worker
                                       return $ Right newHist
                           _ -> do killWorker worker
                                   return $ Right newHist
runThread :: Logfile -> History -> ThreadId -> Topped AccessNr -> Either String History
runThread logfile hist tid acc =
    unsafePerformIO $ do worker <- getWorker False hist
                         mustBeThawed "runThread" worker
                         (evt', newHist, rs) <- runThreadToEventWorker worker hist tid acc
                         case (evt', rs) of
                           (Nothing, _) ->
                               {- nothing which requires special help -}
                               return $ Right $ appendHistory hist $ HistoryRun tid acc
                           (Just evt, ReplayStateOkay acc') ->
                               if Finite acc' <= acc
                               then do let lp = history_logfile_ptr hist
                                           fixedHist =
                                              case nextRecord logfile lp of
                                                Nothing ->
                                                    error "unexpected end of log when worker thought there was more?"
                                                Just (logrecord, nextLogPtr) ->
                                                    let success = return . Right
                                                        justAdvance = success (advanceLog newHist nextLogPtr, True)
                                                        failed = return . Left
                                                        
                                                        {- Go and process all the populate memory records which come
                                                           after logptr. -}
                                                        processPopMemRecords pphist logptr =
                                                            case nextRecord logfile logptr of
                                                              Just (LogRecord _ (LogMemory ptr contents), nlp) ->
                                                                  processPopMemRecords (setMemory pphist ptr contents) nlp
                                                              _ -> (pphist, logptr)

                                                        {- syscalls which we handle by just re-running them -}
                                                        replaySyscall (LogSyscall sysnr _ _ _ _)
                                                            | sysnr `elem` [10, 11, 12, 13, 14, 158, 273] =
                                                                (runSyscall newHist $ trc_tid evt, nextLogPtr)

                                                        {- syscalls which we handle by just imposing the return value -}
                                                        replaySyscall (LogSyscall sysnr sysres _ _ _)
                                                            | sysnr `elem` [0, 1, 2, 3, 4, 5, 21, 63, 79, 97, 102, 202] =
                                                                (setRegister newHist (trc_tid evt) REG_RAX sysres, nextLogPtr)

                                                        {- syscalls which we handle by re-running and then imposing the
                                                           recorded return value. -}
                                                        replaySyscall (LogSyscall sysnr sysres _ _ _)
                                                            | sysnr `elem` [56, 218] =
                                                            (setRegister (runSyscall newHist $ trc_tid evt) (trc_tid evt) REG_RAX sysres,
                                                             nextLogPtr)

                                                        {- exit_group.  Ignore it and move to the next record, which should
                                                           immediately finish the log. -}
                                                        replaySyscall (LogSyscall 231 _ _ _ _) =
                                                            (newHist, nextLogPtr)

                                                        {- mmap -}
                                                        replaySyscall (LogSyscall 9 sysres _ len prot) =
                                                            let (doneMmapHist, finalLogPtr) =
                                                                    if sysres > 0xffffffffffff8000
                                                                    then {- syscall failed -> just replay the failure -}
                                                                        (newHist, nextLogPtr)
                                                                    else {- syscall succeeded -> have to replay it properly -}
                                                                        let addr = sysres
                                                                            allocMem = allocateMemory newHist addr len (prot .|. 2) {- Turn on write access -}
                                                                            (populateMem, ptrAfterPopulateMem) =
                                                                                processPopMemRecords allocMem nextLogPtr
                                                                            resetProt =
                                                                                if prot .&. 2 == 0
                                                                                then populateMem
                                                                                else setMemoryProtection populateMem addr len prot
                                                                        in (resetProt, ptrAfterPopulateMem)
                                                            in (setRegister doneMmapHist (trc_tid evt) REG_RAX sysres, finalLogPtr)

                                                        replaySyscall (LogSyscall sysnr _ _ _ _) =
                                                            error $ "don't know how to replay syscall " ++ (show sysnr)

                                                        replaySyscall _ = error "replaySyscall called on non-syscall?"

                                                        replaySyscall' x =
                                                            let (h, np) = replaySyscall x
                                                                (h', np') = processPopMemRecords h np
                                                            in advanceLog h' np'
                                                        res =
                                                            case (trc_trc evt, lr_body logrecord) of
                                                              (TraceRdtsc, LogRdtsc tsc) ->
                                                                  success (advanceLog (setTsc newHist tid tsc) nextLogPtr, True)
                                                              (TraceRdtsc, r) ->
                                                                  failed $ "rdtsc event with record " ++ (show r)
                                                              (TraceCalling _, LogClientCall) -> justAdvance
                                                              (TraceCalling n, r) ->
                                                                  failed $ "calling " ++ n ++ " event with record " ++ (show r)
                                                              (TraceCalled _, LogClientReturn) -> justAdvance
                                                              (TraceCalled n, r) ->
                                                                  failed $ "called " ++ n ++ " event with record " ++ (show r)
                                                              (TraceLoad val sz ptr _ _, LogAccess True val' sz' ptr') |
                                                                  sz == sz' && ptr == ptr' && val == val' ->
                                                                  justAdvance
                                                              (TraceLoad _ _ _ _ _, _) | useMemoryRecords ->
                                                                  failed $ "load event " ++ (show evt) ++ " against record " ++ (show logrecord)
                                                              (TraceStore val sz ptr _ _, LogAccess False val' sz' ptr') |
                                                                  sz == sz' && ptr == ptr' && val == val' ->
                                                                  justAdvance
                                                              (TraceStore _ _ _ _ _, _) | useMemoryRecords ->
                                                                  failed $ "store event " ++ (show evt) ++ " against record " ++ (show logrecord)
                                                              (TraceSignal rip signr err va, LogSignal rip' signr' err' va') |
                                                                  and [rip == rip', signr == (fromIntegral signr'), err == err', va == va'] ->
                                                                  justAdvance
                                                              (TraceSignal _ _ _ _, _) ->
                                                                  failed $ "signal event " ++ (show evt) ++ " against record " ++ (show logrecord)
                                                              (TraceSyscall sysnr, LogSyscall sysnr' _ arg1 arg2 arg3) ->
                                                                  Debug.Trace.trace ("validate syscall " ++ (show evt)) $
                                                                  do regs <- getRegistersWorker worker
                                                                     let rdi = getRegister' regs REG_RDI
                                                                         rsi = getRegister' regs REG_RSI
                                                                         rdx = getRegister' regs REG_RDX
                                                                     if rdi == arg1 && rsi == arg2 && rdx == arg3 && sysnr == (fromIntegral sysnr')
                                                                      then return $ Right (replaySyscall' $ lr_body logrecord, True)
                                                                      else failed $ "syscall record " ++ (show logrecord) ++ " against trace event " ++ (show evt) ++ " " ++
                                                                                    (showHex rdi $ " " ++ (showHex rsi $ " " ++ (showHex rdx "")))
                                                              (TraceSyscall _, _) ->
                                                                  failed $ "syscall event " ++ (show evt) ++ " against record " ++ (show logrecord)
                                                              (TraceEnterMonitor, _) -> success (newHist, False)
                                                              (TraceExitMonitor, _) -> success (newHist, False)
                                                              (TraceFootstep _ _ _ _, _) -> success (newHist, False)
                                                              (TraceLoad _ _ _ _ _, _) -> success (newHist, False)
                                                              (TraceStore _ _ _ _ _, _) -> success (newHist, False)
                                                    in do r <- res
                                                          case r of
                                                            Left e -> failed e
                                                            Right (res', checkThread) ->
                                                             if checkThread && trc_tid evt /= lr_tid logrecord
                                                             then failed $ "wrong thread: wanted " ++ (show logrecord) ++ ", got " ++ (show evt)
                                                             else success res'
                                       fixedHist' <- fixedHist
                                       killWorker worker
                                       return $ case fixedHist' of
                                                  Left e -> Left e
                                                  Right fh' ->
                                                      if Finite acc' == acc
                                                      then fixedHist'
                                                      else runThread logfile fh' tid acc
                               else do killWorker worker
                                       return $ Right newHist
                           _ -> do killWorker worker
                                   return $ Right newHist
runThread logfile hist tid acc =
    unsafePerformIO $ do worker <- getWorker False hist
                         mustBeThawed "runThread" worker
                         (evt', newHist, rs) <- runThreadToEventWorker worker hist tid acc
                         case (evt', rs) of
                           (Nothing, _) ->
                               {- nothing which requires special help -}
                               return $ Right $ appendHistory hist $ HistoryRun tid acc
                           (Just evt, ReplayStateOkay acc') ->
                               if Finite acc' <= acc
                               then do let lp = history_logfile_ptr hist
                                           fixedHist =
                                              case nextRecord logfile lp of
                                                Nothing ->
                                                    error "unexpected end of log when worker thought there was more?"
                                                Just (logrecord, nextLogPtr) ->
                                                    let success = return . Right
                                                        justAdvance = success (advanceLog newHist nextLogPtr, True)
                                                        failed = return . Left
                                                        
                                                        {- Go and process all the populate memory records which come
                                                           after logptr. -}
                                                        processPopMemRecords pphist logptr =
                                                            case nextRecord logfile logptr of
                                                              Just (LogRecord _ (LogMemory ptr contents), nlp) ->
                                                                  processPopMemRecords (setMemory pphist ptr contents) nlp
                                                              _ -> (pphist, logptr)

                                                        {- syscalls which we handle by just re-running them -}
                                                        replaySyscall (LogSyscall sysnr _ _ _ _)
                                                            | sysnr `elem` [10, 11, 12, 13, 14, 158, 273] =
                                                                (runSyscall newHist $ trc_tid evt, nextLogPtr)

                                                        {- syscalls which we handle by just imposing the return value -}
                                                        replaySyscall (LogSyscall sysnr sysres _ _ _)
                                                            | sysnr `elem` [0, 1, 2, 3, 4, 5, 21, 63, 79, 97, 102, 202] =
                                                                (setRegister newHist (trc_tid evt) REG_RAX sysres, nextLogPtr)

                                                        {- syscalls which we handle by re-running and then imposing the
                                                           recorded return value. -}
                                                        replaySyscall (LogSyscall sysnr sysres _ _ _)
                                                            | sysnr `elem` [56, 218] =
                                                            (setRegister (runSyscall newHist $ trc_tid evt) (trc_tid evt) REG_RAX sysres,
                                                             nextLogPtr)

                                                        {- exit_group.  Ignore it and move to the next record, which should
                                                           immediately finish the log. -}
                                                        replaySyscall (LogSyscall 231 _ _ _ _) =
                                                            (newHist, nextLogPtr)

                                                        {- mmap -}
                                                        replaySyscall (LogSyscall 9 sysres _ len prot) =
                                                            let (doneMmapHist, finalLogPtr) =
                                                                    if sysres > 0xffffffffffff8000
                                                                    then {- syscall failed -> just replay the failure -}
                                                                        (newHist, nextLogPtr)
                                                                    else {- syscall succeeded -> have to replay it properly -}
                                                                        let addr = sysres
                                                                            allocMem = allocateMemory newHist addr len (prot .|. 2) {- Turn on write access -}
                                                                            (populateMem, ptrAfterPopulateMem) =
                                                                                processPopMemRecords allocMem nextLogPtr
                                                                            resetProt =
                                                                                if prot .&. 2 == 0
                                                                                then populateMem
                                                                                else setMemoryProtection populateMem addr len prot
                                                                        in (resetProt, ptrAfterPopulateMem)
                                                            in (setRegister doneMmapHist (trc_tid evt) REG_RAX sysres, finalLogPtr)

                                                        replaySyscall (LogSyscall sysnr _ _ _ _) =
                                                            error $ "don't know how to replay syscall " ++ (show sysnr)

                                                        replaySyscall _ = error "replaySyscall called on non-syscall?"

                                                        replaySyscall' x =
                                                            let (h, np) = replaySyscall x
                                                                (h', np') = processPopMemRecords h np
                                                            in advanceLog h' np'
                                                        res =
                                                            case (trc_trc evt, lr_body logrecord) of
                                                              (TraceRdtsc, LogRdtsc tsc) ->
                                                                  success (advanceLog (setTsc newHist tid tsc) nextLogPtr, True)
                                                              (TraceRdtsc, r) ->
                                                                  failed $ "rdtsc event with record " ++ (show r)
                                                              (TraceCalling _, LogClientCall) -> justAdvance
                                                              (TraceCalling n, r) ->
                                                                  failed $ "calling " ++ n ++ " event with record " ++ (show r)
                                                              (TraceCalled _, LogClientReturn) -> justAdvance
                                                              (TraceCalled n, r) ->
                                                                  failed $ "called " ++ n ++ " event with record " ++ (show r)
                                                              (TraceLoad val sz ptr _ _, LogAccess True val' sz' ptr') |
                                                                  sz == sz' && ptr == ptr' && val == val' ->
                                                                  justAdvance
                                                              (TraceLoad _ _ _ _ _, _) | useMemoryRecords ->
                                                                  failed $ "load event " ++ (show evt) ++ " against record " ++ (show logrecord)
                                                              (TraceStore val sz ptr _ _, LogAccess False val' sz' ptr') |
                                                                  sz == sz' && ptr == ptr' && val == val' ->
                                                                  justAdvance
                                                              (TraceStore _ _ _ _ _, _) | useMemoryRecords ->
                                                                  failed $ "store event " ++ (show evt) ++ " against record " ++ (show logrecord)
                                                              (TraceSignal rip signr err va, LogSignal rip' signr' err' va') |
                                                                  and [rip == rip', signr == (fromIntegral signr'), err == err', va == va'] ->
                                                                  justAdvance
                                                              (TraceSignal _ _ _ _, _) ->
                                                                  failed $ "signal event " ++ (show evt) ++ " against record " ++ (show logrecord)
                                                              (TraceSyscall sysnr, LogSyscall sysnr' _ arg1 arg2 arg3) ->
                                                                  Debug.Trace.trace ("validate syscall " ++ (show evt)) $
                                                                  do regs <- getRegistersWorker worker
                                                                     let rdi = getRegister' regs REG_RDI
                                                                         rsi = getRegister' regs REG_RSI
                                                                         rdx = getRegister' regs REG_RDX
                                                                     if rdi == arg1 && rsi == arg2 && rdx == arg3 && sysnr == (fromIntegral sysnr')
                                                                      then return $ Right (replaySyscall' $ lr_body logrecord, True)
                                                                      else failed $ "syscall record " ++ (show logrecord) ++ " against trace event " ++ (show evt) ++ " " ++
                                                                                    (showHex rdi $ " " ++ (showHex rsi $ " " ++ (showHex rdx "")))
                                                              (TraceSyscall _, _) ->
                                                                  failed $ "syscall event " ++ (show evt) ++ " against record " ++ (show logrecord)
                                                              (TraceEnterMonitor, _) -> success (newHist, False)
                                                              (TraceExitMonitor, _) -> success (newHist, False)
                                                              (TraceFootstep _ _ _ _, _) -> success (newHist, False)
                                                              (TraceLoad _ _ _ _ _, _) -> success (newHist, False)
                                                              (TraceStore _ _ _ _ _, _) -> success (newHist, False)
                                                    in do r <- res
                                                          case r of
                                                            Left e -> failed e
                                                            Right (res', checkThread) ->
                                                             if checkThread && trc_tid evt /= lr_tid logrecord
                                                             then failed $ "wrong thread: wanted " ++ (show logrecord) ++ ", got " ++ (show evt)
                                                             else success res'
                                       fixedHist' <- fixedHist
                                       killWorker worker
                                       return $ case fixedHist' of
                                                  Left e -> Left e
                                                  Right fh' ->
                                                      if Finite acc' == acc
                                                      then fixedHist'
                                                      else runThread logfile fh' tid acc
                               else do killWorker worker
                                       return $ Right newHist
                           _ -> do killWorker worker
                                   return $ Right newHist