Beispiel #1
0
SWIGINTERN void
SWIG_Guile_SetModule(swig_module_info *swig_module)
{
  SCM module;
  SCM variable;

  module = SWIG_Guile_Init();
    
  variable = scm_sym2var(scm_from_locale_symbol("swig-type-list-address" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME),
			       scm_module_lookup_closure(module),
			       SCM_BOOL_T);

  SCM_VARIABLE_SET(variable, scm_from_ulong((unsigned long) swig_module));
}
Beispiel #2
0
SWIGINTERN int
ensure_smob_tag(SCM swig_module,
		scm_t_bits *tag_variable,
		const char *smob_name,
		const char *scheme_variable_name)
{
  SCM variable = scm_sym2var(scm_from_locale_symbol(scheme_variable_name),
			     scm_module_lookup_closure(swig_module),
			     SCM_BOOL_T);
  if (SCM_UNBNDP(SCM_VARIABLE_REF(variable))) {
    *tag_variable = scm_make_smob_type((char*)scheme_variable_name, 0);
    SCM_VARIABLE_SET(variable,
		     scm_from_ulong(*tag_variable));
    return 1;
  }
  else {
    *tag_variable = scm_to_ulong(SCM_VARIABLE_REF(variable));
    return 0;
  }
}
Beispiel #3
0
static SCM
guile_sock_local_address (SCM sock, SCM address)
{
    svz_socket_t *xsock;
    uint16_t port;
    SCM pair;

    scm_assert_smob_type (guile_svz_socket_tag, sock);
    xsock = (svz_socket_t *) SCM_SMOB_DATA (sock);
    pair = scm_cons (scm_from_ulong (xsock->local_addr),
                     scm_from_int ((int) xsock->local_port));
    if (!SCM_UNBNDP (address))
    {
        SCM_ASSERT (scm_is_pair (address) && scm_is_integer (SCM_CAR (address))
                    && scm_is_integer (SCM_CDR (address)), address, SCM_ARG2,
                    FUNC_NAME);
        port = scm_to_uint16 (SCM_CDR (address));
        xsock->local_addr = scm_to_ulong (SCM_CAR (address));
        xsock->local_port = (unsigned short) port;
    }
    return pair;
}
Beispiel #4
0
void
scm_i_rehash (SCM table,
	      scm_t_hash_fn hash_fn,
	      void *closure,
	      const char* func_name)
{
  SCM buckets, new_buckets;
  int i;
  unsigned long old_size;
  unsigned long new_size;

  if (SCM_HASHTABLE_N_ITEMS (table) < SCM_HASHTABLE_LOWER (table))
    {
      /* rehashing is not triggered when i <= min_size */
      i = SCM_HASHTABLE (table)->size_index;
      do
	--i;
      while (i > SCM_HASHTABLE (table)->min_size_index
	     && SCM_HASHTABLE_N_ITEMS (table) < hashtable_size[i] / 4);
    }
  else
    {
      i = SCM_HASHTABLE (table)->size_index + 1;
      if (i >= HASHTABLE_SIZE_N)
	/* don't rehash */
	return;
    }
  SCM_HASHTABLE (table)->size_index = i;
  
  new_size = hashtable_size[i];
  if (i <= SCM_HASHTABLE (table)->min_size_index)
    SCM_HASHTABLE (table)->lower = 0;
  else
    SCM_HASHTABLE (table)->lower = new_size / 4;
  SCM_HASHTABLE (table)->upper = 9 * new_size / 10;
  buckets = SCM_HASHTABLE_VECTOR (table);

  new_buckets = scm_c_make_vector (new_size, SCM_EOL);

  SCM_SET_HASHTABLE_VECTOR (table, new_buckets);
  SCM_SET_HASHTABLE_N_ITEMS (table, 0);

  old_size = SCM_SIMPLE_VECTOR_LENGTH (buckets);
  for (i = 0; i < old_size; ++i)
    {
      SCM ls, cell, handle;

      ls = SCM_SIMPLE_VECTOR_REF (buckets, i);
      SCM_SIMPLE_VECTOR_SET (buckets, i, SCM_EOL);

      while (scm_is_pair (ls))
	{
	  unsigned long h;

	  cell = ls;
	  handle = SCM_CAR (cell);
	  ls = SCM_CDR (ls);

	  h = hash_fn (SCM_CAR (handle), new_size, closure);
	  if (h >= new_size)
	    scm_out_of_range (func_name, scm_from_ulong (h));
	  SCM_SETCDR (cell, SCM_SIMPLE_VECTOR_REF (new_buckets, h));
	  SCM_SIMPLE_VECTOR_SET (new_buckets, h, cell);
	  SCM_HASHTABLE_INCREMENT (table);
	}
    }
}
Beispiel #5
0
static SCM
gdbscm_percent_exception_count (void)
{
  return scm_from_ulong (gdbscm_exception_count);
}
Beispiel #6
0
SCM
gucu_mousemask (SCM x)
{
  return scm_from_ulong (mousemask (scm_to_ulong (x), NULL));
}