scsh-ldap/ffi-tools/ffi-tools.c

#include "ffi-tools.h"

/* convert null-terminated array of strings to a list of Scheme strings */
s48_value ffit_enter_string_array(char **array)
{
  int i;
  s48_value res = S48_NULL;
  S48_DECLARE_GC_PROTECT(1);

  S48_GC_PROTECT_1(res);
  for (i = 0; array[i] != NULL; i++)
    res = s48_cons(s48_enter_string(array[i]), res);
  S48_GC_UNPROTECT();
  return res;
}

int length_scheme_list(s48_value list) 
{
  s48_value res;
  S48_DECLARE_GC_PROTECT(2);
  
  S48_GC_PROTECT_2(list, res);
  FFIT_CHECK_LIST(list);
  res = s48_call_scheme(S48_SHARED_BINDING_REF(scheme_list_length_function), 1, list);
  S48_GC_UNPROTECT();
  return s48_extract_integer(res);
}

int call_scheme_boolean_p(s48_value v)
{
  s48_value res;
  S48_DECLARE_GC_PROTECT(2);
  
  S48_GC_PROTECT_2(v, res);
  res = s48_call_scheme(S48_SHARED_BINDING_REF(scheme_boolean_p_function), 1, v);
  S48_GC_UNPROTECT();
  return S48_TRUE_P(res);
}

int call_scheme_integer_p(s48_value v)
{
  s48_value res;
  S48_DECLARE_GC_PROTECT(2);
  
  S48_GC_PROTECT_2(v, res);
  res = s48_call_scheme(S48_SHARED_BINDING_REF(scheme_integer_p_function), 1, v);
  S48_GC_UNPROTECT();
  return S48_TRUE_P(res);
}

/* convert a Scheme list of strings into an null-terminated array of strings */
char** ffit_extract_list_of_strings(s48_value list)
{
  char **a;
  int l, i;
  s48_value res, e;
  S48_DECLARE_GC_PROTECT(3);

  S48_GC_PROTECT_3(list, res, e);
  l = length_scheme_list(list);

  if ((a = (char **) calloc(l + 1, sizeof(char *))) == NULL)
    s48_raise_out_of_memory_error();
  a[l] = NULL;
  
  e = list;
  i = 0;
  while (e != S48_NULL) {
    if (S48_PAIR_P(e)) 
      if (S48_STRING_P(S48_CAR(e))) {
	a[i] = s48_extract_string(S48_CAR(e));
	e = S48_CDR(e);
	i++;
      }
      else {
	free(a);
	s48_raise_argument_type_error(e);
      }
    else {
      free(a);
      s48_raise_argument_type_error(e);
    }
  }
  return a;
}

void ffit_init_hook(void)
{
  S48_GC_PROTECT_GLOBAL(scheme_list_length_function);
  S48_GC_PROTECT_GLOBAL(scheme_integer_p_function);
  S48_GC_PROTECT_GLOBAL(scheme_boolean_p_function);

  scheme_list_length_function = s48_get_imported_binding("length");
  scheme_integer_p_function = s48_get_imported_binding("integer?");
  scheme_boolean_p_function = s48_get_imported_binding("boolean?"); 
}