More relevant VM backtrace

* module/system/repl/repl.scm: Remove a useless print in the backtrace
  handler.

* module/system/vm/debug.scm (vm-backtrace): s/reverse!/reverse/

* module/system/vm/frame.scm (bootstrap-frame?): A heuristic to see if a
  frame is a bootstrap frame, the one allocated on the stack in
  vm_engine.c; need to have a better solution for this.
  (make-frame-chain): Don't include bootstrap frames, they add no
  information.
  (print-frame-chain-as-backtrace): Remove a pk.

* src/vm_engine.c (vm_run): Add a fixme about the bootstrap prograp.

module/system/repl/repl.scm

@@ -66,7 +66,6 @@
      (vm-backtrace (the-vm))
      (newline))
     ((,key ,subr ,msg ,args . ,rest)
-     (display "This backtrace for free: ")
      (vm-backtrace (the-vm))
      (newline)
      (let ((cep (current-error-port)))

module/system/vm/debug.scm

@@ -59,4 +59,4 @@
 
 (define (vm-backtrace vm)
   (print-frame-chain-as-backtrace
-   (reverse! (vm-last-frame-chain vm))))
+   (reverse (vm-last-frame-chain vm))))

module/system/vm/frame.scm

@@ -21,6 +21,7 @@
 
 (define-module (system vm frame)
   :use-module (system vm program)
+  :use-module (system vm instruction)
   :use-module ((srfi srfi-1) :select (fold))
   :export (frame-number frame-address
            make-frame-chain
@@ -42,17 +43,27 @@
 (define frame-number (make-object-property))
 (define frame-address (make-object-property))
 
+(define (bootstrap-frame? frame)
+  (let ((code (program-bytecode (frame-program frame))))
+    ;; XXX: need to fix the bootstrap prog, its code is on the C stack
+    (and (= (uniform-vector-length code) 3))))
+
 (define (make-frame-chain frame addr)
-  (let* ((link (frame-dynamic-link frame))
+  (define (make-rest)
-	 (chain (cons frame
+    (make-frame-chain (frame-dynamic-link frame)
-                      (if (eq? link #t)
+                      (frame-return-address frame)))
-                          '()
+  (cond
-                          (make-frame-chain
+   ((or (eq? frame #t) (eq? frame #f))
-                           link (frame-return-address frame))))))
+    ;; handle #f or #t dynamic links
-    (set! (frame-number frame) (1- (length chain)))
+    '())
-    (set! (frame-address frame)
+   ((bootstrap-frame? frame)
-	  (- addr (program-base (frame-program frame))))
+    (make-rest))
-    chain))
+   (else
+    (let ((chain (make-rest)))
+      (set! (frame-number frame) (length chain))
+      (set! (frame-address frame)
+            (- addr (program-base (frame-program frame))))
+      (cons frame chain)))))
 
 
 ;;;
@@ -97,10 +108,7 @@
   (if (null? frames)
       (format #t "No backtrace available.\n")
       (begin
-        (format #t "Backtrace:\n")
+        (format #t "VM backtrace:\n")
-        (pk frames (map frame-program frames)
-             (map frame-address frames)
-             )
         (fold (lambda (frame file)
                 (let ((new-file (frame-file frame file)))
                   (if (not (eqv? new-file file))

src/vm_engine.c

@@ -100,6 +100,7 @@ vm_run (SCM vm, SCM program, SCM args)
     SCM prog = program;
 
     /* Boot program */
+    /* FIXME: heap program object points to objcode on the stack. Badness! */
     scm_byte_t bytes[3] = {scm_op_call, 0, scm_op_halt};
     bytes[1] = scm_ilength (args); /* FIXME: argument overflow */
     program = scm_c_make_program (bytes, 3, SCM_BOOL_T);