summaryrefslogtreecommitdiff
path: root/module/system/vm
diff options
context:
space:
mode:
Diffstat (limited to 'module/system/vm')
-rw-r--r--module/system/vm/debug.scm24
-rw-r--r--module/system/vm/frame.scm4
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)))))))