Пример #1
0
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);
}
Пример #2
0
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));
}
Пример #3
0
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));
}
Пример #4
0
unsigned long 
scm_i_locale_string_hash (const char *str, size_t len)
{
  return scm_i_string_hash (scm_from_locale_stringn (str, len));
}
Пример #5
0
  /* 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;
}