| … | |
… | |
| 250 | static num num_op (enum num_op op, num a, num b); |
250 | static num num_op (enum num_op op, num a, num b); |
| 251 | static num num_intdiv (num a, num b); |
251 | static num num_intdiv (num a, num b); |
| 252 | static num num_rem (num a, num b); |
252 | static num num_rem (num a, num b); |
| 253 | static num num_mod (num a, num b); |
253 | static num num_mod (num a, num b); |
| 254 | |
254 | |
| 255 | #if USE_MATH |
|
|
| 256 | static double round_per_R5RS (double x); |
|
|
| 257 | #endif |
|
|
| 258 | static int is_zero_rvalue (RVALUE x); |
255 | static int is_zero_rvalue (RVALUE x); |
| 259 | |
256 | |
| 260 | static num num_zero; |
257 | static num num_zero; |
| 261 | static num num_one; |
258 | static num num_one; |
| 262 | |
259 | |
| … | |
… | |
| 872 | } |
869 | } |
| 873 | |
870 | |
| 874 | return ret; |
871 | return ret; |
| 875 | } |
872 | } |
| 876 | |
873 | |
| 877 | #if USE_MATH |
|
|
| 878 | |
|
|
| 879 | /* Round to nearest. Round to even if midway */ |
|
|
| 880 | static double |
|
|
| 881 | round_per_R5RS (double x) |
|
|
| 882 | { |
|
|
| 883 | double fl = floor (x); |
|
|
| 884 | double ce = ceil (x); |
|
|
| 885 | double dfl = x - fl; |
|
|
| 886 | double dce = ce - x; |
|
|
| 887 | |
|
|
| 888 | if (dfl > dce) |
|
|
| 889 | return ce; |
|
|
| 890 | else if (dfl < dce) |
|
|
| 891 | return fl; |
|
|
| 892 | else |
|
|
| 893 | { |
|
|
| 894 | if (fmod (fl, 2) == 0) /* I imagine this holds */ |
|
|
| 895 | return fl; |
|
|
| 896 | else |
|
|
| 897 | return ce; |
|
|
| 898 | } |
|
|
| 899 | } |
|
|
| 900 | #endif |
|
|
| 901 | |
|
|
| 902 | static int |
874 | static int |
| 903 | is_zero_rvalue (RVALUE x) |
875 | is_zero_rvalue (RVALUE x) |
| 904 | { |
876 | { |
| 905 | return x == 0; |
877 | return x == 0; |
| 906 | #if 0 |
878 | #if 0 |
| … | |
… | |
| 4091 | s_return (mk_real (SCHEME_A_ result)); |
4063 | s_return (mk_real (SCHEME_A_ result)); |
| 4092 | else |
4064 | else |
| 4093 | s_return (mk_integer (SCHEME_A_ result)); |
4065 | s_return (mk_integer (SCHEME_A_ result)); |
| 4094 | } |
4066 | } |
| 4095 | |
4067 | |
| 4096 | case OP_FLOOR: s_return (mk_real (SCHEME_A_ floor (rvalue (x)))); |
4068 | case OP_FLOOR: s_return (mk_real (SCHEME_A_ floor (rvalue (x)))); |
| 4097 | case OP_CEILING: s_return (mk_real (SCHEME_A_ ceil (rvalue (x)))); |
4069 | case OP_CEILING: s_return (mk_real (SCHEME_A_ ceil (rvalue (x)))); |
| 4098 | |
|
|
| 4099 | case OP_TRUNCATE: |
|
|
| 4100 | { |
|
|
| 4101 | RVALUE n = rvalue (x); |
|
|
| 4102 | s_return (mk_real (SCHEME_A_ n > 0 ? floor (n) : ceil (n))); |
|
|
| 4103 | } |
|
|
| 4104 | |
|
|
| 4105 | case OP_ROUND: |
|
|
| 4106 | if (is_integer (x)) |
|
|
| 4107 | s_return (x); |
|
|
| 4108 | |
|
|
| 4109 | s_return (mk_real (SCHEME_A_ round_per_R5RS (rvalue (x)))); |
4070 | case OP_TRUNCATE: s_return (mk_real (SCHEME_A_ trunc (rvalue (x)))); |
|
|
4071 | case OP_ROUND: s_return (mk_real (SCHEME_A_ nearbyint (rvalue (x)))); |
| 4110 | #endif |
4072 | #endif |
| 4111 | |
4073 | |
| 4112 | case OP_ADD: /* + */ |
4074 | case OP_ADD: /* + */ |
| 4113 | v = num_zero; |
4075 | v = num_zero; |
| 4114 | |
4076 | |
