SWIGINTERN swig_module_info *
SWIG_Guile_GetModule(void)
{
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);
if (SCM_UNBNDP(SCM_VARIABLE_REF(variable))) {
return NULL;
} else {
return (swig_module_info *) scm_to_ulong(SCM_VARIABLE_REF(variable));
}
}
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;
}
}
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;
}
scm_puts_unlocked (">", port);
}
SCM
scm_c_make_hash_table (unsigned long k)
{
return make_hash_table (k, "scm_c_make_hash_table");
}
SCM_DEFINE (scm_make_hash_table, "make-hash-table", 0, 1, 0,
(SCM n),
"Make a new abstract hash table object with minimum number of buckets @var{n}\n")
#define FUNC_NAME s_scm_make_hash_table
{
return make_hash_table (SCM_UNBNDP (n) ? 0 : scm_to_ulong (n), FUNC_NAME);
}
#undef FUNC_NAME
#define SCM_WEAK_TABLE_P(x) (scm_is_true (scm_weak_table_p (x)))
SCM_DEFINE (scm_hash_table_p, "hash-table?", 1, 0, 0,
(SCM obj),
"Return @code{#t} if @var{obj} is an abstract hash table object.")
#define FUNC_NAME s_scm_hash_table_p
{
return scm_from_bool (SCM_HASHTABLE_P (obj) || SCM_WEAK_TABLE_P (obj));
}
#undef FUNC_NAME
static SCM
extract_arg (char format_char, SCM arg, void *argp,
const char *func_name, int position)
{
switch (format_char)
{
case 's':
{
char **arg_ptr = (char **) argp;
CHECK_TYPE (gdbscm_is_true (scm_string_p (arg)), arg, position,
func_name, _("string"));
*arg_ptr = gdbscm_scm_to_c_string (arg);
break;
}
case 't':
{
int *arg_ptr = (int *) argp;
/* While in Scheme, anything non-#f is "true", we're strict. */
CHECK_TYPE (gdbscm_is_bool (arg), arg, position, func_name,
_("boolean"));
*arg_ptr = gdbscm_is_true (arg);
break;
}
case 'i':
{
int *arg_ptr = (int *) argp;
CHECK_TYPE (scm_is_signed_integer (arg, INT_MIN, INT_MAX),
arg, position, func_name, _("int"));
*arg_ptr = scm_to_int (arg);
break;
}
case 'u':
{
int *arg_ptr = (int *) argp;
CHECK_TYPE (scm_is_unsigned_integer (arg, 0, UINT_MAX),
arg, position, func_name, _("unsigned int"));
*arg_ptr = scm_to_uint (arg);
break;
}
case 'l':
{
long *arg_ptr = (long *) argp;
CHECK_TYPE (scm_is_signed_integer (arg, LONG_MIN, LONG_MAX),
arg, position, func_name, _("long"));
*arg_ptr = scm_to_long (arg);
break;
}
case 'n':
{
unsigned long *arg_ptr = (unsigned long *) argp;
CHECK_TYPE (scm_is_unsigned_integer (arg, 0, ULONG_MAX),
arg, position, func_name, _("unsigned long"));
*arg_ptr = scm_to_ulong (arg);
break;
}
case 'L':
{
LONGEST *arg_ptr = (LONGEST *) argp;
CHECK_TYPE (scm_is_signed_integer (arg, INT64_MIN, INT64_MAX),
arg, position, func_name, _("LONGEST"));
*arg_ptr = gdbscm_scm_to_longest (arg);
break;
}
case 'U':
{
ULONGEST *arg_ptr = (ULONGEST *) argp;
CHECK_TYPE (scm_is_unsigned_integer (arg, 0, UINT64_MAX),
arg, position, func_name, _("ULONGEST"));
*arg_ptr = gdbscm_scm_to_ulongest (arg);
break;
}
case 'O':
{
SCM *arg_ptr = (SCM *) argp;
*arg_ptr = arg;
break;
}
default:
gdb_assert_not_reached ("invalid argument format character");
}
return SCM_BOOL_F;
}
SCM
gucu_mousemask (SCM x)
{
return scm_from_ulong (mousemask (scm_to_ulong (x), NULL));
}
