diff --git a/flake.nix b/flake.nix
index a9399895f..b774761bb 100644
--- a/flake.nix
+++ b/flake.nix
@@ -51,8 +51,8 @@
           pkgs.haskellPackages.callCabal2nix "hevm" (pkgs.fetchFromGitHub {
             owner = "trail-of-forks";
             repo = "hevm";
-            rev = "2aa7b3e5fea0e0657fe44549ccefbb18f61eb024";
-            sha256 = "sha256-/9NMvSOzP0agJ1qEFDN/OQvV0DXRTN3AbntTAzPXbCw=";
+            rev = "7d4344c5e71d14466e86331af064bab61d06bdad";
+            sha256 = "sha256-kts6mdwx5KUrVdNztzewWgNM9xGViAhFIZPnWOUllOU=";
         }) { secp256k1 = pkgs.secp256k1; });
 
         # FIXME: figure out solc situation, it conflicts with the one from
diff --git a/lib/Echidna.hs b/lib/Echidna.hs
index 2eabd85e2..64b84fe93 100644
--- a/lib/Echidna.hs
+++ b/lib/Echidna.hs
@@ -3,7 +3,7 @@ module Echidna where
 import Control.Concurrent (newChan)
 import Control.Monad.Catch (MonadThrow(..))
 import Control.Monad.ST (RealWorld)
-import Data.IORef (writeIORef, newIORef)
+import Data.IORef (newIORef)
 import Data.List (find)
 import Data.List.NonEmpty (NonEmpty)
 import Data.List.NonEmpty qualified as NE
@@ -13,25 +13,26 @@ import System.FilePath ((</>))
 
 import EVM (cheatCode)
 import EVM.ABI (AbiValue(AbiAddress))
-import EVM.Dapp (DappInfo(..), dappInfo)
+import EVM.Dapp (dappInfo)
 import EVM.Fetch qualified
-import EVM.Solidity (BuildOutput)
+import EVM.Solidity (BuildOutput(..), Contracts(Contracts))
 import EVM.Types hiding (Env)
 
 import Echidna.ABI
 import Echidna.Etheno (loadEtheno, extractFromEtheno)
+import Echidna.Onchain as Onchain
 import Echidna.Output.Corpus
 import Echidna.SourceAnalysis.Slither
 import Echidna.Solidity
 import Echidna.Symbolic (forceAddr)
-import Echidna.Test (createTests)
 import Echidna.Types.Campaign
 import Echidna.Types.Config
 import Echidna.Types.Random
-import Echidna.Types.Signature
 import Echidna.Types.Solidity
 import Echidna.Types.Tx
 import Echidna.Types.World
+import Echidna.Types.Test (EchidnaTest)
+import Echidna.Types.Signature (ContractName)
 
 -- | This function is used to prepare, process, compile and initialize smart contracts for testing.
 -- It takes:
@@ -45,17 +46,20 @@ import Echidna.Types.World
 -- * A list of Echidna tests to check
 -- * A prepopulated dictionary
 prepareContract
-  :: Env
+  :: EConfig
   -> NonEmpty FilePath
+  -> BuildOutput
   -> Maybe ContractName
   -> Seed
-  -> IO (VM Concrete RealWorld, World, GenDict)
-prepareContract env solFiles specifiedContract seed = do
-  let solConf = env.cfg.solConf
-      contracts = Map.elems env.dapp.solcByName
+  -> IO (VM Concrete RealWorld, Env, GenDict)
+prepareContract cfg solFiles buildOutput selectedContract seed = do
+  let solConf = cfg.solConf
+      (Contracts contractMap) = buildOutput.contracts
+      contracts = Map.elems contractMap
 
-  -- deploy contracts
-  (vm, funs, testNames, signatureMap) <- loadSpecified env specifiedContract contracts
+  mainContract <- selectMainContract solConf selectedContract contracts
+  tests <- mkTests solConf mainContract
+  signatureMap <- mkSignatureMap solConf mainContract contracts
 
   -- run processors
   slitherInfo <- runSlither (NE.head solFiles) solConf
@@ -64,16 +68,14 @@ prepareContract env solFiles specifiedContract seed = do
     Just version                              -> throwM $ OutdatedSolcVersion version
     Nothing -> pure ()
 
-  let
-    -- load tests
-    echidnaTests = createTests solConf.testMode
-                               solConf.testDestruction
-                               testNames
-                               (forceAddr vm.state.contract)
-                               funs
+  let world = mkWorld cfg.solConf signatureMap selectedContract slitherInfo contracts
 
-    world = mkWorld solConf signatureMap specifiedContract slitherInfo contracts
+  env <- mkEnv cfg buildOutput tests world
 
+  -- deploy contracts
+  vm <- loadSpecified env mainContract contracts
+
+  let
     deployedAddresses = Set.fromList $ AbiAddress . forceAddr <$> Map.keys vm.env.contracts
     constants = enhanceConstants slitherInfo
                 <> timeConstants
@@ -88,13 +90,12 @@ prepareContract env solFiles specifiedContract seed = do
                      seed
                      (returnTypes contracts)
 
-  writeIORef env.testsRef echidnaTests
-  pure (vm, world, dict)
+  pure (vm, env, dict)
 
-loadInitialCorpus :: Env -> World -> IO [(FilePath, [Tx])]
-loadInitialCorpus env world = do
+loadInitialCorpus :: Env -> IO [(FilePath, [Tx])]
+loadInitialCorpus env = do
   -- load transactions from init sequence (if any)
-  let sigs = Set.fromList $ concatMap NE.toList (Map.elems world.highSignatureMap)
+  let sigs = Set.fromList $ concatMap NE.toList (Map.elems env.world.highSignatureMap)
   ethenoCorpus <-
     case env.cfg.solConf.initialize of
       Nothing -> pure []
@@ -112,18 +113,19 @@ loadInitialCorpus env world = do
 
   pure $ persistedCorpus ++ ethenoCorpus
 
-mkEnv :: EConfig -> BuildOutput -> IO Env
-mkEnv cfg buildOutput = do
-  fetchContractCache <- newIORef mempty
-  fetchSlotCache <- newIORef mempty
+mkEnv :: EConfig -> BuildOutput -> [EchidnaTest] -> World -> IO Env
+mkEnv cfg buildOutput tests world = do
   codehashMap <- newIORef mempty
   chainId <- maybe (pure Nothing) EVM.Fetch.fetchChainIdFrom cfg.rpcUrl
   eventQueue <- newChan
   coverageRef <- newIORef mempty
   corpusRef <- newIORef mempty
-  testsRef <- newIORef mempty
+  testRefs <- traverse newIORef tests
+  (contractCache, slotCache) <- Onchain.loadRpcCache cfg
+  fetchContractCache <- newIORef contractCache
+  fetchSlotCache <- newIORef slotCache
   -- TODO put in real path
   let dapp = dappInfo "/" buildOutput
   pure $ Env { cfg, dapp, codehashMap, fetchContractCache, fetchSlotCache
-             , chainId, eventQueue, coverageRef, corpusRef, testsRef
+             , chainId, eventQueue, coverageRef, corpusRef, testRefs, world
              }
diff --git a/lib/Echidna/Campaign.hs b/lib/Echidna/Campaign.hs
index 65a8ee4d7..dad687231 100644
--- a/lib/Echidna/Campaign.hs
+++ b/lib/Echidna/Campaign.hs
@@ -15,12 +15,12 @@ import Control.Monad.ST (RealWorld)
 import Control.Monad.Trans (lift)
 import Data.Binary.Get (runGetOrFail)
 import Data.ByteString.Lazy qualified as LBS
-import Data.IORef (readIORef, atomicModifyIORef')
+import Data.IORef (readIORef, atomicModifyIORef', writeIORef)
 import Data.Foldable (foldlM)
 import Data.List qualified as List
 import Data.Map qualified as Map
 import Data.Map (Map, (\\))
-import Data.Maybe (isJust, mapMaybe, fromMaybe)
+import Data.Maybe (isJust, mapMaybe)
 import Data.Set (Set)
 import Data.Set qualified as Set
 import Data.Text (Text)
@@ -29,7 +29,7 @@ import System.Random (mkStdGen)
 
 import EVM (cheatCode)
 import EVM.ABI (getAbi, AbiType(AbiAddressType), AbiValue(AbiAddress))
-import EVM.Solidity (SolcContract)
+import EVM.Dapp (DappInfo(..))
 import EVM.Types hiding (Env, Frame(state), Gas)
 
 import Echidna.ABI
@@ -49,7 +49,6 @@ import Echidna.Types.Signature (FunctionName)
 import Echidna.Types.Test
 import Echidna.Types.Test qualified as Test
 import Echidna.Types.Tx (TxCall(..), Tx(..), call)
-import Echidna.Types.World (World)
 import Echidna.Utility (getTimestamp)
 
 instance MonadThrow m => MonadThrow (RandT g m) where
@@ -87,17 +86,17 @@ runWorker
   -> StateT WorkerState m ()
   -- ^ Callback to run after each state update (for instrumentation)
   -> VM Concrete RealWorld -- ^ Initial VM state
-  -> World   -- ^ Initial world state
   -> GenDict -- ^ Generation dictionary
   -> Int     -- ^ Worker id starting from 0
   -> [(FilePath, [Tx])]
   -- ^ Initial corpus of transactions
   -> Int     -- ^ Test limit for this worker
   -> Maybe Text -- ^ Specified contract name
-  -> [SolcContract] -- ^ List of contracts
   -> m (WorkerStopReason, WorkerState)
-runWorker SymbolicWorker callback vm _ dict workerId initialCorpus _ name cs = runSymWorker callback vm dict workerId initialCorpus name cs
-runWorker FuzzWorker callback vm world dict workerId initialCorpus testLimit _ _ = runFuzzWorker callback vm world dict workerId initialCorpus testLimit
+runWorker SymbolicWorker callback vm dict workerId initialCorpus _ name =
+  runSymWorker callback vm dict workerId initialCorpus name
+runWorker FuzzWorker callback vm dict workerId initialCorpus testLimit _ =
+  runFuzzWorker callback vm dict workerId initialCorpus testLimit
 
 runSymWorker
   :: (MonadIO m, MonadThrow m, MonadReader Env m)
@@ -109,9 +108,8 @@ runSymWorker
   -> [(FilePath, [Tx])]
   -- ^ Initial corpus of transactions
   -> Maybe Text -- ^ Specified contract name
-  -> [SolcContract] -- ^ List of contracts
   -> m (WorkerStopReason, WorkerState)
-runSymWorker callback vm dict workerId initialCorpus name cs = do
+runSymWorker callback vm dict workerId initialCorpus name = do
   cfg <- asks (.cfg)
   let nworkers = getNFuzzWorkers cfg.campaignConf -- getNFuzzWorkers, NOT getNWorkers
   eventQueue <- asks (.eventQueue)
@@ -137,6 +135,7 @@ runSymWorker callback vm dict workerId initialCorpus name cs = do
                 , newCoverage = False
                 , ncallseqs = 0
                 , ncalls = 0
+                , totalGas = 0
                 , runningThreads = []
                 }
 
@@ -172,7 +171,9 @@ runSymWorker callback vm dict workerId initialCorpus name cs = do
 
   symexecTx (tx, vm', txsBase) = do
     cfg <- asks (.cfg)
-    (threadId, symTxsChan) <- liftIO $ createSymTx cfg name cs tx vm'
+    dapp <- asks (.dapp)
+    let compiledContracts = Map.elems dapp.solcByName
+    (threadId, symTxsChan) <- liftIO $ createSymTx cfg name compiledContracts tx vm'
 
     modify' (\ws -> ws { runningThreads = [threadId] })
     lift callback
@@ -195,14 +196,13 @@ runFuzzWorker
   => StateT WorkerState m ()
   -- ^ Callback to run after each state update (for instrumentation)
   -> VM Concrete RealWorld -- ^ Initial VM state
-  -> World   -- ^ Initial world state
   -> GenDict -- ^ Generation dictionary
   -> Int     -- ^ Worker id starting from 0
   -> [(FilePath, [Tx])]
   -- ^ Initial corpus of transactions
   -> Int     -- ^ Test limit for this worker
   -> m (WorkerStopReason, WorkerState)
-runFuzzWorker callback vm world dict workerId initialCorpus testLimit = do
+runFuzzWorker callback vm dict workerId initialCorpus testLimit = do
   let
     effectiveSeed = dict.defSeed + workerId
     effectiveGenDict = dict { defSeed = effectiveSeed }
@@ -213,6 +213,7 @@ runFuzzWorker callback vm world dict workerId initialCorpus testLimit = do
                   , newCoverage = False
                   , ncallseqs = 0
                   , ncalls = 0
+                  , totalGas = 0
                   , runningThreads = []
                   }
 
@@ -224,55 +225,80 @@ runFuzzWorker callback vm world dict workerId initialCorpus testLimit = do
 
   where
   run = do
-    testsRef <- asks (.testsRef)
-    tests <- liftIO $ readIORef testsRef
+    testRefs <- asks (.testRefs)
+    tests <- liftIO $ traverse readIORef testRefs
     CampaignConf{stopOnFail, shrinkLimit} <- asks (.cfg.campaignConf)
     ncalls <- gets (.ncalls)
 
     let
-      final test = case test.state of
-                     Solved   -> True
-                     Failed _ -> True
-                     _        -> False
-
-      shrinkable test = case test.state of
-                          Large n -> n < shrinkLimit
-                          _       -> False
-
-      closeOptimizationTest test = case test.testType of
-        OptimizationTest _ _ -> test { Test.state = Large 0 }
-        _                    -> test
+      shrinkable test =
+        case test.state of
+          -- we shrink only tests which were solved on this
+          -- worker, see 'updateOpenTest'
+          Large n | test.workerId == Just workerId ->
+            n < shrinkLimit
+          _       -> False
+
+      final test =
+        case test.state of
+          Solved   -> True
+          Failed _ -> True
+          _        -> False
+
+      closeOptimizationTest test =
+        case test.testType of
+          OptimizationTest _ _ ->
+            test { Test.state = Large 0
+                 , workerId = Just workerId
+                 }
+          _ -> test
 
     if | stopOnFail && any final tests ->
          lift callback >> pure FastFailed
 
+       -- we shrink first before going back to fuzzing
+       | any shrinkable tests ->
+         shrink >> lift callback >> run
+
+       -- no shrinking work, fuzz
        | (null tests || any isOpen tests) && ncalls < testLimit ->
-         fuzz >> continue
+         fuzz >> lift callback >> run
 
+       -- NOTE: this is a hack which forces shrinking of optimization tests
+       -- after test limit is reached
        | ncalls >= testLimit && any (\t -> isOpen t && isOptimizationTest t) tests -> do
-         liftIO $ atomicModifyIORef' testsRef $ \sharedTests ->
-            (closeOptimizationTest <$> sharedTests, ())
-         continue
-
-       | any shrinkable tests ->
-         continue
+         liftIO $ forM_ testRefs $ \testRef ->
+            atomicModifyIORef' testRef (\test -> (closeOptimizationTest test, ()))
+         lift callback >> run
 
+       -- no more work to do, means we reached the test limit, exit
        | otherwise ->
          lift callback >> pure TestLimitReached
 
-  fuzz = randseq vm.env.contracts world >>= fmap fst . callseq vm
-
-  continue = runUpdate (shrinkTest vm) >> lift callback >> run
+  fuzz = randseq vm.env.contracts >>= fmap fst . callseq vm
+
+  -- To avoid contention we only shrink tests that were falsified by this
+  -- worker. Tests are marked with a worker in 'updateOpenTest'.
+  --
+  -- TODO: This makes some workers run longer as they work less on their
+  -- test limit portion during shrinking. We should move to a test limit shared
+  -- between workers to avoid that. This way other workers will "drain"
+  -- the work queue.
+  shrink = updateTests $ \test -> do
+    if test.workerId == Just workerId then
+      shrinkTest vm test
+    else
+      pure Nothing
 
 -- | Generate a new sequences of transactions, either using the corpus or with
 -- randomly created transactions
 randseq
   :: (MonadRandom m, MonadReader Env m, MonadState WorkerState m, MonadIO m)
   => Map (Expr 'EAddr) Contract
-  -> World
   -> m [Tx]
-randseq deployedContracts world = do
+randseq deployedContracts = do
   env <- ask
+  let world = env.world
 
   let
     mutConsts = env.cfg.campaignConf.mutConsts
@@ -435,8 +461,7 @@ updateGasInfo ((tx@Tx{call = SolCall (f, _)}, (_, used')):txs) tseq gi =
 updateGasInfo ((t, _):ts) tseq gi = updateGasInfo ts (t:tseq) gi
 
 -- | Given an initial 'VM' state and a way to run transactions, evaluate a list
--- of transactions, constantly checking if we've solved any tests or can shrink
--- known solves.
+-- of transactions, constantly checking if we've solved any tests.
 evalSeq
   :: (MonadIO m, MonadThrow m, MonadRandom m, MonadReader Env m, MonadState WorkerState m)
   => VM Concrete RealWorld -- ^ Initial VM
@@ -447,66 +472,78 @@ evalSeq vm0 execFunc = go vm0 [] where
   go vm executedSoFar toExecute = do
     -- NOTE: we do reverse here because we build up this list by prepending,
     -- see the last line of this function.
-    runUpdate (updateTest vm0 (vm, reverse executedSoFar))
+    updateTests (updateOpenTest vm (reverse executedSoFar))
     modify' $ \workerState -> workerState { ncalls = workerState.ncalls + 1 }
     case toExecute of
       [] -> pure ([], vm)
       (tx:remainingTxs) -> do
         (result, vm') <- execFunc vm tx
+        modify' $ \workerState -> workerState { totalGas = workerState.totalGas + fromIntegral (vm'.burned - vm.burned) }
         -- NOTE: we don't use the intermediate VMs, just the last one. If any of
         -- the intermediate VMs are needed, they can be put next to the result
         -- of each transaction - `m ([(Tx, result, VM)])`
         (remaining, _vm) <- go vm' (tx:executedSoFar) remainingTxs
         pure ((tx, result) : remaining, vm')
 
--- | Given a rule for updating a particular test's state, apply it to each test
--- in a 'Campaign'.
-runUpdate
+-- | Update tests based on the return value from the given function.
+-- Nothing skips the update.
+updateTests
   :: (MonadIO m, MonadReader Env m, MonadState WorkerState m)
   => (EchidnaTest -> m (Maybe EchidnaTest))
   -> m ()
-runUpdate f = do
-  testsRef <- asks (.testsRef)
-  tests <- liftIO $ readIORef testsRef
-  updates <- mapM f tests
-  when (any isJust updates) $
-    liftIO $ atomicModifyIORef' testsRef $ \sharedTests ->
-      (uncurry fromMaybe <$> zip sharedTests updates, ())
-
--- | Given an initial 'VM' state and a @('SolTest', 'TestState')@ pair, as well
--- as possibly a sequence of transactions and the state after evaluation, see if:
--- (0): The test is past its 'testLimit' or 'shrinkLimit' and should be presumed un[solve|shrink]able
--- (1): The test is 'Open', and this sequence of transactions solves it
--- (2): The test is 'Open', and evaluating it breaks our runtime
--- (3): The test is unshrunk, and we can shrink it
--- Then update accordingly, keeping track of how many times we've tried to solve or shrink.
-updateTest
+updateTests f = do
+  testRefs <- asks (.testRefs)
+  forM_ testRefs $ \testRef -> do
+    test <- liftIO $ readIORef testRef
+    f test >>= \case
+      Just test' -> liftIO $ writeIORef testRef test'
+      Nothing -> pure ()
+
+-- | Update an open test after checking if it is falsified by the 'reproducer'
+updateOpenTest
   :: (MonadIO m, MonadThrow m, MonadRandom m, MonadReader Env m, MonadState WorkerState m)
-  => VM Concrete RealWorld
-  -> (VM Concrete RealWorld, [Tx])
+  => VM Concrete RealWorld -- ^ VM after applying potential reproducer
+  -> [Tx] -- ^ potential reproducer
   -> EchidnaTest
   -> m (Maybe EchidnaTest)
-updateTest vmForShrink (vm, xs) test = do
+updateOpenTest vm reproducer test = do
   case test.state of
     Open -> do
       (testValue, vm') <- checkETest test vm
-      let
-        results = getResultFromVM vm'
-        test' = updateOpenTest test xs (testValue, vm', results)
-      case test'.state of
-        Large _ -> do
+      let result = getResultFromVM vm'
+      case testValue of
+        BoolValue False -> do
+          workerId <- Just <$> gets (.workerId)
+          let test' = test { Test.state = Large 0
+                           , reproducer
+                           , vm = Just vm
+                           , result
+                           , workerId
+                           }
           pushWorkerEvent (TestFalsified test')
-          pure (Just test')
-        _ | test'.value > test.value -> do
+          pure $ Just test'
+
+        IntValue value' | value' > value -> do
+          let test' = test { reproducer
+                           , value = IntValue value'
+                           , vm = Just vm
+                           , result
+                           }
           pushWorkerEvent (TestOptimized test')
-          pure (Just test')
-        _ -> pure Nothing
-    Large _ ->
-      -- TODO: We shrink already in `step`, but we shrink here too. It makes
-      -- shrink go faster when some tests are still fuzzed. It's not incorrect
-      -- but requires passing `vmForShrink` and feels a bit wrong.
-      shrinkTest vmForShrink test
-    _ -> pure Nothing
+          pure $ Just test'
+          where
+          value =
+            case test.value of
+              IntValue x -> x
+              -- TODO: fix this with proper types
+              _ -> error "Invalid type of value for optimization"
+
+        _ ->
+          -- no luck with fuzzing this time
+          pure Nothing
+    _ ->
+      -- not an open test, skip
+      pure Nothing
 
 pushWorkerEvent
   :: (MonadReader Env m, MonadState WorkerState m, MonadIO m)
diff --git a/lib/Echidna/Etheno.hs b/lib/Echidna/Etheno.hs
index 0c4f1008b..702e4ff87 100644
--- a/lib/Echidna/Etheno.hs
+++ b/lib/Echidna/Etheno.hs
@@ -178,7 +178,7 @@ execEthenoTxs et = do
       (_        , AccountCreated _)  -> pure ()
       (Reversion,   _)               -> void $ put vm
       (HandleEffect (Query q), _)    -> crashWithQueryError q et
-      (VMFailure x, _)               -> vmExcept x >> M.fail "impossible"
+      (VMFailure x, _)               -> vmExcept Nothing x >> M.fail "impossible"
       (VMSuccess (ConcreteBuf bc),
        ContractCreated _ ca _ _ _ _) -> do
         #env % #contracts % at (LitAddr ca) % _Just % #code .= InitCode mempty mempty
diff --git a/lib/Echidna/Exec.hs b/lib/Echidna/Exec.hs
index 3d0aea764..fb04d3580 100644
--- a/lib/Echidna/Exec.hs
+++ b/lib/Echidna/Exec.hs
@@ -22,11 +22,12 @@ import Data.Vector qualified as V
 import Data.Vector.Unboxed.Mutable qualified as VMut
 import System.Process (readProcessWithExitCode)
 
-import EVM (bytecode, replaceCodeOfSelf, loadContract, exec1, vmOpIx)
+import EVM (bytecode, replaceCodeOfSelf, loadContract, exec1, vmOpIx, clearTStorages)
 import EVM.ABI
+import EVM.Dapp (DappInfo)
 import EVM.Exec (exec, vmForEthrunCreation)
 import EVM.Fetch qualified
-import EVM.Format (hexText)
+import EVM.Format (hexText, showTraceTree)
 import EVM.Types hiding (Env, Gas)
 
 import Echidna.Events (emptyEvents)
@@ -70,9 +71,12 @@ pattern Illegal :: VMResult Concrete s
 pattern Illegal <- VMFailure (classifyError -> IllegalE)
 
 -- | Given an execution error, throw the appropriate exception.
-vmExcept :: MonadThrow m => EvmError -> m ()
-vmExcept e = throwM $
-  case VMFailure e of {Illegal -> IllegalExec e; _ -> UnknownFailure e}
+-- Also optionally takes a DappInfo and VM, which are used to show the stack trace.
+vmExcept :: MonadThrow m => Maybe (DappInfo, VM Concrete RealWorld) -> EvmError -> m ()
+vmExcept traceInfo e =
+  let trace = uncurry showTraceTree <$> traceInfo
+  in throwM $
+    case VMFailure e of {Illegal -> IllegalExec e; _ -> UnknownFailure e trace}
 
 execTxWith
   :: (MonadIO m, MonadState (VM Concrete RealWorld) m, MonadReader Env m, MonadThrow m)
@@ -94,6 +98,7 @@ execTxWith executeTx tx = do
         vmResult <- runFully
         gasLeftAfterTx <- gets (.state.gas)
         handleErrorsAndConstruction vmResult vmBeforeTx
+        fromEVM clearTStorages
         pure (vmResult, gasLeftBeforeTx - gasLeftAfterTx)
   where
   runFully = do
@@ -201,7 +206,10 @@ execTxWith executeTx tx = do
       #state % #callvalue .= callvalueBeforeVMReset
       #traces .= tracesBeforeVMReset
       #state % #codeContract .= codeContractBeforeVMReset
-    (VMFailure x, _) -> vmExcept x
+    (VMFailure x, _) -> do
+      dapp <- asks (.dapp)
+      vm <- get
+      vmExcept (Just (dapp, vm)) x
     (VMSuccess (ConcreteBuf bytecode'), SolCreate _) -> do
       -- Handle contract creation.
       #env % #contracts % at (LitAddr tx.dst) % _Just % #code .= InitCode mempty mempty
diff --git a/lib/Echidna/Onchain.hs b/lib/Echidna/Onchain.hs
index b511791a4..88e7fa07d 100644
--- a/lib/Echidna/Onchain.hs
+++ b/lib/Echidna/Onchain.hs
@@ -10,7 +10,7 @@ import Data.ByteString (ByteString)
 import Data.ByteString qualified as BS
 import Data.ByteString.UTF8 qualified as UTF8
 import Data.Functor ((<&>))
-import Data.IORef (writeIORef, readIORef)
+import Data.IORef (readIORef)
 import Data.Map (Map)
 import Data.Map qualified as Map
 import Data.Maybe (isJust, fromJust, fromMaybe)
@@ -100,10 +100,14 @@ toFetchedContractData contract =
 
 -- | Try to load the persisted RPC cache.
 -- TODO: we use the corpus dir for now, think about where to place it
-loadRpcCache :: Env -> IO ()
-loadRpcCache Env { cfg, fetchContractCache, fetchSlotCache } =
+loadRpcCache
+  :: EConfig
+  -> IO ( Map Addr (Maybe Contract)
+        , Map Addr (Map W256 (Maybe W256))
+        )
+loadRpcCache cfg =
   case cfg.campaignConf.corpusDir of
-    Nothing -> pure ()
+    Nothing -> pure (mempty, mempty)
     Just dir -> do
       let cache_dir = dir </> "cache"
       createDirectoryIfMissing True cache_dir
@@ -115,10 +119,12 @@ loadRpcCache Env { cfg, fetchContractCache, fetchSlotCache } =
           parsedSlots :: Maybe (Map Addr (Map W256 (Maybe W256))) <-
             readFileIfExists (cache_dir </> "block_" <> show block <> "_fetch_cache_slots.json")
             <&> (>>= JSON.decodeStrict)
-          writeIORef fetchContractCache (maybe mempty (Map.map (Just . fromFetchedContractData)) parsedContracts)
-          writeIORef fetchSlotCache (fromMaybe mempty parsedSlots)
+          pure
+            ( maybe mempty (Map.map (Just . fromFetchedContractData)) parsedContracts
+            , fromMaybe mempty parsedSlots
+            )
         Nothing ->
-          pure ()
+          pure (mempty, mempty)
 
 readFileIfExists :: FilePath -> IO (Maybe BS.ByteString)
 readFileIfExists path = do
diff --git a/lib/Echidna/Output/JSON.hs b/lib/Echidna/Output/JSON.hs
index ebacc8183..39bcaa503 100644
--- a/lib/Echidna/Output/JSON.hs
+++ b/lib/Echidna/Output/JSON.hs
@@ -100,7 +100,7 @@ instance ToJSON Transaction where
 
 encodeCampaign :: Env -> [WorkerState] -> IO L.ByteString
 encodeCampaign env workerStates = do
-  tests <- readIORef env.testsRef
+  tests <- traverse readIORef env.testRefs
   frozenCov <- mapM VU.freeze =<< readIORef env.coverageRef
   -- TODO: this is ugly, refactor seed to live in Env
   let worker0 = Prelude.head workerStates
diff --git a/lib/Echidna/Solidity.hs b/lib/Echidna/Solidity.hs
index 1868ff246..b7e599e16 100644
--- a/lib/Echidna/Solidity.hs
+++ b/lib/Echidna/Solidity.hs
@@ -30,7 +30,6 @@ import System.Info (os)
 
 import EVM (initialContract, currentContract)
 import EVM.ABI
-import EVM.Dapp (DappInfo(..))
 import EVM.Solidity
 import EVM.Types hiding (Env)
 
@@ -42,7 +41,6 @@ import Echidna.Etheno (loadEthenoBatch)
 import Echidna.Events (extractEvents)
 import Echidna.Exec (execTx, initialVM)
 import Echidna.SourceAnalysis.Slither
-import Echidna.Symbolic (forceAddr)
 import Echidna.Test (createTests, isAssertionMode, isPropertyMode, isDapptestMode)
 import Echidna.Types.Config (EConfig(..), Env(..))
 import Echidna.Types.Signature
@@ -167,48 +165,12 @@ abiOf pref solcContract =
 -- filename their code is in, plus a colon.
 loadSpecified
   :: Env
-  -> Maybe Text
+  -> SolcContract
   -> [SolcContract]
-  -> IO (VM Concrete RealWorld, [SolSignature], [Text], SignatureMap)
-loadSpecified env name cs = do
+  -> IO (VM Concrete RealWorld)
+loadSpecified env mainContract cs = do
   let solConf = env.cfg.solConf
 
-  -- Pick contract to load
-  mainContract <- chooseContract cs name
-  when (isNothing name && length cs > 1 && not solConf.quiet) $
-    putStrLn "Multiple contracts found, only analyzing the first"
-  unless solConf.quiet $
-    putStrLn $ "Analyzing contract: " <> T.unpack mainContract.contractName
-
-  let
-    -- generate the complete abi mapping
-    abi = Map.elems mainContract.abiMap <&> \method -> (method.name, snd <$> method.inputs)
-    (tests, funs) = partition (isPrefixOf solConf.prefix . fst) abi
-
-    -- Filter ABI according to the config options
-    fabiOfc = if isDapptestMode solConf.testMode
-                then NE.toList $ filterMethodsWithArgs (abiOf solConf.prefix mainContract)
-                else filterMethods mainContract.contractName solConf.methodFilter $
-                       abiOf solConf.prefix mainContract
-    -- Filter again for dapptest tests or assertions checking if enabled
-    neFuns = filterMethods mainContract.contractName solConf.methodFilter (fallback NE.:| funs)
-    -- Construct ABI mapping for World
-    abiMapping =
-      if solConf.allContracts then
-        Map.fromList $ mapMaybe (\contract ->
-            let filtered = filterMethods contract.contractName
-                                         solConf.methodFilter
-                                         (abiOf solConf.prefix contract)
-            in (contract.runtimeCodehash,) <$> NE.nonEmpty filtered)
-          cs
-      else
-        case NE.nonEmpty fabiOfc of
-          Just ne -> Map.singleton mainContract.runtimeCodehash ne
-          Nothing -> mempty
-
-  when (Map.null abiMapping) $
-    throwM $ InvalidMethodFilters solConf.methodFilter
-
   -- Set up initial VM, either with chosen contract or Etheno initialization file
   -- need to use snd to add to ABI dict
   initVM <- stToIO $ initialVM solConf.allowFFI
@@ -225,20 +187,6 @@ loadSpecified env name cs = do
   -- Select libraries
   ls <- mapM (chooseContract cs . Just . T.pack) solConf.solcLibs
 
-  -- Make sure everything is ready to use, then ship it
-  when (null abi) $
-    throwM NoFuncs
-  when (null tests && isPropertyMode solConf.testMode) $
-    throwM NoTests
-  when (null abiMapping && isDapptestMode solConf.testMode) $
-    throwM NoTests
-  when (mainContract.creationCode == mempty) $
-    throwM (NoBytecode mainContract.contractName)
-
-  case find (not . null . snd) tests of
-    Just (t, _) -> throwM $ TestArgsFound t
-    Nothing -> pure ()
-
   flip runReaderT env $ do
     -- library deployment
     vm0 <- deployContracts (zip [addrLibrary ..] ls) solConf.deployer blank
@@ -262,24 +210,104 @@ loadSpecified env name cs = do
     when (isNothing $ currentContract vm3) $
       throwM $ DeploymentFailed solConf.contractAddr $ T.unlines $ extractEvents True env.dapp vm3
 
-    -- Run
-    let transaction = execTx vm3 $ uncurry basicTx
-                                             setUpFunction
-                                             solConf.deployer
-                                             solConf.contractAddr
-                                             unlimitedGasPerBlock
-                                             (0, 0)
+    -- Run setUp function
+    let
+      abi = Map.elems mainContract.abiMap <&> \method -> (method.name, snd <$> method.inputs)
+      transaction = execTx vm3 $ uncurry basicTx
+                                           setUpFunction
+                                           solConf.deployer
+                                           solConf.contractAddr
+                                           unlimitedGasPerBlock
+                                           (0, 0)
     vm4 <- if isDapptestMode solConf.testMode && setUpFunction `elem` abi
               then snd <$> transaction
               else pure vm3
 
     case vm4.result of
       Just (VMFailure _) -> throwM SetUpCallFailed
-      _ -> pure (vm4, neFuns, fst <$> tests, abiMapping)
+      _ -> pure vm4
 
   where
     setUpFunction = ("setUp", [])
 
+
+selectMainContract
+  :: SolConf
+  -> Maybe ContractName
+  -> [SolcContract]
+  -> IO SolcContract
+selectMainContract solConf name cs = do
+  -- Pick contract to load
+  mainContract <- chooseContract cs name
+  when (isNothing name && length cs > 1 && not solConf.quiet) $
+    putStrLn "Multiple contracts found, only analyzing the first"
+  unless solConf.quiet $
+    putStrLn $ "Analyzing contract: " <> T.unpack mainContract.contractName
+  when (mainContract.creationCode == mempty) $
+    throwM (NoBytecode mainContract.contractName)
+  pure mainContract
+
+mkSignatureMap
+  :: SolConf
+  -> SolcContract
+  -> [SolcContract]
+  -> IO SignatureMap
+mkSignatureMap solConf mainContract contracts = do
+  let
+    -- Filter ABI according to the config options
+    fabiOfc = if isDapptestMode solConf.testMode
+                then NE.toList $ filterMethodsWithArgs (abiOf solConf.prefix mainContract)
+                else filterMethods mainContract.contractName solConf.methodFilter $
+                       abiOf solConf.prefix mainContract
+    -- Construct ABI mapping for World
+    abiMapping =
+      if solConf.allContracts then
+        Map.fromList $ mapMaybe (\contract ->
+            let filtered = filterMethods contract.contractName
+                                         solConf.methodFilter
+                                         (abiOf solConf.prefix contract)
+            in (contract.runtimeCodehash,) <$> NE.nonEmpty filtered)
+          contracts
+      else
+        case NE.nonEmpty fabiOfc of
+          Just ne -> Map.singleton mainContract.runtimeCodehash ne
+          Nothing -> mempty
+  when (null abiMapping && isDapptestMode solConf.testMode) $
+    throwM NoTests
+  when (Map.null abiMapping) $
+    throwM $ InvalidMethodFilters solConf.methodFilter
+  pure abiMapping
+
+mkTests
+  :: SolConf
+  -> SolcContract
+  -> IO [EchidnaTest]
+mkTests solConf mainContract = do
+  let
+    -- generate the complete abi mapping
+    abi = Map.elems mainContract.abiMap <&> \method -> (method.name, snd <$> method.inputs)
+    (tests, funs) = partition (isPrefixOf solConf.prefix . fst) abi
+    -- Filter again for dapptest tests or assertions checking if enabled
+    neFuns = filterMethods mainContract.contractName
+                           solConf.methodFilter
+                           (fallback NE.:| funs)
+    testNames = fst <$> tests
+
+  when (null abi) $
+    throwM NoFuncs
+  when (null tests && isPropertyMode solConf.testMode) $
+    throwM NoTests
+
+  case find (not . null . snd) tests of
+    Just (t, _) -> throwM $ TestArgsFound t
+    Nothing -> pure ()
+
+  pure $ createTests solConf.testMode
+                     solConf.testDestruction
+                     testNames
+                     solConf.contractAddr
+                     neFuns
+
 -- | Given a list of contracts and a requested contract name, pick a contract.
 -- See 'loadSpecified' for more information.
 chooseContract :: (MonadThrow m) => [SolcContract] -> Maybe Text -> m SolcContract
@@ -369,25 +397,6 @@ prepareHashMaps cs as m =
     filterHashMap f xs =
       Map.mapMaybe (NE.nonEmpty . NE.filter (\s -> f $ (hashSig . encodeSig $ s) `elem` xs))
 
--- | Given a file and an optional contract name, compile the file as solidity, then, if a name is
--- given, try to fine the specified contract (assuming it is in the file provided), otherwise, find
--- the first contract in the file. Take said contract and return an initial VM state with it loaded,
--- its ABI (as 'SolSignature's), and the names of its Echidna tests. NOTE: unlike 'loadSpecified',
--- contract names passed here don't need the file they occur in specified.
-loadSolTests
-  :: Env
-  -> Maybe Text
-  -> IO (VM Concrete RealWorld, World, [EchidnaTest])
-loadSolTests env name = do
-  let solConf = env.cfg.solConf
-  let contracts = Map.elems env.dapp.solcByName
-  (vm, funs, testNames, _signatureMap) <- loadSpecified env name contracts
-  let
-    eventMap = Map.unions $ map (.eventMap) contracts
-    world = World solConf.sender mempty Nothing [] eventMap
-    echidnaTests = createTests solConf.testMode True testNames (forceAddr vm.state.contract) funs
-  pure (vm, world, echidnaTests)
-
 mkLargeAbiInt :: Int -> AbiValue
 mkLargeAbiInt i = AbiInt i $ 2 ^ (i - 1) - 1
 
diff --git a/lib/Echidna/Test.hs b/lib/Echidna/Test.hs
index 05837fe41..e11886f3d 100644
--- a/lib/Echidna/Test.hs
+++ b/lib/Echidna/Test.hs
@@ -24,7 +24,6 @@ import Echidna.Symbolic (forceBuf)
 import Echidna.Types.Config
 import Echidna.Types.Signature (SolSignature)
 import Echidna.Types.Test
-import Echidna.Types.Test qualified as Test
 import Echidna.Types.Tx (Tx, TxConf(..), basicTx, TxResult(..), getResult)
 
 --- | Possible responses to a call to an Echidna test: @true@, @false@, @REVERT@, and ???.
@@ -47,7 +46,7 @@ getResultFromVM vm =
     Nothing -> error "getResultFromVM failed"
 
 createTest :: TestType -> EchidnaTest
-createTest m = EchidnaTest Open m v [] Stop Nothing
+createTest m = EchidnaTest Open m v [] Stop Nothing Nothing
   where v = case m of
               PropertyTest _ _     -> BoolValue True
               OptimizationTest _ _ -> IntValue minBound
@@ -111,6 +110,7 @@ createTests m td ts r ss = case m of
   sdt = createTest (CallTest "Target contract is not self-destructed" $ checkSelfDestructedTarget r)
   sdat = createTest (CallTest "No contract can be self-destructed" checkAnySelfDestructed)
 
+  {-
 updateOpenTest
   :: EchidnaTest
   -> [Tx]
@@ -133,6 +133,7 @@ updateOpenTest test txs (IntValue v', vm, r) =
           IntValue x -> x
           _          -> error "Invalid type of value for optimization"
 updateOpenTest _ _ _ = error "Invalid type of test"
+-}
 
 -- | Given a 'SolTest', evaluate it and see if it currently passes.
 checkETest
diff --git a/lib/Echidna/Types.hs b/lib/Echidna/Types.hs
index 316d49e83..f21232d59 100644
--- a/lib/Echidna/Types.hs
+++ b/lib/Echidna/Types.hs
@@ -3,22 +3,25 @@ module Echidna.Types where
 import Control.Exception (Exception)
 import Control.Monad.State.Strict (MonadState, get, put, MonadIO(liftIO), runStateT)
 import Control.Monad.ST (RealWorld, stToIO)
+import Data.Text (Text, unpack)
 import Data.Word (Word64)
 import EVM (initialContract)
 import EVM.Types
 
 -- | We throw this when our execution fails due to something other than reversion.
-data ExecException = IllegalExec EvmError | UnknownFailure EvmError
+-- The `Maybe Text` on `UnknownFailure` is an optional stack trace.
+data ExecException = IllegalExec EvmError | UnknownFailure EvmError (Maybe Text)
 
 instance Show ExecException where
   show = \case
     IllegalExec e -> "VM attempted an illegal operation: " ++ show e
-    UnknownFailure (MaxCodeSizeExceeded limit actual) ->
+    UnknownFailure (MaxCodeSizeExceeded limit actual) _ ->
       "Max code size exceeded. " ++ codeSizeErrorDetails limit actual
-    UnknownFailure (MaxInitCodeSizeExceeded limit actual) ->
+    UnknownFailure (MaxInitCodeSizeExceeded limit actual) _ ->
       "Max init code size exceeded. " ++ codeSizeErrorDetails limit actual
-    UnknownFailure e -> "VM failed for unhandled reason, " ++ show e
+    UnknownFailure e trace -> "VM failed for unhandled reason, " ++ show e
       ++ ". This shouldn't happen. Please file a ticket with this error message and steps to reproduce!"
+      ++ maybe "" ((" Stack trace:\n" ++) . unpack) trace
     where
       codeSizeErrorDetails limit actual =
         "Configured limit: " ++ show limit ++ ", actual: " ++ show actual
diff --git a/lib/Echidna/Types/Campaign.hs b/lib/Echidna/Types/Campaign.hs
index b59815bd3..78a885189 100644
--- a/lib/Echidna/Types/Campaign.hs
+++ b/lib/Echidna/Types/Campaign.hs
@@ -51,7 +51,7 @@ data CampaignConf = CampaignConf
     -- Only relevant if symExec is True
   , symExecTargets     :: Maybe [Text]
   , symExecTimeout     :: Int
-    -- ^ Timeout for symbolic execution SMT solver.
+    -- ^ Timeout for symbolic execution SMT solver queries.
     -- Only relevant if symExec is True
   , symExecNSolvers    :: Int
     -- ^ Number of SMT solvers used in symbolic execution.
@@ -168,6 +168,8 @@ data WorkerState = WorkerState
     -- ^ Number of times the callseq is called
   , ncalls      :: !Int
     -- ^ Number of calls executed while fuzzing
+  , totalGas    :: !Int
+    -- ^ Total gas consumed while fuzzing
   , runningThreads :: [ThreadId]
     -- ^ Extra threads currently being run,
     --   aside from the main worker thread
@@ -181,6 +183,7 @@ initialWorkerState =
               , newCoverage = False
               , ncallseqs = 0
               , ncalls = 0
+              , totalGas = 0
               , runningThreads = []
               }
 
diff --git a/lib/Echidna/Types/Config.hs b/lib/Echidna/Types/Config.hs
index 64bae8b79..62f4e7513 100644
--- a/lib/Echidna/Types/Config.hs
+++ b/lib/Echidna/Types/Config.hs
@@ -19,6 +19,7 @@ import Echidna.Types.Coverage (CoverageMap)
 import Echidna.Types.Solidity (SolConf)
 import Echidna.Types.Test (TestConf, EchidnaTest)
 import Echidna.Types.Tx (TxConf)
+import Echidna.Types.World (World)
 
 data OperationMode = Interactive | NonInteractive OutputFormat deriving (Show, Eq)
 data OutputFormat = Text | JSON | None deriving (Show, Eq)
@@ -68,7 +69,7 @@ data Env = Env
   -- minimal.
   , eventQueue :: Chan (LocalTime, CampaignEvent)
 
-  , testsRef :: IORef [EchidnaTest]
+  , testRefs :: [IORef EchidnaTest]
   , coverageRef :: IORef CoverageMap
   , corpusRef :: IORef Corpus
 
@@ -76,4 +77,5 @@ data Env = Env
   , fetchContractCache :: IORef (Map Addr (Maybe Contract))
   , fetchSlotCache :: IORef (Map Addr (Map W256 (Maybe W256)))
   , chainId :: Maybe W256
+  , world :: World
   }
diff --git a/lib/Echidna/Types/Test.hs b/lib/Echidna/Types/Test.hs
index 2221aa39e..7f6e00925 100644
--- a/lib/Echidna/Types/Test.hs
+++ b/lib/Echidna/Types/Test.hs
@@ -102,6 +102,8 @@ data EchidnaTest = EchidnaTest
   , reproducer :: [Tx]
   , result     :: TxResult
   , vm         :: Maybe (VM Concrete RealWorld)
+  -- | Worker which falsified the test will also shrink it.
+  , workerId   :: Maybe Int
   } deriving (Show)
 
 instance ToJSON EchidnaTest where
diff --git a/lib/Echidna/UI.hs b/lib/Echidna/UI.hs
index 000d87527..5387aed51 100644
--- a/lib/Echidna/UI.hs
+++ b/lib/Echidna/UI.hs
@@ -61,13 +61,11 @@ data UIEvent =
 ui
   :: (MonadCatch m, MonadReader Env m, MonadUnliftIO m)
   => VM Concrete RealWorld -- ^ Initial VM state
-  -> World   -- ^ Initial world state
   -> GenDict
   -> [(FilePath, [Tx])]
   -> Maybe Text
-  -> [SolcContract]
   -> m [WorkerState]
-ui vm world dict initialCorpus cliSelectedContract cs = do
+ui vm dict initialCorpus cliSelectedContract = do
   env <- ask
   conf <- asks (.cfg)
   terminalPresent <- liftIO isTerminal
@@ -99,14 +97,14 @@ ui vm world dict initialCorpus cliSelectedContract cs = do
     Interactive -> do
       -- Channel to push events to update UI
       uiChannel <- liftIO $ newBChan 1000
-      let forwardEvent = writeBChan uiChannel . EventReceived
+      let forwardEvent = void . writeBChanNonBlocking uiChannel . EventReceived
       uiEventsForwarderStopVar <- spawnListener forwardEvent
 
       ticker <- liftIO . forkIO . forever $ do
         threadDelay 200_000 -- 200 ms
 
         now <- getTimestamp
-        tests <- readIORef env.testsRef
+        tests <- traverse readIORef env.testRefs
         states <- workerStates workers
         writeBChan uiChannel (CampaignUpdated now tests states)
 
@@ -124,7 +122,7 @@ ui vm world dict initialCorpus cliSelectedContract cs = do
       app <- customMain initialVty buildVty (Just uiChannel) <$> monitor
 
       liftIO $ do
-        tests <- readIORef env.testsRef
+        tests <- traverse readIORef env.testRefs
         now <- getTimestamp
         void $ app UIState
           { campaigns = [initialWorkerState] -- ugly, fix me
@@ -229,7 +227,7 @@ ui vm world dict initialCorpus cliSelectedContract cs = do
             corpus = if workerType == SymbolicWorker then initialCorpus else corpusChunk
           maybeResult <- timeout timeoutUsecs $
             runWorker workerType (get >>= writeIORef stateRef)
-                      vm world dict workerId corpus testLimit cliSelectedContract cs
+                      vm dict workerId corpus testLimit cliSelectedContract
           pure $ case maybeResult of
             Just (stopReason, _finalState) -> stopReason
             Nothing -> TimeLimitReached
@@ -355,7 +353,7 @@ statusLine
   -> [WorkerState]
   -> IO String
 statusLine env states = do
-  tests <- readIORef env.testsRef
+  tests <- traverse readIORef env.testRefs
   points <- scoveragePoints =<< readIORef env.coverageRef
   corpus <- readIORef env.corpusRef
   let totalCalls = sum ((.ncalls) <$> states)
diff --git a/lib/Echidna/UI/Report.hs b/lib/Echidna/UI/Report.hs
index 0edcbf974..580267b67 100644
--- a/lib/Echidna/UI/Report.hs
+++ b/lib/Echidna/UI/Report.hs
@@ -45,7 +45,7 @@ ppCampaignEventLog vm ev = (ppCampaignEvent ev <>) <$> ppTxIfHas where
 
 ppCampaign :: (MonadIO m, MonadReader Env m) => VM Concrete RealWorld -> [WorkerState] -> m String
 ppCampaign vm workerStates = do
-  tests <- liftIO . readIORef =<< asks (.testsRef)
+  tests <- liftIO . traverse readIORef =<< asks (.testRefs)
   testsPrinted <- ppTests tests
   gasInfoPrinted <- ppGasInfo vm workerStates
   coveragePrinted <- ppCoverage
diff --git a/lib/Echidna/UI/Widgets.hs b/lib/Echidna/UI/Widgets.hs
index 906b1a3a6..a343eb0b9 100644
--- a/lib/Echidna/UI/Widgets.hs
+++ b/lib/Echidna/UI/Widgets.hs
@@ -31,7 +31,7 @@ import Echidna.ABI
 import Echidna.Types.Campaign
 import Echidna.Types.Config
 import Echidna.Types.Test
-import Echidna.Types.Tx (Tx(..), TxResult(..))
+import Echidna.Types.Tx (Tx(..))
 import Echidna.UI.Report
 import Echidna.Utility (timePrefix)
 
@@ -173,6 +173,8 @@ summaryWidget env uiState =
       <=>
       perfWidget uiState
       <=>
+      gasPerfWidget uiState
+      <=>
       str ("Total calls: " <> progress (sum $ (.ncalls) <$> uiState.campaigns)
                                      env.cfg.campaignConf.testLimit)
   middle =
@@ -234,6 +236,18 @@ perfWidget uiState =
     diffLocalTime (fromMaybe uiState.now uiState.timeStopped)
                   uiState.timeStarted
 
+gasPerfWidget :: UIState -> Widget n
+gasPerfWidget uiState =
+  str $ "Gas/s: " <>
+    if totalTime > 0
+       then show $ totalGas `div` totalTime
+       else "-"
+  where
+  totalGas = sum $ (.totalGas) <$> uiState.campaigns
+  totalTime = round $
+    diffLocalTime (fromMaybe uiState.now uiState.timeStopped)
+                  uiState.timeStarted
+
 ppSeed :: [WorkerState] -> String
 ppSeed campaigns = show (head campaigns).genDict.defSeed
 
@@ -290,13 +304,13 @@ tsWidget
   => TestState
   -> EchidnaTest
   -> m (Widget Name, Widget Name)
-tsWidget (Failed e) _ = pure (str "could not evaluate", str $ show e)
-tsWidget Solved     t = failWidget Nothing t.reproducer (fromJust t.vm) t.value t.result
-tsWidget Passed     _ = pure (success $ str "PASSED!", emptyWidget)
-tsWidget Open       _ = pure (success $ str "passing", emptyWidget)
-tsWidget (Large n)  t = do
+tsWidget (Failed e) _    = pure (str "could not evaluate", str $ show e)
+tsWidget Solved     test = failWidget Nothing test
+tsWidget Passed     _    = pure (success $ str "PASSED!", emptyWidget)
+tsWidget Open       _    = pure (success $ str "passing", emptyWidget)
+tsWidget (Large n)  test = do
   m <- asks (.cfg.campaignConf.shrinkLimit)
-  failWidget (if n < m then Just (n,m) else Nothing) t.reproducer (fromJust t.vm) t.value t.result
+  failWidget (if n < m then Just (n,m) else Nothing) test
 
 titleWidget :: Widget n
 titleWidget = str "Call sequence" <+> str ":"
@@ -315,25 +329,21 @@ tracesWidget vm = do
 failWidget
   :: MonadReader Env m
   => Maybe (Int, Int)
-  -> [Tx]
-  -> VM Concrete RealWorld
-  -> TestValue
-  -> TxResult
+  -> EchidnaTest
   -> m (Widget Name, Widget Name)
-failWidget _ [] _  _  _= pure (failureBadge, str "*no transactions made*")
-failWidget b xs vm _ r = do
-  s <- seqWidget vm xs
+failWidget _ test | null test.reproducer =
+  pure (failureBadge, str "*no transactions made*")
+failWidget b test = do
+  -- TODO: we know this is set for failed tests, ideally we should improve this
+  -- with better types in EchidnaTest
+  let vm = fromJust test.vm
+  s <- seqWidget vm test.reproducer
   traces <- tracesWidget vm
   pure
-    ( failureBadge <+> str (" with " ++ show r)
-    , status <=> titleWidget <=> s <=> str " " <=> traces
+    ( failureBadge <+> str (" with " ++ show test.result)
+    , shrinkWidget b test <=> titleWidget <=> s <=> str " " <=> traces
     )
   where
-  status = case b of
-    Nothing -> emptyWidget
-    Just (n,m) ->
-      str "Current action: " <+>
-        withAttr (attrName "working") (str ("shrinking " ++ progress n m))
 
 optWidget
   :: MonadReader Env m
@@ -346,31 +356,36 @@ optWidget Passed     t = pure (str $ "max value found: " ++ show t.value, emptyW
 optWidget Open       t =
   pure (withAttr (attrName "working") $ str $
     "optimizing, max value: " ++ show t.value, emptyWidget)
-optWidget (Large n)  t = do
+optWidget (Large n)  test = do
   m <- asks (.cfg.campaignConf.shrinkLimit)
-  maxWidget (if n < m then Just (n,m) else Nothing) t.reproducer (fromJust t.vm) t.value
+  maxWidget (if n < m then Just (n,m) else Nothing) test
 
 maxWidget
   :: MonadReader Env m
   => Maybe (Int, Int)
-  -> [Tx]
-  -> VM Concrete RealWorld
-  -> TestValue
+  -> EchidnaTest
   -> m (Widget Name, Widget Name)
-maxWidget _ [] _  _ = pure (failureBadge, str "*no transactions made*")
-maxWidget b xs vm v = do
-  s <- seqWidget vm xs
+maxWidget _ test | null test.reproducer =
+  pure (failureBadge, str "*no transactions made*")
+maxWidget b test = do
+  let vm = fromJust test.vm
+  s <- seqWidget vm test.reproducer
   traces <- tracesWidget vm
   pure
-    ( maximumBadge <+> str (" max value: " ++ show v)
-    , status <=> titleWidget <=> s <=> str " " <=> traces
+    ( maximumBadge <+> str (" max value: " ++ show test.value)
+    , shrinkWidget b test <=> titleWidget <=> s <=> str " " <=> traces
     )
-  where
-  status = case b of
+
+shrinkWidget :: Maybe (Int, Int) -> EchidnaTest -> Widget Name
+shrinkWidget b test =
+  case b of
     Nothing -> emptyWidget
     Just (n,m) ->
       str "Current action: " <+>
-        withAttr (attrName "working") (str ("shrinking " ++ progress n m))
+      withAttr (attrName "working")
+               (str ("shrinking " ++ progress n m ++ showWorker))
+  where
+  showWorker = maybe "" (\i -> " (worker " <> show i <> ")") test.workerId
 
 seqWidget :: MonadReader Env m => VM Concrete RealWorld -> [Tx] -> m (Widget Name)
 seqWidget vm xs = do
diff --git a/src/Main.hs b/src/Main.hs
index d64f4023a..9e1d68d49 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -29,7 +29,7 @@ import System.IO (hPutStrLn, stderr)
 import System.IO.CodePage (withCP65001)
 
 import EVM.Dapp (DappInfo(..))
-import EVM.Solidity (BuildOutput(..), Contracts(..))
+import EVM.Solidity (BuildOutput(..))
 import EVM.Types (Addr)
 
 import Echidna
@@ -59,20 +59,16 @@ main = withUtf8 $ withCP65001 $ do
     forM_ ks $ hPutStrLn stderr . ("Warning: unused option: " ++) . Aeson.Key.toString
 
   buildOutput <- compileContracts cfg.solConf cliFilePath
-  env <- mkEnv cfg buildOutput
-
-  Onchain.loadRpcCache env
 
   -- take the seed from config, otherwise generate a new one
   seed <- maybe (getRandomR (0, maxBound)) pure cfg.campaignConf.seed
-  (vm, world, dict) <- prepareContract env cliFilePath cliSelectedContract seed
+  (vm, env, dict) <- prepareContract cfg cliFilePath buildOutput cliSelectedContract seed
 
-  initialCorpus <- loadInitialCorpus env world
-  let (Contracts contractMap) = buildOutput.contracts
+  initialCorpus <- loadInitialCorpus env
   -- start ui and run tests
-  _campaign <- runReaderT (ui vm world dict initialCorpus cliSelectedContract (Map.elems contractMap)) env
+  _campaign <- runReaderT (ui vm dict initialCorpus cliSelectedContract) env
 
-  tests <- readIORef env.testsRef
+  tests <- traverse readIORef env.testRefs
 
   Onchain.saveRpcCache env
 
diff --git a/src/test/Common.hs b/src/test/Common.hs
index ae658a76a..884e11384 100644
--- a/src/test/Common.hs
+++ b/src/test/Common.hs
@@ -18,6 +18,7 @@ module Common
   , gasInRange
   , countCorpus
   , overrideQuiet
+  , loadSolTests
   ) where
 
 import Test.Tasty (TestTree)
@@ -26,6 +27,7 @@ import Test.Tasty.HUnit (testCase, assertBool)
 import Control.Monad (forM_)
 import Control.Monad.Reader (runReaderT)
 import Control.Monad.Random (getRandomR)
+import Control.Monad.ST (RealWorld)
 import Data.DoubleWord (Int256)
 import Data.Function ((&))
 import Data.IORef
@@ -40,7 +42,7 @@ import System.Process (readProcess)
 import Echidna (mkEnv, prepareContract)
 import Echidna.Config (parseConfig, defaultConfig)
 import Echidna.Campaign (runWorker)
-import Echidna.Solidity (loadSolTests, compileContracts)
+import Echidna.Solidity (selectMainContract, mkTests, loadSpecified, compileContracts)
 import Echidna.Test (checkETest)
 import Echidna.Types (Gas)
 import Echidna.Types.Config (Env(..), EConfig(..), EConfigWithUsage(..))
@@ -49,8 +51,10 @@ import Echidna.Types.Signature (ContractName)
 import Echidna.Types.Solidity (SolConf(..))
 import Echidna.Types.Test
 import Echidna.Types.Tx (Tx(..), TxCall(..), call)
+import Echidna.Types.World (World(..))
 
-import EVM.Solidity (Contracts(..), BuildOutput(..))
+import EVM.Solidity (Contracts(..), BuildOutput(..), SolcContract(..))
+import EVM.Types hiding (Env, Gas)
 
 testConfig :: EConfig
 testConfig = defaultConfig & overrideQuiet
@@ -89,14 +93,11 @@ runContract :: FilePath -> Maybe ContractName -> EConfig -> WorkerType -> IO (En
 runContract f selectedContract cfg workerType = do
   seed <- maybe (getRandomR (0, maxBound)) pure cfg.campaignConf.seed
   buildOutput <- compileContracts cfg.solConf (f :| [])
-  env <- mkEnv cfg buildOutput
 
-  (vm, world, dict) <- prepareContract env (f :| []) selectedContract seed
-
-  let (Contracts contractMap) = buildOutput.contracts
+  (vm, env, dict) <- prepareContract cfg (f :| []) buildOutput selectedContract seed
 
   (_stopReason, finalState) <- flip runReaderT env $
-    runWorker workerType (pure ()) vm world dict 0 [] cfg.campaignConf.testLimit selectedContract (Map.elems contractMap)
+    runWorker workerType (pure ()) vm dict 0 [] cfg.campaignConf.testLimit selectedContract
 
   -- TODO: consider snapshotting the state so checking function don't need to
   -- be IO
@@ -138,12 +139,33 @@ testContract' fp n v configPath s workerType expectations = testCase fp $ withSo
   forM_ expectations $ \(message, assertion) -> do
     assertion result >>= assertBool message
 
+-- | Given a file and an optional contract name, compile the file as solidity, then, if a name is
+-- given, try to fine the specified contract (assuming it is in the file provided), otherwise, find
+-- the first contract in the file. Take said contract and return an initial VM state with it loaded,
+-- its ABI (as 'SolSignature's), and the names of its Echidna tests. NOTE: unlike 'loadSpecified',
+-- contract names passed here don't need the file they occur in specified.
+loadSolTests
+  :: EConfig
+  -> BuildOutput
+  -> Maybe Text
+  -> IO (VM Concrete RealWorld, Env, [EchidnaTest])
+loadSolTests cfg buildOutput name = do
+  let solConf = cfg.solConf
+      (Contracts contractMap) = buildOutput.contracts
+      contracts = Map.elems contractMap
+      eventMap = Map.unions $ map (.eventMap) contracts
+      world = World solConf.sender mempty Nothing [] eventMap
+  mainContract <- selectMainContract solConf name contracts
+  echidnaTests <- mkTests solConf mainContract
+  env <- mkEnv cfg buildOutput echidnaTests world
+  vm <- loadSpecified env mainContract contracts
+  pure (vm, env, echidnaTests)
+
 checkConstructorConditions :: FilePath -> String -> TestTree
 checkConstructorConditions fp as = testCase fp $ do
   let cfg = testConfig
   buildOutput <- compileContracts cfg.solConf (pure fp)
-  env <- mkEnv cfg buildOutput
-  (v, _, t) <- loadSolTests env Nothing
+  (v, env, t) <- loadSolTests cfg buildOutput Nothing
   r <- flip runReaderT env $ mapM (`checkETest` v) t
   mapM_ (\(x,_) -> assertBool as (forceBool x)) r
   where forceBool (BoolValue b) = b
@@ -165,7 +187,7 @@ getResult n tests =
 
 optnFor :: Text -> (Env, WorkerState) -> IO (Maybe TestValue)
 optnFor n (env, _) = do
-  tests <- readIORef env.testsRef
+  tests <- traverse readIORef env.testRefs
   pure $ case getResult n tests of
     Just t -> Just t.value
     _      -> Nothing
@@ -180,7 +202,7 @@ optimized n v final = do
 
 solnFor :: Text -> (Env, WorkerState) -> IO (Maybe [Tx])
 solnFor n (env, _) = do
-  tests <- readIORef env.testsRef
+  tests <- traverse readIORef env.testRefs
   pure $ case getResult n tests of
     Just t -> if null t.reproducer then Nothing else Just t.reproducer
     _      -> Nothing
@@ -190,7 +212,7 @@ solved t f = isJust <$> solnFor t f
 
 passed :: Text -> (Env, WorkerState) -> IO Bool
 passed n (env, _) = do
-  tests <- readIORef env.testsRef
+  tests <- traverse readIORef env.testRefs
   pure $ case getResult n tests of
     Just t | isPassed t -> True
     Just t | isOpen t   -> True
diff --git a/src/test/Tests/Compile.hs b/src/test/Tests/Compile.hs
index c4048e504..0b30583ec 100644
--- a/src/test/Tests/Compile.hs
+++ b/src/test/Tests/Compile.hs
@@ -3,13 +3,12 @@ module Tests.Compile (compilationTests) where
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (testCase, assertBool)
 
-import Common (testConfig)
+import Common (testConfig, loadSolTests)
 import Control.Monad (void)
 import Control.Monad.Catch (catch)
 import Data.Text (Text)
 
-import Echidna (mkEnv)
-import Echidna.Solidity (compileContracts, loadSolTests)
+import Echidna.Solidity (compileContracts)
 import Echidna.Types.Solidity (SolException(..))
 import Echidna.Types.Config (EConfig(..))
 
@@ -42,5 +41,4 @@ loadFails fp c e p = testCase fp . catch tryLoad $ assertBool e . p where
   tryLoad = do
     let cfg = testConfig
     buildOutput <- compileContracts cfg.solConf (pure fp)
-    env <- mkEnv cfg buildOutput
-    void $ loadSolTests env c
+    void $ loadSolTests cfg buildOutput c
diff --git a/src/test/Tests/Seed.hs b/src/test/Tests/Seed.hs
index 78897b921..7793af1c3 100644
--- a/src/test/Tests/Seed.hs
+++ b/src/test/Tests/Seed.hs
@@ -40,5 +40,5 @@ seedTests =
       & overrideQuiet
     gen s = do
       (env, _) <- runContract "basic/flags.sol" Nothing (cfg s) FuzzWorker
-      readIORef env.testsRef
+      traverse readIORef env.testRefs
     same s t = (\x y -> ((.reproducer) <$> x) == ((.reproducer) <$> y)) <$> gen s <*> gen t
diff --git a/stack.yaml b/stack.yaml
index d09734d4f..d63fc4282 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -5,7 +5,7 @@ packages:
 
 extra-deps:
 - git: https://github.com/trail-of-forks/hevm.git
-  commit: 2aa7b3e5fea0e0657fe44549ccefbb18f61eb024
+  commit: 7d4344c5e71d14466e86331af064bab61d06bdad
 
 - restless-git-0.7@sha256:346a5775a586f07ecb291036a8d3016c3484ccdc188b574bcdec0a82c12db293,968
 - s-cargot-0.1.4.0@sha256:61ea1833fbb4c80d93577144870e449d2007d311c34d74252850bb48aa8c31fb,3525
diff --git a/tests/solidity/basic/default.yaml b/tests/solidity/basic/default.yaml
index 36428ac49..d9c277287 100644
--- a/tests/solidity/basic/default.yaml
+++ b/tests/solidity/basic/default.yaml
@@ -101,7 +101,7 @@ symExecConcolic: true
 # number of SMT solvers used in symbolic execution
 # only relevant if symExec is true
 symExecNSolvers: 1
-# timeout for symbolic execution SMT solver
+# timeout for symbolic execution SMT solver queries
 # only relevant if symExec is true
 symExecTimeout: 30
 # Number of times we may revisit a particular branching point
diff --git a/tstore_test.sol b/tstore_test.sol
new file mode 100644
index 000000000..eea83c138
--- /dev/null
+++ b/tstore_test.sol
@@ -0,0 +1,24 @@
+pragma solidity >=0.8.25;
+
+contract Test {
+  uint256 x;
+  uint256 y;
+  function A() public {
+    assembly {
+      if tload(0) { revert(0,0) }
+      tstore(0, 1)
+      if iszero(tload(0)) { revert(0,0) }
+    }
+    x = 5;
+  }
+  function B() public {
+    if (x != 5) revert();
+    assembly {
+      if tload(0) { revert(0,0) }
+    }
+    y = 10;
+  }
+  function echidna_foo() public view returns (bool) {
+    return y != 10;
+  }
+}