Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-12 23:37:38 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Add fast numeric comparisons

Browse source
This commit is contained in:
Justin Ethier 2016-10-15 02:37:13 -04:00
parent bdd3edfe4f
commit fa53f1225e
4 changed files with 91 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
include/cyclone/runtime.h
View file

@ -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);

56
runtime.c
View file

@ -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)
{

1
scheme/cyclone/cgen.sld
View file

@ -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
""
"&")

40
scheme/cyclone/primitives.sld
View file

@ -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)))
))