diff options
| -rw-r--r-- | embed.fnc | 8 | ||||
| -rw-r--r-- | embed.h | 20 | ||||
| -rw-r--r-- | ext/ByteLoader/bytecode.h | 12 | ||||
| -rw-r--r-- | global.sym | 2 | ||||
| -rw-r--r-- | op.c | 17 | ||||
| -rw-r--r-- | op.h | 13 | ||||
| -rw-r--r-- | proto.h | 8 | ||||
| -rwxr-xr-x | t/TEST | 18 |
8 files changed, 52 insertions, 46 deletions
@@ -1025,10 +1025,10 @@ s |OP * |my_kid |OP *o|OP *attrs|OP **imopsp s |OP * |dup_attrlist |OP *o s |void |apply_attrs |HV *stash|SV *target|OP *attrs|bool for_my s |void |apply_attrs_my |HV *stash|OP *target|OP *attrs|OP **imopsp -# if defined(PL_OP_SLAB_ALLOC) -s |void* |Slab_Alloc |int m|size_t sz -s |void |Slab_Free |void *op -# endif +#endif +#if defined(PL_OP_SLAB_ALLOC) +Ap |void* |Slab_Alloc |int m|size_t sz +Ap |void |Slab_Free |void *op #endif #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT) @@ -1387,14 +1387,10 @@ #ifdef PERL_CORE #define apply_attrs_my S_apply_attrs_my #endif -# if defined(PL_OP_SLAB_ALLOC) -#ifdef PERL_CORE -#define Slab_Alloc S_Slab_Alloc -#endif -#ifdef PERL_CORE -#define Slab_Free S_Slab_Free #endif -# endif +#if defined(PL_OP_SLAB_ALLOC) +#define Slab_Alloc Perl_Slab_Alloc +#define Slab_Free Perl_Slab_Free #endif #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT) #ifdef PERL_CORE @@ -3873,14 +3869,10 @@ #ifdef PERL_CORE #define apply_attrs_my(a,b,c,d) S_apply_attrs_my(aTHX_ a,b,c,d) #endif -# if defined(PL_OP_SLAB_ALLOC) -#ifdef PERL_CORE -#define Slab_Alloc(a,b) S_Slab_Alloc(aTHX_ a,b) -#endif -#ifdef PERL_CORE -#define Slab_Free(a) S_Slab_Free(aTHX_ a) #endif -# endif +#if defined(PL_OP_SLAB_ALLOC) +#define Slab_Alloc(a,b) Perl_Slab_Alloc(aTHX_ a,b) +#define Slab_Free(a) Perl_Slab_Free(aTHX_ a) #endif #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT) #ifdef PERL_CORE diff --git a/ext/ByteLoader/bytecode.h b/ext/ByteLoader/bytecode.h index 7fb91daf61..d26448239a 100644 --- a/ext/ByteLoader/bytecode.h +++ b/ext/ByteLoader/bytecode.h @@ -191,14 +191,14 @@ typedef char *pvindex; SvFLAGS(sv) = arg; \ BSET_OBJ_STOREX(sv); \ } STMT_END -#define BSET_newop(o, arg) \ - ((o = (OP*)safemalloc(arg)), memzero((char*)o,arg)) + +#define BSET_newop(o, arg) NewOpSz(666, o, arg) #define BSET_newopx(o, arg) STMT_START { \ register int sz = arg & 0x7f; \ - register OP* new = (OP*) safemalloc(sz);\ - memzero(new, sz); \ - /* new->op_next = o; XXX */ \ - o = new; \ + register OP* newop; \ + BSET_newop(newop, sz); \ + /* newop->op_next = o; XXX */ \ + o = newop; \ arg >>=7; \ BSET_op_type(o, arg); \ BSET_OBJ_STOREX(o); \ diff --git a/global.sym b/global.sym index 8d0e0da275..34961986af 100644 --- a/global.sym +++ b/global.sym @@ -628,6 +628,8 @@ Perl_sv_nosharing Perl_sv_nolocking Perl_sv_nounlocking Perl_nothreadhook +Perl_Slab_Alloc +Perl_Slab_Free Perl_sv_setsv_flags Perl_sv_catpvn_flags Perl_sv_catsv_flags @@ -30,13 +30,8 @@ #define PERL_SLAB_SIZE 2048 #endif -#define NewOp(m,var,c,type) \ - STMT_START { var = (type *) Slab_Alloc(m,c*sizeof(type)); } STMT_END - -#define FreeOp(p) Slab_Free(p) - -STATIC void * -S_Slab_Alloc(pTHX_ int m, size_t sz) +void * +Perl_Slab_Alloc(pTHX_ int m, size_t sz) { /* * To make incrementing use count easy PL_OpSlab is an I32 * @@ -74,8 +69,8 @@ S_Slab_Alloc(pTHX_ int m, size_t sz) return (void *)(PL_OpPtr + 1); } -STATIC void -S_Slab_Free(pTHX_ void *op) +void +Perl_Slab_Free(pTHX_ void *op) { I32 **ptr = (I32 **) op; I32 *slab = ptr[-1]; @@ -93,10 +88,6 @@ S_Slab_Free(pTHX_ void *op) } } } - -#else -#define NewOp(m, var, c, type) Newz(m, var, c, type) -#define FreeOp(p) Safefree(p) #endif /* * In the following definition, the ", Nullop" is just to make the compiler @@ -483,3 +483,16 @@ struct loop { #include "reentr.h" #endif +#if defined(PL_OP_SLAB_ALLOC) +#define NewOp(m,var,c,type) \ + STMT_START { \ + var = (type *) Perl_Slab_Alloc(aTHX_ m,c*sizeof(type));\ + } STMT_END +#define NewOpSz(m,var,size) \ + STMT_START { var = (OP *) Perl_Slab_Alloc(aTHX_ m,size); } STMT_END +#define FreeOp(p) Perl_Slab_Free(aTHX_ p) +#else +#define NewOp(m, var, c, type) Newz(m, var, c, type) +#define NewOpSz(m, var, size) Newz(m, (char*)var, size, char) +#define FreeOp(p) Safefree(p) +#endif @@ -981,10 +981,10 @@ STATIC OP * S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp); STATIC OP * S_dup_attrlist(pTHX_ OP *o); STATIC void S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my); STATIC void S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp); -# if defined(PL_OP_SLAB_ALLOC) -STATIC void* S_Slab_Alloc(pTHX_ int m, size_t sz); -STATIC void S_Slab_Free(pTHX_ void *op); -# endif +#endif +#if defined(PL_OP_SLAB_ALLOC) +PERL_CALLCONV void* Perl_Slab_Alloc(pTHX_ int m, size_t sz); +PERL_CALLCONV void Perl_Slab_Free(pTHX_ void *op); #endif #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT) @@ -246,9 +246,17 @@ EOT or print "can't deparse '$deparse': $!.\n"; } elsif ($type eq 'bytecompile') { - my $perl = $ENV{PERL} || './perl'; - my $redir = ($^O eq 'VMS' ? '2>&1' : ''); - my $bswitch = "-MO=Bytecode,-H,-TI,-s`pwd`/$test,"; + my ($pwd, $null); + if( $^O eq 'MSWin32') { + $pwd = `cd`; + $null = 'nul'; + } else { + $pwd = `pwd`; + $null = '/dev/null'; + } + chomp $pwd; + my $perl = $ENV{PERL} || "$pwd/perl"; + my $bswitch = "-MO=Bytecode,-H,-TI,-s$pwd/$test,"; $bswitch .= "-TF$test.plc," if $test =~ m(chdir|pod/|CGI/t/carp|lib/DB); $bswitch .= "-k," @@ -257,8 +265,8 @@ EOT if $test =~ m(op/getpid); my $bytecompile = "$perl $testswitch $switch -I../lib $bswitch". - "-o$test.plc $test 2>/dev/null &&". - "$perl $testswitch $switch -I../lib $utf $test.plc $redir|"; + "-o$test.plc $test 2>$null &&". + "$perl $testswitch $switch -I../lib $utf $test.plc |"; open(RESULTS,$bytecompile) or print "can't byte-compile '$bytecompile': $!.\n"; } |