#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "message.h"
#include "queue.h"
#include "mthread.h"
#include "resources.h"
int
S_return_elements(pTHX_ AV* values, U32 context) {
dSP;
UV count;
if
(context == G_SCALAR) {
SV** ret = av_fetch(values, 0, FALSE);
PUSHs(ret ? *ret : &PL_sv_undef);
count = 1;
}
else
if
(context == G_ARRAY) {
count = av_len(values) + 1;
EXTEND(SP, count);
Copy(AvARRAY(values), SP + 1, count, SV*);
SP += count;
}
PUTBACK;
return
count;
}
#define return_elements(entry, context) S_return_elements(aTHX_ entry, context)
MODULE = threads::lite PACKAGE = threads::lite
PROTOTYPES: DISABLED
BOOT:
global_init(aTHX);
SV*
spawn(options, startup)
SV* options;
SV* startup;
INIT:
HV* real_options;
PPCODE:
PUTBACK;
real_options = SvROK(options) && SvTYPE(SvRV(options)) == SVt_PVHV ? (HV*) SvRV(options) : (HV*)sv_2mortal((SV*)newHV());
create_push_threads(real_options, startup);
SPAGAIN;
SV*
_receive()
PREINIT:
AV* ret;
CODE:
mthread*
thread
= get_self();
message message;
queue_dequeue(&
thread
->queue, &message, NULL);
ret = message_to_array(&message);
RETVAL = newRV_noinc((SV*)ret);
OUTPUT:
RETVAL
SV*
_receive_nb()
PREINIT:
AV* ret;
CODE:
mthread*
thread
= get_self();
message message;
if
(queue_dequeue_nb(&
thread
->queue, &message, NULL)) {
ret = message_to_array(&message);
RETVAL = newRV_noinc((SV*)ret);
}
else
XSRETURN_EMPTY;
OUTPUT:
RETVAL
SV*
self()
CODE:
mthread*
thread
= get_self();
SV** ret = hv_fetch(PL_modglobal,
"threads::lite::self"
, 19, FALSE);
RETVAL = SvREFCNT_inc_NN(*ret);
OUTPUT:
RETVAL
void
_return_elements(arg)
SV* arg;
PREINIT:
AV* values;
PPCODE:
values = (AV*)SvRV(arg);
if
(GIMME_V == G_SCALAR) {
SV** ret = av_fetch(values, 0, FALSE);
PUSHs(ret ? *ret : &PL_sv_undef);
}
else
if
(GIMME_V == G_ARRAY) {
UV count = av_len(values) + 1;
EXTEND(SP, count);
Copy(AvARRAY(values), SP + 1, count, SV*);
SP += count;
}
void
send_to(tid, ...)
SV* tid;
INIT:
message message;
UV thread_id;
CODE:
if
(items == 1)
Perl_croak(aTHX_
"Can't send an empty list\n"
);
thread_id = SvUV(tid);
message_from_stack(&message, MARK + 1);
thread_send(thread_id, &message);
MODULE = threads::lite PACKAGE = threads::lite::tid
PROTOTYPES: DISABLED
void
send(object, ...)
SV* object;
INIT:
message message;
UV thread_id;
CODE:
if
(items == 1)
Perl_croak(aTHX_
"Can't send an empty list\n"
);
thread_id = SvUV(SvRV(object));
message_from_stack(&message, MARK + 1);
thread_send(thread_id, &message);
void
monitor(object)
SV* object;
CODE:
thread_add_listener(aTHX, SvUV(SvRV(object)), get_self()->id);
MODULE = threads::lite PACKAGE = threads::lite::queue
PROTOTYPES: DISABLED
SV*
new
(
class
)
SV*
class
;
INIT:
UV queue_id;
CODE:
queue_id = queue_alloc();
RETVAL = newRV_noinc(newSVuv(queue_id));
sv_bless(RETVAL, gv_stashsv(
class
, FALSE));
OUTPUT:
RETVAL
void
enqueue(object, ...)
SV* object;
INIT:
message message;
UV queue_id;
CODE:
if
(items == 1)
Perl_croak(aTHX_
"Can't send an empty list\n"
);
queue_id = SvUV(SvRV(object));
message_from_stack(&message, MARK + 1);
queue_send(queue_id, &message);
void
dequeue(object)
SV* object;
INIT:
message message;
UV queue_id;
PPCODE:
queue_id = SvUV(SvRV(object));
queue_receive(queue_id, &message);
message_to_stack(&message, GIMME_V);
void
dequeue_nb(object)
SV* object;
INIT:
message message;
UV queue_id;
PPCODE:
queue_id = SvUV(SvRV(object));
if
(queue_receive_nb(queue_id, &message))
message_to_stack(&message, GIMME_V);
else
XSRETURN_EMPTY;