[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: Incomplete backtrace

From: Matt Wette
Subject: Re: Incomplete backtrace
Date: Sat, 14 Mar 2020 07:38:20 -0700
User-agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101 Thunderbird/68.4.1

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)

reply via email to

[Prev in Thread] Current Thread [Next in Thread]