racocs decompile: handle linklets in 'interpret mode

pkgs/compiler-lib/compiler/decompile.rkt

@@ -247,15 +247,22 @@
     [(? linklet?)
      (case (system-type 'vm)
        [(chez-scheme)
-        (define-values (code args) ((vm-primitive 'linklet-fasled-code+arguments) l))
+        (define-values (fmt code args) ((vm-primitive 'linklet-fasled-code+arguments) l))
         (cond
           [code
            (define uncompressed-code
              (if (regexp-match? #rx#"^\0\0\0\0chez" code)
                  code
                  (vm-eval `(bytevector-uncompress ,code))))
+           (case fmt
+             [(compile)
               (define proc ((vm-eval `(load-compiled-from-port (open-bytevector-input-port ,uncompressed-code)))))
               (decompile-chez-procedure (if (null? args) proc (proc args)))]
+             [(interpret)
+              (define bytecode (vm-eval `(fasl-read (open-bytevector-input-port ,uncompressed-code))))
+              (list `(#%interpret ,(unwrap-chez-interpret-jitified bytecode)))]
+             [else
+              '(....)])]
           [else
            `(....)])])]))
 

pkgs/compiler-lib/compiler/private/chez.rkt

@@ -3,7 +3,8 @@
          ffi/unsafe
          racket/promise)
 
-(provide decompile-chez-procedure)
+(provide decompile-chez-procedure
+         unwrap-chez-interpret-jitified)
 
 (define (decompile-chez-procedure p)
   (unless (procedure? p)
@@ -111,9 +112,9 @@
            (parameterize ([current-output-port o])
              (disassemble-bytes bstr #:relocations ((code-obj 'reloc+offset) 'value)))
            (define strs (regexp-split #rx"\n" (get-output-string o)))
-           (list (cons 'assembly-code strs)))]
+           (list (cons '#%assembly-code strs)))]
      [else
-      (list (list 'machine-code bstr))])))
+      (list (list '#%machine-code bstr))])))
 
 (define disassemble-bytes
   (delay
@@ -129,3 +130,24 @@
     [else
      ;; multiple bits set
      'args]))
+
+;; ----------------------------------------
+;; The schemify interpreter's "bytecode" is fairly readable as-is, so
+;; just unpack compiled procedures at the leaves
+
+(define (unwrap-chez-interpret-jitified bc)
+  (define linklet-interpret-jitified? (vm-primitive 'linklet-interpret-jitified?))
+  (define linklet-interpret-jitified-extract (vm-primitive 'linklet-interpret-jitified-extract))
+  (let loop ([bc bc])
+    (cond
+      [(linklet-interpret-jitified? bc)
+       (define proc (linklet-interpret-jitified-extract bc))
+       (define proc-obj ((vm-primitive 'inspect/object) proc))
+       (define code (proc-obj 'code))
+       `(begin . ,(decompile-code code (make-hasheq)))]
+      [(vector? bc)
+       (for/vector #:length (vector-length bc) ([bc (in-vector bc)])
+         (loop bc))]
+      [(pair? bc)
+       (cons (loop (car bc)) (loop (cdr bc)))]
+      [else bc])))

racket/src/cs/linklet.sls

@@ -10,6 +10,8 @@
           linklet-import-variables
           linklet-export-variables
           linklet-fasled-code+arguments      ; for tools like `raco decompile`
+          linklet-interpret-jitified?        ; for `raco decompile`
+          linklet-interpret-jitified-extract ; for `raco decompile`
           
           instance?
           make-instance
@@ -787,15 +789,19 @@
 
   (define (linklet-fasled-code+arguments linklet)
     (unless (linklet? linklet)
-      (raise-argument-error 'linklet-code "linklet?" linklet))
+      (raise-argument-error 'linklet-fasled-code+arguments "linklet?" linklet))
     (case (linklet-preparation linklet)
       [(faslable faslable-strict faslable-unsafe lazy)
-       (case (linklet-format linklet)
+       (values (linklet-format linklet) (linklet-code linklet) (linklet-paths linklet))]
-         [(compile)
+      [else (values #f #f #f)]))
-          (values (linklet-code linklet) (linklet-paths linklet))]
+
-         [else
+  (define (linklet-interpret-jitified? v)
-          (values #f #f)])]
+    (wrapped-code? v))
-      [else (values #f #f)]))
+
+  (define (linklet-interpret-jitified-extract v)
+    (unless (wrapped-code? v)
+      (raise-argument-error 'linklet-interpret-jitified-extract "linklet-interpret-jitified?" v))
+    (force-wrapped-code v))
 
   ;; ----------------------------------------