libguile/convert.i.c

   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 */