From d37a97e912b8711e3c0c824b27b01f6bec456221 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sat, 7 Apr 2018 09:19:24 -0700 Subject: asm: support disassembly on functions. * share/txr/stdlib/asm.tl (disassemble): Drop usr: prefix since symbol is interned already in usr package. Handle vm functions by obtaining their vm desc and entry point. Disassemble whole desc, then indicate entry point. The fallback case tries the object as a potential function name and recurses, so (disassemble '(meth struct slot)) and (disassemble 'name) will work. --- share/txr/stdlib/asm.tl | 27 +++++++++++++++++++-------- 1 file 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)) -- cgit v1.2.3