racket/pkgs/compiler-lib/compiler/commands/decompile.rkt
Matthew Flatt 2a7d94d89c update compilation info, especially for CS
Update the Guide's performance section with current information for
Racket CS, and also document the Racket CS compilation mode and
inspection environment variables. Make a couple of environment
variables work more consistently: PLTDISABLEGC for CS and PLT_ZO_PATH
for BC.
2020-06-14 14:26:22 -06:00

99 lines
3.6 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)]
#: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))))))))))