1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
/* This code in included by numbers.c to generate integer conversion
functions like scm_to_int and scm_from_int. It is only for signed
types, see conv-uinteger.i.c for the unsigned variant.
*/
/* You need to define the following macros before including this
template. They are undefined at the end of this file to give a
clean slate for the next inclusion.
TYPE - the integral type to be converted
TYPE_MIN - the smallest representable number of TYPE
TYPE_MAX - the largest representable number of TYPE
SIZEOF_TYPE - the size of TYPE, equal to "sizeof (TYPE)" but
in a form that can be computed by the preprocessor.
When this number is 0, the preprocessor is not used
to select which code to compile; the most general
code is always used.
SCM_TO_TYPE_PROTO(arg), SCM_FROM_TYPE_PROTO(arg)
- These two macros should expand into the prototype
for the two defined functions, without the return
type.
*/
TYPE
SCM_TO_TYPE_PROTO (SCM val)
{
if (SCM_I_INUMP (val))
{
scm_t_signed_bits n = SCM_I_INUM (val);
#if SIZEOF_TYPE != 0 && SIZEOF_TYPE > SIZEOF_SCM_T_BITS
return n;
#else
if (n >= TYPE_MIN && n <= TYPE_MAX)
return n;
else
{
goto out_of_range;
}
#endif
}
else if (SCM_BIGP (val))
{
if (TYPE_MIN >= SCM_MOST_NEGATIVE_FIXNUM
&& TYPE_MAX <= SCM_MOST_POSITIVE_FIXNUM)
goto out_of_range;
else if (TYPE_MIN >= LONG_MIN && TYPE_MAX <= LONG_MAX)
{
if (mpz_fits_slong_p (SCM_I_BIG_MPZ (val)))
{
long n = mpz_get_si (SCM_I_BIG_MPZ (val));
#if SIZEOF_TYPE != 0 && SIZEOF_TYPE > SCM_SIZEOF_LONG
return n;
#else
if (n >= TYPE_MIN && n <= TYPE_MAX)
return n;
else
goto out_of_range;
#endif
}
else
goto out_of_range;
}
else
{
scm_t_uintmax abs_n;
TYPE n;
size_t count;
if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2)
> CHAR_BIT*sizeof (scm_t_uintmax))
goto out_of_range;
mpz_export (&abs_n, &count, 1, sizeof (scm_t_uintmax), 0, 0,
SCM_I_BIG_MPZ (val));
if (mpz_sgn (SCM_I_BIG_MPZ (val)) >= 0)
{
if (abs_n <= TYPE_MAX)
n = abs_n;
else
goto out_of_range;
}
else
{
/* Carefully avoid signed integer overflow. */
if (TYPE_MIN < 0 && abs_n - 1 <= -(TYPE_MIN + 1))
n = -1 - (TYPE)(abs_n - 1);
else
goto out_of_range;
}
if (n >= TYPE_MIN && n <= TYPE_MAX)
return n;
else
{
out_of_range:
scm_i_range_error (val,
scm_from_signed_integer (TYPE_MIN),
scm_from_signed_integer (TYPE_MAX));
return 0;
}
}
}
else
{
scm_wrong_type_arg_msg (NULL, 0, val, "exact integer");
return 0;
}
}
SCM
SCM_FROM_TYPE_PROTO (TYPE val)
{
#if SIZEOF_TYPE != 0 && SIZEOF_TYPE < SIZEOF_SCM_T_BITS
return SCM_I_MAKINUM (val);
#else
if (SCM_FIXABLE (val))
return SCM_I_MAKINUM (val);
else if (val >= LONG_MIN && val <= LONG_MAX)
return scm_i_long2big (val);
else
{
SCM z = make_bignum ();
mpz_init (SCM_I_BIG_MPZ (z));
if (val < 0)
{
val = -val;
mpz_import (SCM_I_BIG_MPZ (z), 1, 1, sizeof (TYPE), 0, 0,
&val);
mpz_neg (SCM_I_BIG_MPZ (z), SCM_I_BIG_MPZ (z));
}
else
mpz_import (SCM_I_BIG_MPZ (z), 1, 1, sizeof (TYPE), 0, 0,
&val);
return z;
}
#endif
}
/* clean up */
#undef TYPE
#undef TYPE_MIN
#undef TYPE_MAX
#undef SIZEOF_TYPE
#undef SCM_TO_TYPE_PROTO
#undef SCM_FROM_TYPE_PROTO
/*
Local Variables:
c-file-style: "gnu"
End:
*/
|
