suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

racocs decompile: handle linklets in 'interpret mode

Browse Source
This commit is contained in:
Matthew Flatt 2020-01-31 05:40:01 -07:00
parent 4acf864b0e
commit cbcd9505aa
3 changed files with 49 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
pkgs/compiler-lib/compiler/decompile.rkt
View File

@ -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
`(....)])])]))

28
pkgs/compiler-lib/compiler/private/chez.rkt
View File

@ -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])))

20
racket/src/cs/linklet.sls
View File

@ -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)
[(compile)
(values (linklet-code linklet) (linklet-paths linklet))]
[else
(values #f #f)])]
[else (values #f #f)]))
(values (linklet-format linklet) (linklet-code linklet) (linklet-paths linklet))]
[else (values #f #f #f)]))
(define (linklet-interpret-jitified? v)
(wrapped-code? v))
(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))
;; ----------------------------------------