Change 20993 by [EMAIL PROTECTED] on 2003/09/02 14:40:54
Subject: [PATCH] Re: ByteLoader and MSWin32
From: Enache Adrian <[EMAIL PROTECTED]>
Date: Tue, 2 Sep 2003 03:45:11 +0300
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/embed.fnc#102 edit
... //depot/perl/embed.h#414 edit
... //depot/perl/ext/ByteLoader/bytecode.h#37 edit
... //depot/perl/global.sym#244 edit
... //depot/perl/op.c#583 edit
... //depot/perl/op.h#120 edit
... //depot/perl/proto.h#453 edit
... //depot/perl/t/TEST#94 edit
Differences ...
==== //depot/perl/embed.fnc#102 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#101~20726~ Fri Aug 15 13:29:10 2003
+++ perl/embed.fnc Tue Sep 2 07:40:54 2003
@@ -1025,10 +1025,10 @@
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)
==== //depot/perl/embed.h#414 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#413~20591~ Sat Aug 9 14:08:59 2003
+++ perl/embed.h Tue Sep 2 07:40:54 2003
@@ -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
==== //depot/perl/ext/ByteLoader/bytecode.h#37 (text) ====
Index: perl/ext/ByteLoader/bytecode.h
--- perl/ext/ByteLoader/bytecode.h#36~20816~ Thu Aug 21 22:15:30 2003
+++ perl/ext/ByteLoader/bytecode.h Tue Sep 2 07:40:54 2003
@@ -191,14 +191,14 @@
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); \
==== //depot/perl/global.sym#244 (text+w) ====
Index: perl/global.sym
--- perl/global.sym#243~20591~ Sat Aug 9 14:08:59 2003
+++ perl/global.sym Tue Sep 2 07:40:54 2003
@@ -628,6 +628,8 @@
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
==== //depot/perl/op.c#583 (text) ====
Index: perl/op.c
--- perl/op.c#582~20980~ Mon Sep 1 01:49:02 2003
+++ perl/op.c Tue Sep 2 07:40:54 2003
@@ -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 @@
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 @@
}
}
}
-
-#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
==== //depot/perl/op.h#120 (text) ====
Index: perl/op.h
--- perl/op.h#119~19610~ Fri May 23 23:42:52 2003
+++ perl/op.h Tue Sep 2 07:40:54 2003
@@ -483,3 +483,16 @@
#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
==== //depot/perl/proto.h#453 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#452~20591~ Sat Aug 9 14:08:59 2003
+++ perl/proto.h Tue Sep 2 07:40:54 2003
@@ -981,10 +981,10 @@
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)
==== //depot/perl/t/TEST#94 (xtext) ====
Index: perl/t/TEST
--- perl/t/TEST#93~20872~ Mon Aug 25 02:03:44 2003
+++ perl/t/TEST Tue Sep 2 07:40:54 2003
@@ -246,9 +246,17 @@
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 @@
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";
}
End of Patch.
