Re: ByteLoader and MSWin32

Message-ID: <20030902004511.GA1442@ratsnest.hole>

p4raw-id: //depot/perl@20993

diff --git a/embed.fnc b/embed.fnc
index 04b134f..26d3bd5 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -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)

diff --git a/embed.h b/embed.h
index 18b117a..873cb04 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -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 7fb91da..d264482 100644 (file)
--- 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 8d0e0da..3496198 100644 (file)
--- 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

diff --git a/op.c b/op.c
index d859e2a..991a426 100644 (file)
--- a/op.c
+++ b/op.c
@@ -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

diff --git a/op.h b/op.h
index 3bf90c7..ed38438 100644 (file)
--- a/op.h
+++ b/op.h
@@ -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

diff --git a/proto.h b/proto.h
index e41659e..97ae843 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -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)

diff --git a/t/TEST b/t/TEST
index 95869fb..5885060 100755 (executable)
--- a/t/TEST
+++ b/t/TEST
@@ -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";
        }