summaryrefslogtreecommitdiff
path: root/libguile/unif.c
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-06-05 16:31:38 +0200
committerAndy Wingo <wingo@pobox.com>2009-06-05 16:31:38 +0200
commit782a82eed13abb64393f7acad92758ae191ce509 (patch)
tree517a209c703d8810789dbdf3cfc23a835e21e5b1 /libguile/unif.c
parenta9b0f876c12bbbca9bdf1890eb014a30f004d9f8 (diff)
downloadguile-782a82eed13abb64393f7acad92758ae191ce509.tar.gz
add ability to compile uniform arrays
* module/rnrs/bytevector.scm (rnrs): * libguile/bytevectors.h: * libguile/bytevectors.c (scm_uniform_array_to_bytevector): New function. * libguile/unif.h: * libguile/unif.c (scm_from_contiguous_typed_array): New function. * libguile/vm-i-loader.c (load-array): New instruction, for loading byte data into uniform vectors. Currently it copies out the data, though in the future we could avoid that. * module/language/assembly.scm (align-code): New exported function, aligns code on some boundary. (align-program): Use align-code. * module/language/assembly/compile-bytecode.scm (write-bytecode): Support the load-array instruction. * module/language/glil/compile-assembly.scm (dump-object): Dump uniform arrays. Neat :)
Diffstat (limited to 'libguile/unif.c')
-rw-r--r--libguile/unif.c47
1 files changed, 47 insertions, 0 deletions
diff --git a/libguile/unif.c b/libguile/unif.c
index daf085007..4013f29b8 100644
--- a/libguile/unif.c
+++ b/libguile/unif.c
@@ -770,6 +770,53 @@ SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1,
}
#undef FUNC_NAME
+SCM
+scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes,
+ size_t byte_len)
+#define FUNC_NAME "scm_from_contiguous_typed_array"
+{
+ size_t k, rlen = 1;
+ scm_t_array_dim *s;
+ creator_proc *creator;
+ SCM ra;
+ scm_t_array_handle h;
+ void *base;
+ size_t sz;
+
+ creator = type_to_creator (type);
+ ra = scm_i_shap2ra (bounds);
+ SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
+ s = SCM_I_ARRAY_DIMS (ra);
+ k = SCM_I_ARRAY_NDIM (ra);
+
+ while (k--)
+ {
+ s[k].inc = rlen;
+ SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1);
+ rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc;
+ }
+ SCM_I_ARRAY_V (ra) = creator (scm_from_size_t (rlen), SCM_UNDEFINED);
+
+
+ scm_array_get_handle (ra, &h);
+ base = scm_array_handle_uniform_writable_elements (&h);
+ sz = scm_array_handle_uniform_element_size (&h);
+ scm_array_handle_release (&h);
+
+ if (byte_len % sz)
+ SCM_MISC_ERROR ("byte length not a multiple of the unit size", SCM_EOL);
+ if (byte_len / sz != rlen)
+ SCM_MISC_ERROR ("byte length and dimensions do not match", SCM_EOL);
+
+ memcpy (base, bytes, byte_len);
+
+ if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
+ if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc))
+ return SCM_I_ARRAY_V (ra);
+ return ra;
+}
+#undef FUNC_NAME
+
SCM_DEFINE (scm_make_array, "make-array", 1, 0, 1,
(SCM fill, SCM bounds),
"Create and return an array.")