← Back to branch summary

~peter-pearse/ubuntu/natty/guile-1.8/prop001

« back to all changes in this revision

Viewing changes to libguile/conv-integer.i.c

  • Committer: Bazaar Package Importer
  • Author(s): Daniel Schepler
  • Date: 2006-11-09 03:11:16 UTC
  • Revision ID: james.westby@ubuntu.com-20061109031116-hu0q1jxqg12y6yeg
Tags: upstream-1.8.1+1
Import upstream version 1.8.1+1

Show diffs side-by-side

added added

removed removed

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