Hi all, I had a look at Evan's patch in https://bugs.call-cc.org/ticket/894 and tried to test it, but it turns out that just adding the debugging info to the core language isn't enough; it also needs to be propagated to the closure converted/prepared language, and enventually needs to end up in the generated C.
Especially the latter was slightly tricky because direct_calls are used in expression contexts, so the debugging and trace events should be treated as part of the same expression as the actual function call. In any case, the ticket has an example program which you can use to verify the attached patches: feathers should show the lines containing the calls to "ensure-nonzero" in a brighter shade, and they should be clickable, and it should end up in the trace buffer in case of an error. Cheers, Peter
From 60ad22f29f55a38f1ea09e71a5e25ce0cad7ec32 Mon Sep 17 00:00:00 2001
From: Evan Hanson <ev...@foldling.org>
Date: Sat, 27 Sep 2014 13:37:53 +1200
Subject: [PATCH] Include debug info on ##core#direct_call nodes.
Signed-off-by: Peter Bex <pe...@more-magic.net>
---
NEWS | 1 +
c-backend.scm | 26 ++++++++++++++++++++------
compiler.scm | 15 ++++++++++++---
optimizer.scm | 9 ++++++---
4 files changed, 39 insertions(+), 12 deletions(-)
diff --git a/NEWS b/NEWS
index fcdeabc..6a34708 100644
--- a/NEWS
+++ b/NEWS
@@ -7,6 +7,7 @@
- Compiler:
- Fixed incorrect argvector restoration after GC in directly
recursive functions (#1317).
+ - "Direct" procedure invocations now also maintain debug info (#894).
- Runtime system:
- "time" macro now shows peak memory usage (#1318, thanks to Kooda).
diff --git a/c-backend.scm b/c-backend.scm
index 2479986..b006ed0 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -356,14 +356,27 @@
((##core#direct_call)
(let* ((args (cdr subs))
(n (length args))
- (nf (add1 n))
- ;;(name (second params))
- (call-id (third params))
- (demand (fourth params))
+ (nf (add1 n))
+ (dbi (first params))
+ ;; (safe-to-call (second params))
+ (name (third params))
+ (name-str (source-info->string name))
+ (call-id (fourth params))
+ (demand (fifth params))
(allocating (not (zero? demand)))
(empty-closure (zero? (lambda-literal-closure-size (find-lambda call-id))))
(fn (car subs)) )
- (gen call-id #\()
+ (gen #\()
+ (when name
+ (cond (emit-debug-info
+ (when dbi
+ (gen #t " C_debugger(&(C_debug_info[" dbi "]),"
+ (if non-av-proc "0,NULL" "c,av") "),")))
+ (emit-trace-info
+ (gen #t " C_trace(\"" (backslashify name-str) "\"),"))
+ (else
+ (gen #t " /* " (uncommentify name-str) " */") ) ) )
+ (gen #t " " call-id #\()
(when allocating
(gen "C_a_i(&a," demand #\))
(when (or (not empty-closure) (pair? args)) (gen #\,)) )
@@ -371,7 +384,8 @@
(expr fn i)
(when (pair? args) (gen #\,)) )
(when (pair? args) (expr-args args i))
- (gen #\)) ) )
+ (gen #\)) ; function call
+ (gen #t #\)) ) ) ; complete expression
((##core#callunit)
;; The code generated here does not use the extra temporary needed for standard calls, so we have
diff --git a/compiler.scm b/compiler.scm
index db1b0b2..be605f2 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -218,7 +218,7 @@
; [##core#proc {<name> [<non-internal>]}]
; [##core#recurse {<tail-flag> <call-id>} <exp1> ...]
; [##core#return <exp>]
-; [##core#direct_call {<safe-flag> <debug-info> <call-id> <words>} <exp-f> <exp>...]
+; [##core#direct_call {<dbg-info-index> <safe-flag> <debug-info> <call-id> <words>} <exp-f> <exp>...]
; Analysis database entries:
;
@@ -2592,8 +2592,17 @@
(walk-var (first params) e e-count #f) )
((##core#direct_call)
- (set! allocated (+ allocated (fourth params)))
- (make-node class params (mapwalk subs e e-count here boxes)) )
+ (let* ((name (second params))
+ (name-str (source-info->string name))
+ (demand (fourth params)))
+ (if (and emit-debug-info name)
+ (let ((info (list dbg-index 'C_DEBUG_CALL "" name-str)))
+ (set! params (cons dbg-index params))
+ (set! debug-info (cons info debug-info))
+ (set! dbg-index (add1 dbg-index)))
+ (set! params (cons #f params)))
+ (set! allocated (+ allocated demand))
+ (make-node class params (mapwalk subs e e-count here boxes))) )
((##core#inline_allocate)
(set! allocated (+ allocated (second params)))
diff --git a/optimizer.scm b/optimizer.scm
index 129efd6..af4d786 100644
--- a/optimizer.scm
+++ b/optimizer.scm
@@ -1526,8 +1526,11 @@
;; Transform call-sites:
(for-each
(lambda (site)
- (let* ([n (cdr site)]
- [nsubs (node-subexpressions n)] )
+ (let* ((n (cdr site))
+ (nsubs (node-subexpressions n))
+ (params (node-parameters n))
+ (debug-info (and (pair? (cdr params))
+ (second params))))
(unless (= argc (length (cdr nsubs)))
(quit
"known procedure called with wrong number of arguments: `~A'"
@@ -1537,7 +1540,7 @@
(list (second nsubs)
(make-node
'##core#direct_call
- (list #t #f id allocated)
+ (list #t debug-info id allocated)
(cons (car nsubs) (cddr nsubs)) ) ) ) ) )
(lset-difference (lambda (s1 s2) (eq? (cdr s1) (cdr s2))) sites ksites) )
--
2.1.4
From 4a0a862406e0d9bf03758509c309fe4d3a01dacb Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
Date: Sun, 18 Dec 2016 20:11:04 +0100
Subject: [PATCH] Include debug info on ##core#direct_call nodes.
Signed-off-by: Peter Bex <pe...@more-magic.net>
---
NEWS | 1 +
c-backend.scm | 26 ++++++++++++++++++++------
core.scm | 15 ++++++++++++---
optimizer.scm | 9 ++++++---
4 files changed, 39 insertions(+), 12 deletions(-)
diff --git a/NEWS b/NEWS
index dabdd33..79403b9 100644
--- a/NEWS
+++ b/NEWS
@@ -67,6 +67,7 @@
- Compiler:
- Fixed incorrect argvector restoration after GC in directly
recursive functions (#1317).
+ - "Direct" procedure invocations now also maintain debug info (#894).
- Runtime system:
- "time" macro now shows peak memory usage (#1318, thanks to Kooda).
diff --git a/c-backend.scm b/c-backend.scm
index 9b09312..3595e5e 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -372,14 +372,27 @@
((##core#direct_call)
(let* ((args (cdr subs))
(n (length args))
- (nf (add1 n))
- ;;(name (second params))
- (call-id (third params))
- (demand (fourth params))
+ (nf (add1 n))
+ (dbi (first params))
+ ;; (safe-to-call (second params))
+ (name (third params))
+ (name-str (source-info->string name))
+ (call-id (fourth params))
+ (demand (fifth params))
(allocating (not (zero? demand)))
(empty-closure (zero? (lambda-literal-closure-size (find-lambda call-id))))
(fn (car subs)) )
- (gen call-id #\()
+ (gen #\()
+ (when name
+ (cond (emit-debug-info
+ (when dbi
+ (gen #t " C_debugger(&(C_debug_info[" dbi "]),"
+ (if non-av-proc "0,NULL" "c,av") "),")))
+ (emit-trace-info
+ (gen #t " C_trace(\"" (backslashify name-str) "\"),"))
+ (else
+ (gen #t " /* " (uncommentify name-str) " */") ) ) )
+ (gen #t " " call-id #\()
(when allocating
(gen "C_a_i(&a," demand #\))
(when (or (not empty-closure) (pair? args)) (gen #\,)) )
@@ -387,7 +400,8 @@
(expr fn i)
(when (pair? args) (gen #\,)) )
(when (pair? args) (expr-args args i))
- (gen #\)) ) )
+ (gen #\)) ; function call
+ (gen #t #\)) ) ) ; complete expression
((##core#provide)
(gen "C_a_i_provide(&a,1,lf[" (first params) "])"))
diff --git a/core.scm b/core.scm
index db6337d..ebee7c0 100644
--- a/core.scm
+++ b/core.scm
@@ -220,7 +220,7 @@
; [##core#provide <literal>]
; [##core#recurse {<tail-flag> <call-id>} <exp1> ...]
; [##core#return <exp>]
-; [##core#direct_call {<safe-flag> <debug-info> <call-id> <words>} <exp-f> <exp>...]
+; [##core#direct_call {<dbg-info-index> <safe-flag> <debug-info> <call-id> <words>} <exp-f> <exp>...]
; Analysis database entries:
;
@@ -2666,8 +2666,17 @@
(walk-var (first params) e e-count #f) )
((##core#direct_call)
- (set! allocated (+ allocated (fourth params)))
- (make-node class params (mapwalk subs e e-count here boxes)) )
+ (let* ((name (second params))
+ (name-str (source-info->string name))
+ (demand (fourth params)))
+ (if (and emit-debug-info name)
+ (let ((info (list dbg-index 'C_DEBUG_CALL "" name-str)))
+ (set! params (cons dbg-index params))
+ (set! debug-info (cons info debug-info))
+ (set! dbg-index (add1 dbg-index)))
+ (set! params (cons #f params)))
+ (set! allocated (+ allocated demand))
+ (make-node class params (mapwalk subs e e-count here boxes))) )
((##core#inline_allocate)
(set! allocated (+ allocated (second params)))
diff --git a/optimizer.scm b/optimizer.scm
index fa81055..b4f623c 100644
--- a/optimizer.scm
+++ b/optimizer.scm
@@ -1550,8 +1550,11 @@
;; Transform call-sites:
(for-each
(lambda (site)
- (let* ([n (cdr site)]
- [nsubs (node-subexpressions n)] )
+ (let* ((n (cdr site))
+ (nsubs (node-subexpressions n))
+ (params (node-parameters n))
+ (debug-info (and (pair? (cdr params))
+ (second params))))
(unless (= argc (length (cdr nsubs)))
(quit-compiling
"known procedure called with wrong number of arguments: `~A'"
@@ -1561,7 +1564,7 @@
(list (second nsubs)
(make-node
'##core#direct_call
- (list #t #f id allocated)
+ (list #t debug-info id allocated)
(cons (car nsubs) (cddr nsubs)) ) ) ) ) )
(filter (lambda (site)
(let ((s2 (cdr site)))
--
2.1.4
signature.asc
Description: Digital signature
_______________________________________________ Chicken-hackers mailing list Chicken-hackers@nongnu.org https://lists.nongnu.org/mailman/listinfo/chicken-hackers
