1 /* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2011 Free Software Foundation, Inc.
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.
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.
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
26 #include "libguile/_scm.h"
27 #include "libguile/__scm.h"
29 #include "libguile/array-handle.h"
32 SCM scm_i_array_element_types
[SCM_ARRAY_ELEMENT_TYPE_LAST
+ 1];
35 #define ARRAY_IMPLS_N_STATIC_ALLOC 7
36 static scm_t_array_implementation array_impls
[ARRAY_IMPLS_N_STATIC_ALLOC
];
37 static int num_array_impls_registered
= 0;
41 scm_i_register_array_implementation (scm_t_array_implementation
*impl
)
43 if (num_array_impls_registered
>= ARRAY_IMPLS_N_STATIC_ALLOC
)
44 /* need to increase ARRAY_IMPLS_N_STATIC_ALLOC, buster */
47 array_impls
[num_array_impls_registered
++] = *impl
;
50 scm_t_array_implementation
*
51 scm_i_array_implementation_for_obj (SCM obj
)
54 for (i
= 0; i
< num_array_impls_registered
; i
++)
56 && (SCM_CELL_TYPE (obj
) & array_impls
[i
].mask
) == array_impls
[i
].tag
)
57 return &array_impls
[i
];
62 scm_array_get_handle (SCM array
, scm_t_array_handle
*h
)
64 scm_t_array_implementation
*impl
= scm_i_array_implementation_for_obj (array
);
66 scm_wrong_type_arg_msg (NULL
, 0, array
, "array");
72 h
->element_type
= SCM_ARRAY_ELEMENT_TYPE_SCM
; /* have to default to
75 h
->writable_elements
= NULL
;
76 h
->impl
->get_handle (array
, h
);
80 scm_array_handle_pos (scm_t_array_handle
*h
, SCM indices
)
82 scm_t_array_dim
*s
= scm_array_handle_dims (h
);
84 size_t k
= scm_array_handle_rank (h
);
86 while (k
> 0 && scm_is_pair (indices
))
88 i
= scm_to_signed_integer (SCM_CAR (indices
), s
->lbnd
, s
->ubnd
);
89 pos
+= (i
- s
->lbnd
) * s
->inc
;
92 indices
= SCM_CDR (indices
);
94 if (k
> 0 || !scm_is_null (indices
))
95 scm_misc_error (NULL
, "wrong number of indices, expecting ~a",
96 scm_list_1 (scm_from_size_t (scm_array_handle_rank (h
))));
101 scm_array_handle_element_type (scm_t_array_handle
*h
)
103 if (h
->element_type
< 0 || h
->element_type
> SCM_ARRAY_ELEMENT_TYPE_LAST
)
104 abort (); /* guile programming error */
105 return scm_i_array_element_types
[h
->element_type
];
109 scm_array_handle_release (scm_t_array_handle
*h
)
111 /* Nothing to do here until arrays need to be reserved for real.
116 scm_array_handle_elements (scm_t_array_handle
*h
)
118 if (h
->element_type
!= SCM_ARRAY_ELEMENT_TYPE_SCM
)
119 scm_wrong_type_arg_msg (NULL
, 0, h
->array
, "non-uniform array");
120 return ((const SCM
*)h
->elements
) + h
->base
;
124 scm_array_handle_writable_elements (scm_t_array_handle
*h
)
126 if (h
->element_type
!= SCM_ARRAY_ELEMENT_TYPE_SCM
)
127 scm_wrong_type_arg_msg (NULL
, 0, h
->array
, "non-uniform array");
128 return ((SCM
*)h
->elements
) + h
->base
;
132 scm_init_array_handle (void)
134 #define DEFINE_ARRAY_TYPE(tag, TAG) \
135 scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_##TAG] = scm_from_utf8_symbol (#tag)
137 scm_i_array_element_types
[SCM_ARRAY_ELEMENT_TYPE_SCM
] = SCM_BOOL_T
;
138 DEFINE_ARRAY_TYPE (a
, CHAR
);
139 DEFINE_ARRAY_TYPE (b
, BIT
);
140 DEFINE_ARRAY_TYPE (vu8
, VU8
);
141 DEFINE_ARRAY_TYPE (u8
, U8
);
142 DEFINE_ARRAY_TYPE (s8
, S8
);
143 DEFINE_ARRAY_TYPE (u16
, U16
);
144 DEFINE_ARRAY_TYPE (s16
, S16
);
145 DEFINE_ARRAY_TYPE (u32
, U32
);
146 DEFINE_ARRAY_TYPE (s32
, S32
);
147 DEFINE_ARRAY_TYPE (u64
, U64
);
148 DEFINE_ARRAY_TYPE (s64
, S64
);
149 DEFINE_ARRAY_TYPE (f32
, F32
);
150 DEFINE_ARRAY_TYPE (f64
, F64
);
151 DEFINE_ARRAY_TYPE (c32
, C32
);
152 DEFINE_ARRAY_TYPE (c64
, C64
);
154 #include "libguile/array-handle.x"