static SCM
guile_sock_no_delay (SCM sock, SCM enable)
{
svz_socket_t *xsock;
int old = 0, set = 0;
scm_assert_smob_type (guile_svz_socket_tag, sock);
xsock = (svz_socket_t *) SCM_SMOB_DATA (sock);
if (xsock->proto & PROTO_TCP)
{
if (!SCM_UNBNDP (enable))
{
SCM_ASSERT (scm_is_bool (enable) || scm_is_integer (enable), enable,
SCM_ARG2, FUNC_NAME);
if ((scm_is_bool (enable) && scm_is_true (enable)) ||
(scm_is_integer (enable) && scm_to_int (enable) != 0))
set = 1;
}
if (svz_tcp_nodelay (xsock->sock_desc, set, &old) < 0)
old = 0;
else if (SCM_UNBNDP (enable))
svz_tcp_nodelay (xsock->sock_desc, old, NULL);
}
return SCM_BOOL (old);
}
SCM scm_ragnarok_epoll_wait(SCM event_set ,SCM second ,SCM msecond)
#define FUNC_NAME "ragnarok-epoll-wait"
{
scm_rag_epoll_event_set *es = NULL;
int fd;
int op;
int count;
long s = 0L;
long ms = 0L;
SCM cons;
int nfds;
SCM ret = SCM_EOL;
SCM_ASSERT_EPOLL_EVENT_SET(event_set);
es = (scm_rag_epoll_event_set*)SCM_SMOB_DATA(event_set);
if(!SCM_UNBNDP(second))
{
SCM_VALIDATE_NUMBER(3 ,second);
s = (long)scm_to_long(second);
if(!SCM_UNBNDP(msecond))
{
SCM_VALIDATE_NUMBER(4 ,msecond);
ms = (long)scm_to_long(msecond);
}
ms += s*1000; // convert to mseconds since epoll_wait only accept msecond;
}
ms = ms ? ms : -1;
count = es->count;
if(!count)
goto end;
nfds = epoll_wait(es->epfd ,es->ee_set ,count ,ms);
if(nfds < 0)
{
RAG_ERROR1("epoll_wait" ,"epoll_wait error! errno shows %a~%",
RAG_ERR2STR(errno));
}
while(nfds > 0)
{
nfds--;
fd = es->ee_set[nfds].data.fd;
op = es->ee_set[nfds].events;
cons = scm_cons(scm_from_int(fd) ,scm_from_int(op));
ret = scm_cons(cons ,ret);
}
return ret;
end:
return SCM_EOL;
}
SCM scm_ragnarok_select(SCM nfds ,SCM read_set ,SCM write_set,
SCM except_set ,SCM second ,SCM msecond)
#define FUNC_NAME "ragnarok-select"
{
int n = 0;
scm_rag_fd_set *rs = NULL;
scm_rag_fd_set *ws = NULL;
scm_rag_fd_set *es = NULL;
scm_rag_fd_set *ready_set = NULL;
long s = 0L;
long ms = 0L;
int i;
struct timeval tv;
SCM ret = SCM_EOL;
SCM *prev = &ret;
SCM_VALIDATE_NUMBER(1 ,nfds);
SCM_ASSERT_EVENT_SET(read_set);
SCM_ASSERT_EVENT_SET(write_set);
SCM_ASSERT_EVENT_SET(except_set);
if(!SCM_UNBNDP(ms))
{
SCM_VALIDATE_NUMBER(5 ,second);
s = (long)scm_from_long(second);
if(!SCM_UNBNDP(msecond))
{
SCM_VALIDATE_NUMBER(6 ,msecond);
ms = (long)scm_from_long(msecond);
}
}
n = scm_from_int(nfds);
rs = (scm_rag_event_set*)SMOB_DATA(read_set);
ws = (scm_rag_event_set*)SMOB_DATA(write_set);
es = (scm_rag_event_set*)SMOB_DATA(except_set);
tv.tv_sec = (long)s;
tv.tv_usec = (long)us;
ready_set = select(n ,rs->set ,ws->set ,es->set ,&tv);
for(i=0;i<n;i++)
{
if(FD_ISSET(i ,&ready_set))
{
*prev = scm_cons(scm_from_int(i) ,SCM_EOL);
prev = SCM_CDRLOC(*prev);
}
}
return ret;
}
SCM
yacl_scm_hkdf_sha256 (SCM ikm, SCM salt, SCM info)
{
int rc;
uint8_t * ikm_ptr, *salt_ptr, *info_ptr;
size_t ikm_len, salt_len, info_len;
if (!scm_is_bytevector (ikm))
scm_throw (scm_from_locale_symbol ("BADIKM"), SCM_BOOL_T);
ikm_ptr = SCM_BYTEVECTOR_CONTENTS (ikm);
ikm_len = SCM_BYTEVECTOR_LENGTH (ikm);
if (SCM_UNBNDP (salt))
{
salt_ptr = NULL;
salt_len = 0;
}
else if (!scm_is_bytevector (salt))
scm_throw (scm_from_locale_symbol ("BADSALT"), SCM_BOOL_T);
else
{
salt_ptr = SCM_BYTEVECTOR_CONTENTS(salt);
salt_len = SCM_BYTEVECTOR_LENGTH (salt);
}
if (SCM_UNBNDP (info))
{
info_ptr = NULL;
info_len = 0;
}
else if (!scm_is_bytevector (info))
scm_throw (scm_from_locale_symbol ("BADINFO"), SCM_BOOL_T);
else
{
info_ptr = SCM_BYTEVECTOR_CONTENTS(info);
info_len = SCM_BYTEVECTOR_LENGTH (info);
}
SCM out = scm_c_make_bytevector (YACL_SHA256_LEN);
rc = yacl_hkdf_256(salt_ptr, salt_len,
ikm_ptr, ikm_len,
info_ptr, info_len,
SCM_BYTEVECTOR_CONTENTS (out), YACL_SHA256_LEN);
if (rc)
scm_throw (scm_from_locale_symbol ("BADHKDF"), SCM_BOOL_T);
return out;
}
static void
syntax_error (const char* const msg, const SCM form, const SCM expr)
{
SCM msg_string = scm_from_locale_string (msg);
SCM filename = SCM_BOOL_F;
SCM linenr = SCM_BOOL_F;
const char *format;
SCM args;
if (scm_is_pair (form))
{
filename = scm_source_property (form, scm_sym_filename);
linenr = scm_source_property (form, scm_sym_line);
}
if (scm_is_false (filename) && scm_is_false (linenr) && scm_is_pair (expr))
{
filename = scm_source_property (expr, scm_sym_filename);
linenr = scm_source_property (expr, scm_sym_line);
}
if (!SCM_UNBNDP (expr))
{
if (scm_is_true (filename))
{
format = "In file ~S, line ~S: ~A ~S in expression ~S.";
args = scm_list_5 (filename, linenr, msg_string, form, expr);
}
else if (scm_is_true (linenr))
{
format = "In line ~S: ~A ~S in expression ~S.";
args = scm_list_4 (linenr, msg_string, form, expr);
}
else
{
format = "~A ~S in expression ~S.";
args = scm_list_3 (msg_string, form, expr);
}
}
else
{
if (scm_is_true (filename))
{
format = "In file ~S, line ~S: ~A ~S.";
args = scm_list_4 (filename, linenr, msg_string, form);
}
else if (scm_is_true (linenr))
{
format = "In line ~S: ~A ~S.";
args = scm_list_3 (linenr, msg_string, form);
}
else
{
format = "~A ~S.";
args = scm_list_2 (msg_string, form);
}
}
scm_error (syntax_error_key, "memoization", format, args, SCM_BOOL_F);
}
static SCM
scm_type_symbol_to_AnchorPointType (SCM symb, SCM who)
{
int type = INT_MIN;
if (scm_is_eq (symb, scm_symbol__mark ()))
type = at_mark;
else if (scm_is_eq (symb, scm_symbol__base ()))
type = at_basechar;
else if (scm_is_eq (symb, scm_symbol__ligature ()))
type = at_baselig;
else if (scm_is_eq (symb, scm_symbol__base_mark ()))
type = at_basemark;
else if (scm_is_eq (symb, scm_symbol__entry ()))
type = at_centry;
else if (scm_is_eq (symb, scm_symbol__exit ()))
type = at_cexit;
else
{
if (SCM_UNBNDP (who))
who = scm_from_latin1_string ("scm_type_symbol_to_AnchorPointType");
rnrs_raise_condition
(scm_list_4
(rnrs_make_assertion_violation (),
rnrs_make_who_condition (who),
rnrs_c_make_message_condition (_("unrecognized anchor point type")),
rnrs_make_irritants_condition (scm_list_1 (symb))));
}
return scm_from_int (type);
}
SCM
scm_make_srcprops (long line, int col, SCM filename, SCM copy, SCM alist)
{
if (!SCM_UNBNDP (filename))
{
SCM old_alist = alist;
/*
have to extract the acons, and operate on that, for
thread safety.
*/
SCM last_acons = SCM_CDR (scm_last_alist_filename);
if (scm_is_null (old_alist)
&& scm_is_eq (SCM_CDAR (last_acons), filename))
{
alist = last_acons;
}
else
{
alist = scm_acons (scm_sym_filename, filename, alist);
if (scm_is_null (old_alist))
scm_set_cdr_x (scm_last_alist_filename, alist);
}
}
SCM_RETURN_NEWSMOB3 (scm_tc16_srcprops,
SRCPROPMAKPOS (line, col),
SCM_UNPACK (copy),
SCM_UNPACK (alist));
}
SCM scm_mmr_sleep(SCM second ,SCM msecond)
#define FUNC_NAME "ragnarok-sleep"
{
long s = 0L;
long ms = 0L;
SCM_VALIDATE_NUMBER(1 ,second);
s = scm_to_long(second);
if(!SCM_UNBNDP(msecond))
{
SCM_VALIDATE_NUMBER(2 ,msecond);
ms = scm_to_long(msecond);
}
if(s)
{
sleep(s);
}
if(ms)
{
usleep(ms);
}
return SCM_BOOL_T;
}
static SCM
make_weak_vector (size_t len, SCM fill)
#define FUNC_NAME "make-weak-vector"
{
SCM wv;
size_t j;
SCM_ASSERT_RANGE (1, scm_from_size_t (len), len <= VECTOR_MAX_LENGTH);
if (SCM_UNBNDP (fill))
fill = SCM_UNSPECIFIED;
wv = SCM_PACK_POINTER (scm_gc_malloc_pointerless ((len + 1) * sizeof (SCM),
"weak vector"));
SCM_SET_CELL_WORD_0 (wv, (len << 8) | scm_tc7_wvect);
if (SCM_HEAP_OBJECT_P (fill))
{
memset (SCM_I_VECTOR_WELTS (wv), 0, len * sizeof (SCM));
for (j = 0; j < len; j++)
scm_c_weak_vector_set_x (wv, j, fill);
}
else
for (j = 0; j < len; j++)
SCM_SIMPLE_VECTOR_SET (wv, j, fill);
return wv;
}
SCM
gdbscm_scm_from_string (const char *string, size_t len,
const char *charset, int strict)
{
struct scm_from_stringn_data data;
SCM scm_result;
data.string = string;
data.len = len;
data.charset = charset;
/* The use of SCM_FAILED_CONVERSION_QUESTION_MARK is specified by Guile. */
data.conversion_kind = (strict
? SCM_FAILED_CONVERSION_ERROR
: SCM_FAILED_CONVERSION_QUESTION_MARK);
data.result = SCM_UNDEFINED;
scm_result = gdbscm_call_guile (gdbscm_call_scm_from_stringn, &data, NULL);
if (gdbscm_is_false (scm_result))
{
gdb_assert (!SCM_UNBNDP (data.result));
return data.result;
}
gdb_assert (gdbscm_is_exception (scm_result));
return scm_result;
}
static int
pyscm_PySCM_setattr(pyscm_PySCMObject *self, char *name, PyObject *v)
{
/* Set attribute 'name' to value 'v'. v==NULL means delete */
if (pyguile_verbosity_test(PYGUILE_VERBOSE_PYSCM)) {
scm_simple_format(scm_current_output_port(),scm_makfrom0str("# pyscm_PySCM_setattr: trying to set attribute=~S from pobj=~S to value ~S\n"),scm_list_3(scm_makfrom0str(name),verbosity_repr((PyObject *)self),verbosity_repr(v)));
}
SCM sobj_keyword;
SCM sattr_vector = retrieve_sattr_vector(self,name,&sobj_keyword);
if (SCM_UNBNDP(sattr_vector)) {
// Attribute error exception was raised by retrieve_sattr_vector().
return(-1);
}
SCM ssetattr_func = GET_H_SETATTR_FUNC(sattr_vector);
if (SCM_EQ_P(SCM_EOL,ssetattr_func)) {
PyErr_SetString(PyExc_AttributeError, name);
return(-1);
}
if (NULL != v) {
SCM sval = p2g_apply(v,
GET_H_P2G_SETATTR_TEMPLATE(sattr_vector));
scm_append_x(scm_list_2(sobj_keyword,sval));
}
SCM sresult = scm_apply(ssetattr_func,sobj_keyword,SCM_EOL);
return(SCM_EQ_P(SCM_BOOL_F,sresult) ? (-1) : 0);
}
static SCM
scm_srcprops_to_alist (SCM obj)
{
SCM alist = SRCPROPALIST (obj);
if (!SCM_UNBNDP (SRCPROPCOPY (obj)))
alist = scm_acons (scm_sym_copy, SRCPROPCOPY (obj), alist);
alist = scm_acons (scm_sym_column, scm_from_int (SRCPROPCOL (obj)), alist);
alist = scm_acons (scm_sym_line, scm_from_int (SRCPROPLINE (obj)), alist);
return alist;
}
void
gdbscm_parse_function_args (const char *func_name,
int beginning_arg_pos,
const SCM *keywords,
const char *format, ...)
{
va_list args;
const char *p;
int i, have_rest, num_keywords, length, position;
int have_optional = 0;
SCM status;
SCM rest = SCM_EOL;
/* Keep track of malloc'd strings. We need to free them upon error. */
VEC (char_ptr) *allocated_strings = NULL;
char *ptr;
have_rest = validate_arg_format (format);
num_keywords = count_keywords (keywords);
va_start (args, format);
p = format;
position = beginning_arg_pos;
/* Process required, optional arguments. */
while (*p && *p != '#' && *p != '.')
{
SCM arg;
void *arg_ptr;
if (*p == '|')
{
have_optional = 1;
++p;
continue;
}
arg = va_arg (args, SCM);
if (!have_optional || !SCM_UNBNDP (arg))
{
arg_ptr = va_arg (args, void *);
status = extract_arg (*p, arg, arg_ptr, func_name, position);
if (!gdbscm_is_false (status))
goto fail;
if (*p == 's')
VEC_safe_push (char_ptr, allocated_strings, *(char **) arg_ptr);
}
++p;
++position;
}
SCM
scm_dynstack_find_old_fluid_value (scm_t_dynstack *dynstack, SCM fluid,
size_t depth, SCM dflt)
{
scm_t_bits *walk;
for (walk = SCM_DYNSTACK_PREV (dynstack->top); walk;
walk = SCM_DYNSTACK_PREV (walk))
{
scm_t_bits tag = SCM_DYNSTACK_TAG (walk);
switch (SCM_DYNSTACK_TAG_TYPE (tag))
{
case SCM_DYNSTACK_TYPE_WITH_FLUID:
{
if (scm_is_eq (WITH_FLUID_FLUID (walk), fluid))
{
if (depth == 0)
return SCM_VARIABLE_REF (WITH_FLUID_VALUE_BOX (walk));
else
depth--;
}
break;
}
case SCM_DYNSTACK_TYPE_DYNAMIC_STATE:
{
SCM state, val;
/* The previous dynamic state may or may not have
established a binding for this fluid. */
state = scm_variable_ref (DYNAMIC_STATE_STATE_BOX (walk));
val = scm_dynamic_state_ref (state, fluid, SCM_UNDEFINED);
if (!SCM_UNBNDP (val))
{
if (depth == 0)
return val;
else
depth--;
}
break;
}
default:
break;
}
}
return dflt;
}
static SCM
guile_sock_idle_counter (SCM sock, SCM counter)
{
svz_socket_t *xsock;
int ocounter;
scm_assert_smob_type (guile_svz_socket_tag, sock);
xsock = (svz_socket_t *) SCM_SMOB_DATA (sock);
ocounter = xsock->idle_counter;
if (!SCM_UNBNDP (counter))
{
SCM_ASSERT (scm_is_integer (counter), counter, SCM_ARG2, FUNC_NAME);
xsock->idle_counter = scm_to_int (counter);
}
return scm_from_int (ocounter);
}
int
xscm_val_to_int (SCM x)
{
if (SCM_UNBNDP (x))
return 0;
else if (scm_is_bool (x))
{
if (scm_is_false(x))
return 0;
else
return 1;
}
else if (scm_is_integer (x))
return scm_to_int (x);
return 0;
}
static SCM
guile_sock_send_buffer_size (SCM sock, SCM size)
{
svz_socket_t *xsock;
int len;
scm_assert_smob_type (guile_svz_socket_tag, sock);
xsock = (svz_socket_t *) SCM_SMOB_DATA (sock);
if (!SCM_UNBNDP (size))
{
SCM_ASSERT (scm_is_integer (size), size, SCM_ARG2, FUNC_NAME);
len = scm_to_int (size);
svz_sock_resize_buffers (xsock, len, xsock->recv_buffer_size);
}
return scm_cons (scm_from_int (xsock->send_buffer_size),
scm_from_int (xsock->send_buffer_fill));
}
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));
}
}
SCM scm_mmr_create_this_path(SCM path ,SCM mode)
#define FUNC_NAME "create-this-path"
{
char *p = NULL;
char *b = NULL;
char *buf = NULL;
SCM ret = SCM_BOOL_F;
int m = 0777;
int len = 0;
int n = 0;
SCM_VALIDATE_STRING(1 ,path);
if(!SCM_UNBNDP(mode))
{
SCM_VALIDATE_NUMBER(2 ,mode);
m = scm_to_int(mode);
}
scm_dynwind_begin(0);
p = scm_to_locale_string(path);
scm_dynwind_free(p);
len = strlen(p);
buf = (char*)malloc(len+1); // Don't forget +1 for '\0'
n = get_path_levels(p ,len);
while(n >= 0)
{
int l = 0;
b = get_parent_path(p ,&n ,len);
l = b-p;
memcpy(buf ,b ,l);
buf[l+1] = '\0';
do_create(buf ,len);
}
free(buf);
buf = NULL;
scm_dynwind_end();
return ret;
}
static SCM
guile_sock_parent (SCM sock, SCM parent)
{
SCM oparent = SCM_EOL;
svz_socket_t *xsock, *xparent;
scm_assert_smob_type (guile_svz_socket_tag, sock);
xsock = (svz_socket_t *) SCM_SMOB_DATA (sock);
if ((xparent = svz_sock_getparent (xsock)) != NULL)
SCM_NEWSMOB (oparent, guile_svz_socket_tag, xparent);
if (!SCM_UNBNDP (parent))
{
scm_assert_smob_type (guile_svz_socket_tag, parent);
xparent = (svz_socket_t *) SCM_SMOB_DATA (parent);
svz_sock_setparent (xsock, xparent);
}
return oparent;
}
static SCM
guile_sock_referrer (SCM sock, SCM referrer)
{
SCM oreferrer = SCM_EOL;
svz_socket_t *xsock, *xreferrer;
scm_assert_smob_type (guile_svz_socket_tag, sock);
xsock = (svz_socket_t *) SCM_SMOB_DATA (sock);
if ((xreferrer = svz_sock_getreferrer (xsock)) != NULL)
SCM_NEWSMOB (oreferrer, guile_svz_socket_tag, xreferrer);
if (!SCM_UNBNDP (referrer))
{
scm_assert_smob_type (guile_svz_socket_tag, referrer);
xreferrer = (svz_socket_t *) SCM_SMOB_DATA (referrer);
svz_sock_setreferrer (xsock, xreferrer);
}
return oreferrer;
}
static SCM
scm_AnchorPointType_to_type_symbol (SCM type, SCM who)
{
SCM symb = SCM_UNSPECIFIED;
const int _type = scm_to_int (type);
switch (_type)
{
case at_mark:
symb = scm_symbol__mark ();
break;
case at_basechar:
symb = scm_symbol__base ();
break;
case at_baselig:
symb = scm_symbol__ligature ();
break;
case at_basemark:
symb = scm_symbol__base_mark ();
break;
case at_centry:
symb = scm_symbol__entry ();
break;
case at_cexit:
symb = scm_symbol__exit ();
break;
default:
{
if (SCM_UNBNDP (who))
who = scm_from_latin1_string ("scm_AnchorPointType_to_type_symbol");
rnrs_raise_condition
(scm_list_4
(rnrs_make_assertion_violation (),
rnrs_make_who_condition (who),
rnrs_c_make_message_condition (_("unrecognized AnchorPointType "
"value")),
rnrs_make_irritants_condition (scm_list_1 (type))));
}
break;
}
return symb;
}
SCM
scm_call (SCM proc, ...)
{
va_list argp;
SCM *argv = NULL;
size_t i, nargs = 0;
va_start (argp, proc);
while (!SCM_UNBNDP (va_arg (argp, SCM)))
nargs++;
va_end (argp);
argv = alloca (nargs * sizeof (SCM));
va_start (argp, proc);
for (i = 0; i < nargs; i++)
argv[i] = va_arg (argp, SCM);
va_end (argp);
return scm_c_vm_run (scm_the_vm (), proc, argv, nargs);
}
static SCM
guile_sock_server (SCM sock, SCM server)
{
SCM oserver = SCM_EOL;
svz_socket_t *xsock;
svz_server_t *xserver;
scm_assert_smob_type (guile_svz_socket_tag, sock);
xsock = (svz_socket_t *) SCM_SMOB_DATA (sock);
if ((xserver = svz_server_find (xsock->cfg)) != NULL)
SCM_NEWSMOB (oserver, guile_svz_server_tag, xserver);
if (!SCM_UNBNDP (server))
{
scm_assert_smob_type (guile_svz_server_tag, server);
xserver = (svz_server_t *) SCM_SMOB_DATA (server);
xsock->cfg = xserver->cfg;
}
return oserver;
}
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_receive_buffer_reduce (SCM sock, SCM length)
{
svz_socket_t *xsock;
int len;
scm_assert_smob_type (guile_svz_socket_tag, sock);
xsock = (svz_socket_t *) SCM_SMOB_DATA (sock);
/* Check if second length argument is given. */
if (!SCM_UNBNDP (length))
{
SCM_ASSERT (scm_is_integer (length), length, SCM_ARG2, FUNC_NAME);
len = scm_to_signed_integer (length, 0, xsock->recv_buffer_fill);
}
else
{
len = xsock->recv_buffer_fill;
}
svz_sock_reduce_recv (xsock, len);
return scm_from_int (len);
}
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;
}
static PyObject *
pyscm_PySCM_getattr(pyscm_PySCMObject *self, char *name)
{
if (pyguile_verbosity_test(PYGUILE_VERBOSE_PYSCM)) {
scm_simple_format(scm_current_output_port(),scm_makfrom0str("# pyscm_PySCM_getattr: trying to get attribute=~S from pobj=~S\n"),scm_list_2(scm_makfrom0str(name),verbosity_repr((PyObject *)self)));
}
SCM sobj_keyword;
SCM sattr_vector = retrieve_sattr_vector(self,name,&sobj_keyword);
if (SCM_UNBNDP(sattr_vector)) {
// Attribute error exception was raised by retrieve_sattr_vector().
return(NULL);
}
SCM sgetattr_func = GET_H_GETATTR_FUNC(sattr_vector);
if (SCM_EQ_P(SCM_EOL,sgetattr_func)) {
PyErr_SetString(PyExc_AttributeError, name);
return(NULL);
}
SCM stemplate = GET_H_G2P_GETATTR_TEMPLATE(sattr_vector);
SCM sresult = scm_apply(sgetattr_func,sobj_keyword,SCM_EOL);
return(g2p_apply(sresult,stemplate));
}
SCM scm_digest_md5_digest(SCM str ,SCM mode)
{
// TODO: prelude
SCM_VALIDATE_STRING(1 ,str);
char *buf = scm_to_locale_string(str);
int m;
SCM ret;
MD5_CTX state;
byte digest[16];
char hex_output[16*2 + 1];
m = SCM_UNBNDP(mode) ? MD5_HEX : MD5_RAW;
md5_init(&state);
md5_write(&state ,(const char *)buf ,strlen(buf));
md5_final(digest, &state);
sprintf(hex_output ,m ,digest[di]);
ret = scm_from_locale_string(hex_output);
free(buf);
return ret;
}
static SCM
scm_rexp_match_or_search (rexp_match_t match_or_search (rexp_t re,
const uint8_t *s),
SCM re, SCM string, SCM start)
{
const int _start = (SCM_UNBNDP (start)) ? 0 : scm_to_int (start);
uint8_t *_string = (uint8_t *) scm_to_utf8_stringn (string, NULL);
rexp_t _re = scm_to_rexp_t (re);
rexp_match_t _match = match_or_search (_re, &_string[_start]);
free (_string);
SCM result = SCM_BOOL_F;
if (_match != NULL)
{
if (_start != 0)
for (size_t k = 0; k <= _match->capture_count; k++)
{
// FIXME: Catch overflow.
_match->ovector[2 * k] += _start;
_match->ovector[2 * k + 1] += _start;
}
result = scm_from_rexp_match_t (_match);
}
return result;
}
