diff options
Diffstat (limited to 'module/system/vm')
-rw-r--r-- | module/system/vm/debug.scm | 24 | ||||
-rw-r--r-- | module/system/vm/frame.scm | 4 |
2 files changed, 14 insertions, 14 deletions
diff --git a/module/system/vm/debug.scm b/module/system/vm/debug.scm index 814472b7a..4d9a047fe 100644 --- a/module/system/vm/debug.scm +++ b/module/system/vm/debug.scm @@ -468,19 +468,21 @@ section of the ELF image. Returns an ELF symbol, or @code{#f}." (flags (arity-flags* bv header)) (nreq (arity-nreq* bv header)) (nopt (arity-nopt* bv header)) - (nargs (+ nreq nopt (if (has-rest? flags) 1 0)))) + (nargs (+ nreq nopt (if (has-rest? flags) 1 0))) + (nargs+closure (1+ nargs))) (when (is-case-lambda? flags) (error "invalid request for locals of case-lambda wrapper arity")) - (let ((args (arity-locals arity nargs))) - (call-with-values (lambda () (split-at args nreq)) - (lambda (req args) - (call-with-values (lambda () (split-at args nopt)) - (lambda (opt args) - `((required . ,req) - (optional . ,opt) - (keyword . ,(arity-keyword-args arity)) - (allow-other-keys? . ,(allow-other-keys? flags)) - (rest . ,(and (has-rest? flags) (car args))))))))))) + (match (arity-locals arity nargs+closure) + ((closure . args) + (call-with-values (lambda () (split-at args nreq)) + (lambda (req args) + (call-with-values (lambda () (split-at args nopt)) + (lambda (opt args) + `((required . ,req) + (optional . ,opt) + (keyword . ,(arity-keyword-args arity)) + (allow-other-keys? . ,(allow-other-keys? flags)) + (rest . ,(and (has-rest? flags) (car args)))))))))))) (define (find-first-arity context base addr) (let* ((bv (elf-bytes (debug-context-elf context))) diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm index 6e4527956..38850b61e 100644 --- a/module/system/vm/frame.scm +++ b/module/system/vm/frame.scm @@ -277,9 +277,7 @@ (if n (match (vector-ref defs n) (#(name def-offset slot representation) - ;; Binding 0 is the closure, and is not present - ;; in arity-definitions. - (cons (make-binding (1+ n) name slot representation) + (cons (make-binding n name slot representation) (lp (1+ n))))) '())))) (lp (1+ n) (- offset (vector-ref parsed n))))))) |