207
210
INTERFACE static pointer set_vector_elem(pointer vec, int ielem, pointer a);
208
211
INTERFACE INLINE int is_number(pointer p) { return (type(p)==T_NUMBER); }
209
212
INTERFACE INLINE int is_integer(pointer p) {
210
return ((p)->_object._number.is_fixnum);
213
return is_number(p) && ((p)->_object._number.is_fixnum);
212
216
INTERFACE INLINE int is_real(pointer p) {
213
return (!(p)->_object._number.is_fixnum);
217
return is_number(p) && (!(p)->_object._number.is_fixnum);
216
220
INTERFACE INLINE int is_character(pointer p) { return (type(p)==T_CHARACTER); }
217
221
INTERFACE INLINE int string_length(pointer p) { return strlength(p); }
218
222
INTERFACE INLINE char *string_value(pointer p) { return strvalue(p); }
219
223
INLINE num nvalue(pointer p) { return ((p)->_object._number); }
220
INTERFACE long ivalue(pointer p) { return (is_integer(p)?(p)->_object._number.value.ivalue:(long)(p)->_object._number.value.rvalue); }
221
INTERFACE double rvalue(pointer p) { return (!is_integer(p)?(p)->_object._number.value.rvalue:(double)(p)->_object._number.value.ivalue); }
224
INTERFACE long ivalue(pointer p) { return (num_is_integer(p)?(p)->_object._number.value.ivalue:(long)(p)->_object._number.value.rvalue); }
225
INTERFACE double rvalue(pointer p) { return (!num_is_integer(p)?(p)->_object._number.value.rvalue:(double)(p)->_object._number.value.ivalue); }
222
226
#define ivalue_unchecked(p) ((p)->_object._number.value.ivalue)
223
227
#define rvalue_unchecked(p) ((p)->_object._number.value.rvalue)
224
#define set_integer(p) (p)->_object._number.is_fixnum=1;
225
#define set_real(p) (p)->_object._number.is_fixnum=0;
228
#define set_num_integer(p) (p)->_object._number.is_fixnum=1;
229
#define set_num_real(p) (p)->_object._number.is_fixnum=0;
226
230
INTERFACE gunichar charvalue(pointer p) { return (gunichar)ivalue_unchecked(p); }
228
232
INTERFACE INLINE int is_port(pointer p) { return (type(p)==T_PORT); }
719
723
static pointer get_consecutive_cells(scheme *sc, int n) {
726
if(sc->no_memory) { return sc->sink; }
726
728
/* Are there any cells available? */
727
729
x=find_consecutive_cells(sc,n);
729
/* If not, try gc'ing some */
730
gc(sc, sc->NIL, sc->NIL);
731
x=find_consecutive_cells(sc,n);
733
/* If there still aren't, try getting more heap */
734
if (!alloc_cellseg(sc,1)) {
739
x=find_consecutive_cells(sc,n);
741
/* If all fail, report failure */
730
if (x != sc->NIL) { return x; }
732
/* If not, try gc'ing some */
733
gc(sc, sc->NIL, sc->NIL);
734
x=find_consecutive_cells(sc,n);
735
if (x != sc->NIL) { return x; }
737
/* If there still aren't, try getting more heap */
738
if (!alloc_cellseg(sc,1))
744
x=find_consecutive_cells(sc,n);
745
if (x != sc->NIL) { return x; }
747
/* If all fail, report failure */
749
752
static int count_consecutive_cells(pointer x, int needed) {
1959
1962
strcpy(p, "#<PORT>");
1960
1963
} else if (is_number(l)) {
1961
1964
p = sc->strbuff;
1965
if(num_is_integer(l)) {
1963
1966
sprintf(p, "%ld", ivalue_unchecked(l));
1965
1968
g_ascii_formatd (p, sizeof (sc->strbuff), "%.10g",
3041
3044
case OP_INEX2EX: /* inexact->exact */
3042
3045
x=car(sc->args);
3046
if(num_is_integer(x)) {
3044
3047
s_return(sc,x);
3045
3048
} else if(modf(rvalue_unchecked(x),&dd)==0.0) {
3046
3049
s_return(sc,mk_integer(sc,ivalue(x)));
4218
4221
typedef int (*test_predicate)(pointer);
4219
4222
static int is_any(pointer p) { return 1;}
4220
static int is_num_integer(pointer p) {
4221
return is_number(p) && ((p)->_object._number.is_fixnum);
4223
4224
static int is_nonneg(pointer p) {
4224
return is_num_integer(p) && ivalue(p)>=0;
4225
return is_integer(p) && ivalue(p)>=0;
4227
4228
/* Correspond carefully with following defines! */
4242
4243
{is_character, "character"},
4243
4244
{is_vector, "vector"},
4244
4245
{is_number, "number"},
4245
{is_num_integer, "integer"},
4246
{is_nonneg, "non-negative integer"},
4246
{is_integer, "integer"},
4247
{is_nonneg, "non-negative integer"}
4249
4250
#define TST_NONE 0