Skip to content

Commit

Permalink
Merge pull request #1 from rurban/master
Browse files Browse the repository at this point in the history
fix for non-threaded perls
  • Loading branch information
goccy committed Jul 25, 2012
2 parents 5ac39f8 + 2bd57a6 commit 1d7a70f
Show file tree
Hide file tree
Showing 5 changed files with 33 additions and 1,016 deletions.
28 changes: 14 additions & 14 deletions AutoTest.xs
Original file line number Diff line number Diff line change
Expand Up @@ -501,12 +501,12 @@ static CV* current_cv(pTHX_ I32 ix, PERL_SI *si)
//================================================================================//
static CallFlow *cf_stack[MAX_CALLSTACK_SIZE] = {0};
static bool xs_stack[MAX_CALLSTACK_SIZE] = {0};
static char *get_serialized_argument(pTHX, int cxix, char *caller_name, char *callee_name)
static char *get_serialized_argument(pTHX_ int cxix, char *caller_name, char *callee_name)
{
const bool hasargs = (PL_op->op_flags & OPf_STACKED) != 0;
if (hasargs) {
int i = 0;
AV *argarray = my_perl->Icurstackinfo->si_cxstack[cxix].cx_u.cx_blk.blk_u.blku_sub.argarray;
AV *argarray = PL_curstackinfo->si_cxstack[cxix].cx_u.cx_blk.blk_u.blku_sub.argarray;
if (argarray && SvTYPE(argarray) == TYPE_Array) {
int argc = argarray->sv_any->xav_fill;//av_len((AV *)argarray);
SV **a = argarray->sv_u.svu_array;
Expand Down Expand Up @@ -537,7 +537,7 @@ static char *get_serialized_argument(pTHX, int cxix, char *caller_name, char *ca

static void record_callflow(pTHX_ SV *sub_sv, OP *op)
{
int cxix = my_perl->Icurstackinfo->si_cxix;
int cxix = PL_curstackinfo->si_cxix;
int saved_errno = errno;
OP *next_op = PL_op->op_next;
OPCODE op_type = ((opcode) PL_op->op_type == OP_GOTO) ? (opcode) PL_op->op_type : OP_ENTERSUB;
Expand Down Expand Up @@ -617,7 +617,7 @@ static void record_callflow(pTHX_ SV *sub_sv, OP *op)
callee_stash_name, callee_sub_name);
//fprintf(stderr, "stack = [%d]\n", cxix);
//fprintf(stderr, "%s::%s => %s::%s\n", caller_name, callee_name);
char *args = get_serialized_argument(aTHX, cxix, caller_name, callee_name);
char *args = get_serialized_argument(aTHX_ cxix, caller_name, callee_name);
cf_stack[cxix] = cf;
Package *from_pkg = NULL;
Package *to_pkg = NULL;
Expand Down Expand Up @@ -694,10 +694,10 @@ static void record_callflow(pTHX_ SV *sub_sv, OP *op)

static void record_return_value(pTHX)
{
int cxix = my_perl->Icurstackinfo->si_cxix;
SV **sp = my_perl->Istack_sp;
int mark = *my_perl->Imarkstack_ptr;
I32 items = my_perl->Istack_sp - my_perl->Istack_base;
int cxix = PL_curstackinfo->si_cxix;
SV **sp = PL_stack_sp;
int mark = *PL_markstack_ptr;
I32 items = PL_stack_sp - PL_stack_base;
bool is_list = false;
CallFlow *cf = cf_stack[cxix];
if (!cf) return;
Expand All @@ -716,16 +716,16 @@ static void record_return_value(pTHX)
tcg->fs->serialize(tcg->fs, sp[0]);
} else {
int i = 0;
I32 gimme = my_perl->Icurstackinfo->si_cxstack[cxix].cx_u.cx_blk.blku_gimme;
int oldsp = my_perl->Icurstackinfo->si_cxstack[cxix].cx_u.cx_blk.blku_oldsp;
I32 gimme = PL_curstackinfo->si_cxstack[cxix].cx_u.cx_blk.blku_gimme;
int oldsp = PL_curstackinfo->si_cxstack[cxix].cx_u.cx_blk.blku_oldsp;
mark = oldsp;
if (gimme == G_ARRAY) {
//fprintf(stderr, "rvalue : %s::%s => %s::%s\n", cf->from_stash, cf->from, cf->to_stash, cf->to);
if (items > 1 + mark) {
is_list = true;
write_cwb("(");
}
SV **base = my_perl->Istack_base;
SV **base = PL_stack_base;
for (i = 1 + mark; i <= items; i++) {
if (base[i]) {
tcg->fs->serialize(tcg->fs, base[i]);
Expand Down Expand Up @@ -825,12 +825,12 @@ CODE:
{
pp_entersub = PL_ppaddr[OP_ENTERSUB];
pp_leavesub = PL_ppaddr[OP_LEAVESUB];
pp_leavesublv = PL_ppaddr[OP_LEAVESUBLV];
pp_leavesublv = PL_ppaddr[OP_LEAVESUBLV];
pp_return = PL_ppaddr[OP_RETURN];
pp_goto = PL_ppaddr[OP_GOTO];
PL_ppaddr[OP_ENTERSUB] = hook_entersub;
PL_ppaddr[OP_LEAVESUB] = hook_leavesub;
PL_ppaddr[OP_LEAVESUBLV] = hook_leavesublv;
PL_ppaddr[OP_LEAVESUBLV] = hook_leavesublv;
PL_ppaddr[OP_RETURN] = hook_return;
PL_ppaddr[OP_GOTO] = hook_goto;
tcg = new_TestCodeGenerator();
Expand Down Expand Up @@ -861,7 +861,7 @@ void
dump_vmcode()
CODE:
{
OP *pc = my_perl->Iop;
OP *pc = PL_op;
fprintf(stderr, "========= DUMP VMCODE =======\n");
for (; pc; pc = pc->op_next) {
fprintf(stderr, "[%s]\n", OP_NAME(pc));
Expand Down
22 changes: 12 additions & 10 deletions Makefile.PL
Original file line number Diff line number Diff line change
@@ -1,17 +1,19 @@
use 5.008008;
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
NAME => 'AutoTest',
VERSION_FROM => 'lib/AutoTest.pm', # finds $VERSION
PREREQ_PM => {}, # e.g., Module::Name => 1.1
PREREQ_PM => {},
LICENSE => 'perl',
OBJECT => join(" ", map {$_.'$(OBJ_EXT)'} qw(AutoTest serializer hash util)),
($] >= 5.005 ? ## Add these new keywords supported since 5.005
(ABSTRACT_FROM => 'lib/AutoTest.pm', # retrieve abstract from module
AUTHOR => 'A. U. Thor <bkapps@localdomain>') : ()),
LIBS => [''], # e.g., '-lm'
DEFINE => '', # e.g., '-DHAVE_SOMETHING'
INC => '-I.', # e.g., '-I. -I/usr/include/other'
OPTIMIZE => '-O0 -g3',
OBJECT => 'AutoTest.o serializer.o hash.o util.o',
AUTHOR => 'Masaaki Goshima <goccy54@gmail.com>',
) : ()),
($ExtUtils::MakeMaker::VERSION gt '6.46' ?
('META_MERGE' => {resources => {
license => 'http://dev.perl.org/licenses/',
repository => 'https://github.com/goccy/AutoTest',
},
}) : ()),
INC => '-I.',
);
Loading

0 comments on commit 1d7a70f

Please sign in to comment.