SCM scm_make_select_event_set(SCM nfds ,SCM size ,SCM type)
#define FUNC_NAME "make-event-set"
{
int t;
unsigned int n = 0;
int fd;
SCM_VALIDATE_NUMBER(1 ,nfds);
SCM_VALIDATE_NUMBER(2 ,size);
SCM_VALIDATE_NUMBER(3 ,type);
t = scm_to_int(type);
n = scm_to_uint(size);
fd = scm_to_int(nfds);
scm_rag_fd_set *rfd = (scm_rag_fd_set*)scm_gc_malloc(sizeof(scm_rag_fd_set));
scm_rag_select_event_set *ses =
(scm_rag_select_event_set*)scm_gc_malloc(sizeof(scm_rag_select_event_set),
"select-event-set");
ses->type = t;
ses->count = 0;
ses->size = n;
ses->nfds = fd;
ses->set = rfd;
return scm_rag_select_event_set2scm(ses);
}
SCM Display::scm_init_graphics(SCM size) {
#ifdef WITH_SDL
SDL_Init(SDL_INIT_VIDEO);
SDL_Surface *screen = NULL;
screen = SDL_SetVideoMode(scm_to_uint(scm_car(size)),
scm_to_uint(scm_cadr(size)), 32,
SDL_DEFAULT_FLAGS);
if (screen == NULL) {
/* TODO: handle errors like this */
std::cout << "Can't init SDL\n";
exit(0);
}
get()->m_pScreen = screen;
SDL_FillRect(screen, NULL, SDL_MapRGB(screen->format, 0, 0, 0));
#endif
}
static SCM
gdbscm_set_memory_port_write_buffer_size_x (SCM port, SCM size)
{
ioscm_memory_port *iomem;
SCM_ASSERT_TYPE (gdbscm_is_memory_port (port), port, SCM_ARG1, FUNC_NAME,
memory_port_desc_name);
SCM_ASSERT_TYPE (scm_is_integer (size), size, SCM_ARG2, FUNC_NAME,
_("integer"));
if (!scm_is_unsigned_integer (size, min_memory_port_buf_size,
max_memory_port_buf_size))
{
gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG2, size,
out_of_range_buf_size);
}
iomem = (ioscm_memory_port *) SCM_STREAM (port);
ioscm_reinit_memory_port (port, iomem->read_buf_size, scm_to_uint (size),
FUNC_NAME);
return SCM_UNSPECIFIED;
}
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;
}
static void
pascm_set_param_value_x (enum var_types type, union pascm_variable *var,
const char * const *enumeration,
SCM value, int arg_pos, const char *func_name)
{
switch (type)
{
case var_string:
case var_string_noescape:
case var_optional_filename:
case var_filename:
SCM_ASSERT_TYPE (scm_is_string (value)
|| (type != var_filename
&& gdbscm_is_false (value)),
value, arg_pos, func_name,
_("string or #f for non-PARAM_FILENAME parameters"));
if (gdbscm_is_false (value))
{
xfree (var->stringval);
if (type == var_optional_filename)
var->stringval = xstrdup ("");
else
var->stringval = NULL;
}
else
{
char *string;
SCM exception;
string = gdbscm_scm_to_host_string (value, NULL, &exception);
if (string == NULL)
gdbscm_throw (exception);
xfree (var->stringval);
var->stringval = string;
}
break;
case var_enum:
{
int i;
char *str;
SCM exception;
SCM_ASSERT_TYPE (scm_is_string (value), value, arg_pos, func_name,
_("string"));
str = gdbscm_scm_to_host_string (value, NULL, &exception);
if (str == NULL)
gdbscm_throw (exception);
for (i = 0; enumeration[i]; ++i)
{
if (strcmp (enumeration[i], str) == 0)
break;
}
xfree (str);
if (enumeration[i] == NULL)
{
gdbscm_out_of_range_error (func_name, arg_pos, value,
_("not member of enumeration"));
}
var->cstringval = enumeration[i];
break;
}
case var_boolean:
SCM_ASSERT_TYPE (gdbscm_is_bool (value), value, arg_pos, func_name,
_("boolean"));
var->intval = gdbscm_is_true (value);
break;
case var_auto_boolean:
SCM_ASSERT_TYPE (gdbscm_is_bool (value)
|| scm_is_eq (value, auto_keyword),
value, arg_pos, func_name,
_("boolean or #:auto"));
if (scm_is_eq (value, auto_keyword))
var->autoboolval = AUTO_BOOLEAN_AUTO;
else if (gdbscm_is_true (value))
var->autoboolval = AUTO_BOOLEAN_TRUE;
else
var->autoboolval = AUTO_BOOLEAN_FALSE;
break;
case var_zinteger:
case var_uinteger:
case var_zuinteger:
case var_zuinteger_unlimited:
if (type == var_uinteger
|| type == var_zuinteger_unlimited)
{
SCM_ASSERT_TYPE (gdbscm_is_bool (value)
|| scm_is_eq (value, unlimited_keyword),
value, arg_pos, func_name,
_("integer or #:unlimited"));
if (scm_is_eq (value, unlimited_keyword))
{
if (type == var_uinteger)
var->intval = UINT_MAX;
else
var->intval = -1;
break;
}
}
else
{
SCM_ASSERT_TYPE (scm_is_integer (value), value, arg_pos, func_name,
_("integer"));
}
if (type == var_uinteger
|| type == var_zuinteger)
{
unsigned int u = scm_to_uint (value);
if (type == var_uinteger && u == 0)
u = UINT_MAX;
var->uintval = u;
}
else
{
int i = scm_to_int (value);
if (type == var_zuinteger_unlimited && i < -1)
{
gdbscm_out_of_range_error (func_name, arg_pos, value,
_("must be >= -1"));
}
var->intval = i;
}
break;
default:
gdb_assert_not_reached ("bad parameter type");
}
}
PyObject *scm2py(SCM value)
{
if (value == NULL)
return NULL;
if (value == SCM_UNSPECIFIED) {
Py_INCREF(Py_None);
return Py_None;
}
if (scm_is_exact_integer(value))
return PyInt_FromLong(scm_to_long(value));
if (scm_is_real(value))
return PyFloat_FromDouble(scm_to_double(value));
if (scm_is_bool(value)) {
PyObject *result = scm_to_bool(value) ? Py_True : Py_False;
Py_INCREF(result);
return result;
}
if (value == SCM_EOL)
return PyTuple_New(0);
if (scm_is_string(value)) {
size_t len = 0;
char *s = scm_to_utf8_stringn(value, &len);
PyObject *result = PyUnicode_FromStringAndSize(s, len);
free(s);
return result;
}
if (scm_is_pair(value)) {
unsigned int len = scm_to_uint(scm_length(value));
PyObject *result = PyTuple_New(len);
scm_dynwind_begin(0);
scm_dynwind_unwind_handler(
(void (*)(void *))Py_DecRef, result, 0);
unsigned int i;
for (i = 0; i < len; i++) {
PyObject *item = scm2py(scm_car(value));
if (item == NULL) {
scm_dynwind_end();
Py_DECREF(result);
return NULL;
}
PyTuple_SET_ITEM(result, i, item);
value = scm_cdr(value);
}
scm_dynwind_end();
return result;
}
if (scm_to_bool(scm_procedure_p(value))) {
SCM ptr = scm_assq_ref(gsubr_alist, value);
if (!scm_is_false(ptr)) {
PyObject *result = scm_to_pointer(ptr);
Py_INCREF(result);
return result;
}
Procedure *result =
(Procedure *)ProcedureType.tp_alloc(&ProcedureType, 0);
if (result == NULL)
return NULL;
result->proc = value;
return (PyObject *)result;
}
char *msg = scm_to_utf8_stringn(
scm_simple_format(
SCM_BOOL_F,
scm_from_utf8_string(
"Guile expression ~S doesn't have a "
"corresponding Python value"),
scm_list_1(value)), NULL);
PyErr_SetString(PyExc_TypeError, msg);
free(msg);
return NULL;
}