9 extern cl_class cl_class_bignum;
10 extern cl_class cl_class_ratio;
11 extern cl_class cl_class_ffloat;
12 extern cl_class cl_class_dfloat;
13 extern cl_class cl_class_lfloat;
16 inline cl_boolean rationalp (const cl_R& x)
19 if (x.nonpointer_tag() == cl_FN_tag)
22 if (x.pointer_type()->flags & cl_class_flags_subclass_rational)
27 inline cl_boolean integerp (const cl_R& x)
30 if (x.nonpointer_tag() == cl_FN_tag)
33 if (x.pointer_type() == &cl_class_bignum)
38 inline cl_boolean floatp (const cl_R& x)
41 switch (x.nonpointer_tag()) {
43 #if defined(CL_WIDE_POINTERS)
49 if (x.pointer_type()->flags & cl_class_flags_subclass_float)
55 // Comparison with a fixnum.
56 inline cl_boolean eq (const cl_R& x, sint32 y)
58 return (cl_boolean)(x.word == cl_combine(cl_FN_tag,y));
61 inline cl_boolean exact_zerop (const cl_R& x)
67 // Macro: verteilt je nach Real-Typ eines Floats x auf 2 Statements,
68 // die x vom jeweiligen Real-Typ benutzen dürfen.
69 // realcase2(x, RA_statement,F_statement);
70 // x sollte eine Variable sein.
71 #define realcase2(x, RA_statement,F_statement) \
73 { var cl_RA& __tmp = *(cl_RA*)&x; var cl_RA& x = __tmp; RA_statement } \
75 { var cl_F& __tmp = *(cl_F*)&x; var cl_F& x = __tmp; F_statement }
77 // Macro: verteilt je nach Real-Typ eines Floats x auf 7 Statements.
78 // realtypecase(x, FN_statement,BN_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement);
79 // x sollte eine Variable sein.
80 #ifdef CL_WIDE_POINTERS
81 #define realtypecase(x, FN_statement,BN_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement) \
82 if (!(x).pointer_p()) \
83 switch ((x).nonpointer_tag()) \
84 { case cl_FN_tag: { FN_statement } break; \
85 case cl_SF_tag: { SF_statement } break; \
86 case cl_FF_tag: { FF_statement } break; \
90 if ((x).pointer_type() == &cl_class_bignum) { BN_statement } \
91 else if ((x).pointer_type() == &cl_class_ratio) { RT_statement } \
92 else if ((x).pointer_type() == &cl_class_dfloat) { DF_statement } \
93 else if ((x).pointer_type() == &cl_class_lfloat) { LF_statement } \
97 #define realtypecase(x, FN_statement,BN_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement) \
98 if (!(x).pointer_p()) \
99 switch ((x).nonpointer_tag()) \
100 { case cl_FN_tag: { FN_statement } break; \
101 case cl_SF_tag: { SF_statement } break; \
102 default: NOTREACHED \
105 if ((x).pointer_type() == &cl_class_bignum) { BN_statement } \
106 else if ((x).pointer_type() == &cl_class_ratio) { RT_statement } \
107 else if ((x).pointer_type() == &cl_class_ffloat) { FF_statement } \
108 else if ((x).pointer_type() == &cl_class_dfloat) { DF_statement } \
109 else if ((x).pointer_type() == &cl_class_lfloat) { LF_statement } \
114 // Macro: verteilt je nach Real-Typ eines Floats x auf 7 Statements,
115 // die x vom jeweiligen Real-Typ benutzen dürfen.
116 // realcase7(x, FN_statement,BN_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement);
117 // x sollte eine Variable sein.
118 #define realcase7(x, FN_statement,BN_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement) \
120 , var cl_FN& __tmp = *(cl_FN*)&x; var cl_FN& x = __tmp; FN_statement \
121 , var cl_BN& __tmp = *(cl_BN*)&x; var cl_BN& x = __tmp; BN_statement \
122 , var cl_RT& __tmp = *(cl_RT*)&x; var cl_RT& x = __tmp; RT_statement \
123 , var cl_SF& __tmp = *(cl_SF*)&x; var cl_SF& x = __tmp; SF_statement \
124 , var cl_FF& __tmp = *(cl_FF*)&x; var cl_FF& x = __tmp; FF_statement \
125 , var cl_DF& __tmp = *(cl_DF*)&x; var cl_DF& x = __tmp; DF_statement \
126 , var cl_LF& __tmp = *(cl_LF*)&x; var cl_LF& x = __tmp; LF_statement \
129 // Macro: verteilt je nach Real-Typ eines Floats x auf 6 Statements,
130 // die x vom jeweiligen Real-Typ benutzen dürfen.
131 // realcase6(x, I_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement);
132 // x sollte eine Variable sein.
133 #define realcase6(x, I_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement) \
134 realcase7(x, I_statement,I_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement)
136 // contagion(x,y) liefert eine reelle Zahl, die so ungenau ist wie die
137 // ungenauere der beiden reellen Zahlen x und y.
138 extern const cl_R contagion (const cl_R& x, const cl_R& y);
139 // ?? Lieber ein uintL (0, SF_mant_len+1, FF_mant_len+1, DF_mant_len+1, intDsize*len liefern, weniger Kopieraufwand!
141 // GEN_R_OP1_2(arg1,R_OP,ergebnis_zuweisung)
142 // generates the body of a real operation with one argument.
143 // Distinguish two cases (rational/float) only.
144 #define GEN_R_OP1_2(arg1,R_OP,ergebnis_zuweisung) \
147 , ergebnis_zuweisung R_OP(arg1); \
148 , ergebnis_zuweisung R_OP(arg1); \
152 // GEN_R_OP1_7(arg1,R_OP,ergebnis_zuweisung)
153 // generates the body of a real operation with one argument.
154 // Full type dispatch, faster than GEN_R_OP1_2.
155 #define GEN_R_OP1_7(arg1,R_OP,ergebnis_zuweisung) \
158 , ergebnis_zuweisung R_OP(arg1); \
159 , ergebnis_zuweisung R_OP(arg1); \
160 , ergebnis_zuweisung R_OP(arg1); \
161 , ergebnis_zuweisung R_OP(arg1); \
162 , ergebnis_zuweisung R_OP(arg1); \
163 , ergebnis_zuweisung R_OP(arg1); \
164 , ergebnis_zuweisung R_OP(arg1); \
168 // GEN_R_OP2_2(arg1,arg2,R_OP,ergebnis_zuweisung)
169 // generates the body of a real operation with two arguments.
170 // Distinguish two cases (rational/float) only.
171 #define GEN_R_OP2_2(arg1,arg2,R_OP,ergebnis_zuweisung) \
175 , /* beides rationale Zahlen */ \
176 ergebnis_zuweisung R_OP(arg1,arg2); \
177 , /* arg1 rational, arg2 Float -> arg1 in Float umwandeln */ \
178 ergebnis_zuweisung R_OP(cl_float(arg1,arg2),arg2); \
181 , /* arg1 Float, arg2 rational -> arg2 in Float umwandeln */ \
182 ergebnis_zuweisung R_OP(arg1,cl_float(arg2,arg1)); \
183 , /* beides Floats */ \
184 ergebnis_zuweisung R_OP(arg1,arg2); \
189 // cl_somefloat(x,y) wandelt eine reelle Zahl x in ein Float-Format um
190 // (das von y, falls x rational ist) und rundet dabei nötigenfalls.
191 // > x: eine reelle Zahl
193 // < ergebnis: x als Float
194 inline const cl_F cl_somefloat (const cl_R& x, const cl_F& y)
197 DeclareType(cl_RA,x);
198 return cl_float(x,y);