Optimize memory representation and operations

cli/cli.hs

@@ -679,6 +679,7 @@ vmFromCommand cOpts cExecOpts cFileOpts execOpts= do
           , allowFFI       = False
           , freshAddresses = 0
           , beaconRoot     = 0
+          , minMemoryChunk = 1
           }
         word f def = fromMaybe def (f cExecOpts)
         word64 f def = fromMaybe def (f cExecOpts)
@@ -779,6 +780,7 @@ symvmFromCommand cExecOpts sOpts cFileOpts calldata = do
       , allowFFI       = False
       , freshAddresses = 0
       , beaconRoot     = 0
+      , minMemoryChunk = 1
       }
     word f def = fromMaybe def (f cExecOpts)
     word64 f def = fromMaybe def (f cExecOpts)

src/EVM.hs

@@ -160,6 +160,7 @@ makeVm o = do
     , iterations = mempty
     , config = RuntimeConfig
       { allowFFI = o.allowFFI
+      , minMemoryChunk = o.minMemoryChunk
       , baseState = o.baseState
       }
     , forks = Seq.singleton (ForkState env block cache "")
@@ -674,9 +675,9 @@ exec1 conf = do
             mcopy sz srcOff dstOff = do
                   m <- gets (.state.memory)
                   case m of
-                    ConcreteMemory mem -> do
-                      buf <- freezeMemory mem
-                      copyBytesToMemory buf sz srcOff dstOff
+                    ConcreteMemory _ -> do
+                      buf <- readMemory srcOff sz
+                      copyBytesToMemory buf sz (Lit 0) dstOff
                     SymbolicMemory mem -> do
                       assign (#state % #memory) (SymbolicMemory $ copySlice srcOff dstOff sz mem mem)
 
@@ -2953,7 +2954,12 @@ writeMemory memory offset buf = do
   expandMemory targetSize = do
     let toAlloc = targetSize - VUnboxed.Mutable.length memory
     if toAlloc > 0 then do
-      memory' <- VUnboxed.Mutable.grow memory toAlloc
+      vm <- get
+      -- If you are using pure concrete mode, use a large chunk (e.g. 64k).
+      -- We want to always grow at least a chunk, to avoid the performance impact
+      -- that would happen with repeated small expansion operations, as grow does
+      -- a larger *copy* of the vector on a new place
+      memory' <- VUnboxed.Mutable.grow memory $ max toAlloc vm.config.minMemoryChunk
       assign (#state % #memory) (ConcreteMemory memory')
       pure memory'
     else

src/EVM/Exec.hs

@@ -44,6 +44,7 @@ vmForEthrunCreation creationCode =
     , allowFFI = False
     , freshAddresses = 0
     , beaconRoot = 0
+    , minMemoryChunk = 1
     }) <&> set (#env % #contracts % at (LitAddr ethrunAddress))
              (Just (initialContract (RuntimeCode (ConcreteRuntimeCode ""))))
 

src/EVM/SymExec.hs

@@ -248,6 +248,7 @@ loadEmptySymVM x callvalue cd =
     , allowFFI = False
     , freshAddresses = 0
     , beaconRoot = 0
+    , minMemoryChunk = 1
     })
 
 -- Creates a symbolic VM that has symbolic storage, unlike loadEmptySymVM
@@ -285,6 +286,7 @@ loadSymVM x callvalue cd create =
     , allowFFI = False
     , freshAddresses = 0
     , beaconRoot = 0
+    , minMemoryChunk = 1
     })
 
 -- freezes any mutable refs, making it safe to share between threads

src/EVM/Types.hs

@@ -722,6 +722,7 @@ data BaseState
 -- | Configuration options that need to be consulted at runtime
 data RuntimeConfig = RuntimeConfig
   { allowFFI :: Bool
+  , minMemoryChunk :: Int
   , baseState :: BaseState
   }
   deriving (Show)
@@ -1021,6 +1022,7 @@ data VMOpts (t :: VMType) = VMOpts
   , allowFFI :: Bool
   , freshAddresses :: Int
   , beaconRoot :: W256
+  , minMemoryChunk :: Int
   }
 
 deriving instance Show (VMOpts Symbolic)

src/EVM/UnitTest.hs

@@ -433,6 +433,7 @@ initialUnitTestVm (UnitTestOptions {..}) theContract = do
            , allowFFI = ffiAllowed
            , freshAddresses = 0
            , beaconRoot = 0
+           , minMemoryChunk = 1
            }
   let creator =
         initialContract (RuntimeCode (ConcreteRuntimeCode ""))

test/EVM/Test/BlockchainTests.hs

@@ -458,6 +458,7 @@ fromBlockchainCase' block tx preState postState =
        , allowFFI       = False
        , freshAddresses = 0
        , beaconRoot     = block.beaconRoot
+       , minMemoryChunk = 1
        })
       checkState
       postState

test/EVM/Test/Tracing.hs

@@ -472,6 +472,7 @@ vmForRuntimeCode runtimecode calldata' evmToolEnv alloc txn fromAddr toAddress =
     , allowFFI = False
     , freshAddresses = 0
     , beaconRoot = 0
+    , minMemoryChunk = 1
     }) <&> set (#env % #contracts % at (LitAddr ethrunAddress))
              (Just (initialContract (RuntimeCode (ConcreteRuntimeCode BS.empty))))
        <&> set (#state % #calldata) calldata'

test/rpc.hs

@@ -158,6 +158,7 @@ vmFromRpc blockNum calldata callvalue caller address = do
     , allowFFI       = False
     , freshAddresses = 0
     , beaconRoot     = 0
+    , minMemoryChunk = 1
     }) <&> set (#cache % #fetched % at address) (Just ctrct)
 
 testRpc :: Text