int
blizkost_slurpy_to_stack(BLIZKOST_NEXUS, PMC *positional, PMC *named) {
int num_pos, i, stkdepth;
PMC *iter;
dBNPERL; dBNINTERP; dSP;
stkdepth = 0;
/* Stick on positional arguments. */
num_pos = VTABLE_elements(interp, positional);
for (i = 0; i < num_pos; i++) {
PMC *pos_arg = VTABLE_get_pmc_keyed_int(interp, positional, i);
XPUSHs(blizkost_marshal_arg(nexus, pos_arg));
stkdepth++;
}
/* Stick on named arguments (we unbundle them to a string
* followed by the argument. */
iter = VTABLE_get_iter(interp, named);
while (VTABLE_get_bool(interp, iter)) {
STRING *arg_name = VTABLE_shift_string(interp, iter);
PMC *arg_value = VTABLE_get_pmc_keyed_str(interp, named, arg_name);
char *c_arg_name = Parrot_str_to_cstring(interp, arg_name);
XPUSHs(sv_2mortal(newSVpv(c_arg_name, strlen(c_arg_name))));
XPUSHs(blizkost_marshal_arg(nexus, arg_value));
stkdepth += 2;
}
PUTBACK;
return stkdepth;
}
INTVAL
Parrot_Run_OS_Command(PARROT_INTERP, STRING *command)
{
pid_t child;
child = fork();
/* Did we fail? */
if (-1 == child)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_NOSPAWN,
"Can't spawn child process");
/* Are we the parent or child? */
if (child) {
/* parent */
int status;
waitpid(child, &status, 0);
return status;
}
else {
/* child */
char * const cmd = Parrot_str_to_cstring(interp, command);
const int status = execlp("sh", "sh", "-c", cmd, (void *)NULL);
/* if we get here, something's horribly wrong, but free anyway... */
Parrot_str_free_cstring(cmd);
if (status)
exit(status);
}
/* make gcc happy */
return 1;
}
INTVAL
Parrot_Run_OS_Command_Argv(PARROT_INTERP, PMC *cmdargs)
{
DWORD status = 0;
STARTUPINFO si;
PROCESS_INFORMATION pi;
int pmclen;
int cmdlinelen = 1000;
int cmdlinepos = 0;
char *cmdline = (char *)mem_sys_allocate(cmdlinelen);
int i;
/* Ensure there's something in the PMC array. */
pmclen = VTABLE_elements(interp, cmdargs);
if (pmclen == 0)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_NOSPAWN,
"Empty argument array for spawnw");
/* Now build command line. */
for (i = 0; i < pmclen; i++) {
STRING * const s = VTABLE_get_string_keyed_int(interp, cmdargs, i);
char * const cs = Parrot_str_to_cstring(interp, s);
if (cmdlinepos + (int)s->strlen + 3 > cmdlinelen) {
cmdlinelen += s->strlen + 4;
cmdline = (char *)mem_sys_realloc(cmdline, cmdlinelen);
}
strcpy(cmdline + cmdlinepos, "\"");
strcpy(cmdline + cmdlinepos + 1, cs);
strcpy(cmdline + cmdlinepos + 1 + s->strlen, "\" ");
cmdlinepos += s->strlen + 3;
}
/* Start the child process. */
memset(&si, 0, sizeof (si));
si.cb = sizeof (si);
memset(&pi, 0, sizeof (pi));
if (!CreateProcess(NULL, cmdline, NULL, NULL, TRUE, 0, NULL, NULL, &si, &pi))
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_NOSPAWN,
"Can't spawn child process");
WaitForSingleObject(pi.hProcess, INFINITE);
/* Get exit code. */
if (!GetExitCodeProcess(pi.hProcess, &status)) {
Parrot_warn(interp, PARROT_WARNINGS_PLATFORM_FLAG,
"Process completed: Failed to get exit code.");
}
/* Clean up. */
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
mem_sys_free(cmdline);
/* Return exit code left shifted by 8 for POSIX emulation. */
return status << 8;
}
void
Parrot_setenv(PARROT_INTERP, STRING *str_name, STRING *str_value)
{
char * const name = Parrot_str_to_cstring(interp, str_name);
char * const value = Parrot_str_to_cstring(interp, str_value);
assert(name != NULL);
assert(value != NULL);
{
const int name_len = strlen(name);
const int value_len = strlen(value);
{
char * const envstring = (char * const)mem_internal_allocate(
name_len /* name */
+ 1 /* '=' */
+ value_len /* value */
+ 1); /* string terminator */
/* Save a bit of time, by using the fact we already have the
lengths, avoiding strcat */
strcpy(envstring, name);
strcpy(envstring + name_len, "=");
strcpy(envstring + name_len + 1, value);
Parrot_str_free_cstring(name);
Parrot_str_free_cstring(value);
if (_putenv(envstring) == 0) {
/* success */
mem_sys_free(envstring);
}
else {
mem_sys_free(envstring);
Parrot_x_force_error_exit(interp, 1,
"Unable to set environment variable %s=%s",
name, value);
}
}
}
}
PARROT_API
Parrot_Int
Parrot_api_string_export_ascii(ARGIN(Parrot_PMC interp_pmc), ARGIN(Parrot_String string),
ARGOUT(char ** strout))
{
ASSERT_ARGS(Parrot_api_string_export_ascii)
EMBED_API_CALLIN(interp_pmc, interp);
if (!STRING_IS_NULL(string))
*strout = Parrot_str_to_cstring(interp, string);
else
*strout = NULL;
EMBED_API_CALLOUT(interp_pmc, interp);
}
INTVAL
Parrot_stat_info_intval(PARROT_INTERP, STRING *file, INTVAL thing)
{
struct stat statbuf;
/* Get the name of the file as something we can use */
char * const filename = Parrot_str_to_cstring(interp, file);
/* Everything needs the result of stat, so just go do it */
const int status = stat(filename, &statbuf);
Parrot_str_free_cstring(filename);
return stat_common(interp, &statbuf, thing, status);
}
static void
pcf_cstr_cstr_cstr(PARROT_INTERP, PMC *nci, SHIM(PMC *self))
{
typedef char *(* func_t)(char *, char *);
func_t fn_pointer;
void *orig_func;
PMC * const ctx = CURRENT_CONTEXT(interp);
PMC * const call_object = Parrot_pcc_get_signature(interp, ctx);
STRING * t_0; char * v_0;
STRING * t_1; char * v_1;
STRING * t_2; char * v_2;
Parrot_pcc_fill_params_from_c_args(interp, call_object, "SS", &t_1, &t_2);
v_1 = STRING_IS_NULL(t_1) ? NULL : Parrot_str_to_cstring(interp, t_1);
v_2 = STRING_IS_NULL(t_2) ? NULL : Parrot_str_to_cstring(interp, t_2);
GETATTR_NCI_orig_func(interp, nci, orig_func);
fn_pointer = (func_t)D2FPTR(orig_func);
v_0 = (*fn_pointer)(v_1, v_2);
t_0 = Parrot_str_new(interp, v_0, 0);
t_1 = Parrot_str_new(interp, v_1, 0);
t_2 = Parrot_str_new(interp, v_2, 0);
Parrot_pcc_set_call_from_c_args(interp, call_object, "SSS", t_0, t_1, t_2);
}
PARROT_WARN_UNUSED_RESULT
INTVAL
Parrot_io_internal_getprotobyname(PARROT_INTERP, ARGIN(STRING *name))
{
char * const s = Parrot_str_to_cstring(interp, name);
struct protoent * const protoent = getprotobyname(s);
Parrot_str_free_cstring(s);
if (protoent)
return protoent->p_proto;
else
return -1;
}
INTVAL
Parrot_Run_OS_Command_Argv(PARROT_INTERP, PMC *cmdargs)
{
pid_t child;
int len = VTABLE_elements(interp, cmdargs);
if (len == 0)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_NOSPAWN,
"Empty argument array for execvp");
child = fork();
/* Did we fail? */
if (-1 == child)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_NOSPAWN,
"Can't spawn child process");
/* Are we the parent or child? */
if (child) {
/* parent */
int status;
pid_t returnstat = waitpid(child, &status, 0);
UNUSED(returnstat);
return status;
}
else {
/* child. Be horribly profligate with memory, since we're
about to be something else */
int status, i;
STRING *s;
char *cmd;
char **argv = mem_gc_allocate_n_typed(interp, (len+1), char*);
for (i = 0; i < len; ++i) {
s = VTABLE_get_string_keyed_int(interp, cmdargs, i);
argv[i] = Parrot_str_to_cstring(interp, s);
}
cmd = argv[0];
argv[i] = NULL;
status = execvp(cmd, argv);
/* if we get here, something's horribly wrong... */
if (status) {
exit(status);
}
}
return 1; /* make gcc happy */
}
STRING *
Parrot_getenv(PARROT_INTERP, ARGIN(STRING *str_name))
{
char * const name = Parrot_str_to_cstring(interp, str_name);
const DWORD size = GetEnvironmentVariable(name, NULL, 0);
char *buffer = NULL;
STRING *retv;
if (size == 0) {
Parrot_str_free_cstring(name);
return NULL;
}
buffer = (char *)mem_sys_allocate(size);
GetEnvironmentVariable(name, buffer, size);
Parrot_str_free_cstring(name);
retv = Parrot_str_from_platform_cstring(interp, buffer);
mem_sys_free(buffer);
return retv;
}
INTVAL
Parrot_Run_OS_Command(PARROT_INTERP, STRING *command)
{
DWORD status = 0;
STARTUPINFO si;
PROCESS_INFORMATION pi;
char* const cmd = (char *)mem_sys_allocate(command->strlen + 4);
char* const shell = Parrot_getenv(interp, Parrot_str_new(interp, "ComSpec", strlen("ComSpec")));
char* const cmdin = Parrot_str_to_cstring(interp, command);
strcpy(cmd, "/c ");
strcat(cmd, cmdin);
Parrot_str_free_cstring(cmdin);
memset(&si, 0, sizeof (si));
si.cb = sizeof (si);
memset(&pi, 0, sizeof (pi));
/* Start the child process. */
if (!CreateProcess(shell, cmd, NULL, NULL, TRUE, 0, NULL, NULL, &si, &pi))
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_NOSPAWN,
"Can't spawn child process");
WaitForSingleObject(pi.hProcess, INFINITE);
if (!GetExitCodeProcess(pi.hProcess, &status)) {
Parrot_warn(interp, PARROT_WARNINGS_PLATFORM_FLAG,
"Process completed: Failed to get exit code.");
}
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
Parrot_str_free_cstring(shell);
mem_sys_free(cmd);
/* Return exit code left shifted by 8 for POSIX emulation. */
return status << 8;
}
PARROT_WARN_UNUSED_RESULT
INTVAL
Parrot_proc_exec(PARROT_INTERP, ARGIN(STRING *command), INTVAL flags,
ARGMOD(PIOHANDLE *handles))
{
/*
* pipe(), fork() should be defined, if this header is present
* if that's not true, we need a test
*/
int pid;
int in_fds[2];
int out_fds[2];
int err_fds[2];
if (flags & PARROT_EXEC_STDIN
&& pipe(in_fds) < 0)
goto error_pipe_in;
if (flags & PARROT_EXEC_STDOUT
&& pipe(out_fds) < 0)
goto error_pipe_out;
if (flags & PARROT_EXEC_STDERR
&& pipe(err_fds) < 0)
goto error_pipe_err;
pid = fork();
if (pid < 0)
goto error_fork;
if (pid > 0) {
if (flags & PARROT_EXEC_STDIN) {
/* close fd for reading */
close(in_fds[0]);
handles[0] = in_fds[1];
}
if (flags & PARROT_EXEC_STDOUT) {
/* close fd for writing */
close(out_fds[1]);
handles[1] = out_fds[0];
}
if (flags & PARROT_EXEC_STDERR) {
/* close fd for writing */
close(err_fds[1]);
handles[2] = err_fds[0];
}
}
else /* (pid == 0) */ {
/* Child - exec process */
char * argv[4];
/* C strings for the execv call defined without const to avoid
* const problems without copying them.
* Please don't change this without testing with a c++ compiler.
*/
static char auxarg0[] = "/bin/sh";
static char auxarg1[] = "-c";
if (flags & PARROT_EXEC_STDIN) {
/* redirect stdin to pipe */
close(in_fds[1]);
close(STDIN_FILENO);
if (dup(in_fds[0]) != STDIN_FILENO)
exit(EXIT_FAILURE);
}
if (flags & PARROT_EXEC_STDOUT) {
/* redirect stdin to pipe */
close(out_fds[0]);
close(STDOUT_FILENO);
if (dup(out_fds[1]) != STDOUT_FILENO)
exit(EXIT_FAILURE);
if (!(flags & PARROT_EXEC_STDERR)) {
close(STDERR_FILENO);
if (dup(out_fds[1]) != STDERR_FILENO)
exit(EXIT_FAILURE);
}
}
if (flags & PARROT_EXEC_STDERR) {
/* redirect stdin to pipe */
close(err_fds[0]);
close(STDERR_FILENO);
if (dup(err_fds[1]) != STDERR_FILENO)
exit(EXIT_FAILURE);
}
argv [0] = auxarg0;
argv [1] = auxarg1;
argv [2] = Parrot_str_to_cstring(interp, command);
argv [3] = NULL;
execv(argv [0], argv);
/* Will never reach this unless exec fails.
* No need to clean up, we're just going to exit */
perror("execvp");
exit(EXIT_FAILURE);
}
return pid;
error_fork:
if (flags & PARROT_EXEC_STDERR) {
close(err_fds[0]);
close(err_fds[1]);
}
error_pipe_err:
if (flags & PARROT_EXEC_STDOUT) {
close(out_fds[0]);
close(out_fds[1]);
}
error_pipe_out:
if (flags & PARROT_EXEC_STDIN) {
close(in_fds[0]);
close(in_fds[1]);
}
error_pipe_in:
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
"Error executing process: %s", strerror(errno));
}
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
SV *
blizkost_marshal_arg(BLIZKOST_NEXUS, PMC *arg) {
struct sv *result = NULL;
dBNPERL; dBNINTERP;
/* If it's a P5Scalar PMC, then we just fetch the SV from it - trivial
* round-tripping. */
if (VTABLE_isa(interp, arg, CONST_STRING(interp, "P5Scalar"))) {
GETATTR_P5Scalar_sv(interp, arg, result);
}
/* XXX At this point, we should probably wrap it up in a tied Perl 5
* scalar so we can round-trip Parrot objects to. However, that's hard,
* so for now we cheat on a few special cases and just panic otherwise. */
else if (VTABLE_isa(interp, arg, CONST_STRING(interp, "Integer"))) {
result = sv_2mortal(newSViv(VTABLE_get_integer(interp, arg)));
}
else if (VTABLE_isa(interp, arg, CONST_STRING(interp, "Float"))) {
result = sv_2mortal(newSVnv(VTABLE_get_number(interp, arg)));
}
else if (VTABLE_isa(interp, arg, CONST_STRING(interp, "P5Namespace"))) {
STRING *pkg;
char *c_str;
GETATTR_P5Namespace_ns_name(interp, arg, pkg);
c_str = Parrot_str_to_cstring(interp, pkg);
result = sv_2mortal(newSVpv(c_str, strlen(c_str)));
}
else if (VTABLE_isa(interp, arg, CONST_STRING(interp, "String"))) {
char *c_str = Parrot_str_to_cstring(interp, VTABLE_get_string(interp, arg));
result = sv_2mortal(newSVpv(c_str, strlen(c_str)));
}
else if (VTABLE_does(interp, arg, CONST_STRING(interp, "invokable"))) {
CV *wrapper = blizkost_wrap_callable(nexus, arg);
result = sv_2mortal(newRV_inc((SV*)wrapper));
}
else if ( VTABLE_does(interp, arg, CONST_STRING(interp, "array"))) {
PMC *iter;
struct av *array = newAV();
iter = VTABLE_get_iter(interp, arg);
while (VTABLE_get_bool(interp, iter)) {
PMC *item = VTABLE_shift_pmc(interp, iter);
struct sv *marshaled =
blizkost_marshal_arg(nexus, item);
av_push( array, marshaled);
}
result = newRV_inc((SV*)array);
}
else if ( VTABLE_does(interp, arg, CONST_STRING(interp, "hash"))) {
PMC *iter = VTABLE_get_iter(interp, arg);
struct hv *hash = newHV();
INTVAL n = VTABLE_elements(interp, arg);
INTVAL i;
for(i = 0; i < n; i++) {
STRING *s = VTABLE_shift_string(interp, iter);
char *c_str = Parrot_str_to_cstring(interp, s);
struct sv *val = blizkost_marshal_arg(nexus,
VTABLE_get_pmc_keyed_str(interp, arg, s));
hv_store(hash, c_str, strlen(c_str), val, 0);
}
result = newRV_inc((SV*)hash);
}
else {
Parrot_ex_throw_from_c_args(interp, NULL, 1,
"Sorry, we do not support marshaling most things to Perl 5 yet.");
}
return result;
}
PARROT_EXPORT
void
Parrot_run_callback(PARROT_INTERP,
ARGMOD(PMC* user_data), ARGIN(char* external_data))
{
ASSERT_ARGS(Parrot_run_callback)
PMC *signature;
PMC *sub;
STRING *sig_str;
char *p;
char ch;
char *sig_cstr;
char pasm_sig[5];
INTVAL i_param;
PMC *p_param;
void *param = NULL; /* avoid -Ox warning */
STRING *sc;
sc = CONST_STRING(interp, "_sub");
sub = VTABLE_getprop(interp, user_data, sc);
sc = CONST_STRING(interp, "_signature");
signature = VTABLE_getprop(interp, user_data, sc);
sig_str = VTABLE_get_string(interp, signature);
sig_cstr = Parrot_str_to_cstring(interp, sig_str);
p = sig_cstr;
++p; /* Skip return type */
pasm_sig[0] = 'P';
if (*p == 'U') /* user_data Z in pdd16 */
++p; /* p is now type of external data */
switch (*p) {
case 'v':
pasm_sig[1] = 'v';
break;
case 'l':
i_param = (INTVAL)(long) external_data;
goto case_I;
case 'i':
i_param = (INTVAL)(int)(long) external_data;
goto case_I;
case 's':
i_param = (INTVAL)(short)(long) external_data;
goto case_I;
case 'c':
i_param = (INTVAL)(char)(long)external_data;
case_I:
pasm_sig[1] = 'I';
param = (void*) i_param;
break;
case 'p':
/* created a UnManagedStruct */
p_param = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, p_param, external_data);
pasm_sig[1] = 'P';
param = (void*) p_param;
break;
case 't':
pasm_sig[1] = 'S';
param = Parrot_str_new(interp, external_data, 0);
break;
default:
ch = *p;
Parrot_str_free_cstring(sig_cstr);
Parrot_ex_throw_from_c_args(interp, NULL, 1,
"unhandled signature char '%c' in run_cb", ch);
}
Parrot_str_free_cstring(sig_cstr);
pasm_sig[2] = '-';
pasm_sig[3] = '>'; /* no return value supported yet */
pasm_sig[4] = '\0';
Parrot_ext_call(interp, sub, pasm_sig, user_data, param);
}
/* Helper macros to get sockaddr_in */
# define SOCKADDR_LOCAL(p) ((struct sockaddr_in*)VTABLE_get_pointer(interp, \
PARROT_SOCKET((p))->local))
# define SOCKADDR_REMOTE(p) ((struct sockaddr_in*)VTABLE_get_pointer(interp, \
PARROT_SOCKET((p))->remote))
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
PMC *
Parrot_io_sockaddr_in(PARROT_INTERP, ARGIN(STRING *addr), INTVAL port)
{
ASSERT_ARGS(Parrot_io_sockaddr_in)
char * const s = Parrot_str_to_cstring(interp, addr);
PMC * const sockaddr = Parrot_pmc_new(interp, enum_class_Sockaddr);
get_sockaddr_in(interp, sockaddr, s, port);
Parrot_str_free_cstring(s);
return sockaddr;
}
/*
=item C<INTVAL Parrot_io_socket_unix(PARROT_INTERP, PMC *s, int fam, int type,
int proto)>
Uses C<socket()> to create a socket with the specified address family,
socket type and protocol number.
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
PMC *
Parrot_io_internal_getaddrinfo(PARROT_INTERP, ARGIN(STRING *addr), INTVAL port,
INTVAL protocol, INTVAL fam, INTVAL passive)
{
#ifdef PARROT_HAS_IPV6
PMC *array;
struct addrinfo hints;
struct addrinfo *ai, *walk;
/* We need to pass the port as a string (because you could also use a
* service specification from /etc/services). The highest port is 65535,
* so we need 5 characters + trailing null-byte. */
char portstr[6];
int ret;
/* convert Parrot's family to system family */
if (fam < 0
|| fam >= PIO_PF_MAX
|| (fam = pio_pf[fam]) < 0)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
"unsupported protocol family: %ld", fam);
memset(&hints, 0, sizeof (struct addrinfo));
if (passive)
hints.ai_flags = AI_PASSIVE;
hints.ai_family = fam;
hints.ai_protocol = protocol;
snprintf(portstr, sizeof (portstr), "%ld", port);
{
/* Limited scope for the C string to prevent mistakes */
char *s = STRING_IS_NULL(addr)
? (char *) NULL
: Parrot_str_to_cstring(interp, addr);
ret = getaddrinfo(s, portstr, &hints, &ai);
Parrot_str_free_cstring(s);
}
if (ret != 0)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
"getaddrinfo failed: %Ss: %Ss", addr,
Parrot_platform_strerror(interp, PIO_SOCK_ERRNO));
array = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
for (walk = ai; walk; walk = walk->ai_next) {
PMC *sockaddr = Parrot_pmc_new(interp, enum_class_Sockaddr);
Parrot_Sockaddr_attributes *sa_attrs = PARROT_SOCKADDR(sockaddr);
sa_attrs->family = walk->ai_family;
sa_attrs->type = walk->ai_socktype;
sa_attrs->protocol = walk->ai_protocol;
sa_attrs->len = walk->ai_addrlen;
sa_attrs->pointer = Parrot_gc_allocate_memory_chunk(interp,
walk->ai_addrlen);
memcpy(sa_attrs->pointer, walk->ai_addr, walk->ai_addrlen);
VTABLE_push_pmc(interp, array, sockaddr);
}
freeaddrinfo(ai);
return array;
#else /* PARROT_HAS_IPV6 */
const char *host;
char *cstring;
int success;
PMC *sockaddr;
PMC *array;
const size_t addr_len = sizeof (struct sockaddr_in);
struct sockaddr_in *sa;
Parrot_Sockaddr_attributes *sa_attrs;
sa = (struct sockaddr_in *)Parrot_gc_allocate_memory_chunk(interp,
addr_len);
sockaddr = Parrot_pmc_new(interp, enum_class_Sockaddr);
sa_attrs = PARROT_SOCKADDR(sockaddr);
sa_attrs->family = PF_INET;
sa_attrs->type = 0;
sa_attrs->protocol = 0;
sa_attrs->len = addr_len;
sa_attrs->pointer = sa;
if (STRING_IS_NULL(addr)) {
cstring = NULL;
host = "127.0.0.1";
}
else {
cstring = Parrot_str_to_cstring(interp, addr);
host = cstring;
}
# ifdef _WIN32
sa->sin_addr.S_un.S_addr = inet_addr(host);
success = sa->sin_addr.S_un.S_addr != -1;
# else
# ifdef PARROT_DEF_INET_ATON
success = inet_aton(host, &sa->sin_addr) != 0;
# else
/* positive retval is success */
success = inet_pton(PF_INET, host, &sa->sin_addr) > 0;
# endif
# endif
if (!success) {
/* Maybe it is a hostname, try to lookup */
/* XXX Check PIO option before doing a name lookup,
* it may have been toggled off.
*/
const struct hostent * const he = gethostbyname(host);
if (!he) {
if (cstring)
Parrot_str_free_cstring(cstring);
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
"getaddrinfo failed: %s", host);
}
memcpy((char*)&sa->sin_addr, he->h_addr, sizeof (sa->sin_addr));
}
if (cstring)
Parrot_str_free_cstring(cstring);
sa->sin_family = PF_INET;
sa->sin_port = htons(port);
array = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
VTABLE_push_pmc(interp, array, sockaddr);
return array;
#endif /* PARROT_HAS_IPV6 */
}
PARROT_EXPORT
PARROT_CANNOT_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
PMC*
Parrot_make_cb(PARROT_INTERP, ARGMOD(PMC* sub), ARGIN(PMC* user_data),
ARGIN(STRING *cb_signature))
{
ASSERT_ARGS(Parrot_make_cb)
PMC *cb, *cb_sig;
int type = 0;
STRING *sc;
char * const signature = Parrot_str_to_cstring(interp, cb_signature);
/*
* we stuff all the information into the user_data PMC and pass that
* on to the external sub
*/
PMC * const interp_pmc = VTABLE_get_pmc_keyed_int(interp, interp->iglobals,
(INTVAL) IGLOBALS_INTERPRETER);
/* be sure __LINE__ is consistent */
sc = CONST_STRING(interp, "_interpreter");
VTABLE_setprop(interp, user_data, sc, interp_pmc);
sc = CONST_STRING(interp, "_sub");
VTABLE_setprop(interp, user_data, sc, sub);
/* only ASCII signatures are supported */
if (strlen(signature) == 3) {
/* Callback return type ignored */
if (signature[1] == 'U') {
type = 'D';
}
else {
if (signature[2] == 'U') {
type = 'C';
}
}
}
Parrot_str_free_cstring(signature);
if (type != 'C' && type != 'D')
Parrot_ex_throw_from_c_args(interp, NULL, 1,
"unhandled signature '%Ss' in make_cb", cb_signature);
cb_sig = Parrot_pmc_new(interp, enum_class_String);
VTABLE_set_string_native(interp, cb_sig, cb_signature);
sc = CONST_STRING(interp, "_signature");
VTABLE_setprop(interp, user_data, sc, cb_sig);
/*
* We are going to be passing the user_data PMC to external code, but
* it may go out of scope until the callback is called -- we don't know
* for certain as we don't know when the callback will be called.
* Therefore, to prevent the PMC from being destroyed by a GC sweep,
* we need to anchor it.
*
*/
Parrot_pmc_gc_register(interp, user_data);
/*
* Finally, the external lib awaits a function pointer.
* Create a PMC that points to Parrot_callback_C (or _D);
* it can be passed on with signature 'p'.
*/
cb = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
/*
* Currently, we handle only 2 types:
* _C ... user_data is 2nd parameter
* _D ... user_data is 1st parameter
*/
if (type == 'C')
VTABLE_set_pointer(interp, cb, F2DPTR(Parrot_callback_C));
else
VTABLE_set_pointer(interp, cb, F2DPTR(Parrot_callback_D));
Parrot_pmc_gc_register(interp, cb);
return cb;
}
