diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index e49268805..97472db66 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -4189,30 +4189,23 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, { scm_t_uint8 compare_result; scm_t_uint32 nreq, expected; - scm_t_ptrdiff nargs; + scm_t_ptrdiff nargs, npos; UNPACK_24 (op, nreq); UNPACK_24 (ip[1], expected); nargs = FRAME_LOCALS_COUNT (); - /* We can only have too many positionals if there are more - arguments than NPOS. */ - if (nargs < (scm_t_ptrdiff) nreq) - compare_result = SCM_F_COMPARE_LESS_THAN; - else - { - scm_t_ptrdiff npos = nreq; - for (npos = nreq; npos < nargs && npos <= expected; npos++) - if (scm_is_keyword (FP_REF (npos))) - break; + /* Precondition: at least NREQ arguments. */ + for (npos = nreq; npos < nargs && npos <= expected; npos++) + if (scm_is_keyword (FP_REF (npos))) + break; - if (npos < (scm_t_ptrdiff) expected) - compare_result = SCM_F_COMPARE_LESS_THAN; - else if (npos == (scm_t_ptrdiff) expected) - compare_result = SCM_F_COMPARE_EQUAL; - else - compare_result = SCM_F_COMPARE_NONE; - } + if (npos < (scm_t_ptrdiff) expected) + compare_result = SCM_F_COMPARE_LESS_THAN; + else if (npos == (scm_t_ptrdiff) expected) + compare_result = SCM_F_COMPARE_EQUAL; + else + compare_result = SCM_F_COMPARE_NONE; vp->compare_result = compare_result; diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index c94887288..1f2189159 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -139,16 +139,12 @@ emit-call/cc emit-abort emit-builtin-ref - emit-br-if-nargs-ne - emit-br-if-nargs-lt - emit-br-if-nargs-gt emit-assert-nargs-ee emit-assert-nargs-ge emit-assert-nargs-le emit-alloc-frame emit-reset-frame emit-assert-nargs-ee/locals - emit-br-if-npos-gt emit-bind-kwargs emit-bind-rest emit-box @@ -1273,7 +1269,8 @@ returned instead." (define-macro-assembler (standard-prelude asm nreq nlocals alternate) (cond (alternate - (emit-br-if-nargs-ne asm nreq alternate) + (emit-arguments<=? asm nreq) + (emit-jne asm alternate) (emit-alloc-frame asm nlocals)) ((and (< nreq (ash 1 12)) (< (- nlocals nreq) (ash 1 12))) (emit-assert-nargs-ee/locals asm nreq (- nlocals nreq))) @@ -1283,13 +1280,20 @@ returned instead." (define-macro-assembler (opt-prelude asm nreq nopt rest? nlocals alternate) (if alternate - (emit-br-if-nargs-lt asm nreq alternate) + (begin + (emit-arguments<=? asm nreq) + (emit-jl asm alternate)) (emit-assert-nargs-ge asm nreq)) (cond (rest? (emit-bind-rest asm (+ nreq nopt))) (alternate - (emit-br-if-nargs-gt asm (+ nreq nopt) alternate)) + (emit-arguments<=? asm (+ nreq nopt)) + ;; The arguments<=? instruction sets NONE to indicate greater-than, + ;; whereas for <, NONE usually indicates greater-than-or-equal, + ;; hence the name jge. Perhaps we just need to rename jge to + ;; br-if-none. + (emit-jge asm alternate)) (else (emit-assert-nargs-le asm (+ nreq nopt)))) (emit-alloc-frame asm nlocals)) @@ -1298,9 +1302,11 @@ returned instead." allow-other-keys? nlocals alternate) (if alternate (begin - (emit-br-if-nargs-lt asm nreq alternate) + (emit-arguments<=? asm nreq) + (emit-jl asm alternate) (unless rest? - (emit-br-if-npos-gt asm nreq (+ nreq nopt) alternate))) + (emit-positional-arguments<=? asm nreq (+ nreq nopt)) + (emit-jge asm alternate))) (emit-assert-nargs-ge asm nreq)) (let ((ntotal (fold (lambda (kw ntotal) (match kw