Creating Threaded callbacks in XS - perl

EDIT: I have created a ticket for this which has data on an alternative to this way of doing things.
I have updated the code in an attempt to use MY_CXT's callback as gcxt was not storing across threads. However this segfaults at ENTER.
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#ifndef aTHX_
#define aTHX_
#endif
#ifdef USE_THREADS
#define HAVE_TLS_CONTEXT
#endif
/* For windows */
#ifndef SDL_PERL_DEFINES_H
#define SDL_PERL_DEFINES_H
#ifdef HAVE_TLS_CONTEXT
PerlInterpreter *parent_perl = NULL;
extern PerlInterpreter *parent_perl;
#define GET_TLS_CONTEXT parent_perl = PERL_GET_CONTEXT;
#define ENTER_TLS_CONTEXT \
PerlInterpreter *current_perl = PERL_GET_CONTEXT; \
PERL_SET_CONTEXT(parent_perl); { \
PerlInterpreter *my_perl = parent_perl;
#define LEAVE_TLS_CONTEXT \
} PERL_SET_CONTEXT(current_perl);
#else
#define GET_TLS_CONTEXT /* TLS context not enabled */
#define ENTER_TLS_CONTEXT /* TLS context not enabled */
#define LEAVE_TLS_CONTEXT /* TLS context not enabled */
#endif
#endif
#include <SDL.h>
#define MY_CXT_KEY "SDL::Time::_guts" XS_VERSION
typedef struct {
void* data;
SV* callback;
Uint32 retval;
} my_cxt_t;
static my_cxt_t gcxt;
START_MY_CXT
static Uint32 add_timer_cb ( Uint32 interval, void* param )
{
ENTER_TLS_CONTEXT
dMY_CXT;
dSP;
int back;
ENTER; //SEGFAULTS RIGHT HERE!
SAVETMPS;
PUSHMARK(SP);
XPUSHs(sv_2mortal(newSViv(interval)));
PUTBACK;
if (0 != (back = call_sv(MY_CXT.callback,G_SCALAR))) {
SPAGAIN;
if (back != 1 ) Perl_croak (aTHX_ "Timer Callback failed!");
MY_CXT.retval = POPi;
} else {
Perl_croak(aTHX_ "Timer Callback failed!");
}
FREETMPS;
LEAVE;
LEAVE_TLS_CONTEXT
dMY_CXT;
return MY_CXT.retval;
}
MODULE = SDL::Time PACKAGE = SDL::Time PREFIX = time_
BOOT:
{
MY_CXT_INIT;
}
SDL_TimerID
time_add_timer ( interval, cmd )
Uint32 interval
void *cmd
PREINIT:
dMY_CXT;
CODE:
MY_CXT.callback=cmd;
gcxt = MY_CXT;
RETVAL = SDL_AddTimer(interval,add_timer_cb,(void *)cmd);
OUTPUT:
RETVAL
void
CLONE(...)
CODE:
MY_CXT_CLONE;
This segfaults as soon as I go into ENTER for the callback.
use SDL;
use SDL::Time;
SDL::init(SDL_INIT_TIMER);
my $time = 0;
SDL::Timer::add_timer(100, sub { $time++; return $_[0]} );
sleep(10);
print "Never Prints";
Output is
$
it should be
$ Never Prints

Quick comments:
Do not use Perl structs (SV, AV, HV, ...) outside of the context of a Perl interpreter object. I.e. do not use it as C-level static data. It will blow up in a threading context. Trust me, I've been there.
Check out the "Safely Storing Static Data in XS" section in the perlxs manpage.
Some of that stuff you're doing looks rather non-public from the point of view of the perlapi. I'm not quite certain, though.

$time needs to be a shared variable - otherwise perl works with separate copies of the variable.

My preferred way of handling this is storing the data in the PL_modglobal hash. It's automatically tied to the current interpreter.

We have found a solution to this using Perl interpreter threads and threads::shared. Please see these
Time.xs
Also here is an example of a script using this code.
TestTimer.pl

Related

print floats from audio input callback function

I'm working on a university project that involves a lot of programming in C, especially with Portaudio & ALSA. At the moment i'm trying to make a callback function to pass audio through, standard input/output job. I was wondering if anybody could tell me how to print the floats from my inputBuffer to display in real time in the terminal? Here is the internal structure of my callback function so far.
Thanks very much for your help in advance!
#define SAMPLE_RATE (44100)
#define PA_SAMPLE_TYPE paFloat32
#define FRAMES_PER_BUFFER (64)
typedef float SAMPLE;
static int audio_callback( const void *inputBuffer, void *outputBuffer,
unsigned long framesPerBuffer,
const PaStreamCallbackTimeInfo* timeInfo,
PaStreamCallbackFlags statusFlags,
void *userData )
{
SAMPLE *out = (SAMPLE*)outputBuffer;
const SAMPLE *in = (const SAMPLE*)inputBuffer;
unsigned int i;
(void) timeInfo; /* Prevent unused variable warnings. */
(void) statusFlags;
(void) userData;
if( inputBuffer == NULL )
{
for( i=0; i<framesPerBuffer; i++ )
{
*out++ = *in++; /* left - clean */
*out++ = *in++; /* right - clean */
}
}
return paContinue;
}

perl match function for C program

Trying to use perl API functions in C program. Couldn't find the function to do regular expression match. Wish there is a function like regexmatch in the following program.
#include <EXTERN.h> /* from the Perl distribution */
#include <perl.h> /* from the Perl distribution */
#include <sys/time.h>
typedef unsigned long ulong;
static PerlInterpreter *my_perl; /*** The Perl interpreter ***/
int main(int argc, char **argv, char **env) {
int numOfArgs = 0;
PERL_SYS_INIT3(&numOfArgs, NULL, NULL);
my_perl = perl_alloc();
perl_construct(my_perl);
SV* str = newSVpv(argv[1], strlen(argv[1]));
if (regexmatch(str, "/hi (\S+)/")) {
printf("found a match\n");
}
return 0;
}
I know it's possible to use pcre library, just wonder if it's possible to get it from perl library here (libperl.so.5.14.2 on ubuntu 12.04)
Thanks!
UPDATE 1:
Did some google search and got the following simple program compiling. But when I ran the program as ./a.out ping pin, it gave "Segmentation fault" in the "pregcomp" function. Not sure why.
#include <EXTERN.h> /* from the Perl distribution */
#include <perl.h> /* from the Perl distribution */
#include <sys/time.h>
#include <embed.h>
typedef unsigned long ulong;
static PerlInterpreter *my_perl; /*** The Perl interpreter ***/
struct REGEXP * const engine;
int main(int argc, char **argv, char **env) {
int numOfArgs = 0;
PERL_SYS_INIT3(&numOfArgs, NULL, NULL);
my_perl = perl_alloc();
perl_construct(my_perl);
SV* reStr = newSVpv(argv[2], strlen(argv[2]));
printf("compiling regexp\n");
REGEXP * const compiled_regex = pregcomp(reStr, 0);
printf("execing regexp\n");
int len = strlen(argv[1]);
pregexec(compiled_regex, argv[1], argv[1] + len, argv[1], 5, NULL, 0);
return 0;
}
Don't mess with Perl's private internals. Call a Perl sub that uses the match operator.
Say you previously compiled the following in your interpreter (using eval_pv),
sub regex_match { $_[0] =~ $_[1] }
Then you can call
static bool regex_match_sv(SV* str, SV* re) {
dSP;
bool matched;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(str);
XPUSHs(re);
PUTBACK;
call_pv("regex_match", G_SCALAR);
SPAGAIN;
matched = SvTRUE(POPs);
PUTBACK;
FREETMPS;
LEAVE;
return matched;
}

How to add a built-in module to a C-Python API after Py_Initialize?

I have a module defined in my C code like so:
static struct PyModuleDef module_def = {
PyModuleDef_HEAD_INIT,
"the_module_name", /* m_name */
module_documentation, /* m_doc */
//....
};
and a function to initialize it:
PyMODINIT_FUNC init_the_module(void)
{
PyObject *mod, *submodule;
PyObject *sys_modules = PyThreadState_GET()->interp->modules;
mod = PyModule_Create(&module_def);
PyModule_AddObject(mod, "some_submodule", (submodule = init_the_submodule()));
PyDict_SetItemString(sys_modules, PyModule_GetName(submodule), submodule);
Py_INCREF(submodule);
// more submodules..
return mod;
}
The application that I am embedding python into is quite big and I can not change the workflow much. At this point Py_Initialize has already been called, so I can not call PyImport_ExtendInittabor PyImport_AppendInittab .
How can I create and add the module to the system modules?
Maybe I can manipulate the modules dictionary directly? Like so:
PyObject *modules, *the_module;
modules = PyImport_GetModuleDict();
PyDict_SetItemString(modules, "the_module_name", init_the_module());
the_module = PyDict_GetItemString(modules, "the_module_name"); //this is getting something back
std::cout << PyDict_Size(the_module) << std::endl; // this prints -1
The easiest way to handle this is to statically initialize your statically-linked modules by directly calling initspam() after the call to Py_Initialize() or PyMac_Initialize():
int main(int argc, char **argv)
{
/* Pass argv[0] to the Python interpreter */
Py_SetProgramName(argv[0]);
/* Initialize the Python interpreter. Required. */
Py_Initialize();
/* Add a static module */
initspam();
An example may be found in the file Demo/embed/demo.c in the Python source distribution.

socket is not blocking on write operation: OpenSolaris

I have a unit test that checks behavior on blocking and non-blocking sockets - the server writes a long response and at some point it should not be able to write any more and it
blocks on write.
Basically one side writes and other side does not reads.
Under Solaris at some point I get a error "Not enough space" (after writing 75MB) instead of blocking on write:
Program that reproduces the problem:
#include <sys/types.h>
#include <sys/socket.h>
#include <sys/wait.h>
#include <unistd.h>
#include <stdlib.h>
#include <stdio.h>
#include <errno.h>
#include <string.h>
#include <signal.h>
#include <arpa/inet.h>
#include <sys/socket.h>
#include <sys/un.h>
#include <netinet/in.h>
char const *address = "127.0.0.1";
#define check(x) do { if( (x) < 0) { perror(#x) ; exit(1); } } while(0)
int main()
{
signal(SIGPIPE,SIG_IGN);
struct sockaddr_in inaddr = {};
inaddr.sin_family = AF_INET;
inaddr.sin_addr.s_addr = inet_addr(address);
inaddr.sin_port = htons(8080);
int res = fork();
if(res < 0) {
perror("fork");
exit(1);
}
if(res > 0) {
int fd = -1;
int status;
sleep(1);
check(fd = socket(AF_INET,SOCK_STREAM,0));
check(connect(fd,(sockaddr*)&inaddr,sizeof(inaddr)));
sleep(5);
close(fd);
wait(&status);
return 0;
}
else {
int acc,fd;
check(acc = socket(AF_INET,SOCK_STREAM,0));
int yes = 1;
check(setsockopt(acc,SOL_SOCKET,SO_REUSEADDR,&yes,sizeof(yes)));
check(bind(acc,(sockaddr*)&inaddr,sizeof(inaddr)));
check(listen(acc,10));
check(fd = accept(acc,0,0));
char buf[1000];
long long total= 0;
do {
int r = send(fd,buf,sizeof(buf),0);
if(r < 0) {
printf("write %s\n",strerror(errno));
return 0;
}
else if(r==0) {
printf("Got eof\n");
return 0;
}
total += r;
if(total > 100*1024*1024) {
printf("Too much!!!!\n");
return 0;
}
printf("%lld\n",total);
}while(1);
}
return 0;
}
The output on Solaris (last two lines)
75768000
write Not enough space
The expected output on Linux (last two lines)
271760
write Connection reset by peer
Which happens only when the other side closes the socket.
Any ideas why and how can I fix it, what options to set?
P.S.: It is OpenSolaris 2009.06, x86
Edits
Added full C code that reproduces the problem
Answer:
This seems like a bug in specific version of Solaris kernel, libc library.
From OpenSolaris source code, I'm afraid the SO_SNDTIMEO option is unsupported: https://hg.java.net/hg/solaris~on-src/file/tip/usr/src/uts/common/inet/sockmods/socksctp.c#l1233
If you want to block if there's no space available, you need to write code to do that.
POSIX is pretty clear that write on a socket is equivalent to send with no options, and that send "may fail if ... [i]nsufficient resources were available in the system to perform the operation."

generalize call to NSLog

I am tying to generalize calling NSLog and avoid having to comment-out the calls when I am finished debugging.
I have:
#define USE_ADLog 0
#define USE_RPLog 0
#define USE_DLLog 1
void ConsoleADLog(NSString *message, ...);
void ConsoleRPLog(NSString *message, ...);
void ConsoleDLLog(NSString *message, ...);
and, for example:
void ConsoleADLog(NSString *message, ...) {
#if (USE_ADLog)
va_list optionalArgs;
va_start(optionalArgs, message); // after the parm = message
va_end(optionalArgs);
NSLog(message, optionalArgs);
#endif
}
So far, so good ... however, as soon as I call, for example,:
ConsoleDLLog(#"parm1 = %#, parm2 = %#", parm1, parm2);
which call is inside a secondary thread, I bomb. I thought?? that va_start, va_end were thread safe.
... or is the problem %# ... I know %f works ???
Apparently not!, so how do I make them thread safe ... plain ole
NSLog(#"whatever %#", whateverParm)
works, but not the function above.
Thanks,
this is why many variadic functions include variants which accept va_lists.
see NSLogv.
#if DEBUG == 0
#define DebugLog(...)
#elif DEBUG == 1
#define DebugLog(...) NSLog(__VA_ARGS__)
#endif
Then invoke it using DebugLog(#"Uh oh: %#", someArgument);. If DEBUG is set to 1, the preprocessor will emit NSLog(#"Uh oh: %#", someArgument);. If it's set to 0, it will not emit anything.