static SCM
scm_from_byte_string (const char *buf, size_t len)
{
SCM str = scm_from_locale_stringn (buf, len);
return string_to_object (str);
}
static void
sf_write (SCM port, const void *data, size_t size)
{
SCM p = SCM_PACK (SCM_STREAM (port));
/* DATA is assumed to be a locale-encoded C string, which makes it
hard to reliably pass binary data to a soft port. It can be
achieved by choosing a Latin-1 locale, though, but the recommended
approach is to use an R6RS "custom binary output port" instead. */
scm_call_1 (SCM_SIMPLE_VECTOR_REF (p, 1),
scm_from_locale_stringn ((char *) data, size));
}
SCM tf_from_tensor(SCM scm_self)
{
struct tf_tensor_t *self = get_tf_tensor(scm_self);
int type = TF_TensorType(self->tensor);
int num_dims = TF_NumDims(self->tensor);
int count = 1;
SCM scm_shape = SCM_EOL;
for (int i=num_dims - 1; i>=0; i--) {
scm_shape = scm_cons(scm_from_int(TF_Dim(self->tensor, i)), scm_shape);
count = count * TF_Dim(self->tensor, i);
};
size_t size = TF_TensorByteSize(self->tensor);
void *data;
if (type == TF_STRING) {
int64_t *offsets = TF_TensorData(self->tensor);
void *pointer = offsets + count;
size_t str_len;
data = scm_gc_malloc(sizeof(SCM) * count, "from-tensor");
SCM *result = data;
for (int i=0; i<count; i++) {
const char *str;
size_t len;
TF_StringDecode(pointer + *offsets, size - *offsets, &str, &len, status());
if (TF_GetCode(_status) != TF_OK)
scm_misc_error("from-tensor", TF_Message(_status), SCM_EOL);
*result++ = scm_from_locale_stringn(str, len);
offsets++;
};
} else {
data = scm_gc_malloc_pointerless(size, "from-tensor");
memcpy(data, TF_TensorData(self->tensor), size);
};
return scm_list_3(scm_from_int(type),
scm_shape,
scm_from_pointer(data, NULL));
}
unsigned long
scm_i_locale_string_hash (const char *str, size_t len)
{
return scm_i_string_hash (scm_from_locale_stringn (str, len));
}
/* This scandir is a shrink version of the glibc version.
* I believe we don't need versionsort or any other sort in the ragnarok.
*/
SCM scm_mmr_scandir(SCM dir, SCM filter)
#define FUNC_NAME "scandir"
{
struct dirent_or_dirent64 **rdent;
int has_filter = 0;
int n = 0 ,i = 0;
char *tmp_ptr = NULL;
SCM flag;
SCM ret = SCM_EOL;
SCM *prev;
SCM str;
SCM_VALIDATE_STRING(1, dir);
if(!SCM_UNBNDP(filter))
{
SCM_ASSERT(scm_is_true(scm_procedure_p(filter)),
filter ,SCM_ARG2 ,FUNC_NAME);
has_filter = 1;
}
scm_dynwind_begin(0);
errno = 0;
tmp_ptr = scm_to_locale_string(dir);
scm_dynwind_free(tmp_ptr);
n = scandir_or_scandir64(tmp_ptr,
&rdent, NULL,
alphasort_or_alphasort64);
if(has_filter)
{
for(prev = &ret;i<n;i++)
{
str = rdent[i]?
scm_from_locale_stringn(rdent[i]->d_name ,NAMLEN(rdent[i]))
:
SCM_EOF_VAL;
flag = scm_call_1(filter ,str);
free(rdent[i]);
if(scm_is_true(flag))
{
*prev = scm_cons(str ,SCM_EOL);
prev = SCM_CDRLOC(*prev);
}
}
}
else
{
for(prev = &ret;i<n;i++)
{
str = rdent[i]?
scm_from_locale_stringn(rdent[i]->d_name ,NAMLEN(rdent[i]))
:
SCM_EOF_VAL;
*prev = scm_cons(str ,SCM_EOL);
prev = SCM_CDRLOC(*prev);
free(rdent[i]);
}
}
if(errno != 0)
SCM_SYSERROR;
scm_dynwind_end();
free(rdent);
return ret;
}
