b2a27ef05c
Show the machine code that constructs lifted constants for a linket. Also, add a `--partial-fasl` option that shows fasl content in a rawer form, which is useful for checking how content is presented and that nothing is getting lost in other reconstructed views.
101 lines
3.7 KiB
Racket
101 lines
3.7 KiB
Racket
#lang racket/base
|
|
(require racket/cmdline
|
|
raco/command-name
|
|
compiler/zo-parse
|
|
compiler/decompile
|
|
compiler/compilation-path
|
|
racket/pretty
|
|
racket/format
|
|
"../private/chez.rkt")
|
|
|
|
(define (get-name)
|
|
(string->symbol (short-program+command-name)))
|
|
|
|
(define force? #f)
|
|
(define to-linklets? #f)
|
|
|
|
(define source-files
|
|
(command-line
|
|
#:program (short-program+command-name)
|
|
#:once-each
|
|
[("--force") "Ignore timestamp mimatch on associated \".zo\""
|
|
(set! force? #t)]
|
|
[("--columns" "-n") n "Format for <n> columns"
|
|
(let ([num (string->number n)])
|
|
(unless (exact-positive-integer? num)
|
|
(raise-user-error (get-name)
|
|
"not a valid column count: ~a" n))
|
|
(pretty-print-columns num))]
|
|
[("--linklet") "Decompile to linklets"
|
|
(set! to-linklets? #t)]
|
|
[("--no-disassemble") "Show machine code as-is"
|
|
(current-can-disassemble #f)]
|
|
[("--partial-fasl") "Show more detail on fasl structure"
|
|
(current-partial-fasl #t)]
|
|
#:args source-or-bytecode-file
|
|
source-or-bytecode-file))
|
|
|
|
(define (check-files orig-file alt-file)
|
|
(cond
|
|
[(not (file-exists? alt-file))
|
|
(cond
|
|
[(file-exists? orig-file)
|
|
(unless (is-bytecode-file? orig-file)
|
|
(raise-user-error (get-name)
|
|
(~a "not a bytecode file, and no associated \".zo\" file;\n"
|
|
" consider using `raco make` to compile the source file to bytecode\n"
|
|
" path: ~a\n"
|
|
" tried associated path: ~a")
|
|
orig-file
|
|
alt-file))]
|
|
[else
|
|
(raise-user-error (get-name)
|
|
(~a "no such file, and no associated \".zo\" file\n"
|
|
" path: ~a\n"
|
|
" tried associated path: ~a")
|
|
orig-file
|
|
alt-file)])]
|
|
[(not (is-bytecode-file? alt-file))
|
|
(raise-user-error (get-name)
|
|
(~a "associated \".zo\" file is not a bytecode file\n"
|
|
" original path: ~a\n"
|
|
" associated path: ~a")
|
|
orig-file
|
|
alt-file)]
|
|
[(and (not force?)
|
|
((file-or-directory-modify-seconds orig-file
|
|
#f
|
|
(lambda () -inf.0))
|
|
. > .
|
|
(file-or-directory-modify-seconds alt-file)))
|
|
;; return a warning:
|
|
(raise-user-error (get-name)
|
|
(~a "associated \".zo\" file's date is older than given file's date;\n"
|
|
" consider using `raco make` to rebuild the source file, or use `--force`\n"
|
|
" to skip the date check\n"
|
|
" original path: ~a\n"
|
|
" associated path: ~a")
|
|
orig-file
|
|
alt-file)]))
|
|
|
|
(define (is-bytecode-file? orig-file)
|
|
(call-with-input-file*
|
|
orig-file
|
|
(lambda (i)
|
|
(equal? #"#~" (read-bytes 2 i)))))
|
|
|
|
(for ([zo-file source-files])
|
|
(let ([zo-file (path->complete-path zo-file)])
|
|
(let-values ([(base name dir?) (split-path zo-file)])
|
|
(let ([alt-file (get-compilation-bytecode-file zo-file)])
|
|
(check-files zo-file alt-file)
|
|
(parameterize ([current-load-relative-directory base]
|
|
[print-graph #t])
|
|
(pretty-write
|
|
(decompile
|
|
#:to-linklets? to-linklets?
|
|
(call-with-input-file*
|
|
(if (file-exists? alt-file) alt-file zo-file)
|
|
(lambda (in)
|
|
(zo-parse in))))))))))
|