mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-22 20:40:29 +02:00
Code Activity

GDB support: Fix 'display-vm-frames'.

Browse source 
Previously 'vm-frame-older' would fail to traverse the chain of frames.

* libguile/libguile-2.2-gdb.scm (uint-type): New variable
(vm-frame): Fix "saved ip" and "saved fp" computation.  The latter had
been broken roughly since commit
72353de77d.
(vm-frame-older): Return #f when IP is zero, not when FP is zero.
(vm-frame-function-name): Wrap 'vm-frame-program-debug-info' in
'false-if-exception'
This commit is contained in:
Ludovic Courtès 2018-06-24 23:22:52 +02:00 • committed by Andy Wingo
parent 5f75df03c6
commit 6e57d0d56e
1 changed files with 13 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

19
libguile/libguile-2.2-gdb.scm
View file

@ -170,6 +170,7 @@ if the information is not available."
(define ip-type (type-pointer (lookup-type "scm_t_uint32"))) (define ip-type (type-pointer (lookup-type "scm_t_uint32")))
(define fp-type (type-pointer (lookup-type "SCM"))) (define fp-type (type-pointer (lookup-type "SCM")))
(define sp-type (type-pointer (lookup-type "SCM"))) (define sp-type (type-pointer (lookup-type "SCM")))
(define uint-type (type-pointer (lookup-type "scm_t_uintptr")))
(define-record-type <vm-frame> (define-record-type <vm-frame>
(make-vm-frame ip sp fp saved-ip saved-fp) (make-vm-frame ip sp fp saved-ip saved-fp)
@ -186,10 +187,16 @@ if the information is not available."
(make-vm-frame ip (make-vm-frame ip
sp sp
fp fp
(value-dereference (value-cast (value-sub fp 1)
(type-pointer ip-type))) ;; fp[0] is the return address.
(value-dereference (value-cast (value-sub fp 2) (value-dereference (value-cast fp (type-pointer ip-type)))
(type-pointer fp-type)))))
;; fp[1] is the offset to the previous frame pointer.
(value-add fp
(value->integer
(value-dereference
(value-cast (value-add fp 1)
(type-pointer uint-type)))))))
(define (vm-engine-frame? frame) (define (vm-engine-frame? frame)
(let ((sym (frame-function frame))) (let ((sym (frame-function frame)))
@ -217,7 +224,7 @@ if the information is not available."
(let ((ip (vm-frame-saved-ip frame)) (let ((ip (vm-frame-saved-ip frame))
(sp (value-sub (vm-frame-fp frame) 3)) (sp (value-sub (vm-frame-fp frame) 3))
(fp (vm-frame-saved-fp frame))) (fp (vm-frame-saved-fp frame)))
(and (not (zero? (value->integer fp))) (and (not (zero? (value->integer ip)))
(vm-frame ip sp fp backend)))) (vm-frame ip sp fp backend))))
(define (vm-frames) (define (vm-frames)
@ -279,7 +286,7 @@ if the information is not available."
(define (default-name) (define (default-name)
"[unknown]") "[unknown]")
(cond (cond
((vm-frame-program-debug-info frame) ((false-if-exception (vm-frame-program-debug-info frame))
=> (lambda (pdi) => (lambda (pdi)
(or (and=> (program-debug-info-name pdi) symbol->string) (or (and=> (program-debug-info-name pdi) symbol->string)
"[anonymous]"))) "[anonymous]")))