| … | |
… | |
| 4011 | Error_1 ("inexact->exact: not integral:", x); |
4011 | Error_1 ("inexact->exact: not integral:", x); |
| 4012 | } |
4012 | } |
| 4013 | |
4013 | |
| 4014 | s_return (x); |
4014 | s_return (x); |
| 4015 | |
4015 | |
|
|
4016 | case OP_FLOOR: s_return (mk_real (SCHEME_A_ floor (rvalue (x)))); |
|
|
4017 | case OP_CEILING: s_return (mk_real (SCHEME_A_ ceil (rvalue (x)))); |
|
|
4018 | case OP_TRUNCATE: s_return (mk_real (SCHEME_A_ trunc (rvalue (x)))); |
|
|
4019 | case OP_ROUND: s_return (mk_real (SCHEME_A_ nearbyint (rvalue (x)))); |
|
|
4020 | |
|
|
4021 | case OP_SQRT: s_return (mk_real (SCHEME_A_ sqrt (rvalue (x)))); |
| 4016 | case OP_EXP: s_return (mk_real (SCHEME_A_ exp (rvalue (x)))); |
4022 | case OP_EXP: s_return (mk_real (SCHEME_A_ exp (rvalue (x)))); |
| 4017 | case OP_LOG: s_return (mk_real (SCHEME_A_ log (rvalue (x)) |
4023 | case OP_LOG: s_return (mk_real (SCHEME_A_ log (rvalue (x)) |
| 4018 | / (cadr (args) == NIL ? 1 : log (rvalue (cadr (args)))))); |
4024 | / (cadr (args) == NIL ? 1 : log (rvalue (cadr (args)))))); |
| 4019 | case OP_SIN: s_return (mk_real (SCHEME_A_ sin (rvalue (x)))); |
4025 | case OP_SIN: s_return (mk_real (SCHEME_A_ sin (rvalue (x)))); |
| 4020 | case OP_COS: s_return (mk_real (SCHEME_A_ cos (rvalue (x)))); |
4026 | case OP_COS: s_return (mk_real (SCHEME_A_ cos (rvalue (x)))); |
| … | |
… | |
| 4026 | s_return (mk_real (SCHEME_A_ |
4032 | s_return (mk_real (SCHEME_A_ |
| 4027 | cdr (args) == NIL |
4033 | cdr (args) == NIL |
| 4028 | ? atan (rvalue (x)) |
4034 | ? atan (rvalue (x)) |
| 4029 | : atan2 (rvalue (x), rvalue (cadr (args))))); |
4035 | : atan2 (rvalue (x), rvalue (cadr (args))))); |
| 4030 | |
4036 | |
| 4031 | case OP_SQRT: |
|
|
| 4032 | s_return (mk_real (SCHEME_A_ sqrt (rvalue (x)))); |
|
|
| 4033 | |
|
|
| 4034 | case OP_EXPT: |
4037 | case OP_EXPT: |
| 4035 | { |
4038 | { |
| 4036 | RVALUE result; |
4039 | RVALUE result; |
| 4037 | int real_result = 1; |
4040 | int real_result = 1; |
| 4038 | pointer y = cadr (args); |
4041 | pointer y = cadr (args); |
| … | |
… | |
| 4060 | if (real_result) |
4063 | if (real_result) |
| 4061 | s_return (mk_real (SCHEME_A_ result)); |
4064 | s_return (mk_real (SCHEME_A_ result)); |
| 4062 | else |
4065 | else |
| 4063 | s_return (mk_integer (SCHEME_A_ result)); |
4066 | s_return (mk_integer (SCHEME_A_ result)); |
| 4064 | } |
4067 | } |
| 4065 | |
|
|
| 4066 | case OP_FLOOR: s_return (mk_real (SCHEME_A_ floor (rvalue (x)))); |
|
|
| 4067 | case OP_CEILING: s_return (mk_real (SCHEME_A_ ceil (rvalue (x)))); |
|
|
| 4068 | case OP_TRUNCATE: s_return (mk_real (SCHEME_A_ trunc (rvalue (x)))); |
|
|
| 4069 | case OP_ROUND: s_return (mk_real (SCHEME_A_ nearbyint (rvalue (x)))); |
|
|
| 4070 | #endif |
4068 | #endif |
| 4071 | |
4069 | |
| 4072 | case OP_ADD: /* + */ |
4070 | case OP_ADD: /* + */ |
| 4073 | v = num_zero; |
4071 | v = num_zero; |
| 4074 | |
4072 | |
