convert.i.c 3.5 KB

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