From fa53f1225eea09619d284bee4b3e5f6b6a1acdb4 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Sat, 15 Oct 2016 02:37:13 -0400 Subject: [PATCH] Add fast numeric comparisons --- include/cyclone/runtime.h | 5 ++++ runtime.c | 56 ++++++++++++++++++++++++++++------- scheme/cyclone/cgen.sld | 1 + scheme/cyclone/primitives.sld | 40 +++++++++++++++++++++++++ 4 files changed, 91 insertions(+), 11 deletions(-) diff --git a/include/cyclone/runtime.h b/include/cyclone/runtime.h index 2bbf3195..92a8604b 100644 --- a/include/cyclone/runtime.h +++ b/include/cyclone/runtime.h @@ -166,6 +166,11 @@ int Cyc_num_gt_op(void *, object x, object y); int Cyc_num_lt_op(void *, object x, object y); int Cyc_num_gte_op(void *, object x, object y); int Cyc_num_lte_op(void *, object x, object y); +object Cyc_num_fast_eq_op(void *data, object x, object y); +object Cyc_num_fast_gt_op(void *data, object x, object y); +object Cyc_num_fast_lt_op(void *data, object x, object y); +object Cyc_num_fast_gte_op(void *data, object x, object y); +object Cyc_num_fast_lte_op(void *data, object x, object y); object Cyc_num_cmp_va_list(void *data, int argc, int (fn_op(void *, object, object)), object n, va_list ns); diff --git a/runtime.c b/runtime.c index fc2b5ddf..0ba53578 100644 --- a/runtime.c +++ b/runtime.c @@ -1098,7 +1098,7 @@ object Cyc_num_cmp_va_list(void *data, int argc, return boolean_t; } -#define declare_num_cmp(FUNC, FUNC_OP, FUNC_APPLY, OP) \ +#define declare_num_cmp(FUNC, FUNC_OP, FUNC_FAST_OP, FUNC_APPLY, OP) \ int FUNC_OP(void *data, object x, object y) { \ int result = 0, \ tx = (obj_is_int(x) ? -1 : type_of(x)), \ @@ -1144,18 +1144,52 @@ void FUNC_APPLY(void *data, int argc, object clo, object cont, object n, ...) { result = Cyc_num_cmp_va_list(data, argc - 1, FUNC_OP, n, ap); \ va_end(ap); \ return_closcall1(data, cont, result); \ +} \ +object FUNC_FAST_OP(void *data, object x, object y) { \ + int tx = (obj_is_int(x) ? -1 : type_of(x)), \ + ty = (obj_is_int(y) ? -1 : type_of(y)); \ + if (tx == -1 && ty == -1) { \ + return ((obj_obj2int(x)) OP (obj_obj2int(y))) \ + ? boolean_t : boolean_f; \ + } else if (tx == -1 && ty == integer_tag) { \ + return ((obj_obj2int(x)) OP (integer_value(y))) \ + ? boolean_t : boolean_f; \ + } else if (tx == -1 && ty == double_tag) { \ + return ((obj_obj2int(x)) OP (double_value(y))) \ + ? boolean_t : boolean_f; \ + } else if (tx == integer_tag && ty == -1) { \ + return ((integer_value(x)) OP (obj_obj2int(y))) \ + ? boolean_t : boolean_f; \ + } else if (tx == integer_tag && ty == integer_tag) { \ + return ((integer_value(x)) OP (integer_value(y))) \ + ? boolean_t : boolean_f; \ + } else if (tx == integer_tag && ty == double_tag) { \ + return ((integer_value(x)) OP (double_value(y))) \ + ? boolean_t : boolean_f; \ + } else if (tx == double_tag && ty == -1) { \ + return ((double_value(x)) OP (obj_obj2int(y))) \ + ? boolean_t : boolean_f; \ + } else if (tx == double_tag && ty == integer_tag) { \ + return ((double_value(x)) OP (integer_value(y))) \ + ? boolean_t : boolean_f; \ + } else if (tx == double_tag && ty == double_tag) { \ + return ((double_value(x)) OP (double_value(y))) \ + ? boolean_t : boolean_f; \ + } else { \ + make_string(s, "Bad argument type"); \ + make_pair(c2, y, NULL); \ + make_pair(c1, x, &c2); \ + make_pair(c0, &s, &c1); \ + Cyc_rt_raise(data, &c0); \ + } \ + return NULL; \ } -declare_num_cmp(Cyc_num_eq, Cyc_num_eq_op, dispatch_num_eq, ==); -declare_num_cmp(Cyc_num_gt, Cyc_num_gt_op, dispatch_num_gt, >); -declare_num_cmp(Cyc_num_lt, Cyc_num_lt_op, dispatch_num_lt, <); -declare_num_cmp(Cyc_num_gte, Cyc_num_gte_op, dispatch_num_gte, >=); -declare_num_cmp(Cyc_num_lte, Cyc_num_lte_op, dispatch_num_lte, <=); - -//TODO: -//object Cyc_fast_num_eq(void *data, object cont, int argc, object x, object y) { -// return NULL; -//} +declare_num_cmp(Cyc_num_eq, Cyc_num_eq_op, Cyc_num_fast_eq_op, dispatch_num_eq, ==); +declare_num_cmp(Cyc_num_gt, Cyc_num_gt_op, Cyc_num_fast_gt_op, dispatch_num_gt, >); +declare_num_cmp(Cyc_num_lt, Cyc_num_lt_op, Cyc_num_fast_lt_op, dispatch_num_lt, <); +declare_num_cmp(Cyc_num_gte, Cyc_num_gte_op, Cyc_num_fast_gte_op, dispatch_num_gte, >=); +declare_num_cmp(Cyc_num_lte, Cyc_num_lte_op, Cyc_num_fast_lte_op, dispatch_num_lte, <=); object Cyc_is_boolean(object o) { diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 1125d4e1..557f07e2 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -554,6 +554,7 @@ (c-code/vars (string-append (if (or (prim:cont? p) + (equal? (prim/c-var-assign p) "object") (prim/c-var-pointer p)) ;; Assume returns object "" "&") diff --git a/scheme/cyclone/primitives.sld b/scheme/cyclone/primitives.sld index 2728a5f7..742dff3a 100644 --- a/scheme/cyclone/primitives.sld +++ b/scheme/cyclone/primitives.sld @@ -67,6 +67,11 @@ - * / + Cyc-fast-eq + Cyc-fast-gt + Cyc-fast-lt + Cyc-fast-gte + Cyc-fast-lte = > < @@ -184,6 +189,11 @@ (Cyc-stderr 0 0) (Cyc-fast-plus 2 2) (Cyc-fast-sub 2 2) + (Cyc-fast-eq 2 2) + (Cyc-fast-gt 2 2) + (Cyc-fast-lt 2 2) + (Cyc-fast-gte 2 2) + (Cyc-fast-lte 2 2) (- 1 #f) (/ 1 #f) (= 2 #f) @@ -416,6 +426,11 @@ ((eq? p '-) "Cyc_sub") ((eq? p '*) "Cyc_mul") ((eq? p '/) "Cyc_div") + ((eq? p 'Cyc-fast-eq) "Cyc_num_fast_eq_op") + ((eq? p 'Cyc-fast-gt) "Cyc_num_fast_gt_op") + ((eq? p 'Cyc-fast-lt) "Cyc_num_fast_lt_op") + ((eq? p 'Cyc-fast-gte) "Cyc_num_fast_gte_op") + ((eq? p 'Cyc-fast-lte) "Cyc_num_fast_lte_op") ((eq? p '=) "Cyc_num_eq") ((eq? p '>) "Cyc_num_gt") ((eq? p '<) "Cyc_num_lt") @@ -539,6 +554,11 @@ - * / + Cyc-fast-eq + Cyc-fast-gt + Cyc-fast-lt + Cyc-fast-gte + Cyc-fast-lte = > < @@ -629,6 +649,11 @@ ((eq? p '-) "object") ((eq? p '*) "object") ((eq? p '/) "object") + ((eq? p 'Cyc-fast-eq) "object") + ((eq? p 'Cyc-fast-gt) "object") + ((eq? p 'Cyc-fast-lt) "object") + ((eq? p 'Cyc-fast-gte) "object") + ((eq? p 'Cyc-fast-lte) "object") ((eq? p '=) "object") ((eq? p '>) "object") ((eq? p '<) "object") @@ -681,6 +706,11 @@ substring Cyc-fast-plus Cyc-fast-sub + Cyc-fast-eq + Cyc-fast-gt + Cyc-fast-lt + Cyc-fast-gte + Cyc-fast-lte + - * / apply = > < >= <= command-line-arguments @@ -740,6 +770,16 @@ (cons 'Cyc-fast-plus (cdr prim-call))) ((and (equal? (car prim-call) '-) (= (length prim-call) 3)) (cons 'Cyc-fast-sub (cdr prim-call))) + ((and (equal? (car prim-call) '=) (= (length prim-call) 3)) + (cons 'Cyc-fast-eq (cdr prim-call))) + ((and (equal? (car prim-call) '>) (= (length prim-call) 3)) + (cons 'Cyc-fast-gt (cdr prim-call))) + ((and (equal? (car prim-call) '<) (= (length prim-call) 3)) + (cons 'Cyc-fast-lt (cdr prim-call))) + ((and (equal? (car prim-call) '>=) (= (length prim-call) 3)) + (cons 'Cyc-fast-gte (cdr prim-call))) + ((and (equal? (car prim-call) '<=) (= (length prim-call) 3)) + (cons 'Cyc-fast-lte (cdr prim-call))) (else prim-call))) ))