diff options
| -rw-r--r-- | share/txr/stdlib/asm.tl | 27 |
1 files changed, 19 insertions, 8 deletions
diff --git a/share/txr/stdlib/asm.tl b/share/txr/stdlib/asm.tl index 9f28e3b1..33eed4bf 100644 --- a/share/txr/stdlib/asm.tl +++ b/share/txr/stdlib/asm.tl @@ -720,11 +720,22 @@ (put-line "instruction count:") (format t "~5d\n" ninsn)))) -(defun usr:disassemble (obj : (stream *stdout*)) - (typecase obj - (vm-desc (disassemble-cdf (vm-desc-bytecode obj) - (vm-desc-datavec obj) - (vm-desc-funvec obj) - stream)) - (t (error "~s: not a compiled object: ~s" 'vm-disassemble obj))) - obj) +(defun disassemble (obj : (stream *stdout*)) + (symacrolet ((self 'vm-disassemble-obj)) + (typecase obj + (vm-desc (disassemble-cdf (vm-desc-bytecode obj) + (vm-desc-datavec obj) + (vm-desc-funvec obj) + stream)) + (fun (unless (vm-fun-p obj) + (error "~s: not a vm function: ~s" self obj)) + (let* ((clo (func-get-env obj)) + (desc (sys:vm-closure-desc clo)) + (ip (sys:vm-closure-entry clo))) + (disassemble desc stream) + (put-line "entry point:") + (format stream "~5d\n" ip))) + (t (iflet ((fun (symbol-function obj))) + (disassemble fun stream) + (error "~s: not a compiled object: ~s" self obj)))) + obj)) |