temporarily disable elisp exception tests
[bpt/guile.git] / libguile / uniform.c
1 /* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010, 2013, 2014 Free Software Foundation, Inc.
2 *
3 * This library is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU Lesser General Public License
5 * as published by the Free Software Foundation; either version 3 of
6 * the License, or (at your option) any later version.
7 *
8 * This library is distributed in the hope that it will be useful, but
9 * WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 * Lesser General Public License for more details.
12 *
13 * You should have received a copy of the GNU Lesser General Public
14 * License along with this library; if not, write to the Free Software
15 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
16 * 02110-1301 USA
17 */
18
19
20 \f
21
22 #ifdef HAVE_CONFIG_H
23 # include <config.h>
24 #endif
25
26 #include "libguile/_scm.h"
27 #include "libguile/__scm.h"
28
29 #include "libguile/uniform.h"
30
31
32 const size_t scm_i_array_element_type_sizes[SCM_ARRAY_ELEMENT_TYPE_LAST + 1] = {
33 0,
34 0,
35 1,
36 8,
37 8, 8,
38 16, 16,
39 32, 32,
40 64, 64,
41 32, 64,
42 64, 128
43 };
44
45 size_t
46 scm_array_handle_uniform_element_size (scm_t_array_handle *h)
47 {
48 size_t ret = scm_i_array_element_type_sizes[h->element_type];
49 if (ret && ret % 8 == 0)
50 return ret / 8;
51 else if (ret)
52 scm_wrong_type_arg_msg (NULL, 0, h->array, "byte-aligned uniform array");
53 else
54 scm_wrong_type_arg_msg (NULL, 0, h->array, "uniform array");
55 }
56
57 size_t
58 scm_array_handle_uniform_element_bit_size (scm_t_array_handle *h)
59 {
60 size_t ret = scm_i_array_element_type_sizes[h->element_type];
61 if (ret)
62 return ret;
63 else
64 scm_wrong_type_arg_msg (NULL, 0, h->array, "uniform array");
65 }
66
67 const void *
68 scm_array_handle_uniform_elements (scm_t_array_handle *h)
69 {
70 return scm_array_handle_uniform_writable_elements (h);
71 }
72
73 void *
74 scm_array_handle_uniform_writable_elements (scm_t_array_handle *h)
75 {
76 size_t esize;
77 scm_t_uint8 *ret;
78
79 esize = scm_array_handle_uniform_element_size (h);
80 ret = ((scm_t_uint8*) h->writable_elements) + h->base * esize;
81 return ret;
82 }
83
84 void
85 scm_init_uniform (void)
86 {
87 #include "libguile/uniform.x"
88 }
89
90 /*
91 Local Variables:
92 c-file-style: "gnu"
93 End:
94 */