Re: Incomplete backtrace

[Matt Wette]

On 3/14/20 7:19 AM, Christopher Howard wrote:
> I think there are others here better qualified to answer your question,
> but maybe one helpful thing: have you read the Guile Implementation
> section of the Guile Reference Manual? In subsection "A Virtual Machine
> for Guile" there is this paragraph:
>
> '''
> Note that once a value in a local variable slot is no longer needed,
> Guile is free to re-use that slot.  This applies to the slots that were
> initially used for the callee and arguments, too.  For this reason,
> backtraces in Guile aren’t always able to show all of the arguments: it
> could be that the slot corresponding to that argument was re-used by
> some other variable.
> '''
>
> I do not know if there is a way to disable slot reuse, for debugging
> purposes. Anyone...?
I started looking into this a while back but gave up for now.
  What I tried was

1) Add a debug flag "-g" to guild compile.  In interactive mode
    I think it's possible to set the optimization flags, this would
   be '(debug . #t)

2) In the cps conversion add a hook to un-reuse slots.

It didn't work.  I think the return value(s) need to be in the first
slots.   Back to the drawing board.  Below is the patch.

Below is a patch reflecting the changes I made to guile-2.2.4 to try:
--- module/scripts/compile.scm-orig    2018-08-07 03:34:55.000000000 -0700
+++ module/scripts/compile.scm    2019-06-01 16:47:37.586223675 -0700
@@ -84,6 +84,12 @@
                                     (cons (string->symbol arg) warnings)
                                     (alist-delete 'warnings result))))))

+    (option '(#\g "debug") #f #f
+        (lambda (opt name arg result)
+          (alist-cons 'optimizations
+                  (cons* #:debug #t (optimizations-for-level 0))
+                  result)))
+
     (option '(#\O "optimize") #t #f
         (lambda (opt name arg result)
                   (define (return val)
--- module/language/cps/compile-bytecode.scm-orig    2018-10-03 
13:55:11.000000000 -0700
+++ module/language/cps/compile-bytecode.scm    2019-06-02 
11:49:31.812374598 -0700
@@ -41,6 +41,12 @@
   #:use-module (system base types internal)
   #:export (compile-bytecode))

+(define-public cps-debug-1 #f)
+(define-public cps-debug-2 #f)
+(define-public cps-debug-3 #f)
+(define-public cps-debug-4 #f)
+(define-public cps-debug-5 #f)
+
 (define (kw-arg-ref args kw default)
   (match (memq kw args)
     ((_ val . _) val)
@@ -84,6 +90,9 @@
 (define (compile-function cps asm opts)
   (let* ((allocation (allocate-slots cps #:precolor-calls?
                                      (kw-arg-ref opts 
#:precolor-calls? #t)))
+     (allocation (if (kw-arg-ref opts #:debug #f)
+             (expand-slots allocation cps)
+             allocation))
          (forwarding-labels (compute-forwarding-labels cps allocation))
          (frame-size (lookup-nlocals allocation)))
     (define (forward-label k)
@@ -655,6 +664,8 @@
          (emit-end-arity asm)
          (emit-end-program asm))))

+    (set! cps-debug-1 cps)
+    (set! cps-debug-2 allocation)
     (intmap-for-each compile-cont cps)))

 (define (emit-bytecode exp env opts)
--- module/language/cps/slot-allocation.scm-orig    2019-06-01 
16:47:37.586223675 -0700
+++ module/language/cps/slot-allocation.scm    2019-06-02 
19:46:49.473749251 -0700
@@ -998,3 +998,35 @@
                (shuffles (compute-shuffles cps slots calls live-in))
                (frame-size (compute-frame-size cps slots calls shuffles)))
           (make-allocation slots representations calls shuffles 
frame-size))))))
+
+;;(use-modules (ice-9 pretty-print))
+;;(define (pp exp) (pretty-print exp #:per-line-prefix "  "))
+(define (find-return-slots cps)
+  (let* ((kt (match (intmap-ref cps 0) (($ $kfun _ m s t c) t))))
+    (intmap-fold
+     (lambda (ix iv kv)
+       (match iv
+     (($ $kargs _ _ ($ $continue kx _ ($ $values vals)))
+      (if (= kx kt) vals kv))
+     (_ kv)))
+     cps #f)))
+
+(define (expand-slots allocation cps)
+  (display "expanding slots\n")
+  (let* ((rs (find-return-slots cps))
+     (nr (length rs))
+     (rm (map cons rs (iota nr))))
+    (match allocation
+      (($ $allocation slots representations call-allocs shuffles 
frame-size)
+       (call-with-values
+       (lambda ()
+         (intmap-fold
+          (lambda (ix iv im n)
+        (if (assq-ref rm ix)
+            (values (intmap-add im ix (assq-ref rm ix)) n)
+            (values (intmap-add im ix n) (1+ n))))
+          slots empty-intmap nr))
+     (lambda (xslots xframe-size)
+       (make-allocation xslots representations call-allocs shuffles
+                xframe-size)))))))
+(export expand-slots)