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

Added fast mul/div

Browse source
This commit is contained in:
Justin Ethier 2016-10-14 18:07:00 -04:00
parent fa53f1225e
commit 1326d0d5c2
3 changed files with 87 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
include/cyclone/runtime.h
View file

@ -269,6 +269,8 @@ object Cyc_mul(void *data, object cont, int argc, object n, ...);
object Cyc_div(void *data, object cont, int argc, object n, ...);
object Cyc_fast_sum(void *data, object ptr, object x, object y);
object Cyc_fast_sub(void *data, object ptr, object x, object y);
object Cyc_fast_mul(void *data, object ptr, object x, object y);
object Cyc_fast_div(void *data, object ptr, object x, object y);
object Cyc_bit_unset(void *data, object n1, object n2);
object Cyc_bit_set(void *data, object n1, object n2);
object Cyc_num_op_va_list(void *data, int argc,

67
runtime.c
View file

@ -2388,6 +2388,73 @@ object Cyc_fast_sub(void *data, object ptr, object x, object y) {
return NULL;
}
object Cyc_fast_mul(void *data, object ptr, object x, object y) {
// x is int (assume value types for integers)
if (obj_is_int(x)){
if (obj_is_int(y)){
int z = obj_obj2int(x) * obj_obj2int(y);
return obj_int2obj(z);
} else if (is_object_type(y) && type_of(y) == double_tag) {
assign_double(ptr, (double)(obj_obj2int(x)) * double_value(y));
return ptr;
}
}
// x is double
if (is_object_type(x) && type_of(x) == double_tag) {
if (obj_is_int(y)){
assign_double(ptr, (double)(obj_obj2int(y)) * double_value(x));
return ptr;
} else if (is_object_type(y) && type_of(y) == double_tag) {
assign_double(ptr, double_value(x) * double_value(y));
return ptr;
}
}
// still here, raise an error
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;
}
object Cyc_fast_div(void *data, object ptr, object x, object y) {
int z;
// x is int (assume value types for integers)
if (obj_is_int(x)){
if (obj_is_int(y)){
if (obj_obj2int(y) == 0) { goto divbyzero; }
z = obj_obj2int(x) / obj_obj2int(y);
return obj_int2obj(z);
} else if (is_object_type(y) && type_of(y) == double_tag) {
if (double_value(y) == 0.0) { goto divbyzero; }
assign_double(ptr, (double)(obj_obj2int(x)) / double_value(y));
return ptr;
}
}
// x is double
if (is_object_type(x) && type_of(x) == double_tag) {
if (obj_is_int(y)){
if (obj_obj2int(y) == 0.0) { goto divbyzero; }
assign_double(ptr, (double)(obj_obj2int(y)) / double_value(x));
return ptr;
} else if (is_object_type(y) && type_of(y) == double_tag) {
if (double_value(y) == 0.0) { goto divbyzero; }
assign_double(ptr, double_value(x) / double_value(y));
return ptr;
}
}
// still here, raise an error
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);
divbyzero:
Cyc_rt_raise_msg(data, "Divide by zero");
return NULL;
}
object Cyc_div_op(void *data, common_type * x, object y)
{
int tx = type_of(x), ty = (obj_is_int(y) ? -1 : type_of(y));

18
scheme/cyclone/primitives.sld
View file

@ -63,6 +63,8 @@
Cyc-stderr
Cyc-fast-plus
Cyc-fast-sub
Cyc-fast-mul
Cyc-fast-div
+
-
*
@ -189,6 +191,8 @@
(Cyc-stderr 0 0)
(Cyc-fast-plus 2 2)
(Cyc-fast-sub 2 2)
(Cyc-fast-mul 2 2)
(Cyc-fast-div 2 2)
(Cyc-fast-eq 2 2)
(Cyc-fast-gt 2 2)
(Cyc-fast-lt 2 2)
@ -422,6 +426,8 @@
((eq? p 'Cyc-stderr) "Cyc_stderr")
((eq? p 'Cyc-fast-plus) "Cyc_fast_sum")
((eq? p 'Cyc-fast-sub) "Cyc_fast_sub")
((eq? p 'Cyc-fast-mul) "Cyc_fast_mul")
((eq? p 'Cyc-fast-div) "Cyc_fast_div")
((eq? p '+) "Cyc_sum")
((eq? p '-) "Cyc_sub")
((eq? p '*) "Cyc_mul")
@ -550,6 +556,8 @@
(member p '(
Cyc-fast-plus
Cyc-fast-sub
Cyc-fast-mul
Cyc-fast-div
+
-
*
@ -632,6 +640,8 @@
(cond
((eq? p 'Cyc-fast-plus) "common_type")
((eq? p 'Cyc-fast-sub) "common_type")
((eq? p 'Cyc-fast-mul) "common_type")
((eq? p 'Cyc-fast-div) "common_type")
(else #f)))
;; Determine if primitive assigns (allocates) a C variable
@ -645,6 +655,8 @@
((eq? p 'open-output-file) "port_type")
((eq? p 'Cyc-fast-plus) "object")
((eq? p 'Cyc-fast-sub) "object")
((eq? p 'Cyc-fast-mul) "object")
((eq? p 'Cyc-fast-div) "object")
((eq? p '+) "object")
((eq? p '-) "object")
((eq? p '*) "object")
@ -706,6 +718,8 @@
substring
Cyc-fast-plus
Cyc-fast-sub
Cyc-fast-mul
Cyc-fast-div
Cyc-fast-eq
Cyc-fast-gt
Cyc-fast-lt
@ -770,6 +784,10 @@
(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-mul (cdr prim-call)))
((and (equal? (car prim-call) '/) (= (length prim-call) 3))
(cons 'Cyc-fast-div (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))