diff options
author | Andy Wingo <wingo@pobox.com> | 2009-06-05 16:31:38 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-06-05 16:31:38 +0200 |
commit | 782a82eed13abb64393f7acad92758ae191ce509 (patch) | |
tree | 517a209c703d8810789dbdf3cfc23a835e21e5b1 /libguile/unif.c | |
parent | a9b0f876c12bbbca9bdf1890eb014a30f004d9f8 (diff) | |
download | guile-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.c | 47 |
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.") |