On Wed, Jul 06, 2005 at 03:49:27PM -0700, William Ahern wrote:
> I've seen a couple of coroutine packages, but it doesn't seem that any of
> these can yield back into C, or resume from C. Is this true? Am I completely
> SOL if I'm looking for Lua-style coroutines that work across the binding
> boundaries?
>
Using this nifty coro library for C
http://xmailserver.org/libpcl.html
I seemed to have been able to do accomplish the impossible.
Using libpcl, libevent, and abusing Linux's weak/strong symbols for read(2)
and write(2), I've got some proof-of-concept code which can jump out of the
Perl VM when read returns with EAGAIN and back into it when the fd is
selected for reading.
Here's the code if anybody is interested. The program is looping in
event_loop() from the main "thread". When there is something to read on
stdin Perl is "resumed", and when stdin is empty Perl "yields". Pretty
nifty. I noticed that you can't load dynamic libraries from inside the
coroutine (segfault). I anticipate many other surprises, but I'm quite happy
with this so far.
If anybody thinks this is a non-starter and I'm doomed to failure, please
let me know! :)
-- Makefile:
CFLAGS=-g -Wall -O2 -std=gnu99 $(shell perl -MExtUtils::Embed -e ccopts)
LDFLAGS=$(shell perl -MExtUtils::Embed -e ldopts) -levent -lpcl
-L/usr/local/lib -Wl,-rpath /usr/local/lib
pcl: pcl.c
$(CC) $(CPPFLAGS) $(CFLAGS) pcl.c -o pcl $(LDFLAGS)
-- pcl.c:
#include <stdio.h>
#include <stdlib.h>
#include <sys/queue.h>
#include <sys/time.h>
#include <fcntl.h>
#include <dlfcn.h>
#include <err.h>
#include <event.h>
#include <pcl.h>
#include <EXTERN.h>
#include <perl.h>
#undef MARK
#define MARK (fprintf(stderr,"MARK %s:%d\n",__func__,__LINE__))
CIRCLEQ_HEAD(perlq,perl);
struct perl {
coroutine_t stack;
PerlInterpreter *vm;
void (*issue)(struct perl *);
struct perlq *live;
struct perlq *idle;
struct {
struct event ev;
int ok;
} io;
CIRCLEQ_ENTRY(perl) cqe;
};
static PerlInterpreter *my_perl;
static struct perl *this_perl;
EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
EXTERN_C void xs_init(pTHX) {
newXS("DynaLoader::boot_DynaLoader",boot_DynaLoader,__FILE__);
return /* void */;
} /* xs_init() */
void perl_switchin(struct perl *p) {
if (p->idle && p->live) {
CIRCLEQ_REMOVE(p->idle,p,cqe);
CIRCLEQ_INSERT_HEAD(p->live,p,cqe);
}
PERL_SET_CONTEXT(p->vm);
my_perl = p->vm;
this_perl = p;
return /* void */;
} /* perl_switchin() */
void perl_switchout(struct perl *p) {
this_perl = 0;
my_perl = 0;
if (p->idle && p->live) {
CIRCLEQ_REMOVE(p->live,p,cqe);
CIRCLEQ_INSERT_HEAD(p->idle,p,cqe);
}
return /* void */;
} /* perl_switchout() */
void perl_main(void *arg) {
struct perl *p = arg;
for (;;) {
//MARK;
if (p->issue) {
perl_switchin(p);
p->issue(p);
p->issue = 0;
perl_switchout(p);
}
//MARK;
co_resume();
}
return /* void */;
} /* perl_main() */
void perl_init(struct perl *p) {
//MARK;
perl_parse(p->vm,xs_init,3,(char *[]){"perl_init","-e","while (<>) {
print \"Got line: $_\" }"},0);
perl_run(p->vm);
//MARK;
return /* void */;
} /* perl_init() */
struct perl *perl_open(const char *initcode) {
struct perl *p = NULL;
if (!(p = malloc(sizeof *p)))
goto sysfail;
*p = (typeof(*p)){ 0 };
if (!(p->stack = co_create(perl_main,p,0,8192)))
goto sysfail;
if (!(p->vm = perl_alloc()))
goto sysfail;
perl_construct(p->vm);
p->issue = perl_init;
co_call(p->stack);
//MARK;
return p;
sysfail:
return NULL;
} /* perl_open() */
void perl_close(struct perl *p) {
return /* void */;
} /* perl_close() */
void timer_resume(int fd, short events, void *arg) {
struct event *timer = arg;
MARK;
evtimer_add(timer,(&(struct timeval){ 3, 0 }));
return /* void */;
} /* timer_resume() */
void perl_resume(int fd, short event, void *arg) {
struct perl *p = arg;
p->io.ok = 1;
co_call(p->stack);
return /* void */;
} /* perl_resume() */
ssize_t read(int fd, void *buf, size_t len) {
static ssize_t (*real_read)(int, void *, size_t);
ssize_t ret;
struct perl *volatile p;
if (!real_read)
real_read = dlsym(RTLD_NEXT,"read");
if (!(p = this_perl))
return real_read(fd,buf,len);
fcntl(fd,F_SETFL,O_NONBLOCK | fcntl(fd,F_GETFL));
retry:
ret = real_read(fd,buf,len);
if (ret == -1 && errno == EAGAIN) {
p->io.ok = 0;
event_set(&p->io.ev,fd,EV_READ,perl_resume,p);
event_add(&p->io.ev,NULL);
do {
perl_switchout(p);
co_resume();
perl_switchin(p);
} while (!p->io.ok);
goto retry;
}
return ret;
} /* read() */
ssize_t write(int fd, const void *buf, size_t len) {
static ssize_t (*real_write)(int, const void *, size_t);
ssize_t ret;
if (!real_write)
real_write = dlsym(RTLD_NEXT,"write");
ret = real_write(fd,buf,len);
return ret;
} /* write() */
int main(int argc, char *argv[]) {
struct event timer;
struct perl *p;
event_init();
evtimer_set(&timer,timer_resume,&timer);
evtimer_add(&timer,(&(struct timeval){ 3, 0 }));
p = perl_open("print \"Hello world!\\n\"");
event_loop(0);
return 0;
}
