mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-31 01:10:24 +02:00
Code Activity

frame-call-representation avoids frame-procedure.

Browse source 
* module/system/vm/frame.scm (frame-call-representation): Never use
  frame-procedure, as we don't know that slot 0 is a SCM value and even
  if it were, we don't know that it corresponds to the procedure being
  applied, except in the case of primcalls.  Print _ as the procedure
  name if we don't know it, instead of #f.
This commit is contained in:
Andy Wingo 2015-11-27 12:25:26 +01:00
parent 39090e677e
commit 029af6f68a
1 changed files with 3 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

7
module/system/vm/frame.scm
View file

@ -364,8 +364,7 @@
(define* (frame-call-representation frame #:key top-frame?) (define* (frame-call-representation frame #:key top-frame?)
(let* ((ip (frame-instruction-pointer frame)) (let* ((ip (frame-instruction-pointer frame))
(info (find-program-debug-info ip)) (info (find-program-debug-info ip))
(nlocals (frame-num-locals frame)) (nlocals (frame-num-locals frame)))
(closure (frame-procedure frame)))
(define (find-slot i bindings) (define (find-slot i bindings)
(match bindings (match bindings
(() #f) (() #f)
@ -410,7 +409,7 @@
(else (else
'()))) '())))
(cons (cons
(frame-procedure-name frame #:info info) (or (frame-procedure-name frame #:info info) '_)
(cond (cond
((find-program-arity ip) ((find-program-arity ip)
=> (lambda (arity) => (lambda (arity)
@ -423,7 +422,7 @@
(arity-has-rest? arity) (arity-has-rest? arity)
1)))) 1))))
((and (primitive-code? ip) ((and (primitive-code? ip)
(program-arguments-alist closure ip)) (program-arguments-alist (frame-local-ref frame 0 'scm) ip))
=> (lambda (args) => (lambda (args)
(match args (match args
((('required . req) ((('required . req)