Merge pull request #1687 from clasp-developers/bytecode-frame-arguments

Bytecode frame arguments

Author: Bike

RELEASE_NOTES.md

@@ -5,6 +5,7 @@
   for weak-key-or-value tables, although at present they are actually
   strong tables in practice.
 * `ext:macroexpand-all` macroexpands a form and its subforms.
+* Arguments to bytecode functions are made available to debuggers.
 
 ## Fixed
 * Weak pointers and weak hash tables survive snapshot save/load.

include/clasp/core/bytecode.h

@@ -348,6 +348,13 @@ class VMFrameDynEnv_O : public DynEnv_O {
 
 namespace core {
 
+// Offsets on the VM stack. These are pushed throughout bytecode.cc,
+// e.g. the PC is pushed by call instructions, and the FP by bytecode_call.
+const size_t BYTECODE_FRAME_PC_OFFSET = 3;
+const size_t BYTECODE_FRAME_NARGS_OFFSET = 2;
+const size_t BYTECODE_FRAME_ARGS_OFFSET = 1;
+const size_t BYTECODE_FRAME_FP_OFFSET = 0;
+
 bool bytecode_module_contains_address_p(BytecodeModule_sp, void*);
 bool bytecode_function_contains_address_p(BytecodeSimpleFun_sp, void*);
 T_sp bytecode_function_for_pc(BytecodeModule_sp, void*);

src/core/backtrace.cc

@@ -473,7 +473,18 @@ static DebuggerFrame_sp make_bytecode_frame_from_function(BytecodeSimpleFun_sp f
   T_sp closure = (fun->environmentSize() == 0) ? (T_sp)fun : nil<T_O>();
   List_sp bindings = bytecode_bindings_for_pc(fun->code(), bpc, bfp);
   T_sp spi = bytecode_spi_for_pc(fun->code(), bpc);
-  return DebuggerFrame_O::make(fun->functionName(), Pointer_O::create(bpc), spi, fun->fdesc(), closure, nil<T_O>(), false, bindings,
+  // Grab arguments.
+  T_sp tnargs((gctools::Tagged)(*(bfp - BYTECODE_FRAME_NARGS_OFFSET)));
+  size_t nargs = tnargs.unsafe_fixnum();
+  T_O** argptr = (T_O**)*(bfp - BYTECODE_FRAME_ARGS_OFFSET);
+  ql::list largs;
+  for (size_t i = 0; i < nargs; ++i) {
+    T_O* rarg = argptr[i];
+    T_sp temp((gctools::Tagged)rarg);
+    largs << temp;
+  }
+  // Finally make the frame.
+  return DebuggerFrame_O::make(fun->functionName(), Pointer_O::create(bpc), spi, fun->fdesc(), closure, largs.cons(), true, bindings,
                                INTERN_(kw, bytecode), false);
 }
 
@@ -482,9 +493,8 @@ static DebuggerFrame_sp make_bytecode_frame(size_t frameIndex, unsigned char*& p
   void* bpc = pc;
   T_O** bfp = fp;
   if (fp) { // null fp means we've hit the end.
-    // PC was pushed just before the frame pointer.
-    pc = (unsigned char*)(*(fp - 1));
-    fp = (T_O**)(*fp);
+    pc = (unsigned char*)(*(fp - BYTECODE_FRAME_PC_OFFSET));
+    fp = (T_O**)(*(fp - BYTECODE_FRAME_FP_OFFSET));
   }
   // Find the bytecode module containing the current pc.
   List_sp modules = _lisp->_Roots._AllBytecodeModules.load(std::memory_order_relaxed);

src/core/bytecode.cc

@@ -259,6 +259,11 @@ bytecode_vm(VirtualMachine& vm, T_O** literals, T_O** closed, Closure_O* closure
       T_sp tfunc((gctools::Tagged)(*(vm.stackref(sp, nargs))));
       Function_sp func = gc::As_assert<Function_sp>(tfunc);
       T_O** args = vm.stackref(sp, nargs - 1);
+      // We push the PC for the debugger (see make_bytecode_frame in backtrace.cc)
+      // We do this here rather than bytecode_call because e.g. we may call a
+      // non-bytecode function, that in turn calls a bunch of different bytecode
+      // functions, which may trash vm._pc making it unsuitable.
+      // We have to do this for all call instructions, not just this one.
       vm.push(sp, (T_O*)pc);
       vm._pc = pc;
       vm._stackPointer = sp;
@@ -1510,6 +1515,12 @@ gctools::return_type bytecode_call(unsigned char* pc, core::T_O* lcc_closure, si
   // being unwound to.
   core::T_O** old_fp = vm._framePointer;
   core::T_O** old_sp = vm._stackPointer;
+  // Push the args and FP for debugging (see backtrace.cc)
+  // This is mildly wasteful of stack space, but when calling bytecode from
+  // non-bytecode the arguments won't be on the VM stack, so this is the
+  // best I got.
+  vm.push(vm._stackPointer, core::make_fixnum(lcc_nargs).raw_());
+  vm.push(vm._stackPointer, (core::T_O*)lcc_args);
   vm.push(vm._stackPointer, (core::T_O*)old_fp);
   core::T_O** fp = vm._framePointer = vm._stackPointer;
   core::T_O** sp = vm.push_frame(fp, nlocals);

src/lisp/kernel/lsp/debug.lisp

@@ -143,8 +143,43 @@ If the arguments are not available, returns NIL NIL."
         (bind-var (first auxs) (second auxs)))
       (nreverse bindings))))
 
-(defun frame-locals (frame &key eval
-                           &aux (fname (frame-function-name frame)))
+(defun locals-from-arguments (frame eval &aux (fname (frame-function-name frame)))
+  (multiple-value-bind (args args-available) (frame-arguments frame)
+    (multiple-value-bind (lambda-list lambda-list-available)
+        (frame-function-lambda-list frame)
+      (cond
+        ((not args-available) nil)
+        (lambda-list-available
+         (lambda-list-alist lambda-list args eval))
+        ;; The frame is missing a lambda list so fallback to just naming the arguments sequentially.
+        ((and (consp fname)
+           (eq (first fname) 'cl:method)
+           (= (length args) 2)
+           (core:vaslistp (first args)))
+         ;; This is non-fast method. The real arguments are a vaslist in
+         ;; the first element and the method list is in the second element.
+         (let ((method-args (core:list-from-vaslist (first args)))
+               (next-methods (second args)))
+           (append
+            (let ((result ()))
+              (do ((args method-args (cdr method-args))
+                   (i 0 (1+ i)))
+                  ((null args) (nreverse result))
+                (push (cons (intern (format nil "ARG~d" i) :cl-user)
+                            (first args))
+                      result)))
+            (list (cons 'cl-user::next-methods next-methods)))))
+        (t
+         ;; This is a fast method. Just treat it normally.
+         (let ((result ()))
+           (do ((args args (cdr args))
+                (i 0 (1+ i)))
+               ((null args) (nreverse result))
+             (push (cons (intern (format nil "ARG~d" i) :cl-user)
+                         (first args))
+                   result))))))))
+
+(defun frame-locals (frame &key eval)
   "Return an alist of local lexical/special variables and their values at the continuation the frame
   represents. The CARs are variable names and CDRs their values. Multiple bindings with the same
   name may be returned, as there is no notion of lexical scope in this interface. By default
@@ -154,40 +189,10 @@ If the arguments are not available, returns NIL NIL."
   (append
    ;; This only gives anything for bytecode functions right now.
    (core:debugger-frame-locals frame)
-   (multiple-value-bind (args args-available) (frame-arguments frame)
-     (multiple-value-bind (lambda-list lambda-list-available)
-         (frame-function-lambda-list frame)
-       (cond
-         ((not args-available) nil)
-         (lambda-list-available
-          (lambda-list-alist lambda-list args eval))
-         ;; The frame is missing a lambda list so fallback to just naming the arguments sequentially.
-         ((and (consp fname)
-               (eq (first fname) 'cl:method)
-               (= (length args) 2)
-               (core:vaslistp (first args)))
-          ;; This is non-fast method. The real arguments are a vaslist in
-          ;; the first element and the method list is in the second element.
-          (let ((method-args (core:list-from-vaslist (first args)))
-                (next-methods (second args)))
-            (append
-             (let ((result ()))
-               (do ((args method-args (cdr method-args))
-                    (i 0 (1+ i)))
-                   ((null args) (nreverse result))
-                 (push (cons (intern (format nil "ARG~d" i) :cl-user)
-                             (first args))
-                       result)))
-             (list (cons 'cl-user::next-methods next-methods)))))
-         (t
-          ;; This is a fast method. Just treat it normally.
-          (let ((result ()))
-            (do ((args args (cdr args))
-                 (i 0 (1+ i)))
-                ((null args) (nreverse result))
-              (push (cons (intern (format nil "ARG~d" i) :cl-user)
-                          (first args))
-                    result)))))))))
+   (if (eq (core:debugger-frame-lang frame) :bytecode)
+       ;; bytecode frames already have good locals, so don't bother w/arguments
+       nil
+       (locals-from-arguments frame eval))))
 
 (defun frame-function-lambda-list (frame)
   "Return the lambda list of the function being called in this frame, and a second value indicating success. This function may fail, in which case the first value is undefined and the second is NIL. In success the first value is the lambda list and the second value is true."