Work with fare branch of gerbil, past v0.18.1

abi.ss

@@ -105,7 +105,7 @@
   (ethabi-encode-into types xs bytes prefix-length prefix-length get-tail set-tail!)
   bytes)
 
-;; : Void <- [Listof Type] [Listof Any] Bytes Nat Nat [-> Nat] [Nat -> Void]
+;; : Void <- [Listof Type] [Listof Any] Bytes UInt UInt [-> UInt] [UInt -> Void]
 ;; types and xs are lists of the same length,
 ;; each x corresponds to the type at the same index.
 ;; start is the location that addresses are relative to, at the beginning of the current fixed-size header section,
@@ -117,7 +117,7 @@
               (increment! head (.@ type .ethabi-head-length)))
             types xs))
 
-;; : [Listof Any] <- [Listof Type] Bytes Nat Nat
+;; : [Listof Any] <- [Listof Type] Bytes UInt UInt
 (def (ethabi-decode types bytes (start 0) (end (u8vector-length bytes)))
   (def head-end (+ start (ethabi-head-length types)))
   (def tail head-end)
@@ -128,7 +128,7 @@
   (begin0 (ethabi-decode-from types bytes start start get-tail set-tail!)
     (assert! (= tail end))))
 
-;; : [Listof Any] <- [Listof Type] Bytes Nat Nat [-> Nat] [Nat -> Void]
+;; : [Listof Any] <- [Listof Type] Bytes UInt UInt [-> UInt] [UInt -> Void]
 ;; start is the location that addresses are relative to, at the beginning of the current fixed-size header section,
 ;; head is the location within that header section at which the current/next entry will be stored.
 ;; get-tail and set-tail! are a getter/setter pair for where the next tail goes.

assembly.ss

@@ -3,7 +3,9 @@
 (import
   :gerbil/gambit
   :std/error :std/format
-  :std/misc/bytes :std/misc/hash :std/misc/number
+  :std/misc/bytes
+  :std/misc/hash
+  :std/misc/number
   :std/srfi/1 :std/stxutil
   :std/sugar
   :std/text/hex :std/values
@@ -145,7 +147,7 @@
           (else
             (cons name (loop (cdr data)))))))))
 
-;; push-code-amount : Byte -> (Maybe Nat)
+;; push-code-amount : Byte -> (Maybe UInt)
 ;;
 ;; Returns the length of the argument to the PUSH instruction with the provided
 ;; opcode.
@@ -159,16 +161,17 @@
   (segment-push-bytes! (Assembler-segment a) b))
 (def (&type a type x)
   (&bytes a ((.@ type .bytes<-) x)))
-(def (&uint a u (n-bytes (nat-length-in-u8 u)))
-  (check-argument (and (nat? u) (<= (integer-length u) 256)) "uint256" u)
-  (check-argument (<= (integer-length u) (* 8 n-bytes) 256) "valid length for u" [n-bytes u])
-  (segment-push-bytes! (Assembler-segment a) (nat->u8vector u n-bytes)))
-(def (&push a u (n-bytes (nat-length-in-u8 u)))
-  (check-argument (and (nat? n-bytes) (<= n-bytes 32)) "length of immediate data" n-bytes)
+(def (&uint a u (n-bytes (uint-length-in-u8 u)))
+  (check-argument-uint256 u)
+  (check-argument-datum-length n-bytes)
+  (check-argument (<= (integer-length u) (* 8 n-bytes)) "valid length for u" [n-bytes u])
+  (segment-push-bytes! (Assembler-segment a) (uint->u8vector u big n-bytes)))
+(def (&push a u (n-bytes (uint-length-in-u8 u)))
+  (check-argument-datum-length n-bytes)
   (&byte a (+ #x5F n-bytes)) ;; PUSH0
   (&uint a u n-bytes))
 (def (&push-bytes a bytes)
-  (&push a (u8vector->nat bytes)))
+  (&push a (u8vector->uint bytes)))
 
 (def (current-offset a)
   (Segment-fill-pointer (Assembler-segment a)))
@@ -244,9 +247,9 @@
   (#x18 XOR 3) ;; Bitwise XOR operation
   (#x19 NOT 3) ;; Bitwise NOT operation
   (#x1a BYTE 3) ;; Retrieve single byte from word
-  (#x1b SHL #t) ;; logical shift left (EIP-145)
-  (#x1c SHR #t) ;; logical shift right (EIP-145)
-  (#x1d SAR #t) ;; arithmetic shift right (EIP-145)
+  (#x1b SHL 3) ;; logical shift left (EIP-145)
+  (#x1c SHR 3) ;; logical shift right (EIP-145)
+  (#x1d SAR 3) ;; arithmetic shift right (EIP-145)
   ;; #x1e - #x1f  Unused
   (#x20 SHA3 30 #t) ;; Compute Keccak-256 hash. Cost: 30+6/word
   ;; #x21 - #x2f  Unused
@@ -400,20 +403,19 @@
 (def (&jumpi2 a l)
   (&push-label2 a l)
   (JUMPI a))
-(def (&z a z)
+(def (&z a z use-once?: (use-once? #f))
+  (set! z ((.@ UInt256 .normalize) z))
   (cond
-   ((and (> 0 z) (<= (integer-length z) 240))
+   ;; Only an optimization if the number is used once
+   ;; (actually, a number of times less than the number of bytes saved, or so)
+   ((and use-once? (= 65535 (extract-bit-field 16 240 z)))
     (&z a (bitwise-not z))
     (NOT a))
-   ((> 0 z)
-    (&z a ((.@ UInt256 .normalize) z)))
-   ((= 0 z)
-    (PUSH1 a) (&byte a 0))
    (else
-    (let ((n-bytes (nat-length-in-u8 z)))
-      (check-argument (<= 1 n-bytes 32) "length of immediate data" n-bytes)
+    (let ((n-bytes (uint-length-in-u8 z)))
+      (check-argument-datum-length n-bytes)
       (&byte a (+ #x5f n-bytes))
-      (&bytes a (nat->u8vector z n-bytes))))))
+      (&bytes a (uint->u8vector z big n-bytes))))))
 
 (def (&directive a directive)
   (cond

build.ss

@@ -6,7 +6,7 @@
 ;; Note that may you need to first:
 ;;   for i in github.com/fare/gerbil-utils github.com/fare/gerbil-crypto github.com/fare/gerbil-poo github.com/fare/gerbil-persist ; do gxpkg install $i ; done
 
-(import :clan/building)
+(import :clan/building :std/sugar)
 
 (def (files)
   [(all-gerbil-modules) ...

cli.ss

@@ -2,11 +2,14 @@
 
 (import
   :gerbil/expander
-  :std/format :std/getopt :std/iter
+  :std/cli/getopt
+  :std/cli/multicall
+  :std/cli/print-exit
+  :std/format :std/iter
   :std/misc/decimal :std/misc/hash :std/misc/list
   :std/sort :std/srfi/13 :std/sugar
-  :clan/cli :clan/exit :clan/hash :clan/list
-  :clan/multicall :clan/path-config :clan/string
+  :clan/cli :clan/hash :clan/list
+  :clan/path-config :clan/string
   :clan/poo/object :clan/poo/brace :clan/poo/cli :clan/poo/debug
   :clan/persist/db
   ./network-config ./types ./ethereum ./known-addresses ./json-rpc ./testing)

contract-config.ss

@@ -4,8 +4,7 @@
   (only-in :std/generic type-of)
   (only-in :std/error Error-message Error-irritants)
   (only-in :std/misc/repr repr)
-  (only-in :std/sugar try catch)
-  (only-in :clan/base ignore-errors)
+  (only-in :std/sugar try catch ignore-errors)
   (only-in :clan/json write-file-json read-file-json)
   (only-in :clan/path-config config-path)
   (only-in :clan/poo/object .@)

ethereum.ss

@@ -16,11 +16,11 @@
   (only-in ./types Maybe Record Bytes Bytes4 Bytes20 Bytes32 UInt32 UInt63 UInt256
            register-simple-eth-type ensure-zeroes)
   (only-in ./hex address-bytes<-0x bytes<-0x 0x<-address-bytes)
-  (only-in ./rlp rlpbytes<-rlp rlp<-nat))
+  (only-in ./rlp rlpbytes<-rlp rlp<-uint))
 
 ;; Types used by Ethereum APIs
 (define-type Quantity UInt256)
-(define-type UInt UInt256)
+(define-type UInt UInt256) ;; NB: fixed-length, unlike variable-length poo.UInt
 (define-type Digest Bytes32)
 (define-type Data Bytes)
 
@@ -29,33 +29,33 @@
 (define-type Block UInt63) ;; in practice, for the next century, will fit UInt32
 (define-type BufferSize UInt32) ;; in practice, for the next years, will fit UInt24
 
-;; : Nat
+;; : UInt
 (def one-ether-in-wei (expt 10 18)) ;; 1 ETH = 10^18 wei
 
-;; : Nat
+;; : UInt
 (def one-gwei-in-wei (expt 10 9)) ;; 1 gwei = 10^9 wei
 
-;; : Nat <- Real
+;; : UInt <- Real
 (def (wei<-ether ether-amount)
   (integer-part (* ether-amount one-ether-in-wei))) ;; allow floating point, round to integer
 
-;; : Decimal <- Nat
+;; : Decimal <- UInt
 (def (ether<-wei wei-amount)
   (/ wei-amount one-ether-in-wei))
 
-;; : Nat <- Real
+;; : UInt <- Real
 (def (wei<-gwei gwei-amount)
   (integer-part (* gwei-amount one-gwei-in-wei))) ;; allow floating point, round to integer
 
-;; : Decimal <- Nat
+;; : Decimal <- UInt
 (def (gwei<-wei wei-amount)
   (/ wei-amount one-gwei-in-wei))
 
-;; : String <- Nat
+;; : String <- UInt
 (def (decimal-string-ether<-wei wei-amount)
   (decimal->string (ether<-wei wei-amount)))
 
-;; : String <- Nat
+;; : String <- UInt
 (def (decimal-string-gwei<-wei wei-amount)
   (decimal->string (gwei<-wei wei-amount)))
 
@@ -138,7 +138,7 @@
 ;; Current contract address from transaction
 ;; : Address <- Address UInt256
 (def (address<-creator-nonce creator nonce)
-  (address<-data (rlpbytes<-rlp [(bytes<- Address creator) (rlp<-nat nonce)])))
+  (address<-data (rlpbytes<-rlp [(bytes<- Address creator) (rlp<-uint nonce)])))
 
 ;; Address from CREATE2 given creator and nonce
 ;; NB: when executing from a transaction, the creator is not the CALLER,

evm-instructions.ss

@@ -1,13 +1,14 @@
 (export #t)
 (import
   :gerbil/gambit
-  :std/assert :std/format
+  :std/assert
+  :std/format
   :std/misc/list :std/misc/number
   :std/srfi/1 (only-in :std/srfi/141 floor/)
   :std/sugar
   :clan/base
   :clan/poo/object (only-in :clan/poo/mop Type)
-  ./assembly ./ethereum ./evm-runtime)
+  ./assembly ./ethereum ./evm-runtime ./types)
 
 ;; --------------------------------
 ;; General purpose EVM instructions
@@ -124,7 +125,7 @@
 ;; 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
+;; (ListOf (List RelativeOffset Size)) <- UInt
 (def (offsets-and-sizes<-size size)
   (def sizes (sizes/word-size<-size size))
   (def relative-offsets (iota (length sizes) 0 (EVM-WORD-SIZE)))
@@ -293,3 +294,31 @@
   (assert!
     (<= lower-bound total-bytes)
     (format "total bytes: ~d should be more than ~d" total-bytes lower-bound)))
+
+
+
+;; load size bytes from pointer at calldataptr, increment calldataptr by size
+(def (&calldata-load-increment (size 32)) ;; calldataptr --> data calldataptr+32
+  (check-argument-datum-length size)
+  (cond
+   ((zero? size) (&begin 0)) ;; 1b 2g
+   ((= size 32) (&begin DUP1 32 ADD SWAP1 CALLDATALOAD)) ;; 6b 14g
+   (else (&begin DUP1 size ADD SWAP1 CALLDATALOAD (- 256 (* 8 size)) SHR)))) ;; 9b 19g
+
+(def (calldata-load-varint-increment) ;; 22b 49g
+  (&begin ; -- calldataptr
+   DUP1 CALLDATALOAD ;; -- len calldataptr ;; 2b 6g
+   SWAP1 1 ADD ;; calldataptr+1 len ;; 4b 9g
+   DUP2 DUP2 ADD ;; calldataptr+1 len ;; 3b 9g
+   SWAP1 MLOAD ;; datapad calldataptr+1+len len ;; 2b 6g
+   SWAP1 SWAP2 8 MUL 256 SUB SHR)) ;; data calldataptr+1+len ;; 9b 19g
+#|
+;; Do it with code vector? Nah, it adds up to 54 instead of 49... JUMP has too much overhead;
+;; unless it's used as a shared function, in which case it's still 54 but with more expensive rivals
+  (&begin 'ret ;; -- ret len calldataptr ;; 2b 2g ;; push the return address
+     DUP2 11 MUL 'base ADD JUMP ;; 9b 21g ;;
+     (&label 'base)
+     [repeat 32 times, with small optimization for n=0]
+     JUMPDEST SWAP1 DUP3 ADD SWAP2 CALLDATALOAD (- 256 (* 8 n)) SHR SWAP1 JUMP ;; 11b 32g
+     (&jumpdest 'ret)) ;; 1
+|#

evm-runtime.ss

@@ -381,7 +381,7 @@
 ;; <-- dst
 ;; TESTING STATUS: Wholly tested.
 (def (&memcpy/const-size/expr-src &addr n overwrite-after?: (overwrite-after? #f))
-  (if (nat? &addr) (&memcpy/const-size/const-src &addr n overwrite-after?: overwrite-after?)
+  (if (uint256? &addr) (&memcpy/const-size/const-src &addr n overwrite-after?: overwrite-after?)
       (&begin &addr (&memcpy/const-size n overwrite-after?: overwrite-after? dst-first?: #f))))
 
 ;; This *defines* [25B] a function with label 'unsafe-memcopy [(53*LEN+35)G]

hex.ss

@@ -67,8 +67,8 @@
   (string-append "0x" (unparser x)))
 
 ;; Decoding a "quantity"
-;; : Nat <- 0xQuantityString
-(def (nat<-0x hs)
+;; : UInt <- 0xQuantityString
+(def (uint<-0x hs)
   (validate-0x-prefix hs)
   (def len (string-length hs))
   (check-argument (> len 2) "at least one hexit for 0x quantity" hs) ;; 0 is "0x0"
@@ -79,9 +79,9 @@
     (bytevector->uint (hex-decode (remove-0x-from-string hs)) big)))
 
 ;; Encoding a "quantity"
-;; : 0xQuantityString <- Nat
-(def (0x<-nat nat)
-  (string-append "0x" (number->string nat 16)))
+;; : 0xQuantityString <- UInt
+(def (0x<-uint uint)
+  (string-append "0x" (number->string uint 16)))
 
 ;; Decoding "unformatted data"
 ;; : Bytes <- 0xDataString

known-addresses.ss

@@ -4,17 +4,17 @@
   (only-in :std/error check-argument)
   (only-in :std/format format)
   (only-in :std/iter for in-range in-naturals)
-  (only-in :std/misc/bytes u8vector->nat)
+  (only-in :std/misc/bytes u8vector->uint)
   (only-in :std/misc/list push!)
   (only-in :std/misc/number half)
   (only-in :std/sort sort)
   (only-in :std/srfi/13 string-ci= string-every)
-  (only-in :std/sugar while hash)
+  (only-in :std/sugar while hash ignore-errors)
   (only-in :std/text/hex unhex unhex*)
-  (only-in :clan/base ignore-errors nest)
+  (only-in :clan/base nest)
   (only-in :clan/json read-file-json write-json-ln)
   (only-in :std/misc/ports with-output)
-  (only-in :clan/random random-nat)
+  (only-in :clan/random random-uint)
   (only-in :clan/crypto/keccak keccak256<-bytes)
   (only-in :clan/poo/mop <-json json<- validate Type.)
   (only-in :clan/poo/type Map)
@@ -100,15 +100,15 @@
     (let/cc return)
     (with ([score-function enough-score] scoring))
     (let ((best-score-so-far -inf.0)
-          (seed (random-nat secp256k1-order))))
+          (seed (random-uint secp256k1-order))))
     (while #t)
     (let* ((seckey-data (bytes<- UInt256 seed))
            (seckey (secp256k1-seckey seckey-data))
            (pubkey (secp256k1-pubkey<-seckey seckey-data))
            (h (keccak256<-bytes (bytes<- PublicKey pubkey)))
            (address-bytes (subu8vector h 12 32))
            (s (score-function address-bytes)))
-      (set! seed (modulo (+ seed (u8vector->nat h)) secp256k1-order)))
+      (set! seed (modulo (+ seed (u8vector->uint h)) secp256k1-order)))
     (when (<= best-score-so-far s))
     (let (kp (keypair (make-address address-bytes) pubkey seckey))
       (when print-candidates

presigned.ss

@@ -38,7 +38,7 @@
   :std/iter
   :std/misc/number
   :std/srfi/1
-  :std/sugar
+  (only-in :std/sugar check-argument-uint)
   :std/text/hex
   :clan/base
   :clan/poo/object :clan/poo/brace :clan/poo/io
@@ -49,7 +49,7 @@
 ;; Return the nth power of sqrt(2), rounded down to the nearest integer
 ;; : Nat <- Nat
 (def (integer-floor-sqrt2expt n)
-  (check-argument (nat? n) "natural" n)
+  (check-argument-uint n)
   (if (odd? n) (integer-sqrt (arithmetic-shift 1 n))
       (arithmetic-shift 1 (half n))))
 
@@ -61,7 +61,7 @@
 ;; (every (lambda (i) (<= (integer-floor-sqrt2expt (integer-floor-logsqrt2 i)) i (1- (integer-floor-sqrt2expt (1+ (integer-floor-logsqrt2 i)))))) (iota 500 1))
 ;; : Nat <- Nat+
 (def (integer-floor-logsqrt2 n)
-  (check-argument (and (nat? n) (positive? n)) "positive integer" n)
+  (check-argument-positive-integer n)
   (def j (* 2 (1- (integer-length n))))
   #;(DBG icl: n j (integer-floor-sqrt2expt j) (integer-floor-sqrt2expt (1+ j)) (integer-floor-sqrt2expt (+ j 2)))
   #;(assert! (<= (integer-floor-sqrt2expt j) n (1- (integer-floor-sqrt2expt (+ j 2)))))
@@ -72,7 +72,7 @@
 #;(every (lambda (i) (<= (1+ (integer-floor-sqrt2expt (1- (integer-ceiling-logsqrt2 i)))) i (integer-floor-sqrt2expt (integer-ceiling-logsqrt2 i)))) (iota 500 2))
 ;; : Nat <- Nat
 (def (integer-ceiling-logsqrt2 n)
-  (check-argument (nat? n) "natural" n)
+  (check-argument-uint n)
   (if (< n 2) n (1+ (integer-floor-logsqrt2 (1- n)))))
 
 ;; Treat 0 specially, mapping it to 0
@@ -138,7 +138,7 @@
   (def-slots (from to data nonce value gas sigs) presigned)
   (def creator from)
   (def block (eth_blockNumber))
-  (unless (nat? gasPrice)
+  (unless (uint256? gasPrice)
     (set! gasPrice (max 1 (eth_gasPrice))))
   (unless (equal? (eth_getTransactionCount creator block) nonce)
     (error "Creator address was already used or initial nonce > 0"))