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

Emit new instructions in function preludes

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2017-10-30 10:39:37 +01:00
parent 7aff0fff22
commit c92b80be2d
2 changed files with 26 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

29
libguile/vm-engine.c
View file

@ -4189,30 +4189,23 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
{ {
scm_t_uint8 compare_result; scm_t_uint8 compare_result;
scm_t_uint32 nreq, expected; scm_t_uint32 nreq, expected;
scm_t_ptrdiff nargs; scm_t_ptrdiff nargs, npos;
UNPACK_24 (op, nreq); UNPACK_24 (op, nreq);
UNPACK_24 (ip[1], expected); UNPACK_24 (ip[1], expected);
nargs = FRAME_LOCALS_COUNT (); nargs = FRAME_LOCALS_COUNT ();
/* We can only have too many positionals if there are more /* Precondition: at least NREQ arguments. */
arguments than NPOS. */ for (npos = nreq; npos < nargs && npos <= expected; npos++)
if (nargs < (scm_t_ptrdiff) nreq) if (scm_is_keyword (FP_REF (npos)))
compare_result = SCM_F_COMPARE_LESS_THAN; break;
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) if (npos < (scm_t_ptrdiff) expected)
compare_result = SCM_F_COMPARE_LESS_THAN; compare_result = SCM_F_COMPARE_LESS_THAN;
else if (npos == (scm_t_ptrdiff) expected) else if (npos == (scm_t_ptrdiff) expected)
compare_result = SCM_F_COMPARE_EQUAL; compare_result = SCM_F_COMPARE_EQUAL;
else else
compare_result = SCM_F_COMPARE_NONE; compare_result = SCM_F_COMPARE_NONE;
}
vp->compare_result = compare_result; vp->compare_result = compare_result;

24
module/system/vm/assembler.scm
View file

@ -139,16 +139,12 @@
emit-call/cc emit-call/cc
emit-abort emit-abort
emit-builtin-ref 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-ee
emit-assert-nargs-ge emit-assert-nargs-ge
emit-assert-nargs-le emit-assert-nargs-le
emit-alloc-frame emit-alloc-frame
emit-reset-frame emit-reset-frame
emit-assert-nargs-ee/locals emit-assert-nargs-ee/locals
emit-br-if-npos-gt
emit-bind-kwargs emit-bind-kwargs
emit-bind-rest emit-bind-rest
emit-box emit-box
@ -1273,7 +1269,8 @@ returned instead."
(define-macro-assembler (standard-prelude asm nreq nlocals alternate) (define-macro-assembler (standard-prelude asm nreq nlocals alternate)
(cond (cond
(alternate (alternate
(emit-br-if-nargs-ne asm nreq alternate) (emit-arguments<=? asm nreq)
(emit-jne asm alternate)
(emit-alloc-frame asm nlocals)) (emit-alloc-frame asm nlocals))
((and (< nreq (ash 1 12)) (< (- nlocals nreq) (ash 1 12))) ((and (< nreq (ash 1 12)) (< (- nlocals nreq) (ash 1 12)))
(emit-assert-nargs-ee/locals asm nreq (- nlocals nreq))) (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) (define-macro-assembler (opt-prelude asm nreq nopt rest? nlocals alternate)
(if 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)) (emit-assert-nargs-ge asm nreq))
(cond (cond
(rest? (rest?
(emit-bind-rest asm (+ nreq nopt))) (emit-bind-rest asm (+ nreq nopt)))
(alternate (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 (else
(emit-assert-nargs-le asm (+ nreq nopt)))) (emit-assert-nargs-le asm (+ nreq nopt))))
(emit-alloc-frame asm nlocals)) (emit-alloc-frame asm nlocals))
@ -1298,9 +1302,11 @@ returned instead."
allow-other-keys? nlocals alternate) allow-other-keys? nlocals alternate)
(if alternate (if alternate
(begin (begin
(emit-br-if-nargs-lt asm nreq alternate) (emit-arguments<=? asm nreq)
(emit-jl asm alternate)
(unless rest? (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)) (emit-assert-nargs-ge asm nreq))
(let ((ntotal (fold (lambda (kw ntotal) (let ((ntotal (fold (lambda (kw ntotal)
(match kw (match kw