Implement instructions for known-size bytes

See: #49

evm-instructions.ss

@@ -0,0 +1,157 @@
+(export #t)
+(import
+  :gerbil/gambit/bits :gerbil/gambit/bytes
+  :std/misc/number :std/sugar :std/misc/list :std/format
+  :clan/base :clan/number :std/srfi/1
+  :clan/poo/object (only-in :clan/poo/mop Type)
+  (only-in :std/srfi/141 floor/)
+  ./assembly ./ethereum ./evm-runtime)
+
+;; --------------------------------
+;; General purpose EVM instructions
+;; --------------------------------
+;; Extends instruction set.
+;; Examples include:
+;; - Storing bytes larger than EVM Word
+;; - Storing to memory with reference
+;; - Load from memory with reference
+;;
+;; NOTE: Regarding reference types:
+;; The start-offset and length are stored on the stack,
+;; and the contents are stored compactly in memory.
+;; The start-offset and length can then be used
+;; to access contents located in memory.
+;;
+;; -------------
+;; Byte encoding
+;; -------------
+;; Instructions encode bytes as big-endian, left-padding them.
+;;
+;; For example, given an array of two bytes: #u8(#x11 #xff).
+;;
+;; After &push/any-size:
+;; The topmost word on the EVM Stack will be:
+;; #x00000000000000000000000000000000000000000000000000000000000011ff
+;;
+;; After (&mstore/free/any-size 2):
+;; "0x11" will be located at mem[offset],
+;; "0xff" located at mem[offset+1].
+;;
+;; For larger bytes (larger than a EVM word),
+;; we partition them into smaller chunks,
+;; less than or equal to a EVM word.
+;; We use the notation: "part[n]", to denote the partition index.
+;; E.g. 65-bytes -> | 32-bytes | 32-bytes | 1-byte  |
+;;                  | part0    | part1    | part2 |
+(defrule (EVM-WORD-SIZE) 32)
+
+;; -----------------------
+;; Instruction definitions
+;; -----------------------
+
+;; For contracts, to store values in memory,
+;; we first have to marshal them to the stack.
+;; This instruction serves that purpose.
+;;
+;; This allows us to PUSH a non-empty sequence of bytes
+;; which are variably sized onto the stack.
+;; PUSH[1-32] instructions cannot handle more than 32 bytes,
+;; which this instruction supports,
+;; by chunking up larger byte sequences into 32 bytes or less.
+;;
+;; stack input: -
+;; stack output: part0 part1 ... partn
+;; (Thunk part0 part1 ... partn <-) <- Bytes
+(def (&push/any-size bytes)
+  (def total-bytes (u8vector-length bytes))
+  (assert-bytes-at-least! total-bytes 1)
+  (def start 0)
+  (&push-1/any-size bytes start total-bytes))
+
+(def (&push-1/any-size bytes start total-bytes)
+  (def end (min total-bytes (+ start (EVM-WORD-SIZE))))
+  (when (< start end)
+    (let ()
+      (def bytes<=evm-word-size (subu8vector bytes start end))
+      (&begin (&push-1/any-size bytes end total-bytes) [&push-bytes bytes<=evm-word-size]))))
+
+;; Helper function - Make list of word-sizes for byte partitions.
+;;
+;; E.g. If we have 65 bytes, we need to store these in 32, 32, 1 sized chunks,
+;; since EVM Word is 32 bytes.
+;; this function computes the list of chunk sizes:
+;; (sizes/word-size<-size 65 32) -> [32 32 1]
+;;
+;; (ListOf Size) <- Size WordSize
+(def (sizes/word-size<-size size (word-size (EVM-WORD-SIZE)))
+  (defvalues (n-words rem) (floor/ size word-size))
+  (def words (make-list n-words word-size))
+  (if (zero? rem) words [words ... rem]))
+
+;; NOTE: Uses brk@ for offset via &brk-cons, dependent on EVM memory layout.
+;; stack input:  part0 part1 ... partn
+;; stack output: -
+(def (&mstore/free/any-size size)
+  (assert-bytes-at-least! size 1)
+  (def sizes/base/evm-word-size (sizes/word-size<-size size))
+  (&begin (map &brk-cons sizes/base/evm-word-size) ...)
+  )
+
+;; Helper function - Make list of relative offsets and sizes for partitions.
+;; Used by `&mload/any-size` to obtain memory ranges for storing partitions.
+;; E.g. (offsets-and-sizes<-size 65) -> [[0 (EVM-WORD-SIZE)] [32 32] [64 1]]
+;; (ListOf (List RelativeOffset Size)) <- Nat
+(def (offsets-and-sizes<-size size)
+  (def sizes (sizes/word-size<-size size))
+  (def relative-offsets (iota (length sizes) 0 (EVM-WORD-SIZE)))
+  (zip relative-offsets sizes))
+
+;; Given relative-offset and size,
+;; generates EVM code to:
+;; - load specified bytes
+;; - maintain start-offset for loading next segment
+;;
+;; stack input: start-offset
+;; stack output: start-offset bytes[offset:end]
+;;   where offset = start-offset+relative-offset
+;;         end    = offset+size
+;; (Thunk start-offset bytes[offset:end] <- start-offset) <- (List RelativeOffset Size)
+(def &mload-1/any-size
+  (match <>
+    ([relative-offset size]
+     (&begin                                    ; start-offset
+      DUP1 #|start-offset|# relative-offset ADD ; offset       start-offset
+      (&mload size) SWAP1))))                   ; start-offset bytes[offset:end]
+
+;; stack input:  start-offset
+;; stack output: part0 part1 ... partn
+;; (Thunk part0 ... partn <- start-offset) <- Size
+(def (&mload/any-size size)
+  (assert-bytes-at-least! size 0)
+  (match (offsets-and-sizes<-size size)
+    ;; = 0 bytes
+    ([] (&begin POP)
+     )
+    ;; > 0 bytes
+    ([[_ start-size] . rest]
+     (&begin
+      (map &mload-1/any-size (reverse rest)) ...
+      (&mload start-size)))))
+
+;; stack in:  -
+;; mem in:    part0 part1 ... partn
+;; stack out: part0 part1 ... partn
+;; (Thunk part0 ... partn <-) <- Offset Size
+(def (&mloadat/any-size offset length-size)
+  (&begin offset (&mload/any-size length-size)))
+
+;; ----------------
+;; Shared Utilities
+;; ----------------
+
+;; FIXME: there should be some upper bound for the length of bytes,
+;; where it will be unfeasible due to stack/memory/gas constraints to push/store/load bytes.
+(def (assert-bytes-at-least! total-bytes lower-bound)
+  (assert!
+    (<= lower-bound total-bytes)
+    (format "total bytes: ~d should be more than ~d" total-bytes lower-bound)))

t/100-evm-instructions-integrationtest.ss

@@ -0,0 +1,149 @@
+(export #t)
+
+(import
+  :std/test :clan/number :clan/poo/object
+  ../types ../assembly ../evm-runtime
+  ../testing ../evm-instructions.ss
+  ./10-json-rpc-integrationtest)
+
+;; Initializes free memory pointer
+(def &init-brk
+  (&begin #x20 (&mstoreat brk@ 32)))
+
+;; Stores free memory pointer at free memory location for returning
+(def &store-brk
+  (&begin (&mloadat brk@) DUP1 MSTORE))
+
+(def 100-evm-instructions-integrationtest
+  (test-suite "integration tests for evm instructions"
+    (test-case "EVM-type: &mstore/free/any-size, size = 1"
+      (evm-test [] (&begin
+                    &init-brk
+                    (&push/any-size #u8(1))
+                    (&mstore/free/any-size 1)
+                    &store-brk
+                    )
+                [[Bytes1 . #u8(1)]
+                 [UInt256 . 33]]
+                result-in-memory?: #t
+                result-start: #x20))
+
+    (test-case "EVM-type: &mstore/free/any-size, size = 1, left-padded for topmost word on EVM stack"
+      (evm-test [] (&begin
+                    &init-brk
+                    (&push/any-size #u8(1))
+                    (&mstore/free/any-size 32)
+                    &store-brk
+                    )
+                [[Bytes32 . #u8(0 0 0 0  0 0 0 0  0 0 0 0  0 0 0 0
+                                0 0 0 0  0 0 0 0  0 0 0 0  0 0 0 1
+                                )]
+                 [UInt256 . 64]]
+                result-in-memory?: #t
+                result-start: #x20))
+
+    (test-case "EVM-type: &mstore/free/any-size, size = 2"
+      (evm-test [] (&begin
+                    &init-brk
+                    (&push/any-size #u8(#x11 #xff))
+                    (&mstore/free/any-size 2)
+                    &store-brk
+                    )
+                [[Bytes2 . #u8(#x11 #xff)]
+                 [UInt256 . 34]]
+                result-in-memory?: #t
+                result-start: #x20))
+
+    (test-case "EVM-type: &mstore/free/any-size, size = 2, left-padded for topmost word on EVM stack"
+      (evm-test [] (&begin
+                    &init-brk
+                    (&push/any-size #u8(#x11 #xff))
+                    (&mstore/free/any-size 32)
+                    &store-brk
+                    )
+                [[Bytes32 . #u8(0 0 0 0  0 0 0 0  0 0 0 0  0 0 0 0
+                                0 0 0 0  0 0 0 0  0 0 0 0  0 0 #x11 #xff
+                                )]
+                 [UInt256 . 64]]
+                result-in-memory?: #t
+                result-start: #x20))
+
+    (test-case "EVM-type: &mstore/free/any-size, size = 65"
+      (def 65-bytes (list->u8vector (make-list 65 65)))
+      (u8vector-set! 65-bytes 0 66)
+      (u8vector-set! 65-bytes 32 67)
+      (u8vector-set! 65-bytes 64 68)
+
+      (def 65-bytes/0-32  (subu8vector 65-bytes 0  32))
+      (def 65-bytes/32-64 (subu8vector 65-bytes 32 64))
+      (def 65-bytes/64-65 (subu8vector 65-bytes 64 65))
+
+      (evm-test [] (&begin
+                    &init-brk
+                    (&push/any-size 65-bytes)
+                    (&mstore/free/any-size 65)
+                    &store-brk
+                    )
+                [[Bytes32 . 65-bytes/0-32]
+                 [Bytes32 . 65-bytes/32-64]
+                 [Bytes1  . 65-bytes/64-65]
+                 [UInt256 . 97] ; 32 (free mem ptr) + 65 (str65) = 97
+                 ]
+                result-in-memory?: #t
+                result-start: #x20))
+
+    (test-case "EVM-type &mload/free/any-size, size = 65"
+      (def 65-bytes (list->u8vector (make-list 65 65)))
+      (u8vector-set! 65-bytes 0 66)
+      (u8vector-set! 65-bytes 32 67)
+      (u8vector-set! 65-bytes 64 68)
+
+      (def 65-bytes/0-32  (subu8vector 65-bytes 0  32))
+      (def 65-bytes/32-64 (subu8vector 65-bytes 32 64))
+      (def 65-bytes/64-65 (subu8vector 65-bytes 64 65))
+
+      (evm-test [] (&begin
+                    &init-brk
+
+                    ;; Store str65 in mem
+                    (&push/any-size 65-bytes)    ; bytes[0-32] bytes[32-64] bytes[64-65]
+                    (&mstore/free/any-size 65)   ; -
+                    (&mloadat/any-size #x20 65)  ; bytes[0-32] bytes[32-64] bytes[64-65]
+                    (&mstore/free/any-size 65)   ; -
+
+                    &store-brk
+                    )
+
+                 ;; Original 65-bytes
+                [[Bytes32 . 65-bytes/0-32]
+                 [Bytes32 . 65-bytes/32-64]
+                 [Bytes1  . 65-bytes/64-65]
+
+                 ;; Duplicate 65-bytes
+                 [Bytes32 . 65-bytes/0-32]
+                 [Bytes32 . 65-bytes/32-64]
+                 [Bytes1  . 65-bytes/64-65]
+
+                 ;; freememptr: 32 + 65 + 65 = 162
+                 [UInt256 . 162        ]
+                 ]
+                result-in-memory?: #t
+                result-start: #x20)
+      )
+
+    ;; Dependent on network config initialized during integration tests
+    (test-case "&mload/any-size assembled, size = 65"
+      (def &load65/actual (assemble/bytes (&mload/any-size 65)))
+      (def &load65/expected
+           (assemble/bytes (&begin            ; -- offset
+                            ;; Load last string segment
+                            DUP1 64 ADD       ; -- offset+64   offset
+                            (&mload 1) SWAP1  ; -- offset      bytes[64-65]
+
+                            ;; Load second string segment
+                            DUP1 32 ADD       ; -- offset+32   offset       bytes[64-65]
+                            (&mload 32) SWAP1 ; -- offset      bytes[32-64] bytes[64-65]
+
+                            ;; Load first string segment
+                            (&mload 32))))    ; -- bytes[0-32] bytes[32-64] bytes[64-65]
+      (check-equal? &load65/actual &load65/expected))))

t/80-evm-eval-integrationtest.ss

@@ -263,4 +263,15 @@
 
     (test-case "&marshal UInt8"
       (evm-test [] (&begin brk DUP1 DUP1 (&marshal UInt16 7))
-                [[UInt16 . 2]]))))
+                [[UInt16 . 2]]))
+
+    (test-case "&mstore 1 byte"
+      (evm-test [] (&begin 42 0 (&mstore 1))
+                [[UInt8 . 42]]
+                result-in-memory?: #t))
+
+    (test-case "&mstore 32 bytes"
+      (def maxUInt256 (- (expt 2 256) 1))
+      (evm-test [] (&begin maxUInt256 0 (&mstore 32))
+                [[UInt256 . maxUInt256]]
+                result-in-memory?: #t))))

t/evm-instructions-test.ss

@@ -0,0 +1,37 @@
+(export #t)
+
+(import
+  :std/test :clan/poo/object
+  ../assembly ../evm-instructions ../types)
+
+;; Verify assembled bytecode of instruction(s)
+(def (check-inst? i/actual i/expected)
+  (check-equal? (assemble/bytes i/actual) (assemble/bytes i/expected)))
+
+;; NOTE: Boxed/Unboxed stack<-mem (load) methods are dependent
+;; on EVM network (eip145).
+;; Hence they are tested in integration tests.
+(def evm-instructions-test
+  (test-suite "test suite for evm-instructions"
+    (test-case "&push/any-size <= 32"
+      (def 1-byte #u8(1))
+      (check-inst? (&push/any-size 1-byte) [1-byte])
+
+      (def 5-bytes #u8(104 101 108 108 111))
+      (check-inst? (&push/any-size 5-bytes) [5-bytes])
+
+      (def 32-bytes (list->u8vector (make-list 32 65)))
+      (check-inst? (&push/any-size 32-bytes) [32-bytes])
+      )
+
+    (test-case "&push/any-size > 32"
+      (def 65-bytes (list->u8vector (make-list 65 65)))
+      (u8vector-set! 65-bytes 0 66)  ; bytes/0-32:  66 65 65 ... 65
+      (u8vector-set! 65-bytes 32 67) ; bytes/32-64: 67 65 65 ... 65
+      (u8vector-set! 65-bytes 64 68) ; bytes/64-65: 68
+
+      (check-inst? (&push/any-size 65-bytes)
+                   [(subu8vector 65-bytes 64 65) ; bytes/64-65: 68
+                    (subu8vector 65-bytes 32 64) ; bytes/32-64: 67 65 65 ... 65
+                    (subu8vector 65-bytes 0  32) ; bytes/0-32:  66 65 65 ... 65
+                    ]))))