Debug tool for printing boxed bytestrings

abstract-analyzer.rkt

@@ -8,6 +8,7 @@
 (require "globals.rkt")
 (require "utils.rkt")
 (require "expander.rkt")
+(require (submod "codegen.rkt" constants))
 (require (submod "types.rkt" common))
 (require (submod "types.rkt" abstract-machine))
 (require (submod "types.rkt" evm-assembly))
@@ -635,7 +636,10 @@
                                 (v-box (cast (rest x) RegisterValue)))]
     [(? vector?)        (v-vector (vector-map v-box x))]
     [(? char?)          (v-char x)]
-    [(? string?)        (v-bytes (allocate-bytes! (string->bytes/utf-8 x)))]
+    [(? string?)        (let ([ bs (string->bytes/utf-8 x) ])
+                          (v-bytes (allocate-bytes! (bytes-append (word->bytes TAG-BYTES)
+                                                                  (word->bytes (bytes-length bs))
+                                                                  bs))))]
     [_ (error "v-box: Unknown type" x)]))
 
 (: print-debug-line (-> Void))

debugger.rkt

@@ -65,6 +65,7 @@
   (match t
     [0 (println `(LOGNUM ,(bytes->integer bs #f)))]
     [1 (println `(LOGSYM ,(string->symbol (integer->string (bytes->integer bs #f)))))]
+    [2 (println `(LOGSTR ,bs))]
     ))
 
 (: memory-dict (-> vm-exec (Listof (List UnlinkedOffset EthWord))))

psl/primitives.pmd

@@ -274,6 +274,14 @@
   (%#-log2 ptr #u32 #u0 #u1)
   )
 
+(define (%#-ioctl-print-string x)
+  (define ptr (%#-bytes-data x))
+  (define size (%#-bytes-size x))
+  (%#-ioctl-print-word ptr)
+  (%#-ioctl-print-word size)
+  (%#-log2 ptr size #u0 #u2)
+  )
+
 ; Compile-time macros
 
 (define-syntax (%#-set-max-iterations! stx)
@@ -311,3 +319,5 @@
   (%#-memcpy (%#-ptr-offset bytes-ptr #u2) src-ptr num-bytes)
   bytes-ptr
   )
+(define (%#-bytes-data x) (%#-+ x (%#-* #u2 %#-WORD)))
+(define (%#-bytes-size x) (%#-mem-read x #u1))

tests/0045-strings-3.pmd

@@ -0,0 +1,7 @@
+#lang pyramid
+
+(require psl "primitives.pmd")
+
+(set-test-result! 11)
+
+(%#-box (%#-bytes-size "hello world"))

utils.rkt

@@ -171,6 +171,10 @@
       (- w WORDLIMIT)
       w))
 
+(: word->bytes (-> Natural Bytes))
+(define (word->bytes x)
+  (integer->bytes x 32 #f))
+
 ;; xxxxxxxxxxxx11111111 -> 11111111111111111
 ;; xxxxxxxxxxxx01111111 -> 00000000001111111
 (: sign-extend (-> EthWord Natural EthWord))