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

« back to all changes in this revision

Viewing changes to libguile/convert.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:
 
1
/* this file is #include'd (x times) by convert.c */
 
2
 
 
3
/* You need to define the following macros before including this
 
4
   template.  They are undefined at the end of this file to give a
 
5
   clean slate for the next inclusion.
 
6
 
 
7
   - CTYPE
 
8
 
 
9
   The type of an element of the C array, for example 'char'.
 
10
 
 
11
   - FROM_CTYPE
 
12
 
 
13
   The function that converts a CTYPE to a SCM, for example
 
14
   scm_from_char.
 
15
 
 
16
   - UVEC_TAG
 
17
 
 
18
   The tag of a suitable uniform vector that can hold the CTYPE, for
 
19
   example 's8'.
 
20
 
 
21
   - UVEC_CTYPE
 
22
 
 
23
   The C type of an element of the uniform vector, for example
 
24
   scm_t_int8.
 
25
 
 
26
   - SCM2CTYPES
 
27
 
 
28
   The name of the 'SCM-to-C' function, for example scm_c_scm2chars.
 
29
 
 
30
   - CTYPES2SCM
 
31
 
 
32
   The name of the 'C-to-SCM' function, for example, scm_c_chars2scm.
 
33
 
 
34
   - CTYPES2UVECT
 
35
 
 
36
   The name of the 'C-to-uniform-vector' function, for example
 
37
   scm_c_chars2byvect.  It will create a uniform vector of kind
 
38
   UVEC_TAG.
 
39
 
 
40
   - CTYPES2UVECT_2
 
41
 
 
42
   The name of a second 'C-to-uniform-vector' function.  Leave
 
43
   undefined if you want only one such function.
 
44
 
 
45
   - CTYPE_2
 
46
   - UVEC_TAG_2
 
47
   - UVEC_CTYPE_2
 
48
 
 
49
   The tag and C type of the second kind of uniform vector, for use
 
50
   with the function described above.
 
51
 
 
52
*/
 
53
 
 
54
/* The first level does not expand macros in the arguments. */
 
55
#define paste(a1,a2,a3)   a1##a2##a3
 
56
#define stringify(a)      #a
 
57
 
 
58
/* But the second level does. */
 
59
#define F(pre,T,suf)   paste(pre,T,suf)
 
60
#define S(T)           stringify(T)
 
61
 
 
62
/* Convert a vector, list or uniform vector into a C array.  If the
 
63
   result array in argument 2 is NULL, malloc() a new one.
 
64
*/
 
65
 
 
66
CTYPE *
 
67
SCM2CTYPES (SCM obj, CTYPE *data)
 
68
{
 
69
  scm_t_array_handle handle;
 
70
  size_t i, len;
 
71
  ssize_t inc;
 
72
  const UVEC_CTYPE *uvec_elements;
 
73
 
 
74
  obj = F(scm_any_to_,UVEC_TAG,vector) (obj);
 
75
  uvec_elements = F(scm_,UVEC_TAG,vector_elements) (obj, &handle, &len, &inc);
 
76
 
 
77
  if (data == NULL)
 
78
    data = scm_malloc (len * sizeof (CTYPE));
 
79
  for (i = 0; i < len; i++, uvec_elements += inc)
 
80
    data[i] = uvec_elements[i];
 
81
 
 
82
  scm_array_handle_release (&handle);
 
83
 
 
84
  return data;
 
85
}
 
86
 
 
87
/* Converts a C array into a vector. */
 
88
 
 
89
SCM
 
90
CTYPES2SCM (const CTYPE *data, long n)
 
91
{
 
92
  long i;
 
93
  SCM v;
 
94
  
 
95
  v = scm_c_make_vector (n, SCM_UNSPECIFIED);
 
96
 
 
97
  for (i = 0; i < n; i++)
 
98
    SCM_SIMPLE_VECTOR_SET (v, i, FROM_CTYPE (data[i]));
 
99
 
 
100
  return v;
 
101
}
 
102
 
 
103
/* Converts a C array into a uniform vector. */
 
104
 
 
105
SCM
 
106
CTYPES2UVECT (const CTYPE *data, long n)
 
107
{
 
108
  scm_t_array_handle handle;
 
109
  long i;
 
110
  SCM uvec;
 
111
  UVEC_CTYPE *uvec_elements;
 
112
  
 
113
  uvec = F(scm_make_,UVEC_TAG,vector) (scm_from_long (n), SCM_UNDEFINED);
 
114
  uvec_elements = F(scm_,UVEC_TAG,vector_writable_elements) (uvec, &handle,
 
115
                                                             NULL, NULL);
 
116
  for (i = 0; i < n; i++)
 
117
    uvec_elements[i] = data[i];
 
118
 
 
119
  scm_array_handle_release (&handle);
 
120
 
 
121
  return uvec;
 
122
}
 
123
 
 
124
#ifdef CTYPE2UVECT_2
 
125
 
 
126
SCM
 
127
CTYPES2UVECT_2 (const CTYPE_2 *data, long n)
 
128
{
 
129
  scm_t_array_handle handle;
 
130
  long i;
 
131
  SCM uvec;
 
132
  UVEC_CTYPE_2 *uvec_elements;
 
133
  
 
134
  uvec = F(scm_make_,UVEC_TAG_2,vector) (scm_from_long (n), SCM_UNDEFINED);
 
135
  uvec_elements = F(scm_,UVEC_TAG_2,vector_writable_elements) (uvec, &handle,
 
136
                                                               NULL, NULL);
 
137
 
 
138
  for (i = 0; i < n; i++)
 
139
    uvec_elements[i] = data[i];
 
140
 
 
141
  scm_array_handle_release (&handle);
 
142
 
 
143
  return uvec;
 
144
}
 
145
 
 
146
#endif
 
147
 
 
148
#undef paste
 
149
#undef stringify
 
150
#undef F
 
151
#undef S
 
152
 
 
153
#undef CTYPE
 
154
#undef FROM_CTYPE
 
155
#undef UVEC_TAG
 
156
#undef UVEC_CTYPE
 
157
#undef SCM2CTYPES
 
158
#undef CTYPES2SCM
 
159
#undef CTYPES2UVECT
 
160
#ifdef CTYPES2UVECT_2
 
161
#undef CTYPES2UVECT_2
 
162
#undef CTYPE_2
 
163
#undef UVEC_TAG_2
 
164
#undef UVEC_CTYPE_2
 
165
#endif
 
166
 
 
167
/*
 
168
  Local Variables:
 
169
  c-file-style: "gnu"
 
170
  End:
 
171
*/