2007-01-21 19:20:37 -05:00
|
|
|
|
2007-10-17 09:22:47 -04:00
|
|
|
#include "ikarus-data.h"
|
2007-01-21 19:20:37 -05:00
|
|
|
#include <stdlib.h>
|
|
|
|
#include <string.h>
|
|
|
|
#include <errno.h>
|
|
|
|
#include <math.h>
|
|
|
|
|
2007-06-18 07:06:13 -04:00
|
|
|
ikp
|
|
|
|
ikrt_fl_round(ikp x, ikp y){
|
|
|
|
flonum_data(y) = round(flonum_data(x));
|
|
|
|
return y;
|
|
|
|
}
|
|
|
|
|
2007-09-10 23:36:36 -04:00
|
|
|
ikp
|
|
|
|
ikrt_fl_exp(ikp x, ikp y){
|
|
|
|
flonum_data(y) = exp(flonum_data(x));
|
|
|
|
return y;
|
|
|
|
}
|
|
|
|
|
2007-09-12 03:56:08 -04:00
|
|
|
ikp
|
|
|
|
ikrt_flfl_expt(ikp a, ikp b, ikp z){
|
|
|
|
flonum_data(z) = exp(flonum_data(b) * log(flonum_data(a)));
|
|
|
|
return z;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2007-09-10 23:36:36 -04:00
|
|
|
|
|
|
|
|
|
|
|
|
2007-01-21 19:20:37 -05:00
|
|
|
ikp
|
2007-05-18 22:01:04 -04:00
|
|
|
ikrt_bytevector_to_flonum(ikp x, ikpcb* pcb){
|
|
|
|
double v = strtod((char*)x+off_bytevector_data, NULL);
|
2007-01-21 19:20:37 -05:00
|
|
|
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
|
|
|
ref(r, -vector_tag) = (ikp)flonum_tag;
|
|
|
|
flonum_data(r) = v;
|
|
|
|
return r;
|
|
|
|
}
|
|
|
|
|
2007-05-18 22:01:04 -04:00
|
|
|
|
2007-01-21 19:20:37 -05:00
|
|
|
ikp
|
|
|
|
ikrt_fl_plus(ikp x, ikp y,ikpcb* pcb){
|
|
|
|
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
|
|
|
ref(r, -vector_tag) = (ikp)flonum_tag;
|
|
|
|
flonum_data(r) = flonum_data(x) + flonum_data(y);
|
|
|
|
return r;
|
|
|
|
}
|
|
|
|
|
|
|
|
ikp
|
|
|
|
ikrt_fl_minus(ikp x, ikp y,ikpcb* pcb){
|
|
|
|
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
|
|
|
ref(r, -vector_tag) = (ikp)flonum_tag;
|
|
|
|
flonum_data(r) = flonum_data(x) - flonum_data(y);
|
|
|
|
return r;
|
|
|
|
}
|
|
|
|
|
|
|
|
ikp
|
|
|
|
ikrt_fl_times(ikp x, ikp y,ikpcb* pcb){
|
|
|
|
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
|
|
|
ref(r, -vector_tag) = (ikp)flonum_tag;
|
|
|
|
flonum_data(r) = flonum_data(x) * flonum_data(y);
|
|
|
|
return r;
|
|
|
|
}
|
|
|
|
|
|
|
|
ikp
|
|
|
|
ikrt_fl_div(ikp x, ikp y,ikpcb* pcb){
|
|
|
|
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
|
|
|
ref(r, -vector_tag) = (ikp)flonum_tag;
|
|
|
|
flonum_data(r) = flonum_data(x) / flonum_data(y);
|
|
|
|
return r;
|
|
|
|
}
|
|
|
|
|
|
|
|
ikp
|
|
|
|
ikrt_fl_invert(ikp x, ikpcb* pcb){
|
|
|
|
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
|
|
|
ref(r, -vector_tag) = (ikp)flonum_tag;
|
|
|
|
flonum_data(r) = 1.0 / flonum_data(x);
|
|
|
|
return r;
|
|
|
|
}
|
|
|
|
|
|
|
|
ikp
|
|
|
|
ikrt_fl_sin(ikp x, ikpcb* pcb){
|
|
|
|
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
|
|
|
ref(r, -vector_tag) = (ikp)flonum_tag;
|
|
|
|
flonum_data(r) = sin(flonum_data(x));
|
|
|
|
return r;
|
|
|
|
}
|
|
|
|
|
2007-03-09 14:01:17 -05:00
|
|
|
ikp
|
|
|
|
ikrt_fl_cos(ikp x, ikpcb* pcb){
|
|
|
|
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
|
|
|
ref(r, -vector_tag) = (ikp)flonum_tag;
|
|
|
|
flonum_data(r) = cos(flonum_data(x));
|
|
|
|
return r;
|
|
|
|
}
|
|
|
|
|
2007-09-02 20:53:28 -04:00
|
|
|
ikp
|
|
|
|
ikrt_fl_tan(ikp x, ikpcb* pcb){
|
|
|
|
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
|
|
|
ref(r, -vector_tag) = (ikp)flonum_tag;
|
|
|
|
flonum_data(r) = tan(flonum_data(x));
|
|
|
|
return r;
|
|
|
|
}
|
2007-03-09 14:01:17 -05:00
|
|
|
|
|
|
|
ikp
|
2007-09-02 20:53:28 -04:00
|
|
|
ikrt_fl_asin(ikp x, ikpcb* pcb){
|
2007-03-09 14:01:17 -05:00
|
|
|
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
|
|
|
ref(r, -vector_tag) = (ikp)flonum_tag;
|
2007-09-02 20:53:28 -04:00
|
|
|
flonum_data(r) = asin(flonum_data(x));
|
2007-03-09 14:01:17 -05:00
|
|
|
return r;
|
|
|
|
}
|
|
|
|
|
2007-06-08 20:08:36 -04:00
|
|
|
ikp
|
2007-09-02 20:53:28 -04:00
|
|
|
ikrt_fl_acos(ikp x, ikpcb* pcb){
|
2007-06-08 20:08:36 -04:00
|
|
|
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
|
|
|
ref(r, -vector_tag) = (ikp)flonum_tag;
|
2007-09-02 20:53:28 -04:00
|
|
|
flonum_data(r) = acos(flonum_data(x));
|
|
|
|
return r;
|
|
|
|
}
|
|
|
|
|
|
|
|
ikp
|
|
|
|
ikrt_fl_atan(ikp x, ikpcb* pcb){
|
|
|
|
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
|
|
|
ref(r, -vector_tag) = (ikp)flonum_tag;
|
|
|
|
flonum_data(r) = atan(flonum_data(x));
|
2007-06-08 20:08:36 -04:00
|
|
|
return r;
|
|
|
|
}
|
|
|
|
|
2007-03-09 14:01:17 -05:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
ikp
|
2007-09-02 20:53:28 -04:00
|
|
|
ikrt_fl_sqrt(ikp x, ikpcb* pcb){
|
2007-03-09 14:01:17 -05:00
|
|
|
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
|
|
|
ref(r, -vector_tag) = (ikp)flonum_tag;
|
2007-09-02 20:53:28 -04:00
|
|
|
flonum_data(r) = sqrt(flonum_data(x));
|
2007-03-09 14:01:17 -05:00
|
|
|
return r;
|
|
|
|
}
|
|
|
|
|
2007-09-02 20:53:28 -04:00
|
|
|
ikp
|
|
|
|
ikrt_fl_log(ikp x, ikpcb* pcb){
|
|
|
|
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
|
|
|
ref(r, -vector_tag) = (ikp)flonum_tag;
|
|
|
|
flonum_data(r) = log(flonum_data(x));
|
|
|
|
return r;
|
|
|
|
}
|
2007-03-09 14:01:17 -05:00
|
|
|
|
|
|
|
|
2007-01-21 19:20:37 -05:00
|
|
|
ikp
|
|
|
|
ikrt_fx_sin(ikp x, ikpcb* pcb){
|
|
|
|
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
|
|
|
ref(r, -vector_tag) = (ikp)flonum_tag;
|
|
|
|
flonum_data(r) = sin(unfix(x));
|
|
|
|
return r;
|
|
|
|
}
|
|
|
|
|
2007-03-09 14:01:17 -05:00
|
|
|
ikp
|
|
|
|
ikrt_fx_cos(ikp x, ikpcb* pcb){
|
|
|
|
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
|
|
|
ref(r, -vector_tag) = (ikp)flonum_tag;
|
|
|
|
flonum_data(r) = cos(unfix(x));
|
|
|
|
return r;
|
|
|
|
}
|
|
|
|
|
|
|
|
ikp
|
2007-09-02 20:53:28 -04:00
|
|
|
ikrt_fx_tan(ikp x, ikpcb* pcb){
|
2007-03-09 14:01:17 -05:00
|
|
|
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
|
|
|
ref(r, -vector_tag) = (ikp)flonum_tag;
|
2007-09-02 20:53:28 -04:00
|
|
|
flonum_data(r) = tan(unfix(x));
|
|
|
|
return r;
|
|
|
|
}
|
|
|
|
|
|
|
|
ikp
|
|
|
|
ikrt_fx_asin(ikp x, ikpcb* pcb){
|
|
|
|
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
|
|
|
ref(r, -vector_tag) = (ikp)flonum_tag;
|
|
|
|
flonum_data(r) = asin(unfix(x));
|
|
|
|
return r;
|
|
|
|
}
|
|
|
|
|
|
|
|
ikp
|
|
|
|
ikrt_fx_acos(ikp x, ikpcb* pcb){
|
|
|
|
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
|
|
|
ref(r, -vector_tag) = (ikp)flonum_tag;
|
|
|
|
flonum_data(r) = acos(unfix(x));
|
2007-03-09 14:01:17 -05:00
|
|
|
return r;
|
|
|
|
}
|
|
|
|
|
|
|
|
ikp
|
|
|
|
ikrt_fx_atan(ikp x, ikpcb* pcb){
|
|
|
|
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
|
|
|
ref(r, -vector_tag) = (ikp)flonum_tag;
|
|
|
|
flonum_data(r) = atan(unfix(x));
|
|
|
|
return r;
|
|
|
|
}
|
|
|
|
|
2007-09-02 20:53:28 -04:00
|
|
|
ikp
|
|
|
|
ikrt_fx_sqrt(ikp x, ikpcb* pcb){
|
|
|
|
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
|
|
|
ref(r, -vector_tag) = (ikp)flonum_tag;
|
|
|
|
flonum_data(r) = sqrt(unfix(x));
|
|
|
|
return r;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2007-06-08 20:08:36 -04:00
|
|
|
ikp
|
|
|
|
ikrt_fx_log(ikp x, ikpcb* pcb){
|
|
|
|
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
|
|
|
ref(r, -vector_tag) = (ikp)flonum_tag;
|
|
|
|
flonum_data(r) = log(unfix(x));
|
|
|
|
return r;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2007-01-21 19:20:37 -05:00
|
|
|
ikp
|
|
|
|
ikrt_fixnum_to_flonum(ikp x, ikpcb* pcb){
|
|
|
|
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
|
|
|
ref(r, -vector_tag) = (ikp)flonum_tag;
|
|
|
|
flonum_data(r) = unfix(x);
|
|
|
|
return r;
|
|
|
|
}
|
|
|
|
|
|
|
|
ikp
|
|
|
|
ikrt_fl_equal(ikp x, ikp y){
|
|
|
|
if(flonum_data(x) == flonum_data(y)){
|
|
|
|
return true_object;
|
|
|
|
} else {
|
|
|
|
return false_object;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
ikp
|
|
|
|
ikrt_fl_less_or_equal(ikp x, ikp y){
|
|
|
|
if(flonum_data(x) <= flonum_data(y)){
|
|
|
|
return true_object;
|
|
|
|
} else {
|
|
|
|
return false_object;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
ikp
|
|
|
|
ikrt_fl_less(ikp x, ikp y){
|
|
|
|
if(flonum_data(x) < flonum_data(y)){
|
|
|
|
return true_object;
|
|
|
|
} else {
|
|
|
|
return false_object;
|
|
|
|
}
|
|
|
|
}
|