[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 04/08: Emit new instructions in function preludes
From: |
Andy Wingo |
Subject: |
[Guile-commits] 04/08: Emit new instructions in function preludes |
Date: |
Mon, 30 Oct 2017 07:35:34 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit c92b80be2d60f9189ac4f7ee53b9386d34921dd4
Author: Andy Wingo <address@hidden>
Date: Mon Oct 30 10:39:37 2017 +0100
Emit new instructions in function preludes
* module/system/vm/assembler.scm (standard-prelude, opt-prelude):
(kw-prelude): Emit new instructions in function preludes. Now all
branches are via the new instructions. Remove exports for old
branches.
---
libguile/vm-engine.c | 27 ++++++++++-----------------
module/system/vm/assembler.scm | 24 +++++++++++++++---------
2 files changed, 25 insertions(+), 26 deletions(-)
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index e492688..97472db 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)
+ /* 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
- {
- scm_t_ptrdiff npos = nreq;
- 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;
- }
+ 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 c948872..1f21891 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
- [Guile-commits] branch master updated (d1c69b5 -> 4267a8b), Andy Wingo, 2017/10/30
- [Guile-commits] 03/08: Fix argument type of arguments<=? instruction, Andy Wingo, 2017/10/30
- [Guile-commits] 02/08: Remove assembler exports for old-style predicates and branches, Andy Wingo, 2017/10/30
- [Guile-commits] 07/08: RTL test uses new instructions, Andy Wingo, 2017/10/30
- [Guile-commits] 04/08: Emit new instructions in function preludes,
Andy Wingo <=
- [Guile-commits] 06/08: Simplify special immediate predicate inferrer., Andy Wingo, 2017/10/30
- [Guile-commits] 01/08: Lower logtest branches to instead be 'zero? logand', Andy Wingo, 2017/10/30
- [Guile-commits] 05/08: Remove disassembler support for old-style jump instructions, Andy Wingo, 2017/10/30
- [Guile-commits] 08/08: Remove old branching instructions from VM, Andy Wingo, 2017/10/30