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.

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