├── .gitignore ├── EVM ├── Environment.ml ├── Ethereum.ml ├── Exceptions.ml ├── Gas.ml ├── Instructions.ml ├── README ├── Semantics.ml ├── State.ml ├── TODO.org ├── Tests.ml ├── Word256.ml └── examples │ ├── basics.ml │ └── registry.ml ├── LICENSE ├── README.md └── media └── ic_logo.png /.gitignore: -------------------------------------------------------------------------------- 1 | .imandra_init.log 2 | -------------------------------------------------------------------------------- /EVM/Environment.ml: -------------------------------------------------------------------------------- 1 | (* A formal model of the Ethereum Virtual Machine in ImandraML *) 2 | (* (c)Copyright Aesthetic Integration, Ltd., 2016 *) 3 | (* All rights reserved. *) 4 | (* *) 5 | (* Released under Apache 2.0 license as described in the file LICENSE. *) 6 | (* *) 7 | (* Contributors: *) 8 | (* Grant Olney Passmore (grant@aestheticintegration.com) *) 9 | (* *) 10 | 11 | (* Core environmental data structures and lemmata (ABI compliant) *) 12 | 13 | type exit_explanation = 14 | Code_out_of_range 15 | | Stop_instruction 16 | | Return_instruction 17 | | Out_of_gas 18 | | Insufficient_stack 19 | | Stack_size_limit_exceeded 20 | | Oog_exponent 21 | | Oog_paying_for_SHA3 22 | | Oog_extending_memory 23 | | Oog_copy_data 24 | | Bad_jumpdest 25 | | Intentional_suicide 26 | ;; 27 | 28 | type exit_data = { e_flag : bool; 29 | e_gas : word; 30 | e_data : word list; 31 | e_desc : exit_explanation } 32 | ;; 33 | 34 | type halt_reason = 35 | Exit of exit_data 36 | | Exception of exit_data 37 | ;; 38 | 39 | type halt_status = halt_reason option 40 | ;; 41 | 42 | (* Call data *) 43 | 44 | type call_data = 45 | { fun_selector : fun_id option; 46 | call_args : word list } 47 | ;; 48 | 49 | let empty_call_data = 50 | { fun_selector = None; 51 | call_args = [] } 52 | ;; 53 | 54 | let offset_of_call_data d = 55 | match d.fun_selector with 56 | Some _ -> Z.(4) 57 | | None -> Z.(0) 58 | ;; 59 | 60 | let rec word_of_call_data (d, loc) = 61 | let m = offset_of_call_data d in 62 | let l = Z.((loc - m) / 32) in 63 | let call_arg = List.nth d.call_args (Z.to_int l) in 64 | call_arg 65 | ;; 66 | 67 | let size_of_call_data d = 68 | let m = offset_of_call_data d in 69 | Z.(m + (32 * of_int(List.length d.call_args))) 70 | ;; 71 | 72 | (* Memory *) 73 | 74 | type memory = 75 | { data : word list; 76 | cur_size : word; 77 | peek : word } 78 | ;; 79 | 80 | let empty_mem = Z.({ data = []; cur_size = 0; peek = 0 });; 81 | 82 | let round_up_word_index (max_index, i) = 83 | Z.(max max_index (ceiling(i + 32, 32))) 84 | ;; 85 | 86 | (* @meta[measure : k_zeroes] 87 | let measure_k_zeroes (k : int) = k 88 | @end 89 | *) 90 | 91 | let rec k_zeroes (k) = 92 | Z.(if k <= 0 then [] 93 | else 0 :: k_zeroes (k-1)) 94 | ;; 95 | 96 | let pad_mem_up_to (data, from, upto) = 97 | Z.(let d = List.rev data in 98 | let z = k_zeroes (upto - from) in 99 | List.rev (z @ d)) 100 | ;; 101 | 102 | (* Note: get_mem is currently for word boundary reads, byte-addressable *) 103 | 104 | let get_mem (i, mem : word * memory) = 105 | Z.(let k = mem.cur_size in 106 | if i < k*32 then 107 | let v = List.nth mem.data (Z.to_int (i/32)) in 108 | { mem with peek = v } 109 | else 110 | let new_size = round_up_word_index (mem.cur_size, i) in 111 | let data' = pad_mem_up_to(mem.data, mem.cur_size, new_size) in 112 | { cur_size = new_size; 113 | data = data'; 114 | peek = 0 }) 115 | ;; 116 | 117 | (* @meta[measure : drop_fst] 118 | let measure_drop_fst (lst, n : _ * int) = n 119 | @end 120 | *) 121 | 122 | let rec drop_fst (lst, n) = 123 | Z.(if n <= 0 || lst = [] then lst 124 | else drop_fst (List.tl lst, n-1)) 125 | ;; 126 | 127 | let rec take (lst, n) = 128 | Z.(if n <= 0 || lst = [] then [] 129 | else List.hd lst :: (take (List.tl lst, n-1))) 130 | ;; 131 | 132 | let subseq (lst, base, len) = 133 | Z.(let new_lst = drop_fst (lst, base) in 134 | take (new_lst, len)) 135 | ;; 136 | 137 | let rec replace_nth (lst, i, v) = 138 | Z.(match lst with 139 | [] -> [] 140 | | x::xs -> if i = 0 then 141 | v :: xs 142 | else x :: replace_nth (xs, i-1, v)) 143 | ;; 144 | 145 | (* Set on word boundaries *) 146 | 147 | let set_mem (i, v, mem : word * word * memory) = 148 | Z.(if (i / 32) >= mem.cur_size then 149 | let new_size = round_up_word_index (mem.cur_size, i) in 150 | let data' = pad_mem_up_to(mem.data, mem.cur_size, new_size) in 151 | let data'' = replace_nth(data', i / 32, v) in 152 | { mem with cur_size = new_size; 153 | data = data'' } 154 | else 155 | let data' = replace_nth(mem.data, i / 32, v) in 156 | { mem with data = data'; 157 | cur_size = round_up_word_index (mem.cur_size, i) }) 158 | ;; 159 | 160 | let subseq_32 (lst, base) = 161 | subseq (lst, base, Z.(32)) 162 | ;; 163 | 164 | (* Return a range of memory - endpoints must be word boundaries *) 165 | 166 | let mem_range (mem, from_idx, len) = 167 | Z.(if len = 0 then [] 168 | else subseq (mem.data, from_idx / 32, len / 32)) 169 | ;; 170 | 171 | (* Set a byte in memory *) 172 | 173 | let set_byte (idx, v, mem : word * byte * memory) = 174 | Z.(let w_idx = idx / 32 in 175 | let w = 176 | if w_idx < mem.cur_size then 177 | List.nth mem.data (to_int w_idx) 178 | else 0 in 179 | let b_idx = w mod 32 in 180 | let bytes = mk_32_bytes w in 181 | let bytes = replace_nth(bytes, b_idx, v) in 182 | let w = word_of_bytes bytes in 183 | set_mem (w_idx, w, mem)) 184 | ;; 185 | 186 | (* Various concrete maps *) 187 | 188 | type located_word = { w_loc : address; w_val : word };; 189 | 190 | type word_map = located_word list;; 191 | 192 | let rec get_word_map (w_map, w_loc) = 193 | match w_map with 194 | [] -> Z.(0) 195 | | x :: xs -> 196 | if x.w_loc = w_loc then x.w_val 197 | else get_word_map (xs, w_loc) 198 | ;; 199 | 200 | type located_code = { c_loc : address; c_val : program };; 201 | 202 | type code_map = located_code list;; 203 | 204 | let rec get_code_map (c_map, c_loc) = 205 | match c_map with 206 | [] -> [] 207 | | x :: xs -> 208 | if x.c_loc = c_loc then x.c_val 209 | else get_code_map (xs, c_loc) 210 | ;; 211 | 212 | let rec code_acct_exists (c_map, c_loc) = 213 | match c_map with 214 | [] -> false 215 | | x :: xs -> 216 | x.c_loc = c_loc 217 | || code_acct_exists (xs, c_loc) 218 | ;; 219 | 220 | type ext = 221 | { tx_origin : address; 222 | tx_gas_price : word; 223 | block_hashes : word_map; 224 | block_coinbase : word; 225 | block_timestamp : word; 226 | block_number : word; 227 | block_difficulty : word; 228 | block_gas_limit : word; 229 | code_repository : code_map; 230 | } 231 | ;; 232 | 233 | let empty_ext = 234 | Z.({ tx_origin = 0; 235 | tx_gas_price = 0; 236 | block_hashes = []; 237 | block_coinbase = 0; 238 | block_timestamp = 0; 239 | block_number = 0; 240 | block_difficulty = 0; 241 | block_gas_limit = 0; 242 | code_repository = []}) 243 | ;; 244 | 245 | (* Get external code *) 246 | 247 | let get_ext_code (addr, ext) = 248 | get_code_map (ext.code_repository, addr) 249 | ;; 250 | 251 | let account_exists (addr, ext) = 252 | code_acct_exists (ext.code_repository, addr) 253 | ;; 254 | 255 | (* Balance *) 256 | 257 | type balance_entry = 258 | { bal_loc : address; 259 | bal_val : word } 260 | ;; 261 | 262 | type balance = balance_entry list;; 263 | 264 | (* Call return *) 265 | 266 | type return_result = 267 | { return_data : byte list; 268 | return_balance : balance } 269 | ;; 270 | 271 | (* Storage *) 272 | 273 | type storage_entry = { storage_loc : word; 274 | storage_val : word } 275 | ;; 276 | 277 | type storage = storage_entry list;; 278 | 279 | (* Balance manipulation *) 280 | 281 | let set_balance (a,n,b : address * word * balance) = 282 | { bal_loc = a; bal_val = n } :: b 283 | ;; 284 | 285 | let rec get_balance (a,b : address * balance) = 286 | match b with 287 | [] -> Z.zero 288 | | b :: bs -> 289 | if b.bal_loc = a then b.bal_val 290 | else get_balance (a, bs) 291 | ;; 292 | 293 | theorem[rw] set_balance_works (a,n,b) = 294 | get_balance(a, set_balance(a,n,b)) = n 295 | ;; 296 | 297 | theorem[rw] set_balance_stable (a1,a2,b1,b2,bals) = 298 | (a1 <> a2) 299 | ==> 300 | (get_balance(a1, set_balance(a2,b2,bals)) 301 | = 302 | get_balance(a1, bals)) 303 | ;; 304 | 305 | :disable get_balance set_balance 306 | 307 | (* Simple example lemma *) 308 | 309 | lemma _ (b) = Z.(get_balance (10, set_balance(10, 5, b)) = 5);; 310 | 311 | (* Storage *) 312 | 313 | let set_storage (a,v,store : address * word * storage) = 314 | { storage_loc = a; storage_val = v } :: store 315 | ;; 316 | 317 | let rec get_storage (a,store : address * storage) = 318 | match store with 319 | [] -> Z.zero 320 | | e :: es -> 321 | if e.storage_loc = a then e.storage_val 322 | else get_storage (a, es) 323 | ;; 324 | 325 | theorem[rw] set_storage_works (a,v,store) = 326 | get_storage(a, set_storage(a,v,store)) = v 327 | ;; 328 | 329 | theorem[rw] set_storage_stable (a1,a2,v1,v2,store) = 330 | (a1 <> a2) 331 | ==> 332 | (get_storage(a1, set_storage(a2,v2,store)) 333 | = 334 | get_storage(a1, store)) 335 | ;; 336 | 337 | :disable get_storage set_storage 338 | 339 | (* Substate: Suicides, Logs, Refund balance *) 340 | 341 | type log_entry = 342 | { topics : word list; 343 | logged_mem : word list } 344 | ;; 345 | 346 | type substate = 347 | { suicides : address list; 348 | logs : log_entry list; 349 | refund : word } 350 | ;; 351 | 352 | let empty_substate = 353 | { suicides = []; 354 | logs = []; 355 | refund = Z.(0) } 356 | ;; 357 | 358 | (* Note: We store logs in reverse chronological order. *) 359 | 360 | let add_log (substate, topics, mem : substate * word list * word list) = 361 | let l = { topics = topics; 362 | logged_mem = mem } in 363 | { substate with logs = l :: substate.logs } 364 | ;; 365 | 366 | let add_suicide (substate, target : substate * address) = 367 | { substate with suicides = target :: substate.suicides } 368 | ;; 369 | 370 | (* Messages *) 371 | 372 | type msg = 373 | { recipient : address; 374 | sender : address; 375 | value : word; 376 | msg_gas : word; 377 | msg_data : call_data; 378 | depth : word; 379 | msg_logs : log_entry list; 380 | code_address : address; 381 | is_create : bool; 382 | transfers_value : bool } 383 | ;; 384 | 385 | type call_status = msg option 386 | ;; 387 | 388 | let empty_msg = 389 | Z.({ recipient = 0; 390 | sender = 0; 391 | value = 0; 392 | msg_gas = 0; 393 | msg_data = empty_call_data; 394 | depth = 0; 395 | msg_logs = []; 396 | code_address = 0; 397 | is_create = false; 398 | transfers_value = false 399 | }) 400 | ;; 401 | 402 | let mk_basic_msg (call_data) = 403 | { empty_msg with msg_data = call_data } 404 | ;; 405 | 406 | -------------------------------------------------------------------------------- /EVM/Ethereum.ml: -------------------------------------------------------------------------------- 1 | (* A formal model of the Ethereum Virtual Machine in ImandraML *) 2 | (* (c)Copyright Aesthetic Integration, Ltd., 2016 *) 3 | (* All rights reserved. *) 4 | (* *) 5 | (* Released under Apache 2.0 license as described in the file LICENSE. *) 6 | (* *) 7 | (* Contributors: *) 8 | (* Grant Olney Passmore (grant@aestheticintegration.com) *) 9 | (* *) 10 | 11 | :load Word256.ml 12 | :load Instructions.ml 13 | :load Environment.ml 14 | :load Gas.ml 15 | :load State.ml 16 | :load Exceptions.ml 17 | :load Semantics.ml 18 | 19 | let next_inst s = 20 | index_into_program (s.pc, s.program) 21 | ;; 22 | 23 | (* From a given state, execute a given EVM instruction *) 24 | 25 | let do_inst (s, inst : state * instruction) = 26 | 27 | if s.pc >= program_length(s.program) then 28 | raise_exception (s, Code_out_of_range) 29 | else if Z.(base_cost_of_inst(inst) > s.gas) then 30 | raise_exception (s, Out_of_gas) 31 | else if num_in_args(inst) > List.length s.stack then 32 | raise_exception (s, Insufficient_stack) 33 | else if (List.length s.stack - num_in_args(inst) + num_out_args(inst) > 1024) then 34 | raise_exception (s, Stack_size_limit_exceeded) 35 | 36 | else 37 | 38 | let s = { s with gas = Z.(s.gas - base_cost_of_inst(inst)) } 39 | in 40 | 41 | match inst with 42 | 43 | (* Stop and arithmetic *) 44 | 45 | | Stop -> exec_Stop (s) 46 | | Add -> exec_Add (s) 47 | | Mul -> exec_Mul (s) 48 | | Sub -> exec_Sub (s) 49 | | Div -> exec_Div (s) 50 | | SDiv -> exec_SDiv (s) 51 | | Mod -> exec_Mod (s) 52 | | SMod -> exec_SMod (s) 53 | | AddMod -> exec_AddMod (s) 54 | | MulMod -> exec_MulMod (s) 55 | | Exp -> exec_Exp (s) 56 | | SignExtend -> exec_SignExtend (s) 57 | 58 | (* Comparison and bitwise logical operations *) 59 | 60 | | Lt -> exec_Lt (s) 61 | | Gt -> exec_Gt (s) 62 | | Slt -> exec_Slt (s) 63 | | Sgt -> exec_Sgt (s) 64 | | Eq -> exec_Eq (s) 65 | | IsZero -> exec_IsZero (s) 66 | | BitAnd -> exec_BitAnd (s) 67 | | BitOr -> exec_BitOr (s) 68 | | BitXor -> exec_BitXor (s) 69 | | BitNot -> exec_BitNot (s) 70 | | Byte -> exec_Byte (s) 71 | 72 | (* SHA3 *) 73 | 74 | | SHA3 -> exec_SHA3 (s) 75 | 76 | (* Environment *) 77 | 78 | | Address -> exec_Address (s) 79 | | Balance -> exec_Balance (s) 80 | | Origin -> exec_Origin (s) 81 | | Caller -> exec_Caller (s) 82 | | CallValue -> exec_CallValue (s) 83 | | CallDataLoad -> exec_CallDataLoad (s) 84 | | CallDataSize -> exec_CallDataSize (s) 85 | | CallDataCopy -> exec_CallDataCopy (s) 86 | | CodeSize -> exec_CodeSize (s) 87 | | CodeCopy -> exec_CodeCopy (s) 88 | | GasPrice -> exec_GasPrice (s) 89 | | ExtCodeSize -> exec_ExtCodeSize (s) 90 | | ExtCodeCopy -> exec_CodeCopy (s) 91 | 92 | (* Block information *) 93 | 94 | | BlockHash -> exec_BlockHash (s) 95 | | CoinBase -> exec_CoinBase (s) 96 | | TimeStamp -> exec_TimeStamp (s) 97 | | Number -> exec_Number (s) 98 | | Difficulty -> exec_Difficulty (s) 99 | | GasLimit -> exec_GasLimit (s) 100 | 101 | (* Stack, memory, storage and flow operations *) 102 | 103 | | Pop -> exec_Pop (s) 104 | | MLoad -> exec_MLoad (s) 105 | | MStore -> exec_MStore (s) 106 | | MStore8 -> exec_MStore8 (s) 107 | | SLoad -> exec_SLoad (s) 108 | | SStore -> exec_SStore (s) 109 | | Jump -> exec_Jump (s) 110 | | JumpI -> exec_JumpI (s) 111 | | Pc -> exec_Pc (s) 112 | | MSize -> exec_MSize (s) 113 | | Gas -> exec_Gas (s) 114 | | JumpDest -> exec_JumpDest (s) 115 | 116 | (* Push operations *) 117 | (* We use (Push ...) for Push1 ... Push32, 118 | determining which we have by the length of byte list. *) 119 | 120 | | Push w -> exec_Push (s, w) 121 | 122 | (* Duplication operations *) 123 | 124 | | Dup k -> exec_Dup (s, k) 125 | 126 | (* Exchange operations *) 127 | 128 | | Swap k -> exec_Swap (s, k) 129 | 130 | (* Log operations *) 131 | 132 | | Log k -> exec_Log (s, k) 133 | 134 | (* System operations *) 135 | 136 | | Create -> exec_Create (s) 137 | | Call -> exec_Call (s) 138 | | CallCode -> exec_CallCode (s) 139 | | Return -> exec_Return (s) 140 | | DelegateCall -> exec_DelegateCall (s) 141 | | Suicide -> exec_Suicide (s) 142 | ;; 143 | 144 | (* Step a state *) 145 | 146 | let step (s) = 147 | do_inst (s, next_inst s) 148 | ;; 149 | 150 | (* From a given state, run the EVM k steps. 151 | 152 | @meta[measure : run] 153 | let measure_run (s, k : _ * int) = k 154 | @end 155 | *) 156 | 157 | let rec run (s, k) = 158 | if k <= 0 then s 159 | else 160 | match s.pending_call with 161 | Some m -> 162 | let s_c = init_call_state (s,m) in 163 | let s_c' = run(s_c, k-1) in 164 | let s = recover_state_from_call (s, s_c') in 165 | run (step s, k-1) 166 | | None -> run (step s, k-1) 167 | ;; 168 | 169 | (* Register `run' as the entry point to our semantic machine model. 170 | 171 | This instructs Imandra to give special treatment to the expansion and 172 | simplification of instances of the (recursive) `run' function. 173 | 174 | The result is a bytecode analysis engine combining staged symbolic execution 175 | with inductive proof, automatically derived from the formal operational 176 | semantics given by the body of `run.' 177 | *) 178 | 179 | :machine run 10000 180 | -------------------------------------------------------------------------------- /EVM/Exceptions.ml: -------------------------------------------------------------------------------- 1 | (* A formal model of the Ethereum Virtual Machine in ImandraML *) 2 | (* (c)Copyright Aesthetic Integration, Ltd., 2016 *) 3 | (* All rights reserved. *) 4 | (* *) 5 | (* Released under Apache 2.0 license as described in the file LICENSE. *) 6 | (* *) 7 | (* Contributors: *) 8 | (* Grant Olney Passmore (grant@aestheticintegration.com) *) 9 | (* *) 10 | 11 | (* Raising exceptions and exiting peacefully *) 12 | (* Note: See Environment for exit explanations *) 13 | 14 | let raise_exception (s, e : state * exit_explanation) = 15 | let r = { e_flag = true; 16 | e_gas = s.gas; 17 | e_data = []; 18 | e_desc = e } in 19 | { s with halted = Some (Exception r) } 20 | ;; 21 | 22 | let peaceful_exit (s, e, mem : state * exit_explanation * word list) = 23 | let r = { e_flag = false; 24 | e_gas = s.gas; 25 | e_data = mem; 26 | e_desc = e } in 27 | { s with halted = Some (Exit r) } 28 | ;; 29 | 30 | (* If it's OK to extend memory as specified, then we return 31 | (Some g), where g is our new gas after the extension fee is taken. 32 | 33 | If it's not OK to extend memory, then we return None. 34 | Gas must be zeroed / Out_of_memory exception must be raised by caller. *) 35 | 36 | type mem_extn = 37 | { new_size : word; 38 | new_gas : word } 39 | ;; 40 | 41 | let mem_extend_ok (cur_gas, cur_size, start, sz) = 42 | Z.(if sz > 0 then 43 | let old_size = cur_size in 44 | let old_total_fee = (old_size * gas_MEMORY + 45 | (old_size * old_size) / gas_QUADRATICMEMDENOM) in 46 | let new_size = ceiling(start + sz, 32) in 47 | let new_total_fee = (new_size * gas_MEMORY + 48 | (new_size * new_size) / gas_QUADRATICMEMDENOM) in 49 | if old_total_fee < new_total_fee then 50 | let mem_fee = new_total_fee - old_total_fee in 51 | if cur_gas < mem_fee then 52 | None 53 | else 54 | let g = cur_gas - mem_fee in 55 | Some { new_size = new_size; new_gas = g } 56 | else Some { new_size = new_size; new_gas = cur_gas } 57 | else Some { new_size = cur_size; new_gas = cur_gas }) 58 | ;; 59 | 60 | (* Is a data_copy operation OK? If so, compute the remaining gas. *) 61 | 62 | let data_copy_ok (cur_gas, sz) = 63 | Z.(if sz > 0 then 64 | let fee = gas_COPY * ceiling(sz, 32) in 65 | if cur_gas < fee then 66 | None 67 | else Some (cur_gas - fee) 68 | else Some cur_gas) 69 | ;; 70 | 71 | 72 | -------------------------------------------------------------------------------- /EVM/Gas.ml: -------------------------------------------------------------------------------- 1 | (* A formal model of the Ethereum Virtual Machine in ImandraML *) 2 | (* (c)Copyright Aesthetic Integration, Ltd., 2016 *) 3 | (* All rights reserved. *) 4 | (* *) 5 | (* Released under Apache 2.0 license as described in the file LICENSE. *) 6 | (* *) 7 | (* Contributors: *) 8 | (* Grant Olney Passmore (grant@aestheticintegration.com) *) 9 | (* *) 10 | 11 | (* Base gas cost of an instruction *) 12 | 13 | let base_cost_of_inst x = 14 | Z.(match x with 15 | (* Stop and arithmetic *) 16 | Stop -> 0 17 | | Add -> 3 18 | | Mul -> 5 19 | | Sub -> 3 20 | | Div -> 5 21 | | SDiv -> 5 22 | | Mod -> 5 23 | | SMod -> 5 24 | | AddMod -> 8 25 | | MulMod -> 8 26 | | Exp -> 10 27 | | SignExtend -> 5 28 | (* Comparison and bitwise logical operations *) 29 | | Lt -> 3 30 | | Gt -> 3 31 | | Slt -> 3 32 | | Sgt -> 3 33 | | Eq -> 3 34 | | IsZero -> 3 35 | | BitAnd -> 3 36 | | BitOr -> 3 37 | | BitXor -> 3 38 | | BitNot -> 3 39 | | Byte -> 3 40 | (* SHA3 *) 41 | | SHA3 -> 30 42 | (* Environment *) 43 | | Address -> 2 44 | | Balance -> 20 45 | | Origin -> 2 46 | | Caller -> 2 47 | | CallValue -> 2 48 | | CallDataLoad -> 3 49 | | CallDataSize -> 2 50 | | CallDataCopy -> 3 51 | | CodeSize -> 2 52 | | CodeCopy -> 3 53 | | GasPrice -> 2 54 | | ExtCodeSize -> 20 55 | | ExtCodeCopy -> 20 56 | (* Block information *) 57 | | BlockHash -> 20 58 | | CoinBase -> 2 59 | | TimeStamp -> 2 60 | | Number -> 2 61 | | Difficulty -> 2 62 | | GasLimit -> 2 63 | (* Stack, memory, storage and flow operations *) 64 | | Pop -> 2 65 | | MLoad -> 3 66 | | MStore -> 3 67 | | MStore8 -> 3 68 | | SLoad -> 50 69 | | SStore -> 0 70 | | Jump -> 8 71 | | JumpI -> 10 72 | | Pc -> 2 73 | | MSize -> 2 74 | | Gas -> 2 75 | | JumpDest -> 1 76 | | Push _ -> 3 77 | (* Duplication operations *) 78 | | Dup _ -> 3 79 | (* Exchange operations *) 80 | | Swap _ -> 3 81 | (* Log operations *) 82 | | Log 0 -> 375 83 | | Log 1 -> 750 84 | | Log 2 -> 1125 85 | | Log 3 -> 1500 86 | | Log 4 -> 1875 87 | | Log n -> 0 (* Unreachable *) 88 | (* System operations *) 89 | | Create -> 32000 90 | | Call -> 40 91 | | CallCode -> 40 92 | | Return -> 0 93 | | DelegateCall -> 40 94 | | Suicide -> 0) 95 | ;; 96 | 97 | (* -- Other gas prices -- *) 98 | 99 | let gas_DEFAULT = Z.(1);; 100 | let gas_MEMORY = Z.(3);; 101 | let gas_QUADRATICMEMDENOM = Z.(512);; 102 | let gas_STORAGEREFUND = Z.(15000);; 103 | let gas_STORAGEKILL = Z.(5000);; 104 | let gas_STORAGEMOD = Z.(5000);; 105 | let gas_STORAGEADD = Z.(20000);; 106 | let gas_EXPONENTBYTE = Z.(10);; 107 | let gas_COPY = Z.(3);; 108 | let gas_CONTRACTBYTE = Z.(200);; 109 | let gas_CALLVALUETRANSFER = Z.(9000);; 110 | let gas_LOGBYTE = Z.(8);; 111 | let gas_TXCOST = Z.(21000);; 112 | let gas_TXDATAZERO = Z.(4);; 113 | let gas_TXDATANONZERO = Z.(68);; 114 | let gas_SHA3WORD = Z.(6);; 115 | let gas_SHA256BASE = Z.(60);; 116 | let gas_SHA256WORD = Z.(12);; 117 | let gas_RIPEMD160BASE = Z.(600);; 118 | let gas_RIPEMD160WORD = Z.(120);; 119 | let gas_IDENTITYBASE = Z.(15);; 120 | let gas_IDENTITYWORD = Z.(3);; 121 | let gas_ECRECOVER = Z.(3000);; 122 | let gas_STIPEND = Z.(2300);; 123 | let gas_CALLNEWACCOUNT = Z.(25000);; 124 | let gas_SUICIDEREFUND = Z.(24000);; 125 | 126 | -------------------------------------------------------------------------------- /EVM/Instructions.ml: -------------------------------------------------------------------------------- 1 | (* A formal model of the Ethereum Virtual Machine in ImandraML *) 2 | (* (c)Copyright Aesthetic Integration, Ltd., 2016 *) 3 | (* All rights reserved. *) 4 | (* *) 5 | (* Released under Apache 2.0 license as described in the file LICENSE. *) 6 | (* *) 7 | (* Contributors: *) 8 | (* Grant Olney Passmore (grant@aestheticintegration.com) *) 9 | (* *) 10 | 11 | (* Ethereum instruction set (Homestead revision) *) 12 | 13 | type instruction = 14 | (* Stop and arithmetic *) 15 | | Stop 16 | | Add 17 | | Mul 18 | | Sub 19 | | Div 20 | | SDiv 21 | | Mod 22 | | SMod 23 | | AddMod 24 | | MulMod 25 | | Exp 26 | | SignExtend 27 | (* Comparison and bitwise logical operations *) 28 | | Lt 29 | | Gt 30 | | Slt 31 | | Sgt 32 | | Eq 33 | | IsZero 34 | | BitAnd 35 | | BitOr 36 | | BitXor 37 | | BitNot 38 | | Byte 39 | (* SHA3 *) 40 | | SHA3 41 | (* Environment *) 42 | | Address 43 | | Balance 44 | | Origin 45 | | Caller 46 | | CallValue 47 | | CallDataLoad 48 | | CallDataSize 49 | | CallDataCopy 50 | | CodeSize 51 | | CodeCopy 52 | | GasPrice 53 | | ExtCodeSize 54 | | ExtCodeCopy 55 | (* Block information *) 56 | | BlockHash 57 | | CoinBase 58 | | TimeStamp 59 | | Number 60 | | Difficulty 61 | | GasLimit 62 | (* Stack, memory, storage and flow operations *) 63 | | Pop 64 | | MLoad 65 | | MStore 66 | | MStore8 67 | | SLoad 68 | | SStore 69 | | Jump 70 | | JumpI 71 | | Pc 72 | | MSize 73 | | Gas 74 | | JumpDest 75 | (* Push operations *) 76 | (* We use (Push ...) for Push1 ... Push32, 77 | determining which we have by the length of byte list. *) 78 | | Push of byte list 79 | (* Duplication operations *) 80 | | Dup of int (* 1 ... 16 *) 81 | (* Exchange operations *) 82 | | Swap of int (* 1 ... 16 *) 83 | (* Log operations *) 84 | | Log of int (* 0 ... 4 *) 85 | (* System operations *) 86 | | Create 87 | | Call 88 | | CallCode 89 | | Return 90 | | DelegateCall 91 | | Suicide 92 | ;; 93 | 94 | (* Pretty-printing *) 95 | 96 | let rec string_of_bytes (bs : byte list) = 97 | match bs with 98 | [] -> "" 99 | | b :: bs -> (Z.to_string b) ^ (string_of_bytes bs) 100 | ;; 101 | 102 | let string_of_instruction x = 103 | match x with 104 | (* Stop and arithmetic *) 105 | | Stop -> "STOP" 106 | | Add -> "ADD" 107 | | Mul -> "MUL" 108 | | Sub -> "SUB" 109 | | Div -> "DIV" 110 | | SDiv -> "SDIV" 111 | | Mod -> "MOD" 112 | | SMod -> "SMOD" 113 | | AddMod -> "ADDMOD" 114 | | MulMod -> "MULMOD" 115 | | Exp -> "EXP" 116 | | SignExtend -> "SIGNEXTEND" 117 | (* Comparison and bitwise logical operations *) 118 | | Lt -> "LT" 119 | | Gt -> "GT" 120 | | Slt -> "SLT" 121 | | Sgt -> "SGT" 122 | | Eq -> "EQ" 123 | | IsZero -> "ISZERO" 124 | | BitAnd -> "AND" 125 | | BitOr -> "OR" 126 | | BitXor -> "XOR" 127 | | BitNot -> "NOT" 128 | | Byte -> "BYTE" 129 | (* SHA3 *) 130 | | SHA3 -> "SHA3" 131 | (* Environment *) 132 | | Address -> "ADDRESS" 133 | | Balance -> "BALANCE" 134 | | Origin -> "ORIGIN" 135 | | Caller -> "CALLER" 136 | | CallValue -> "CALLVALUE" 137 | | CallDataLoad -> "CALLDATALOAD" 138 | | CallDataSize -> "CALLDATASIZE" 139 | | CallDataCopy -> "CALLDATACOPY" 140 | | CodeSize -> "CODESIZE" 141 | | CodeCopy -> "CODECOPY" 142 | | GasPrice -> "GASPRICE" 143 | | ExtCodeSize -> "EXTCODESIZE" 144 | | ExtCodeCopy -> "EXTCODECOPY" 145 | (* Block information *) 146 | | BlockHash -> "BLOCKHASH" 147 | | CoinBase -> "COINBASE" 148 | | TimeStamp -> "TIMESTAMP" 149 | | Number -> "NUMBER" 150 | | Difficulty -> "DIFFICULTY" 151 | | GasLimit -> "GASLIMIT" 152 | (* Stack, memory, storage and flow operations *) 153 | | Pop -> "POP" 154 | | MLoad -> "MLOAD" 155 | | MStore -> "MSTORE" 156 | | MStore8 -> "MSTORE8" 157 | | SLoad -> "SLOAD" 158 | | SStore -> "SSTORE" 159 | | Jump -> "JUMP" 160 | | JumpI -> "JUMPI" 161 | | Pc -> "PC" 162 | | MSize -> "MSIZE" 163 | | Gas -> "GAS" 164 | | JumpDest -> "JUMPDEST" 165 | | Push bytes -> 166 | let n = List.length bytes in 167 | "PUSH" ^ (string_of_int n) ^ "(" ^ (string_of_bytes bytes) ^ ")" 168 | (* Duplication operations *) 169 | | Dup n -> "DUP" ^ (string_of_int n) 170 | (* Exchange operations *) 171 | | Swap n -> "SWAP" ^ (string_of_int n) 172 | (* Log operations *) 173 | | Log n -> "LOG" ^ (string_of_int n) 174 | (* System operations *) 175 | | Create -> "CREATE" 176 | | Call -> "CALL" 177 | | CallCode -> "CALLCODE" 178 | | Return -> "RETURN" 179 | | DelegateCall -> "DELEGATECALL" 180 | | Suicide -> "SUICIDE" 181 | ;; 182 | 183 | (* Number of in and out (stack) args *) 184 | 185 | type inst_sig = { num_in : int; num_out : int };; 186 | 187 | let sig_of_inst x = 188 | match x with 189 | (* Stop and arithmetic *) 190 | | Stop -> { num_in = 0; num_out = 0 } 191 | | Add -> { num_in = 2; num_out = 1 } 192 | | Mul -> { num_in = 2; num_out = 1 } 193 | | Sub -> { num_in = 2; num_out = 1 } 194 | | Div -> { num_in = 2; num_out = 1 } 195 | | SDiv -> { num_in = 2; num_out = 1 } 196 | | Mod -> { num_in = 2; num_out = 1 } 197 | | SMod -> { num_in = 2; num_out = 1 } 198 | | AddMod -> { num_in = 3; num_out = 1 } 199 | | MulMod -> { num_in = 3; num_out = 1 } 200 | | Exp -> { num_in = 2; num_out = 1 } 201 | | SignExtend -> { num_in = 2; num_out = 1 } 202 | (* Comparison and bitwise logical operations *) 203 | | Lt -> { num_in = 2; num_out = 1 } 204 | | Gt -> { num_in = 2; num_out = 1 } 205 | | Slt -> { num_in = 2; num_out = 1 } 206 | | Sgt -> { num_in = 2; num_out = 1 } 207 | | Eq -> { num_in = 2; num_out = 1 } 208 | | IsZero -> { num_in = 1; num_out = 1 } 209 | | BitAnd -> { num_in = 2; num_out = 1 } 210 | | BitOr -> { num_in = 2; num_out = 1 } 211 | | BitXor -> { num_in = 2; num_out = 1 } 212 | | BitNot -> { num_in = 1; num_out = 1 } 213 | | Byte -> { num_in = 2; num_out = 1 } 214 | (* SHA3 *) 215 | | SHA3 -> { num_in = 2; num_out = 1 } 216 | (* Environment *) 217 | | Address -> { num_in = 0; num_out = 1 } 218 | | Balance -> { num_in = 1; num_out = 1 } 219 | | Origin -> { num_in = 0; num_out = 1 } 220 | | Caller -> { num_in = 0; num_out = 1 } 221 | | CallValue -> { num_in = 0; num_out = 1 } 222 | | CallDataLoad -> { num_in = 1; num_out = 1 } 223 | | CallDataSize -> { num_in = 0; num_out = 1 } 224 | | CallDataCopy -> { num_in = 3; num_out = 0 } 225 | | CodeSize -> { num_in = 0; num_out = 1 } 226 | | CodeCopy -> { num_in = 3; num_out = 0 } 227 | | GasPrice -> { num_in = 0; num_out = 1 } 228 | | ExtCodeSize -> { num_in = 1; num_out = 1 } 229 | | ExtCodeCopy -> { num_in = 4; num_out = 0 } 230 | (* Block information *) 231 | | BlockHash -> { num_in = 1; num_out = 1 } 232 | | CoinBase -> { num_in = 0; num_out = 1 } 233 | | TimeStamp -> { num_in = 0; num_out = 1 } 234 | | Number -> { num_in = 0; num_out = 1 } 235 | | Difficulty -> { num_in = 0; num_out = 1 } 236 | | GasLimit -> { num_in = 0; num_out = 1 } 237 | (* Stack, memory, storage and flow operations *) 238 | | Pop -> { num_in = 1; num_out = 0 } 239 | | MLoad -> { num_in = 1; num_out = 1 } 240 | | MStore -> { num_in = 2; num_out = 0 } 241 | | MStore8 -> { num_in = 2; num_out = 0 } 242 | | SLoad -> { num_in = 1; num_out = 1 } 243 | | SStore -> { num_in = 2; num_out = 0 } 244 | | Jump -> { num_in = 1; num_out = 0 } 245 | | JumpI -> { num_in = 2; num_out = 0 } 246 | | Pc -> { num_in = 0; num_out = 1 } 247 | | MSize -> { num_in = 0; num_out = 1 } 248 | | Gas -> { num_in = 0; num_out = 1 } 249 | | JumpDest -> { num_in = 0; num_out = 0 } 250 | | Push _ -> { num_in = 0; num_out = 1 } 251 | (* Duplication operations *) 252 | | Dup n -> { num_in = n; num_out = n + 1 } 253 | (* Exchange operations *) 254 | | Swap n -> { num_in = n + 1; num_out = n + 1 } 255 | (* Log operations *) 256 | | Log n -> { num_in = n + 2; num_out = 0 } 257 | (* System operations *) 258 | | Create -> { num_in = 3; num_out = 1 } 259 | | Call -> { num_in = 7; num_out = 1 } 260 | | CallCode -> { num_in = 7; num_out = 1 } 261 | | Return -> { num_in = 2; num_out = 0 } 262 | | DelegateCall -> { num_in = 6; num_out = 0 } 263 | | Suicide -> { num_in = 1; num_out = 0 } 264 | ;; 265 | 266 | let num_in_args (x : instruction) = 267 | (sig_of_inst x).num_in 268 | ;; 269 | 270 | let num_out_args (x : instruction) = 271 | (sig_of_inst x).num_out 272 | ;; 273 | 274 | (* Length of an instruction: Varies only for PUSH *) 275 | 276 | let length_of_inst i = 277 | Z.(match i with 278 | Push bs -> 1 + (of_int (List.length bs)) 279 | | _ -> 1) 280 | ;; 281 | 282 | type program = instruction list;; 283 | 284 | let rec program_length (p : program) = 285 | Z.(match p with 286 | [] -> 0 287 | | inst :: rst -> 288 | (length_of_inst inst) + (program_length rst)) 289 | ;; 290 | 291 | (* @meta[measure : index_into_program] 292 | let measure_index_into_program (i, p : int * _) = i 293 | @end 294 | *) 295 | 296 | let rec index_into_program (i, p : word * program) = 297 | Z.(match p with 298 | [] -> Stop 299 | | inst :: rst -> 300 | if i <= 0 then inst else 301 | index_into_program (i - (length_of_inst inst), rst)) 302 | ;; 303 | 304 | (* Convert an instruction to a byte encoding *) 305 | 306 | let bytes_of_inst x = 307 | Z.(match x with 308 | (* Stop and arithmetic *) 309 | | Stop -> [0x00] 310 | | Add -> [0x01] 311 | | Mul -> [0x02] 312 | | Sub -> [0x03] 313 | | Div -> [0x04] 314 | | SDiv -> [0x05] 315 | | Mod -> [0x06] 316 | | SMod -> [0x07] 317 | | AddMod -> [0x08] 318 | | MulMod -> [0x09] 319 | | Exp -> [0x0a] 320 | | SignExtend -> [0x0b] 321 | (* Comparison and bitwise logical operations *) 322 | | Lt -> [0x10] 323 | | Gt -> [0x11] 324 | | Slt -> [0x12] 325 | | Sgt -> [0x13] 326 | | Eq -> [0x14] 327 | | IsZero -> [0x15] 328 | | BitAnd -> [0x16] 329 | | BitOr -> [0x17] 330 | | BitXor -> [0x18] 331 | | BitNot -> [0x19] 332 | | Byte -> [0x1a] 333 | (* SHA3 *) 334 | | SHA3 -> [0x20] 335 | (* Environment *) 336 | | Address -> [0x30] 337 | | Balance -> [0x31] 338 | | Origin -> [0x32] 339 | | Caller -> [0x33] 340 | | CallValue -> [0x34] 341 | | CallDataLoad -> [0x35] 342 | | CallDataSize -> [0x36] 343 | | CallDataCopy -> [0x37] 344 | | CodeSize -> [0x38] 345 | | CodeCopy -> [0x39] 346 | | GasPrice -> [0x3a] 347 | | ExtCodeSize -> [0x3b] 348 | | ExtCodeCopy -> [0x3c] 349 | (* Block information *) 350 | | BlockHash -> [0x40] 351 | | CoinBase -> [0x41] 352 | | TimeStamp -> [0x42] 353 | | Number -> [0x43] 354 | | Difficulty -> [0x44] 355 | | GasLimit -> [0x45] 356 | (* Stack, memory, storage and flow operations *) 357 | | Pop -> [0x50] 358 | | MLoad -> [0x51] 359 | | MStore -> [0x52] 360 | | MStore8 -> [0x53] 361 | | SLoad -> [0x54] 362 | | SStore -> [0x55] 363 | | Jump -> [0x56] 364 | | JumpI -> [0x57] 365 | | Pc -> [0x58] 366 | | MSize -> [0x59] 367 | | Gas -> [0x5a] 368 | | JumpDest -> [0x5b] 369 | | Push bs -> (0x5f + (of_int (List.length bs))) :: bs 370 | (* Duplication operations *) 371 | | Dup n -> [0x7f + (of_int n)] 372 | (* Exchange operations *) 373 | | Swap n -> [0x8f + (of_int n)] 374 | (* Log operations *) 375 | | Log n -> [0xa0 + (of_int n)] 376 | (* System operations *) 377 | | Create -> [0xf0] 378 | | Call -> [0xf1] 379 | | CallCode -> [0xf2] 380 | | Return -> [0xf3] 381 | | DelegateCall -> [0xf4] 382 | | Suicide -> [0xff]) 383 | ;; 384 | 385 | (* Some non-logical utilities *) 386 | 387 | :shadow off 388 | 389 | let rec list_program' (p, n : program * int) = 390 | match p with 391 | [] -> () 392 | | i :: is -> 393 | Printf.printf "%d. %s\n" n (string_of_instruction i); 394 | list_program' (is, n + (Z.to_int (length_of_inst i))) 395 | ;; 396 | 397 | let list_program (p) = list_program' (p, 0) 398 | ;; 399 | 400 | :shadow on 401 | 402 | -------------------------------------------------------------------------------- /EVM/README: -------------------------------------------------------------------------------- 1 | ===================================================================== 2 | A formal model of the Ethereum Virtual Machine in ImandraML 3 | (c)Copyright Aesthetic Integration, Ltd., 2016 4 | All rights reserved. 5 | 6 | Released under Apache 2.0 license as described in the file LICENSE. 7 | ===================================================================== 8 | 9 | To get started, 10 | 11 | (1) Login to Imandra Contracts and bring up an Imandra interactive session: 12 | 13 | $ imandra 14 | .__ /\ .__ .___ 15 | _____ |__| / / |__| _____ _____ ____ __| _/___________ 16 | \__ \ | | / / | |/ \__ \ / \ / __ |\_ __ \__ \ 17 | / __ \| | / / | | Y Y \/ __ \| | \/ /_/ | | | \// __ \_ 18 | (____ /__| / / |__|__|_| (____ /___| /\____ | |__| (____ / 19 | \/ \/ \/ \/ \/ \/ \/ 20 | ---------------------------------------------------------------------------- 21 | Imandra Commander 0.8a88 - (c)Copyright Aesthetic Integration Ltd, 2014-16 22 | ---------------------------------------------------------------------------- 23 | 24 | (2) Run the command ":load Ethereum.ml" 25 | 26 | # :load Ethereum.ml 27 | 28 | (3) The system will then process the Imandra EVM model, and should end with a message 29 | similar to the following: 30 | 31 | . 32 | . 33 | . 34 | val exec_Difficulty : state -> state = 35 | val exec_Suicide : state -> state = 36 | val exec_Log : state * int -> state = 37 | val exec_ExtCodeSize : state -> state = 38 | val exec_CallDataCopy : state -> state = 39 | val exec_CodeCopy : state -> state = 40 | val exec_ExtCodeCopy : state -> state = 41 | val exec_Create : state -> state = 42 | val exec_Call : state -> state = 43 | val exec_CallCode : state -> state = 44 | val exec_DelegateCall : state -> state = 45 | - Finished loading $imandra/contracts/EVM/Semantics.ml. 46 | ---------------------------------------------------------------------------- 47 | val next_inst : state -> instruction = 48 | val do_inst : state * instruction -> state = 49 | val step : state -> state = 50 | val run : state * int -> state = 51 | - Defining custom measure function (measure_run)...Success 52 | Function run staged to depth 10000. 53 | - Finished loading $imandra/contracts/EVM/Ethereum.ml. 54 | ---------------------------------------------------------------------------- 55 | # 56 | 57 | 58 | (4) Interactively create EVM machine states poised with the bytecode you wish 59 | to analyse. For example: 60 | 61 | # let c1 = 62 | Z.([ Push [0]; 63 | CallDataLoad; 64 | SLoad; 65 | IsZero; 66 | Push [9]; 67 | JumpI; 68 | Stop; 69 | JumpDest; 70 | Push [32]; 71 | CallDataLoad; 72 | Push [0]; 73 | CallDataLoad; 74 | SStore ]);; 75 | 76 | # let s1 = init_state Z.([], 77 | [], 78 | c1, 79 | 100, 80 | mk_basic_msg ({ fun_selector = None; 81 | call_args = [54; 2020202020] }), 82 | empty_ext);; 83 | 84 | 85 | (5) Use Imandra to analyse the bytecode with respect to the EVM semantics. 86 | For example, to perform a `principal region decomposition' on s1 with 87 | respect to arbitrary symbolic storage values and 15 clock cycles: 88 | 89 | 90 | # let run_15_sym_storage x = run({s1 with storage = x}, 15);; 91 | 92 | # :decompose run_15_sym_storage 93 | 94 | 95 | (6) Finally, you can use Imandra interactively to step through possible 96 | symbolic executions, and to investigate and prove theorems about EVM bytecode: 97 | 98 | 99 | # theorem c1_correct_1 (x, k, v, v_new : storage * _ * _ * _) = 100 | Z.(valid_word k && valid_word v_new && 101 | get_storage(k,x) = v && v <> 0) 102 | ==> 103 | let init_state = { s1 with storage = x; 104 | msg = { s1.msg with 105 | msg_data = { fun_selector = None; 106 | call_args = [k; v_new] }}} in 107 | get_storage(k, (run (init_state, 15)).storage) = v;; 108 | 109 | 110 | ===== 111 | 112 | Learn more at the Imandra Developers Hub: http://docs.imandra.ai/ 113 | 114 | 115 | -------------------------------------------------------------------------------- /EVM/Semantics.ml: -------------------------------------------------------------------------------- 1 | (* A formal model of the Ethereum Virtual Machine in ImandraML *) 2 | (* (c)Copyright Aesthetic Integration, Ltd., 2016 *) 3 | (* All rights reserved. *) 4 | (* *) 5 | (* Released under Apache 2.0 license as described in the file LICENSE. *) 6 | (* *) 7 | (* Contributors: *) 8 | (* Grant Olney Passmore (grant@aestheticintegration.com) *) 9 | (* *) 10 | 11 | (* Executable operational semantics for the EVM ISA *) 12 | 13 | let exec_Stop (s) = 14 | peaceful_exit (s, Stop_instruction, []) 15 | ;; 16 | 17 | let exec_Push (s, bytes) = 18 | { s with 19 | stack = (word_of_bytes (List.rev bytes)) :: s.stack; 20 | pc = Z.(s.pc + (of_int (List.length bytes)) + 1) } 21 | ;; 22 | 23 | let exec_CallDataLoad (s) = 24 | let loc = List.hd s.stack in 25 | let data = word_of_call_data (s.msg.msg_data, loc) in 26 | { s with 27 | stack = data :: (List.tl s.stack); 28 | pc = Z.(s.pc + 1) } 29 | ;; 30 | 31 | let exec_CallDataSize (s) = 32 | let size = size_of_call_data s.msg.msg_data in 33 | { s with 34 | stack = size :: s.stack; 35 | pc = Z.(s.pc + 1) } 36 | ;; 37 | 38 | let exec_CodeSize (s) = 39 | let size = Z.of_int (List.length s.program) in 40 | { s with 41 | stack = size :: s.stack; 42 | pc = Z.(s.pc + 1) } 43 | ;; 44 | 45 | let exec_SLoad (s) = 46 | let loc = List.hd s.stack in 47 | let v = get_storage (loc, s.storage) in 48 | { s with 49 | stack = v :: (List.tl s.stack); 50 | pc = Z.(s.pc + 1) } 51 | ;; 52 | 53 | let exec_SStore (s) = 54 | let loc = List.hd s.stack in 55 | let v = List.hd (List.tl s.stack) in 56 | { s with 57 | stack = List.tl (List.tl s.stack); 58 | storage = set_storage(loc, v, s.storage); 59 | pc = Z.(s.pc + 1) } 60 | ;; 61 | 62 | let exec_BitAnd (s) = 63 | let v1 = List.hd s.stack in 64 | let v2 = List.hd (List.tl s.stack) in 65 | let new_v = Z.(logand v1 v2) in 66 | { s with 67 | stack = new_v :: (List.tl (List.tl s.stack)); 68 | pc = Z.(s.pc + 1) } 69 | ;; 70 | 71 | let exec_BitNot (s) = 72 | let v = List.hd s.stack in 73 | let new_v = u256(Z.lognot v) in 74 | { s with 75 | stack = new_v :: (List.tl s.stack); 76 | pc = Z.(s.pc + 1) } 77 | ;; 78 | 79 | let exec_BitOr (s) = 80 | let v1 = List.hd s.stack in 81 | let v2 = List.hd (List.tl s.stack) in 82 | let new_v = fix_word(Z.logor v1 v2) in 83 | { s with 84 | stack = new_v :: (List.tl (List.tl s.stack)); 85 | pc = Z.(s.pc + 1) } 86 | ;; 87 | 88 | let exec_BitXor (s) = 89 | let v1 = List.hd s.stack in 90 | let v2 = List.hd (List.tl s.stack) in 91 | let new_v = fix_word(Z.logxor v1 v2) in 92 | { s with 93 | stack = new_v :: (List.tl (List.tl s.stack)); 94 | pc = Z.(s.pc + 1) } 95 | ;; 96 | 97 | (* Control flow *) 98 | 99 | let exec_JumpI (s) = 100 | let new_pc = List.hd s.stack in 101 | let test = List.hd (List.tl s.stack) in 102 | if test <> Z.(0) then 103 | { s with stack = List.tl (List.tl s.stack); 104 | pc = new_pc } 105 | else 106 | { s with stack = List.tl (List.tl s.stack); 107 | pc = Z.(s.pc + 1) } 108 | ;; 109 | 110 | let exec_Jump (s) = 111 | let a1 = List.hd s.stack in 112 | { s with stack = List.tl s.stack; 113 | pc = a1 } 114 | ;; 115 | 116 | let exec_JumpDest (s) = 117 | { s with pc = Z.(s.pc + 1) } 118 | ;; 119 | 120 | (* Arithmetic *) 121 | 122 | let exec_Add (s) = 123 | let x1 = List.hd s.stack in 124 | let x2 = List.hd (List.tl s.stack) in 125 | let v = fix_word Z.(x1 + x2) in 126 | let st = List.tl (List.tl s.stack) in 127 | { s with stack = v :: st; 128 | pc = Z.(s.pc + 1) } 129 | ;; 130 | 131 | let exec_Sub (s) = 132 | let x1 = List.hd s.stack in 133 | let x2 = List.hd (List.tl s.stack) in 134 | let v = fix_word Z.(x1 - x2) in 135 | let st = List.tl (List.tl s.stack) in 136 | { s with stack = v :: st; 137 | pc = Z.(s.pc + 1) } 138 | ;; 139 | 140 | let exec_Mul (s) = 141 | let x1 = List.hd s.stack in 142 | let x2 = List.hd (List.tl s.stack) in 143 | let v = fix_word Z.(x1 * x2) in 144 | let st = List.tl (List.tl s.stack) in 145 | { s with stack = v :: st; 146 | pc = Z.(s.pc + 1) } 147 | ;; 148 | 149 | let exec_Div (s) = 150 | let x1 = List.hd s.stack in 151 | let x2 = List.hd (List.tl s.stack) in 152 | let v = if x2 = Z.(0) then Z.(0) else 153 | fix_word Z.(x1 / x2) in 154 | let st = List.tl (List.tl s.stack) in 155 | { s with stack = v :: st; 156 | pc = Z.(s.pc + 1) } 157 | ;; 158 | 159 | let exec_SDiv (s) = 160 | let x1 = List.hd s.stack in 161 | let x2 = List.hd (List.tl s.stack) in 162 | let v = 163 | let open Z in 164 | if x2 = zero then zero else 165 | if x2 = minus_one && x1 = neg pow_2_255 166 | then pow_2_255 else 167 | let q = (x1 / x2) in 168 | let sgn = if q < zero then minus_one else 169 | if q = zero then zero else 170 | one 171 | in 172 | sgn * fix_word(x1 / x2) 173 | in 174 | let st = List.tl (List.tl s.stack) in 175 | { s with stack = v :: st; 176 | pc = Z.(s.pc + 1) } 177 | ;; 178 | 179 | let exec_Mod (s) = 180 | let x1 = List.hd s.stack in 181 | let x2 = List.hd (List.tl s.stack) in 182 | let v = 183 | let open Z in 184 | if x2 = zero then zero else 185 | fix_word (x1 mod x2) in 186 | let st = List.tl (List.tl s.stack) in 187 | { s with stack = v :: st; 188 | pc = Z.(s.pc + 1) } 189 | ;; 190 | 191 | let exec_SMod (s) = 192 | let x1 = List.hd s.stack in 193 | let x2 = List.hd (List.tl s.stack) in 194 | let v = 195 | let open Z in 196 | if x1 < zero then neg(abs(x1) mod abs(x2)) 197 | else (abs(x1) mod abs(x2)) in 198 | let v = fix_word v in 199 | let st = List.tl (List.tl s.stack) in 200 | { s with stack = v :: st; 201 | pc = Z.(s.pc + 1) } 202 | ;; 203 | 204 | let exec_AddMod (s) = 205 | let x1 = List.hd s.stack in 206 | let x2 = List.hd (List.tl s.stack) in 207 | let x3 = List.hd (List.tl (List.tl s.stack)) in 208 | let v = Z.(fix_word ((x1 + x2) mod x3)) in 209 | let st = List.tl (List.tl (List.tl s.stack)) in 210 | { s with stack = v :: st; 211 | pc = Z.(s.pc + 1) } 212 | ;; 213 | 214 | let exec_MulMod (s) = 215 | let x1 = List.hd s.stack in 216 | let x2 = List.hd (List.tl s.stack) in 217 | let x3 = List.hd (List.tl (List.tl s.stack)) in 218 | let v = Z.(fix_word ((x1 * x2) mod x3)) in 219 | let st = List.tl (List.tl (List.tl s.stack)) in 220 | { s with stack = v :: st; 221 | pc = Z.(s.pc + 1) } 222 | ;; 223 | 224 | let exec_Exp (s) = 225 | let x1 = List.hd s.stack in 226 | let x2 = List.hd (List.tl s.stack) in 227 | let v = Z.(fix_word (pow x1 (to_int x2))) in 228 | let st = List.tl (List.tl s.stack) in 229 | { s with stack = v :: st; 230 | pc = Z.(s.pc + 1) } 231 | ;; 232 | 233 | (* Comparison operations *) 234 | 235 | let exec_Lt (s) = 236 | let x1 = List.hd s.stack in 237 | let x2 = List.hd (List.tl s.stack) in 238 | let v = Z.(if x1 < x2 then 1 else 0) in 239 | let st = List.tl (List.tl s.stack) in 240 | { s with stack = v :: st; 241 | pc = Z.(s.pc + 1) } 242 | ;; 243 | 244 | let exec_Gt (s) = 245 | let x1 = List.hd s.stack in 246 | let x2 = List.hd (List.tl s.stack) in 247 | let v = Z.(if x1 > x2 then 1 else 0) in 248 | let st = List.tl (List.tl s.stack) in 249 | { s with stack = v :: st; 250 | pc = Z.(s.pc + 1) } 251 | ;; 252 | 253 | let exec_Slt (s) = 254 | let x1 = List.hd s.stack in 255 | let x2 = List.hd (List.tl s.stack) in 256 | let v = Z.(if x1 < x2 then 1 else 0) in 257 | let st = List.tl (List.tl s.stack) in 258 | { s with stack = v :: st; 259 | pc = Z.(s.pc + 1) } 260 | ;; 261 | 262 | let exec_Sgt (s) = 263 | let x1 = List.hd s.stack in 264 | let x2 = List.hd (List.tl s.stack) in 265 | let v = Z.(if x1 > x2 then 1 else 0) in 266 | let st = List.tl (List.tl s.stack) in 267 | { s with stack = v :: st; 268 | pc = Z.(s.pc + 1) } 269 | ;; 270 | 271 | let exec_SignExtend (s) = 272 | let byte_num = List.hd s.stack in 273 | let sign_bit_index = Z.(byte_num * 8) in 274 | let word = List.hd (List.tl s.stack) in 275 | let v = sign_extend_from_bit(word, sign_bit_index) in 276 | let st = List.tl (List.tl s.stack) in 277 | { s with stack = v :: st; 278 | pc = Z.(s.pc + 1) } 279 | ;; 280 | 281 | let exec_Byte (s) = 282 | let byte_num = List.hd s.stack in 283 | let word = List.hd (List.tl s.stack) in 284 | let v = get_byte(word, 32 - Z.(to_int byte_num)) in 285 | let st = List.tl (List.tl s.stack) in 286 | { s with stack = v :: st; 287 | pc = Z.(s.pc + 1) } 288 | ;; 289 | 290 | let exec_Eq (s) = 291 | let x1 = List.hd s.stack in 292 | let x2 = List.hd (List.tl s.stack) in 293 | let v = Z.(if x1 = x2 then 1 else 0) in 294 | let st = List.tl (List.tl s.stack) in 295 | { s with stack = v :: st; 296 | pc = Z.(s.pc + 1) } 297 | ;; 298 | 299 | let exec_IsZero (s) = 300 | let x1 = List.hd s.stack in 301 | let v = Z.(if x1 = zero then 1 else 0) in 302 | let st = List.tl s.stack in 303 | { s with stack = v :: st; 304 | pc = Z.(s.pc + 1) } 305 | ;; 306 | 307 | let exec_Pop (s) = 308 | { s with stack = List.tl s.stack; 309 | pc = Z.(s.pc + 1) } 310 | ;; 311 | 312 | let exec_Pc (s) = 313 | let pc = s.pc in 314 | { s with stack = pc :: s.stack; 315 | pc = Z.(s.pc + 1) } 316 | ;; 317 | 318 | let exec_Gas (s) = 319 | let g = s.gas in 320 | { s with stack = g :: s.stack; 321 | pc = Z.(s.pc + 1) } 322 | ;; 323 | 324 | let exec_Dup (s, k) = 325 | let i = List.nth s.stack k in 326 | { s with stack = i :: s.stack; 327 | pc = Z.(s.pc + 1) } 328 | ;; 329 | 330 | let swap_k (stack, k : word list * int) = 331 | if k = 1 then 332 | match stack with 333 | x0 :: x1 :: rst -> 334 | x1 :: x0 :: rst 335 | | _ -> stack 336 | else if k = 2 then 337 | match stack with 338 | x0 :: x1 :: x2 :: rst -> 339 | x2 :: x1 :: x0 :: rst 340 | | _ -> stack 341 | else if k = 3 then 342 | match stack with 343 | x0 :: x1 :: x2 :: x3 :: rst -> 344 | x3 :: x1 :: x2 :: x0 :: rst 345 | | _ -> stack 346 | else if k = 4 then 347 | match stack with 348 | x0 :: x1 :: x2 :: x3 :: x4 :: rst -> 349 | x4 :: x1 :: x2 :: x3 :: x0 :: rst 350 | | _ -> stack 351 | else if k = 5 then 352 | match stack with 353 | x0 :: x1 :: x2 :: x3 :: x4 :: x5 :: rst -> 354 | x5 :: x1 :: x2 :: x3 :: x4 :: x0 :: rst 355 | | _ -> stack 356 | else if k = 6 then 357 | match stack with 358 | x0 :: x1 :: x2 :: x3 :: x4 :: x5 :: x6 :: rst -> 359 | x6 :: x1 :: x2 :: x3 :: x4 :: x5 :: x0 :: rst 360 | | _ -> stack 361 | else if k = 7 then 362 | match stack with 363 | x0 :: x1 :: x2 :: x3 :: x4 :: x5 :: x6 :: x7 :: rst -> 364 | x7 :: x1 :: x2 :: x3 :: x4 :: x5 :: x6 :: x0 :: rst 365 | | _ -> stack 366 | else if k = 8 then 367 | match stack with 368 | x0 :: x1 :: x2 :: x3 :: x4 :: x5 :: x6 :: x7 :: x8 :: rst -> 369 | x8 :: x1 :: x2 :: x3 :: x4 :: x5 :: x6 :: x7 :: x0 :: rst 370 | | _ -> stack 371 | else if k = 9 then 372 | match stack with 373 | x0 :: x1 :: x2 :: x3 :: x4 :: x5 :: x6 :: x7 :: x8 :: x9 :: rst -> 374 | x9 :: x1 :: x2 :: x3 :: x4 :: x5 :: x6 :: x7 :: x8 :: x0 :: rst 375 | | _ -> stack 376 | else if k = 10 then 377 | match stack with 378 | x0 :: x1 :: x2 :: x3 :: x4 :: x5 :: x6 :: x7 :: x8 :: x9 :: x10 :: rst -> 379 | x10 :: x1 :: x2 :: x3 :: x4 :: x5 :: x6 :: x7 :: x8 :: x9 :: x0 :: rst 380 | | _ -> stack 381 | else if k = 11 then 382 | match stack with 383 | x0 :: x1 :: x2 :: x3 :: x4 :: x5 :: x6 :: x7 :: x8 :: x9 :: x10 :: x11 :: rst -> 384 | x11 :: x1 :: x2 :: x3 :: x4 :: x5 :: x6 :: x7 :: x8 :: x9 :: x10 :: x0 :: rst 385 | | _ -> stack 386 | else if k = 12 then 387 | match stack with 388 | x0 :: x1 :: x2 :: x3 :: x4 :: x5 :: x6 :: x7 :: x8 :: x9 :: x10 :: x11 :: x12 :: rst -> 389 | x12 :: x1 :: x2 :: x3 :: x4 :: x5 :: x6 :: x7 :: x8 :: x9 :: x10 :: x11 :: x0 :: rst 390 | | _ -> stack 391 | else if k = 13 then 392 | match stack with 393 | x0 :: x1 :: x2 :: x3 :: x4 :: x5 :: x6 :: x7 :: x8 :: x9 :: x10 :: x11 :: x12 :: x13 :: rst -> 394 | x13 :: x1 :: x2 :: x3 :: x4 :: x5 :: x6 :: x7 :: x8 :: x9 :: x10 :: x11 :: x12 :: x0 :: rst 395 | | _ -> stack 396 | else if k = 14 then 397 | match stack with 398 | x0 :: x1 :: x2 :: x3 :: x4 :: x5 :: x6 :: x7 :: x8 :: x9 :: x10 :: x11 :: x12 :: x13 :: x14 :: rst -> 399 | x14 :: x1 :: x2 :: x3 :: x4 :: x5 :: x6 :: x7 :: x8 :: x9 :: x10 :: x11 :: x12 :: x13 :: x0 :: rst 400 | | _ -> stack 401 | else if k = 15 then 402 | match stack with 403 | x0 :: x1 :: x2 :: x3 :: x4 :: x5 :: x6 :: x7 :: x8 :: x9 :: x10 :: x11 :: x12 :: x13 :: x14 :: x15 :: rst -> 404 | x15 :: x1 :: x2 :: x3 :: x4 :: x5 :: x6 :: x7 :: x8 :: x9 :: x10 :: x11 :: x12 :: x13 :: x14 :: x0 :: rst 405 | | _ -> stack 406 | else if k = 16 then 407 | match stack with 408 | x0 :: x1 :: x2 :: x3 :: x4 :: x5 :: x6 :: x7 :: x8 :: x9 :: x10 :: x11 :: x12 :: x13 :: x14 :: x15 :: x16 :: rst -> 409 | x16 :: x1 :: x2 :: x3 :: x4 :: x5 :: x6 :: x7 :: x8 :: x9 :: x10 :: x11 :: x12 :: x13 :: x14 :: x15 :: x0 :: rst 410 | | _ -> stack 411 | else stack 412 | ;; 413 | 414 | let exec_Swap (s, k) = 415 | let new_stack = swap_k (s.stack, k) in 416 | { s with stack = new_stack; 417 | pc = Z.(s.pc + 1) } 418 | ;; 419 | 420 | let exec_Balance (s) = 421 | let address = List.hd s.stack in 422 | let v = get_balance(address, s.balance) in 423 | let st = List.tl s.stack in 424 | { s with stack = v :: st; 425 | pc = Z.(s.pc + 1) } 426 | ;; 427 | 428 | (* Byte-addressable, reads and writes on word boundaries (i mod 32 = 0) *) 429 | 430 | let exec_MLoad (s) = 431 | let i = List.hd s.stack in 432 | let m = s.memory in 433 | let ok = mem_extend_ok(s.gas, m.cur_size, i, Z.(32)) in 434 | match ok with 435 | Some e -> 436 | let mem = get_mem(i, s.memory) in 437 | let st = List.tl s.stack in 438 | { s with stack = mem.peek :: st; 439 | memory = mem; 440 | gas = e.new_gas; 441 | pc = Z.(s.pc + 1) } 442 | | None -> raise_exception(s, Oog_extending_memory) 443 | ;; 444 | 445 | let exec_MStore (s) = 446 | let i = List.hd s.stack in 447 | let v = List.hd (List.tl s.stack) in 448 | let mem = set_mem(i, v, s.memory) in 449 | let st = List.tl (List.tl s.stack) in 450 | { s with stack = st; 451 | memory = mem; 452 | pc = Z.(s.pc + 1) } 453 | ;; 454 | 455 | let exec_MStore8 (s : state) = 456 | let i = List.hd s.stack in 457 | let v = List.hd (List.tl s.stack) in 458 | let mem = set_byte(i, Z.(v mod 256), s.memory) in 459 | let st = List.tl (List.tl s.stack) in 460 | { s with stack = st; 461 | memory = mem; 462 | pc = Z.(s.pc + 1) } 463 | ;; 464 | 465 | let exec_MSize (s) = 466 | let num_bytes = Z.(s.memory.cur_size * 32) in 467 | { s with stack = num_bytes :: s.stack; 468 | pc = Z.(s.pc + 1) } 469 | ;; 470 | 471 | let exec_Origin (s) = 472 | { s with stack = s.ext.tx_origin :: s.stack; 473 | pc = Z.(s.pc + 1) } 474 | ;; 475 | 476 | let exec_Caller (s) = 477 | { s with stack = s.msg.sender :: s.stack; 478 | pc = Z.(s.pc + 1) } 479 | ;; 480 | 481 | let exec_CallValue (s) = 482 | { s with stack = s.msg.value :: s.stack; 483 | pc = Z.(s.pc + 1) } 484 | ;; 485 | 486 | let exec_GasPrice (s) = 487 | { s with stack = s.ext.tx_gas_price :: s.stack; 488 | pc = Z.(s.pc + 1) } 489 | ;; 490 | 491 | let exec_TimeStamp (s) = 492 | { s with stack = s.ext.block_timestamp :: s.stack; 493 | pc = Z.(s.pc + 1) } 494 | ;; 495 | 496 | let exec_Address (s) = 497 | { s with stack = s.msg.recipient :: s.stack; 498 | pc = Z.(s.pc + 1) } 499 | ;; 500 | 501 | val sha3 : word list -> word;; 502 | 503 | (* Note: As far as I can tell, the yellow paper doesn't specify if exec_SHA3 504 | should update the memory.cur_size in the manner that, e.g., MLOAD does. As 505 | there is no mention of it, we assume the answer is no. But, we should check 506 | this with Vitalik et al and in all major EVMs. *) 507 | 508 | let exec_SHA3 (s) = 509 | let base = List.hd s.stack in 510 | let len = List.hd (List.tl s.stack) in 511 | let seq = mem_range (s.memory, base, len) in 512 | let w = sha3 (seq) in 513 | let st = List.tl (List.tl s.stack) in 514 | { s with stack = w :: st; 515 | pc = Z.(s.pc + 1) } 516 | ;; 517 | 518 | let exec_Return (s : state) = 519 | Z.(let s0 = List.hd s.stack in 520 | let s1 = List.hd (List.tl s.stack) in 521 | let ok = mem_extend_ok (s.gas, s.memory.cur_size, s0, s1) in 522 | match ok with 523 | Some e -> 524 | peaceful_exit({s with gas = e.new_gas}, 525 | Return_instruction, 526 | mem_range(s.memory, s0, s1)) 527 | | None -> 528 | let s' = {s with gas = 0} in 529 | raise_exception(s', Oog_extending_memory)) 530 | ;; 531 | 532 | let exec_GasLimit (s : state) = 533 | { s with 534 | stack = s.ext.block_difficulty :: s.stack; 535 | pc = Z.(s.pc + 1) } 536 | ;; 537 | 538 | let exec_BlockHash (s : state) = 539 | let loc = List.hd s.stack in 540 | let h = get_word_map(s.ext.block_hashes, loc) in 541 | { s with 542 | stack = h :: (List.tl s.stack); 543 | pc = Z.(s.pc + 1) } 544 | ;; 545 | 546 | let exec_CoinBase (s : state) = 547 | { s with 548 | stack = s.ext.block_coinbase :: s.stack; 549 | pc = Z.(s.pc + 1) } 550 | ;; 551 | 552 | let exec_Number (s : state) = 553 | { s with 554 | stack = s.ext.block_number :: s.stack; 555 | pc = Z.(s.pc + 1) } 556 | ;; 557 | 558 | let exec_Difficulty (s : state) = 559 | { s with 560 | stack = s.ext.block_difficulty :: s.stack; 561 | pc = Z.(s.pc + 1) } 562 | ;; 563 | 564 | let exec_Suicide (s : state) = 565 | Z.(let to_ = List.hd s.stack in 566 | let to_b = get_balance(to_, s.balance) in 567 | let xfer = get_balance(s.msg.recipient, s.balance) in 568 | let b = set_balance(to_, to_b + xfer, s.balance) in 569 | let b = set_balance(s.msg.recipient, 0, b) in 570 | let sub = add_suicide(s.substate, s.msg.recipient) in 571 | let s = { s with 572 | stack = List.tl s.stack; 573 | balance = b; 574 | substate = sub; 575 | pc = s.pc + 1 } 576 | in 577 | peaceful_exit (s, Intentional_suicide, [])) 578 | ;; 579 | 580 | let exec_Log (s, k : state * int) = 581 | let mem_start = List.hd s.stack in 582 | let mem_size = List.hd (List.tl s.stack) in 583 | let data = mem_range(s.memory, mem_start, mem_size) in 584 | let topic_stk = List.tl (List.tl s.stack) in 585 | let topics = 586 | if (k = 0) then 587 | [] 588 | else if (k = 1) then 589 | [List.hd topic_stk] 590 | else if (k = 2) then 591 | [List.hd topic_stk; 592 | List.hd (List.tl topic_stk)] 593 | else if (k = 3) then 594 | [List.hd topic_stk; 595 | List.hd (List.tl topic_stk); 596 | List.hd (List.tl (List.tl topic_stk))] 597 | else 598 | [List.hd topic_stk; 599 | List.hd (List.tl topic_stk); 600 | List.hd (List.tl (List.tl topic_stk)); 601 | List.hd (List.tl (List.tl (List.tl topic_stk)))] 602 | in 603 | let stack = drop_fst(topic_stk, Z.of_int k) in 604 | let substate = add_log(s.substate, topics, data) in 605 | { s with stack = stack; 606 | substate = substate; 607 | pc = Z.(s.pc + 1) } 608 | ;; 609 | 610 | let exec_ExtCodeSize (s : state) = 611 | let addr = List.hd s.stack in 612 | let code = get_code_map (s.ext.code_repository, addr) in 613 | let len = Z.of_int (List.length code) in 614 | { s with stack = len :: (List.tl s.stack); 615 | pc = Z.(s.pc + 1) } 616 | ;; 617 | 618 | let exec_CallDataCopy (s : state) = 619 | let mstart = List.hd s.stack in 620 | let dstart = List.hd (List.tl s.stack) in 621 | let size = List.hd (List.tl (List.tl s.stack)) in 622 | let stk = List.tl (List.tl (List.tl s.stack)) in 623 | let ok = mem_extend_ok (s.gas, s.memory.cur_size, mstart, size) in 624 | match ok with 625 | Some e -> 626 | let ok = data_copy_ok (e.new_gas, size) in 627 | (match ok with 628 | Some g -> 629 | { s with 630 | stack = stk; 631 | gas = g; 632 | memory = copy_call_data_to_mem (s.memory, s.msg.msg_data, mstart, dstart, size); 633 | pc = Z.(s.pc + 1) } 634 | | None -> 635 | raise_exception (s, Oog_copy_data)) 636 | | None -> 637 | raise_exception (s, Oog_extending_memory) 638 | ;; 639 | 640 | let exec_CodeCopy (s : state) = 641 | let start = List.hd s.stack in 642 | let s1 = List.hd (List.tl s.stack) in 643 | let size = List.hd (List.tl (List.tl s.stack)) in 644 | let stk = List.tl (List.tl (List.tl s.stack)) in 645 | let ok = mem_extend_ok (s.gas, s.memory.cur_size, start, size) in 646 | match ok with 647 | Some e -> 648 | let ok = data_copy_ok (e.new_gas, size) in 649 | (match ok with 650 | Some g -> 651 | { s with stack = stk; 652 | gas = g; 653 | memory = copy_code_to_mem (s.memory, s1, s.program, start, size); 654 | pc = Z.(s.pc + 1) } 655 | | None -> 656 | raise_exception (s, Oog_copy_data)) 657 | | None -> 658 | raise_exception (s, Oog_extending_memory) 659 | ;; 660 | 661 | let exec_ExtCodeCopy (s : state) = 662 | let addr = List.hd s.stack in 663 | let start = List.hd (List.tl s.stack) in 664 | let s1 = List.hd (List.tl (List.tl s.stack)) in 665 | let size = List.hd (List.tl (List.tl (List.tl s.stack))) in 666 | let stk = List.tl (List.tl (List.tl (List.tl s.stack))) in 667 | let ok = mem_extend_ok (s.gas, s.memory.cur_size, start, size) in 668 | let code = get_ext_code (addr, s.ext) in 669 | match ok with 670 | Some e -> 671 | let ok = data_copy_ok (e.new_gas, size) in 672 | (match ok with 673 | Some g -> 674 | { s with stack = stk; 675 | gas = g; 676 | memory = copy_code_to_mem (s.memory, s1, code, start, size); 677 | pc = Z.(s.pc + 1) } 678 | | None -> 679 | raise_exception (s, Oog_copy_data)) 680 | | None -> 681 | raise_exception (s, Oog_extending_memory) 682 | ;; 683 | 684 | let exec_Create (s : state) = 685 | let open List in 686 | Z.(let value = hd s.stack in 687 | let mem_start = hd (tl s.stack) in 688 | let mem_size = hd (tl (tl s.stack)) in 689 | let new_stack = tl (tl (tl s.stack)) in 690 | let ok = mem_extend_ok (s.gas, s.memory.cur_size, mem_start, mem_size) in 691 | match ok with 692 | Some e -> 693 | if get_balance(s.msg.recipient, s.balance) >= value && s.msg.depth < 1024 694 | then 695 | begin 696 | let cd = mk_call_data (s.memory, mem_start, mem_size) in 697 | let cm = { sender = s.msg.recipient; 698 | recipient = 0; 699 | value = value; 700 | msg_gas = e.new_gas; 701 | msg_data = cd; 702 | depth = s.msg.depth + 1; 703 | code_address = 0; 704 | is_create = true; 705 | transfers_value = value > 0; 706 | msg_logs = [] } in 707 | { s with 708 | pending_call = Some cm; 709 | gas = e.new_gas; 710 | pc = s.pc + 1; 711 | stack = new_stack } 712 | end 713 | else 714 | { s with 715 | stack = 0 :: new_stack; 716 | pc = s.pc + 1; 717 | gas = e.new_gas } 718 | | None -> raise_exception(s, Out_of_gas) 719 | ) 720 | ;; 721 | 722 | let exec_Call (s : state) = 723 | let open List in 724 | Z.(let gas = hd s.stack in 725 | let target = hd (tl s.stack) in 726 | let value = hd (tl (tl s.stack)) in 727 | let mem_in_start = hd (tl (tl (tl s.stack))) in 728 | let mem_in_size = hd (tl (tl (tl (tl s.stack)))) in 729 | let mem_out_start = hd (tl (tl (tl (tl (tl s.stack))))) in 730 | let mem_out_size = hd (tl (tl (tl (tl (tl (tl s.stack)))))) in 731 | let new_stack = tl (tl (tl (tl (tl (tl (tl s.stack)))))) in 732 | let ok_1 = mem_extend_ok (s.gas, s.memory.cur_size, mem_in_start, mem_in_size) in 733 | let ok_2 = mem_extend_ok (s.gas, s.memory.cur_size, mem_out_start, mem_out_size) in 734 | let is_create = account_exists (target, s.ext) in 735 | match ok_1, ok_2 with 736 | Some e1, Some e2 -> 737 | let extra_gas = 738 | match is_create, (value > 0) with 739 | true, true -> gas_CALLVALUETRANSFER 740 | | true, false -> 0 741 | | false, true -> gas_CALLNEWACCOUNT + gas_CALLVALUETRANSFER 742 | | false, false -> gas_CALLNEWACCOUNT 743 | in 744 | let submsg_gas = 745 | if value > 0 then gas + gas_STIPEND else gas in 746 | if (s.gas < gas + extra_gas) then 747 | raise_exception (s, Out_of_gas) 748 | else 749 | if get_balance (s.msg.recipient, s.balance) >= value && s.msg.depth < 1024 then 750 | begin 751 | 752 | (* Now we can actually setup the call! *) 753 | let new_gas = s.gas - (gas + extra_gas) in 754 | let cd = mk_call_data (s.memory, mem_in_start, mem_in_size) in 755 | let cm = { sender = s.msg.recipient; 756 | recipient = target; 757 | value = value; 758 | msg_gas = submsg_gas; 759 | msg_data = cd; 760 | depth = s.msg.depth + 1; 761 | code_address = target; 762 | is_create = is_create; 763 | transfers_value = value > 0; 764 | msg_logs = [] } in 765 | { s with 766 | pending_call = Some cm; 767 | gas = new_gas; 768 | pc = s.pc + 1; 769 | stack = new_stack } 770 | end 771 | else 772 | let new_gas = s.gas - (gas + extra_gas - submsg_gas) in 773 | { s with 774 | gas = new_gas; 775 | pc = s.pc + 1; 776 | stack = 0 :: new_stack } 777 | | _ -> 778 | raise_exception (s, Oog_extending_memory)) 779 | ;; 780 | 781 | let exec_CallCode (s : state) = 782 | let open List in 783 | Z.(let gas = hd s.stack in 784 | let target = hd (tl s.stack) in 785 | let value = hd (tl (tl s.stack)) in 786 | let mem_in_start = hd (tl (tl (tl s.stack))) in 787 | let mem_in_size = hd (tl (tl (tl (tl s.stack)))) in 788 | let mem_out_start = hd (tl (tl (tl (tl (tl s.stack))))) in 789 | let mem_out_size = hd (tl (tl (tl (tl (tl (tl s.stack)))))) in 790 | let new_stack = tl (tl (tl (tl (tl (tl (tl s.stack)))))) in 791 | let ok_1 = mem_extend_ok (s.gas, s.memory.cur_size, mem_in_start, mem_in_size) in 792 | let ok_2 = mem_extend_ok (s.gas, s.memory.cur_size, mem_out_start, mem_out_size) in 793 | match ok_1, ok_2 with 794 | Some e1, Some e2 -> 795 | let extra_gas = 796 | if value > 0 then 797 | gas_CALLVALUETRANSFER 798 | else 0 799 | in 800 | let submsg_gas = 801 | if value > 0 then gas + gas_STIPEND else gas in 802 | if (s.gas < gas + extra_gas) then 803 | raise_exception (s, Out_of_gas) 804 | else 805 | if get_balance (s.msg.recipient, s.balance) >= value && s.msg.depth < 1024 then 806 | begin 807 | (* Now we can actually setup the call(code)! *) 808 | let new_gas = s.gas - (gas + extra_gas) in 809 | let cd = mk_call_data (s.memory, mem_in_start, mem_in_size) in 810 | let cm = { sender = s.msg.sender; 811 | recipient = target; 812 | value = value; 813 | msg_gas = submsg_gas; 814 | msg_data = cd; 815 | depth = s.msg.depth + 1; 816 | code_address = target; 817 | is_create = false; 818 | transfers_value = false; 819 | msg_logs = [] } in 820 | { s with 821 | pending_call = Some cm; 822 | gas = new_gas; 823 | pc = s.pc + 1; 824 | stack = new_stack } 825 | end 826 | else 827 | let new_gas = s.gas - (gas + extra_gas - submsg_gas) in 828 | { s with 829 | gas = new_gas; 830 | pc = s.pc + 1; 831 | stack = 0 :: new_stack } 832 | | _ -> 833 | raise_exception (s, Oog_extending_memory)) 834 | ;; 835 | 836 | let exec_DelegateCall (s : state) = 837 | let open List in 838 | Z.(let gas = hd s.stack in 839 | let target = hd (tl s.stack) in 840 | let mem_in_start = hd (tl (tl s.stack)) in 841 | let mem_in_size = hd (tl (tl (tl s.stack))) in 842 | let mem_out_start = hd (tl (tl (tl (tl s.stack)))) in 843 | let mem_out_size = hd (tl (tl (tl (tl (tl s.stack))))) in 844 | let new_stack = tl (tl (tl (tl (tl (tl s.stack))))) in 845 | let value = 0 in 846 | let ok_1 = mem_extend_ok (s.gas, s.memory.cur_size, mem_in_start, mem_in_size) in 847 | let ok_2 = mem_extend_ok (s.gas, s.memory.cur_size, mem_out_start, mem_out_size) in 848 | match ok_1, ok_2 with 849 | Some e1, Some e2 -> 850 | let extra_gas = 851 | if value > 0 then 852 | gas_CALLVALUETRANSFER 853 | else 0 854 | in 855 | let submsg_gas = 856 | if value > 0 then gas + gas_STIPEND else gas in 857 | if (s.gas < gas + extra_gas) then 858 | raise_exception (s, Out_of_gas) 859 | else 860 | if get_balance (s.msg.recipient, s.balance) >= value && s.msg.depth < 1024 then 861 | begin 862 | (* Now we can actually setup the (delegate)call! *) 863 | let new_gas = s.gas - (gas + extra_gas) in 864 | let cd = mk_call_data (s.memory, mem_in_start, mem_in_size) in 865 | let cm = { sender = s.msg.sender; 866 | recipient = s.msg.recipient; 867 | value = value; 868 | msg_gas = submsg_gas; 869 | msg_data = cd; 870 | depth = s.msg.depth + 1; 871 | code_address = target; 872 | is_create = false; 873 | transfers_value = false; 874 | msg_logs = [] } in 875 | { s with 876 | pending_call = Some cm; 877 | gas = new_gas; 878 | pc = s.pc + 1; 879 | stack = new_stack } 880 | end 881 | else 882 | let new_gas = s.gas - (gas + extra_gas - submsg_gas) in 883 | { s with 884 | gas = new_gas; 885 | pc = s.pc + 1; 886 | stack = 0 :: new_stack } 887 | | _ -> 888 | raise_exception (s, Oog_extending_memory)) 889 | ;; 890 | 891 | -------------------------------------------------------------------------------- /EVM/State.ml: -------------------------------------------------------------------------------- 1 | (* A formal model of the Ethereum Virtual Machine in ImandraML *) 2 | (* (c)Copyright Aesthetic Integration, Ltd., 2016 *) 3 | (* All rights reserved. *) 4 | (* *) 5 | (* Released under Apache 2.0 license as described in the file LICENSE. *) 6 | (* *) 7 | (* Contributors: *) 8 | (* Grant Olney Passmore (grant@aestheticintegration.com) *) 9 | (* *) 10 | 11 | (* EVM machine state *) 12 | 13 | type state = 14 | { stack : word list; 15 | memory : memory; 16 | program : program; 17 | pc : word; 18 | storage : storage; 19 | balance : balance; 20 | ext : ext; 21 | msg : msg; 22 | gas : word; 23 | substate : substate; 24 | halted : halt_status; 25 | pending_call : call_status; 26 | } 27 | ;; 28 | 29 | (* Initialise EVM machine state with a program *) 30 | 31 | let init_state (storage, balance, program, gas, msg, ext) = 32 | Z.({ stack = []; 33 | memory = empty_mem; 34 | program = program; 35 | pc = 0; 36 | storage = storage; 37 | balance = balance; 38 | ext = ext; 39 | msg = msg; 40 | gas = gas; 41 | substate = empty_substate; 42 | halted = None; 43 | pending_call = None; 44 | }) 45 | ;; 46 | 47 | let stack_top s = 48 | match s.stack with 49 | [] -> None 50 | | x :: _ -> Some x 51 | ;; 52 | 53 | let stack_size s = 54 | Z.of_int (List.length s.stack) 55 | ;; 56 | 57 | (* A simple example initial state *) 58 | 59 | let example_init_state = 60 | init_state Z.([], 61 | [], 62 | [Push [10]; Push [20]; Add], 63 | 100, 64 | empty_msg, 65 | empty_ext) 66 | ;; 67 | 68 | (* Initialise a call state *) 69 | 70 | let init_call_state (s, m) = 71 | let code_loc = m.code_address in 72 | let program = get_code_map (s.ext.code_repository, code_loc) in 73 | { s with 74 | pc = Z.(0); 75 | stack = []; 76 | msg = m; 77 | gas = m.msg_gas; 78 | program = program; 79 | memory = empty_mem; 80 | pending_call = None } 81 | ;; 82 | 83 | (* Merge final state of call with parent state *) 84 | 85 | let recover_state_from_call (s, s') = 86 | match s'.halted with 87 | Some (Exception _) -> 88 | { s with 89 | stack = Z.(0) :: s.stack } 90 | | Some (Exit e) -> 91 | (* TODO: Copy proper data subsequence here *) 92 | { s with 93 | stack = Z.(1) :: s.stack; 94 | memory = { s.memory with data = e.e_data} } 95 | | None -> s' 96 | ;; 97 | 98 | (* Make call_data from memory *) 99 | 100 | let mk_call_data (mem, mem_start, mem_size) = 101 | (* We're currently ignoring the fun_selector *) 102 | let d = mem_range (mem, mem_start, mem_size) in 103 | { fun_selector = None; 104 | call_args = d } 105 | ;; 106 | 107 | let rec set_mem_range (mstart, data, mem) = 108 | Z.(match data with 109 | [] -> mem 110 | | d :: ds -> 111 | let new_mem = set_mem (mstart, d, mem) in 112 | set_mem_range (mstart + 1, ds, new_mem)) 113 | ;; 114 | 115 | let copy_call_data_to_mem (mem, msg_data, mstart, dstart, size) = 116 | let d = subseq (msg_data.call_args, dstart, size) in 117 | set_mem_range (mstart, d, mem) 118 | ;; 119 | 120 | let rec program_to_word_list (p : program) : word list = 121 | match p with 122 | [] -> [] 123 | | i :: is -> 124 | (bytes_of_inst i) @ (program_to_word_list is) 125 | ;; 126 | 127 | let copy_code_to_mem (mem, code_start, program, mstart, size) = 128 | let prg_data = program_to_word_list program in 129 | let d = subseq (prg_data, code_start, size) in 130 | set_mem_range (mstart, d, mem) 131 | ;; 132 | -------------------------------------------------------------------------------- /EVM/TODO.org: -------------------------------------------------------------------------------- 1 | * TODO: 2 | ** TODO Extend memory model for reads/writes not at word boundaries (a mod 32 <> 0) 3 | ** TODO Proper gas calculations for CREATE instructions (nested mem_extend_ok's) 4 | ** TODO Update gas calculations for Oct/Nov, 2016 hard fork(s) 5 | ** TODO Proper behaviour (failure) when JUMP* destination invalid 6 | ** TODO Copy proper memory subsequences from *CALL* results 7 | ** TODO Check CodeSize (and ExtCodeSize) computation -- is it # of instructions? # of bytes? 8 | ** TODO Implement SHA3 in logic: currently it's an uninterpreted function 9 | ** TODO Implement SStore refund semantics 10 | ** TODO Overflow semantics for program counter increment (s.pc + 1 when s.pc = max_word)? 11 | Currently, we treat s.pc as arbitrary precision. 12 | This is a moot point in practice, but we should clarify w.r.t. official semantics. 13 | -------------------------------------------------------------------------------- /EVM/Tests.ml: -------------------------------------------------------------------------------- 1 | (* Some experiments with memory *) 2 | 3 | let test_1 () = 4 | Z.(let m = { data = [1;2]; cur_size = 2; peek = 0 } in 5 | set_mem(96, 100, m)) 6 | ;; 7 | 8 | test_1 ();; 9 | 10 | let test_2 () = 11 | Z.(let m = { data = [1;2;3;]; cur_size = 3; peek = 2 } in 12 | let m = set_mem(32, 100, m) in 13 | get_mem(1024,m)) 14 | ;; 15 | 16 | test_2 ();; 17 | 18 | (* incorrect *) 19 | set_mem <-- (128, 3, {data = []; cur_size = 0; peek = 0}) 20 | set_mem --> {data = [0; 0; 0; 0; 3]; cur_size = 5; peek = 0} 21 | set_mem <-- (160, 6, {data = [0; 0; 0; 0; 3]; cur_size = 5; peek = 3}) 22 | set_mem --> {data = [0; 0; 0; 0; 3]; cur_size = 6; peek = 3} 23 | 24 | 25 | let test_3 () = 26 | Z.(let m = { data = [0;0;0;0;3]; cur_size = 5; peek = 3 } in 27 | set_mem(160, 6, m)) 28 | ;; 29 | 30 | 31 | -------------------------------------------------------------------------------- /EVM/Word256.ml: -------------------------------------------------------------------------------- 1 | (* A formal model of the Ethereum Virtual Machine in ImandraML *) 2 | (* (c)Copyright Aesthetic Integration, Ltd., 2016 *) 3 | (* All rights reserved. *) 4 | (* *) 5 | (* Released under Apache 2.0 license as described in the file LICENSE. *) 6 | (* *) 7 | (* Contributors: *) 8 | (* Grant Olney Passmore (grant@aestheticintegration.com) *) 9 | (* *) 10 | 11 | (* 256-bit word arithmetic for Ethereum *) 12 | 13 | let fix_unsigned (x, bit_width) = 14 | Z.(x mod (pow 2 bit_width)) 15 | ;; 16 | 17 | let fix_signed (x, bit_width) = 18 | Z.(let tmp = x mod (pow 2 bit_width) in 19 | if tmp < pow 2 Int.(bit_width - 1) then 20 | tmp 21 | else (tmp - (pow 2 bit_width))) 22 | ;; 23 | 24 | type byte = Z.t;; 25 | 26 | let u8 (x : Z.t) : byte = 27 | fix_unsigned (x, 8) 28 | ;; 29 | 30 | let s8 (x : Z.t) : byte = 31 | fix_signed (x, 8) 32 | ;; 33 | 34 | type word = Z.t;; 35 | 36 | let u256 (x : Z.t) : word = 37 | fix_unsigned (x, 256) 38 | ;; 39 | 40 | let s256 (x : Z.t) : word = 41 | fix_signed (x, 256) 42 | ;; 43 | 44 | let fix_word (x : Z.t) : word = 45 | u256 x 46 | ;; 47 | 48 | let valid_word (x : Z.t) = 49 | u256 x = x 50 | ;; 51 | 52 | let max_u256 : word = 53 | Z.((pow 2 (to_int 256)) - 1) 54 | ;; 55 | 56 | let pow_to_256 = Z.(pow 2 (to_int 256)) 57 | ;; 58 | 59 | let pow_2_255 = Z.(pow 2 (to_int 255)) 60 | ;; 61 | 62 | let word_of_bool b = 63 | if b then Z.one else Z.zero 64 | ;; 65 | 66 | type fun_id = Z.t;; 67 | 68 | :reasoner bits 69 | 70 | lemma[rw] lognot_is_zero_elim (x) = 71 | Z.((lognot x = 0) = (x = -1)) 72 | ;; 73 | 74 | lemma[rw] lognot_is_minus_one_elim (x : Z.t) = 75 | Z.((lognot x = -1) = (x = 0)) 76 | ;; 77 | 78 | lemma[rw] u256_idempotent (x : Z.t) = 79 | u256 (u256 x) = u256 x 80 | ;; 81 | 82 | :disable u256 83 | 84 | lemma[rw] u256_lognot_zero_cases (x) = 85 | Z.(u256 x = x && 86 | u256(-x - 1) = (-x - 1) 87 | ==> 88 | (u256 (lognot x) = 0) 89 | = (x = -1)) 90 | ;; 91 | 92 | :disable u256_lognot_zero_cases 93 | 94 | type address = Z.t;; 95 | 96 | let rec word_of_bytes' (bytes, coeff, res) = 97 | match bytes with 98 | [] -> res 99 | | b :: bs -> 100 | Z.(let n = b * coeff + res in 101 | word_of_bytes' (bs, coeff * 256, n)) 102 | ;; 103 | 104 | let word_of_bytes (bytes) = 105 | Z.(word_of_bytes' (bytes, 1, 0)) 106 | ;; 107 | 108 | lemma[rw] word_of_bytes_single (bytes) = 109 | List.length bytes = 1 110 | ==> 111 | word_of_bytes bytes = List.hd bytes 112 | ;; 113 | 114 | let get_byte (word, i) = 115 | Z.(let n = shift_right word Int.(8 * i) in 116 | logand n 255) 117 | ;; 118 | 119 | lemma[rw] get_byte_grounded (word) = 120 | Z.(0 <= word && word <= 255 121 | ==> 122 | get_byte(word, to_int 0) = word) 123 | ;; 124 | 125 | (* @meta[measure : mk_32_bytes_aux] 126 | let measure_mk_32_bytes_aux (word, shift : _ * int) = 127 | 256 - shift 128 | @end 129 | *) 130 | 131 | let rec mk_32_bytes_aux (word, shift) = 132 | Z.(if Int.(shift >= 256) then [] 133 | else 134 | let byte = u8 (word asr shift) in 135 | byte :: mk_32_bytes_aux (word, Int.(shift + 8))) 136 | ;; 137 | 138 | let mk_32_bytes (word) = 139 | mk_32_bytes_aux (word, 0) 140 | ;; 141 | 142 | :disable word_of_bytes 143 | :disable mk_32_bytes 144 | 145 | (* @meta[measure : bits_of_word_aux] 146 | let measure_bits_of_word_aux (word, k : _ * int) = 147 | k + 1 148 | @end 149 | *) 150 | 151 | let rec bits_of_word_aux (word, k) = 152 | if k < 0 then [] 153 | else 154 | let b = Z.(if testbit word k then 1 else 0) in 155 | b :: (bits_of_word_aux (word, k-1)) 156 | ;; 157 | 158 | let bits_of_word (word) = 159 | let num_bits = Z.numbits word in 160 | bits_of_word_aux (word, num_bits - 1) 161 | ;; 162 | 163 | let rec word_of_bits_aux (bits, coeff) = 164 | Z.(match bits with 165 | [] -> 0 166 | | b :: bs -> 167 | let k = if b = 1 then coeff else 0 in 168 | k + word_of_bits_aux(bs, 2 * coeff)) 169 | ;; 170 | 171 | let word_of_bits (bits) = 172 | word_of_bits_aux (List.rev bits, Z.(1)) 173 | ;; 174 | 175 | let sign_extend (sint, size) = 176 | fix_signed (sint, size) 177 | ;; 178 | 179 | let sign_extend_from_bit (word, sign_bit) = 180 | let i = Z.(signed_extract word (to_int 0) (to_int sign_bit)) in 181 | sign_extend (i, 256) 182 | ;; 183 | -------------------------------------------------------------------------------- /EVM/examples/basics.ml: -------------------------------------------------------------------------------- 1 | (* A formal model of the Ethereum Virtual Machine in ImandraML *) 2 | (* (c)Copyright Aesthetic Integration, Ltd., 2016 *) 3 | (* All rights reserved. *) 4 | (* *) 5 | (* Released under Apache 2.0 license as described in the file LICENSE. *) 6 | (* *) 7 | (* Contributors: *) 8 | (* Grant Passmore (grant@aestheticintegration.com) *) 9 | (* *) 10 | 11 | (* Let's verify some basic facts about the EVM *) 12 | 13 | lemma _ (s,w) = 14 | Z.(s.pc < program_length s.program 15 | && s.gas > 3 16 | && stack_size s < 1024 17 | ==> 18 | stack_top ((do_inst (s, Push [w]))) = Some w) 19 | ;; 20 | 21 | lemma _ (s,w) = 22 | Z.(s.pc + 2 < program_length s.program 23 | && s.gas > 6 24 | && stack_size s < 1024 25 | ==> 26 | let s1 = do_inst (s, Push [w]) in 27 | let s2 = do_inst (s1, Pop) in 28 | s2.stack = s.stack) 29 | ;; 30 | 31 | (* Let's introduce a predicate for being non-exceptionally poised to 32 | execute a given instruction. *) 33 | 34 | let well_poised_inst (s, inst) = 35 | s.pc < program_length(s.program) 36 | && Z.(base_cost_of_inst(inst) <= s.gas) 37 | && num_in_args(inst) <= List.length s.stack 38 | && List.length s.stack - num_in_args(inst) + num_out_args(inst) <= 1024 39 | ;; 40 | 41 | (* Now, let's prove functional correctness of our instruction set. *) 42 | 43 | lemma[rw] inst_correct_Add (s, inst) = 44 | Z.(well_poised_inst(s, inst) 45 | && inst = Add 46 | ==> 47 | let x = List.hd s.stack in 48 | let y = List.hd (List.tl s.stack) in 49 | let s1 = do_inst (s, inst) in 50 | List.hd s1.stack = u256 (x + y)) 51 | ;; 52 | 53 | lemma[rw] inst_correct_Sub (s, inst) = 54 | Z.(well_poised_inst(s, inst) 55 | && inst = Sub 56 | ==> 57 | let x = List.hd s.stack in 58 | let y = List.hd (List.tl s.stack) in 59 | let s1 = do_inst (s, inst) in 60 | List.hd s1.stack = u256 (x - y)) 61 | ;; 62 | 63 | (* etc.! *) 64 | -------------------------------------------------------------------------------- /EVM/examples/registry.ml: -------------------------------------------------------------------------------- 1 | (* A formal model of the Ethereum Virtual Machine in ImandraML *) 2 | (* (c)Copyright Aesthetic Integration, Ltd., 2016 *) 3 | (* All rights reserved. *) 4 | (* *) 5 | (* Released under Apache 2.0 license as described in the file LICENSE. *) 6 | (* *) 7 | (* Contributors: *) 8 | (* Grant Passmore (grant@aestheticintegration.com) *) 9 | (* *) 10 | 11 | (* Example: Analysing a simple registry smart contract *) 12 | 13 | :indent on 14 | :adts on 15 | 16 | (* Example contract 17 | from 18 | https://ethereum.gitbooks.io/frontier-guide/content/opcodes,_costs,_and_gas.html 19 | 20 | Note: Ethereum documentation uses NOT (i.e., BitNot) for the next 21 | instruction, but that's wrong! We need to use IsZero here. Why? 22 | Observe that BitNot(x) = 0 iff x = -1 ... Not what we want! 23 | *) 24 | 25 | let c1 = 26 | Z.([ Push [0]; 27 | CallDataLoad; 28 | SLoad; 29 | IsZero; 30 | Push [9]; 31 | JumpI; 32 | Stop; 33 | JumpDest; 34 | Push [32]; 35 | CallDataLoad; 36 | Push [0]; 37 | CallDataLoad; 38 | SStore ]) 39 | ;; 40 | 41 | let s1 = init_state Z.([], 42 | [], 43 | c1, 44 | 100, 45 | mk_basic_msg ({ fun_selector = None; 46 | call_args = [54; 2020202020] }), 47 | empty_ext);; 48 | 49 | (* Let's run the machine for 15 steps with symbolic storage *) 50 | 51 | let run_15_sym (storage, ext) = run({s1 with storage = storage; 52 | ext = ext}, 53 | 15);; 54 | 55 | (* Now, what are its possible behaviours? 56 | We do a region decomposition to see. *) 57 | 58 | :decompose run_15_sym 59 | 60 | (* Let's make gas and storage symbolic *) 61 | 62 | let run_15_sym_gas (gas, storage) = run({s1 with gas = gas; 63 | storage = storage}, 64 | 15);; 65 | 66 | :decompose run_15_sym_gas 67 | 68 | (* Notice that now examines all the possible ways we can run out of gas! 69 | So, let's add an assumption that we have at least, e.g., 100 gas. *) 70 | 71 | let gas_lb (gas, storage : word * storage) = gas >= Z.(100);; 72 | 73 | :decompose run_15_sym_gas assuming gas_lb 74 | 75 | (* Let's prove some theorems. For fun, we'll use a version with only symbolic storage. *) 76 | 77 | let run_15_sym_storage (storage) = run({s1 with storage = storage;}, 15);; 78 | 79 | (* Next, let's verify the name registry bytecode w.r.t. its spec *) 80 | 81 | theorem c1_correct_1 (x, k, v, v_new : storage * _ * _ * _) = 82 | Z.(valid_word k && valid_word v_new && 83 | get_storage(k,x) = v && v <> 0) 84 | ==> 85 | let init_state = { s1 with storage = x; 86 | msg = { s1.msg with 87 | msg_data = { fun_selector = None; 88 | call_args = [k; v_new] } } } in 89 | get_storage(k, (run (init_state, 15)).storage) = v 90 | ;; 91 | 92 | theorem c1_correct_2 (x, k, v : storage * _ * _) = 93 | Z.(valid_word k && valid_word v && 94 | get_storage(k,x) = 0) 95 | ==> 96 | let init_state = { s1 with storage = x; 97 | msg = { s1.msg with 98 | msg_data = { fun_selector = None; 99 | call_args = [k; v] } } } 100 | in 101 | get_storage(k, (run(init_state, 15)).storage) = v 102 | ;; 103 | 104 | (* Both goals above are proved automatically. *) 105 | 106 | (* Now, some nice examples of a false goals *) 107 | 108 | theorem c1_bad_1 (x, k, v : storage * _ * _) = 109 | Z.(get_storage(k,x) = 0) 110 | ==> 111 | let init_state = {s1 with storage = x; 112 | msg = { s1.msg with 113 | msg_data = { fun_selector = None; 114 | call_args = [v; k] } } } in 115 | get_storage(k, (run(init_state, 15)).storage) = v 116 | ;; 117 | 118 | (* To see the subgoals left by the failed proof attempt, 119 | use ':s' -- 120 | 121 | # :s 122 | 2 subgoals: 123 | 124 | k : int 125 | v : int 126 | x : storage_entry list 127 | get_storage(k, x) = 0 128 | get_storage(v, x) = 0 129 | |-------------------------------------------------------------------------- 130 | get_storage(k, set_storage(v, k, x)) = v 131 | 132 | k : int 133 | v : int 134 | x : storage_entry list 135 | get_storage(k, x) = 0 136 | get_storage(v, x) <> 0 137 | |-------------------------------------------------------------------------- 138 | 0 = v 139 | 140 | *) 141 | 142 | (* And another false goal *) 143 | 144 | theorem c1_bad_2 (x, k, v : storage * _ * _) = 145 | Z.(get_storage(k,x) = 0) 146 | ==> 147 | let init_state = {s1 with storage = x; 148 | msg = { s1.msg with 149 | msg_data = { fun_selector = None; 150 | call_args = [k; v] } } } in 151 | get_storage(k, (run(init_state, 6)).storage) = v 152 | ;; 153 | 154 | (* Let's look at the remaining subgoal, which is obviously false!: 155 | 156 | # :s 157 | 1 subgoal: 158 | 159 | k : int 160 | v : int 161 | x : storage_entry list 162 | get_storage(k, x) = 0 163 | |-------------------------------------------------------------------------- 164 | 0 = v 165 | 166 | *) 167 | 168 | (* And another where gas is too low! *) 169 | 170 | theorem c1_bad_3 (x, k, v : storage * _ * _) = 171 | Z.(valid_word k && valid_word v && 172 | get_storage(k,x) = 0 && v > 0 173 | ==> 174 | let init_state = {s1 with storage = x; 175 | gas = 80; 176 | msg = { s1.msg with 177 | msg_data = { fun_selector = None; 178 | call_args = [k; v] } } } in 179 | get_storage(k, (run(init_state, to_int 15)).storage) = v) 180 | ;; 181 | 182 | (* Let's inspect the failure... 183 | Notice: Our subgoal tries to establish the hyp (v > 0) is always false! 184 | 185 | # :s 186 | 1 subgoal: 187 | 188 | k : int 189 | v : int 190 | x : storage_entry list 191 | get_storage(k, x) = 0 192 | u256(k) = k 193 | u256(v) = v 194 | |-------------------------------------------------------------------------- 195 | v <= 0 196 | 197 | *) 198 | 199 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "{}" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright {yyyy} {name of copyright owner} 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Imandra Contracts 2 | 3 | ![Imandra Contracts](media/ic_logo.png "Imandra Contracts") 4 | 5 | Imandra Contracts is a platform for analysing and reasoning about smart contracts, built on top of the Imandra formal verification system. 6 | 7 | ### Community Models 8 | This repository contains our *community models*. 9 | These models customise Imandra for reasoning about various classes of smart contracts. 10 | 11 | ### Ethereum 12 | 13 | Our first community model is an Imandra model of the Ethereum Virtual Machine (EVM). 14 | This model provides an *executable operational semantics* for the EVM, empowering Imandra to reason about Ethereum bytecode. 15 | 16 | ### Resources 17 | 18 | For a quick example, see EVM/README. For more, see [docs.imandra.ai](http://docs.imandra.ai "Imandra documentation"). 19 | 20 | ### Get Involved 21 | 22 | Have an idea to improve these models? Please join us! 23 | 24 | ### Contributors 25 | 26 | - Grant Passmore (grant@aestheticintegration.com) 27 | - Kostya Kanishev (kostya@aestheticintegration.com) 28 | 29 | 30 | License 31 | ---- 32 | 33 | Apache 2.0 34 | -------------------------------------------------------------------------------- /media/ic_logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/imandra-ai/contracts/7cd43c09f4555bf09564e21e1fef192bd2298662/media/ic_logo.png --------------------------------------------------------------------------------