Integrate with Sarathy.

p4raw-id: //depot/cfgperl@3609

16 files changed, 229 insertions, 88 deletions

diff --git a/ext/ByteLoader/bytecode.h b/ext/ByteLoader/bytecode.h
index 9d597fbed2..04a05e4251 100644
--- a/ext/ByteLoader/bytecode.h
+++ b/ext/ByteLoader/bytecode.h
@@ -70,10 +70,10 @@ typedef IV IV64;
 	arg = PL_tokenbuf;			\
     } STMT_END
 
-#define BGET_double(arg) STMT_START {	\
+#define BGET_NV(arg) STMT_START {	\
 	char *str;			\
 	BGET_strconst(str);		\
-	arg = atof(str);		\
+	arg = Perl_atonv(str);		\
     } STMT_END
 
 #define BGET_objindex(arg, type) STMT_START {	\
diff --git a/ext/ByteLoader/byterun.c b/ext/ByteLoader/byterun.c
index 544a59f042..035578f424 100644
--- a/ext/ByteLoader/byterun.c
+++ b/ext/ByteLoader/byterun.c
@@ -221,8 +221,8 @@ byterun(pTHXo_ struct bytestream bs)
 	    }
 	  case INSN_XNV:		/* 21 */
 	    {
-		double arg;
-		BGET_double(arg);
+		NV arg;
+		BGET_NV(arg);
 		SvNVX(bytecode_sv) = arg;
 		break;
 	    }
diff --git a/ext/DB_File/Changes b/ext/DB_File/Changes
index 82d9af5af0..236af0f312 100644
--- a/ext/DB_File/Changes
+++ b/ext/DB_File/Changes
@@ -237,3 +237,12 @@
 1.66 15th March 1999
 
    * Added DBM Filter code
+
+1.67 6th June 1999
+
+   * Added DBM Filter documentation to DB_File.pm
+
+   * Fixed DBM Filter code to work with 5.004
+
+   * A few instances of newSVpvn were used in 1.66. This isn't available in
+     Perl 5.004_04 or earlier. Replaced with newSVpv.
diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm
index 7e6c90789f..7dd1d26360 100644
--- a/ext/DB_File/DB_File.pm
+++ b/ext/DB_File/DB_File.pm
@@ -1,10 +1,10 @@
 # DB_File.pm -- Perl 5 interface to Berkeley DB 
 #
 # written by Paul Marquess (Paul.Marquess@btinternet.com)
-# last modified 6th March 1999
-# version 1.66
+# last modified 6th June 1999
+# version 1.67
 #
-#     Copyright (c) 1995-9 Paul Marquess. All rights reserved.
+#     Copyright (c) 1995-1999 Paul Marquess. All rights reserved.
 #     This program is free software; you can redistribute it and/or
 #     modify it under the same terms as Perl itself.
 
@@ -145,7 +145,7 @@ use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DB_BTREE $DB_HASH $DB_RECNO $db_ver
 use Carp;
 
 
-$VERSION = "1.66" ;
+$VERSION = "1.67" ;
 
 #typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE;
 $DB_BTREE = new DB_File::BTREEINFO ;
@@ -408,6 +408,12 @@ DB_File - Perl5 access to Berkeley DB version 1.x
  $a = $X->shift;
  $X->unshift(list);
 
+ # DBM Filters
+ $old_filter = $db->filter_store_key  ( sub { ... } ) ;
+ $old_filter = $db->filter_store_value( sub { ... } ) ;
+ $old_filter = $db->filter_fetch_key  ( sub { ... } ) ;
+ $old_filter = $db->filter_fetch_value( sub { ... } ) ;
+
  untie %hash ;
  untie @array ;
 
@@ -1488,6 +1494,141 @@ R_RECNOSYNC is the only valid flag at present.
 
 =back
 
+=head1 DBM FILTERS
+
+A DBM Filter is a piece of code that is be used when you I<always>
+want to make the same transformation to all keys and/or values in a
+DBM database.
+
+There are four methods associated with DBM Filters. All work identically,
+and each is used to install (or uninstall) a single DBM Filter. Each
+expects a single parameter, namely a reference to a sub. The only
+difference between them is the place that the filter is installed.
+
+To summarise:
+
+=over 5
+
+=item B<filter_store_key>
+
+If a filter has been installed with this method, it will be invoked
+every time you write a key to a DBM database.
+
+=item B<filter_store_value>
+
+If a filter has been installed with this method, it will be invoked
+every time you write a value to a DBM database.
+
+
+=item B<filter_fetch_key>
+
+If a filter has been installed with this method, it will be invoked
+every time you read a key from a DBM database.
+
+=item B<filter_fetch_value>
+
+If a filter has been installed with this method, it will be invoked
+every time you read a value from a DBM database.
+
+=back
+
+You can use any combination of the methods, from none, to all four.
+
+All filter methods return the existing filter, if present, or C<undef>
+in not.
+
+To delete a filter pass C<undef> to it.
+
+=head2 The Filter
+
+When each filter is called by Perl, a local copy of C<$_> will contain
+the key or value to be filtered. Filtering is achieved by modifying
+the contents of C<$_>. The return code from the filter is ignored.
+
+=head2 An Example -- the NULL termination problem.
+
+Consider the following scenario. You have a DBM database
+that you need to share with a third-party C application. The C application
+assumes that I<all> keys and values are NULL terminated. Unfortunately
+when Perl writes to DBM databases it doesn't use NULL termination, so
+your Perl application will have to manage NULL termination itself. When
+you write to the database you will have to use something like this:
+
+    $hash{"$key\0"} = "$value\0" ;
+
+Similarly the NULL needs to be taken into account when you are considering
+the length of existing keys/values.
+
+It would be much better if you could ignore the NULL terminations issue
+in the main application code and have a mechanism that automatically
+added the terminating NULL to all keys and values whenever you write to
+the database and have them removed when you read from the database. As I'm
+sure you have already guessed, this is a problem that DBM Filters can
+fix very easily.
+
+    use strict ;
+    use DB_File ;
+
+    my %hash ;
+    my $filename = "/tmp/filt" ;
+    unlink $filename ;
+
+    my $db = tie %hash, 'DB_File', $filename, O_CREAT|O_RDWR, 0666, $DB_HASH 
+      or die "Cannot open $filename: $!\n" ;
+
+    # Install DBM Filters
+    $db->filter_fetch_key  ( sub { s/\0$//    } ) ;
+    $db->filter_store_key  ( sub { $_ .= "\0" } ) ;
+    $db->filter_fetch_value( sub { s/\0$//    } ) ;
+    $db->filter_store_value( sub { $_ .= "\0" } ) ;
+
+    $hash{"abc"} = "def" ;
+    my $a = $hash{"ABC"} ;
+    # ...
+    undef $db ;
+    untie %hash ;
+
+Hopefully the contents of each of the filters should be
+self-explanatory. Both "fetch" filters remove the terminating NULL,
+and both "store" filters add a terminating NULL.
+
+
+=head2 Another Example -- Key is a C int.
+
+Here is another real-life example. By default, whenever Perl writes to
+a DBM database it always writes the key and value as strings. So when
+you use this:
+
+    $hash{12345} = "soemthing" ;
+
+the key 12345 will get stored in the DBM database as the 5 byte string
+"12345". If you actually want the key to be stored in the DBM database
+as a C int, you will have to use C<pack> when writing, and C<unpack>
+when reading.
+
+Here is a DBM Filter that does it:
+
+    use strict ;
+    use DB_File ;
+    my %hash ;
+    my $filename = "/tmp/filt" ;
+    unlink $filename ;
+
+
+    my $db = tie %hash, 'DB_File', $filename, O_CREAT|O_RDWR, 0666, $DB_HASH 
+      or die "Cannot open $filename: $!\n" ;
+
+    $db->filter_fetch_key  ( sub { $_ = unpack("i", $_) } ) ;
+    $db->filter_store_key  ( sub { $_ = pack ("i", $_) } ) ;
+    $hash{123} = "def" ;
+    # ...
+    undef $db ;
+    untie %hash ;
+
+This time only two filters have been used -- we only need to manipulate
+the contents of the key, so it wasn't necessary to install any value
+filters.
+
 =head1 HINTS AND TIPS 
 
 
@@ -1557,7 +1698,7 @@ shared by both a Perl and a C application.
 
 The vast majority of problems that are reported in this area boil down
 to the fact that C strings are NULL terminated, whilst Perl strings are
-not. 
+not. See L<DBM FILTERS> for a generic way to work around this problem.
 
 Here is a real example. Netscape 2.0 keeps a record of the locations you
 visit along with the time you last visited them in a DB_HASH database.
@@ -1746,6 +1887,19 @@ double quotes, like this:
 Although it might seem like a real pain, it is really worth the effort
 of having a C<use strict> in all your scripts.
 
+=head1 REFERENCES
+
+Articles that are either about B<DB_File> or make use of it.
+
+=over 5
+
+=item 1.
+
+I<Full-Text Searching in Perl>, Tim Kientzle (tkientzle@ddj.com),
+Dr. Dobb's Journal, Issue 295, January 1999, pp 34-41
+
+=back
+
 =head1 HISTORY
 
 Moved to the Changes file.
@@ -1771,10 +1925,8 @@ F<modules/by-module/DB_File>.
 This version of B<DB_File> will work with either version 1.x or 2.x of
 Berkeley DB, but is limited to the functionality provided by version 1.
 
-The official web site for Berkeley DB is
-F<http://www.sleepycat.com/db>. The ftp equivalent is
-F<ftp.sleepycat.com:/pub>. Both versions 1 and 2 of Berkeley DB are
-available there.
+The official web site for Berkeley DB is F<http://www.sleepycat.com>.
+Both versions 1 and 2 of Berkeley DB are available there.
 
 Alternatively, Berkeley DB version 1 is available at your nearest CPAN
 archive in F<src/misc/db.1.85.tar.gz>.
@@ -1785,7 +1937,7 @@ compile properly on IRIX 5.3.
 
 =head1 COPYRIGHT
 
-Copyright (c) 1995-9 Paul Marquess. All rights reserved. This program
+Copyright (c) 1995-1999 Paul Marquess. All rights reserved. This program
 is free software; you can redistribute it and/or modify it under the
 same terms as Perl itself.
 
diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
index be584a2ce6..ed3a7fa3e0 100644
--- a/ext/DB_File/DB_File.xs
+++ b/ext/DB_File/DB_File.xs
@@ -3,8 +3,8 @@
  DB_File.xs -- Perl 5 interface to Berkeley DB 
 
  written by Paul Marquess <Paul.Marquess@btinternet.com>
- last modified 6th March 1999
- version 1.66
+ last modified 6th June 1999
+ version 1.67
 
  All comments/suggestions/problems are welcome
 
@@ -66,6 +66,9 @@
         1.65 -  Fixed a bug in the PUSH logic.
 		Added BOOT check that using 2.3.4 or greater
         1.66 -  Added DBM filter code
+        1.67 -  Backed off the use of newSVpvn.
+		Fixed DBM Filter code for Perl 5.004.
+		Fixed a small memory leak in the filter code.
 
 
 
@@ -89,6 +92,11 @@
 
 #endif
 
+/* DEFSV appears first in 5.004_56 */
+#ifndef DEFSV
+#define DEFSV		GvSV(defgv)
+#endif
+
 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
  * shortly #included by the <db.h>) __attribute__ to the possibly
  * already defined __attribute__, for example by GNUC or by Perl. */
@@ -301,16 +309,13 @@ typedef DBT DBTKEY ;
 	    if (db->filtering)					\
 	        croak("recursion detected in %s", name) ;	\
 	    db->filtering = TRUE ;				\
-	    /* SAVE_DEFSV ;*/   /* save $_ */			\
 	    save_defsv = newSVsv(DEFSV) ;			\
 	    sv_setsv(DEFSV, arg) ;				\
 	    PUSHMARK(sp) ;					\
 	    (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); 	\
-	    /* SPAGAIN ; */						\
 	    sv_setsv(arg, DEFSV) ;				\
-	    sv_setsv(DEFSV, save_defsv) ;				\
+	    sv_setsv(DEFSV, save_defsv) ;			\
 	    SvREFCNT_dec(save_defsv) ;				\
-	    /* PUTBACK ; */						\
 	    db->filtering = FALSE ;				\
 	    /*printf("end of filtering %s\n", name) ;*/		\
 	}
@@ -417,7 +422,7 @@ btree_compare(const DBT *key1, const DBT *key2)
     
     data1 = key1->data ;
     data2 = key2->data ;
-#if 0
+
     /* As newSVpv will assume that the data pointer is a null terminated C 
        string if the size parameter is 0, make sure that data points to an 
        empty string if the length is 0
@@ -426,14 +431,14 @@ btree_compare(const DBT *key1, const DBT *key2)
         data1 = "" ; 
     if (key2->size == 0)
         data2 = "" ;
-#endif
+
     ENTER ;
     SAVETMPS;
 
     PUSHMARK(SP) ;
     EXTEND(SP,2) ;
-    PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
-    PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
+    PUSHs(sv_2mortal(newSVpv(data1,key1->size)));
+    PUSHs(sv_2mortal(newSVpv(data2,key2->size)));
     PUTBACK ;
 
     count = perl_call_sv(CurrentDB->compare, G_SCALAR); 
@@ -463,7 +468,7 @@ btree_prefix(const DBT *key1, const DBT *key2)
     
     data1 = key1->data ;
     data2 = key2->data ;
-#if 0
+
     /* As newSVpv will assume that the data pointer is a null terminated C 
        string if the size parameter is 0, make sure that data points to an 
        empty string if the length is 0
@@ -472,14 +477,14 @@ btree_prefix(const DBT *key1, const DBT *key2)
         data1 = "" ;
     if (key2->size == 0)
         data2 = "" ;
-#endif
+
     ENTER ;
     SAVETMPS;
 
     PUSHMARK(SP) ;
     EXTEND(SP,2) ;
-    PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
-    PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
+    PUSHs(sv_2mortal(newSVpv(data1,key1->size)));
+    PUSHs(sv_2mortal(newSVpv(data2,key2->size)));
     PUTBACK ;
 
     count = perl_call_sv(CurrentDB->prefix, G_SCALAR); 
@@ -505,17 +510,17 @@ hash_cb(const void *data, size_t size)
     dSP ;
     int retval ;
     int count ;
-#if 0
+
     if (size == 0)
         data = "" ;
-#endif
+
      /* DGH - Next two lines added to fix corrupted stack problem */
     ENTER ;
     SAVETMPS;
 
     PUSHMARK(SP) ;
 
-    XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
+    XPUSHs(sv_2mortal(newSVpv((char*)data,size)));
     PUTBACK ;
 
     count = perl_call_sv(CurrentDB->hash, G_SCALAR); 
@@ -1564,7 +1569,8 @@ db_seq(db, key, value, flags)
 #define setFilter(type)					\
 	{						\
 	    if (db->type)				\
-	        RETVAL = newSVsv(db->type) ; 		\
+	        RETVAL = sv_mortalcopy(db->type) ;	\
+	    ST(0) = RETVAL ;				\
 	    if (db->type && (code == &PL_sv_undef)) {	\
                 SvREFCNT_dec(db->type) ;		\
 	        db->type = NULL ;			\
@@ -1585,8 +1591,6 @@ filter_fetch_key(db, code)
 	SV *		RETVAL = &PL_sv_undef ;
 	CODE:
 	    setFilter(filter_fetch_key) ;
-	OUTPUT:
-	    RETVAL
 
 SV *
 filter_store_key(db, code)
@@ -1595,8 +1599,6 @@ filter_store_key(db, code)
 	SV *		RETVAL = &PL_sv_undef ;
 	CODE:
 	    setFilter(filter_store_key) ;
-	OUTPUT:
-	    RETVAL
 
 SV *
 filter_fetch_value(db, code)
@@ -1605,8 +1607,6 @@ filter_fetch_value(db, code)
 	SV *		RETVAL = &PL_sv_undef ;
 	CODE:
 	    setFilter(filter_fetch_value) ;
-	OUTPUT:
-	    RETVAL
 
 SV *
 filter_store_value(db, code)
@@ -1615,7 +1615,5 @@ filter_store_value(db, code)
 	SV *		RETVAL = &PL_sv_undef ;
 	CODE:
 	    setFilter(filter_store_value) ;
-	OUTPUT:
-	    RETVAL
 
 #endif /* DBM_FILTERING */
diff --git a/ext/DB_File/typemap b/ext/DB_File/typemap
index 8e4dacbdd0..a614cc4c29 100644
--- a/ext/DB_File/typemap
+++ b/ext/DB_File/typemap
@@ -1,8 +1,8 @@
 # typemap for Perl 5 interface to Berkeley 
 #
 # written by Paul Marquess <Paul.Marquess@btinternet.com>
-# last modified 20th March 1999
-# version 1.66
+# last modified 6th June 1999
+# version 1.67
 #
 #################################### DB SECTION
 #
@@ -33,6 +33,7 @@ T_dbtdatum
 	$var.size = (int)PL_na;
 	DBT_flags($var);
 
+
 OUTPUT
 
 T_dbtkeydatum
diff --git a/ext/GDBM_File/GDBM_File.pm b/ext/GDBM_File/GDBM_File.pm
index 42bb6d28e8..aff01527dc 100644
--- a/ext/GDBM_File/GDBM_File.pm
+++ b/ext/GDBM_File/GDBM_File.pm
@@ -59,7 +59,7 @@ require DynaLoader;
 	GDBM_WRITER
 );
 
-$VERSION = "1.02";
+$VERSION = "1.03";
 
 sub AUTOLOAD {
     my($constname);
diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs
index db28891b79..be1817bba2 100644
--- a/ext/GDBM_File/GDBM_File.xs
+++ b/ext/GDBM_File/GDBM_File.xs
@@ -304,7 +304,8 @@ gdbm_setopt (db, optflag, optval, optlen)
 #define setFilter(type)					\
 	{						\
 	    if (db->type)				\
-	        RETVAL = newSVsv(db->type) ; 		\
+	        RETVAL = sv_mortalcopy(db->type) ; 	\
+	    ST(0) = RETVAL ;				\
 	    if (db->type && (code == &PL_sv_undef)) {	\
                 SvREFCNT_dec(db->type) ;		\
 	        db->type = NULL ;			\
@@ -326,8 +327,6 @@ filter_fetch_key(db, code)
 	SV *		RETVAL = &PL_sv_undef ;
 	CODE:
 	    setFilter(filter_fetch_key) ;
-	OUTPUT:
-	    RETVAL
 
 SV *
 filter_store_key(db, code)
@@ -336,8 +335,6 @@ filter_store_key(db, code)
 	SV *		RETVAL =  &PL_sv_undef ;
 	CODE:
 	    setFilter(filter_store_key) ;
-	OUTPUT:
-	    RETVAL
 
 SV *
 filter_fetch_value(db, code)
@@ -346,8 +343,6 @@ filter_fetch_value(db, code)
 	SV *		RETVAL =  &PL_sv_undef ;
 	CODE:
 	    setFilter(filter_fetch_value) ;
-	OUTPUT:
-	    RETVAL
 
 SV *
 filter_store_value(db, code)
@@ -356,6 +351,4 @@ filter_store_value(db, code)
 	SV *		RETVAL =  &PL_sv_undef ;
 	CODE:
 	    setFilter(filter_store_value) ;
-	OUTPUT:
-	    RETVAL
 
diff --git a/ext/NDBM_File/NDBM_File.pm b/ext/NDBM_File/NDBM_File.pm
index cad800adf4..8db59ee03c 100644
--- a/ext/NDBM_File/NDBM_File.pm
+++ b/ext/NDBM_File/NDBM_File.pm
@@ -12,7 +12,7 @@ require DynaLoader;
 
 @ISA = qw(Tie::Hash DynaLoader);
 
-$VERSION = "1.02";
+$VERSION = "1.03";
 
 bootstrap NDBM_File $VERSION;
 
diff --git a/ext/NDBM_File/NDBM_File.xs b/ext/NDBM_File/NDBM_File.xs
index 60b141e230..29cc288769 100644
--- a/ext/NDBM_File/NDBM_File.xs
+++ b/ext/NDBM_File/NDBM_File.xs
@@ -117,7 +117,8 @@ ndbm_clearerr(db)
 #define setFilter(type)					\
 	{						\
 	    if (db->type)				\
-	        RETVAL = newSVsv(db->type) ; 		\
+	        RETVAL = sv_mortalcopy(db->type) ; 	\
+	    ST(0) = RETVAL ;				\
 	    if (db->type && (code == &PL_sv_undef)) {	\
                 SvREFCNT_dec(db->type) ;		\
 	        db->type = NULL ;			\
@@ -139,8 +140,6 @@ filter_fetch_key(db, code)
 	SV *		RETVAL = &PL_sv_undef ;
 	CODE:
 	    setFilter(filter_fetch_key) ;
-	OUTPUT:
-	    RETVAL
 
 SV *
 filter_store_key(db, code)
@@ -149,8 +148,6 @@ filter_store_key(db, code)
 	SV *		RETVAL =  &PL_sv_undef ;
 	CODE:
 	    setFilter(filter_store_key) ;
-	OUTPUT:
-	    RETVAL
 
 SV *
 filter_fetch_value(db, code)
@@ -159,8 +156,6 @@ filter_fetch_value(db, code)
 	SV *		RETVAL =  &PL_sv_undef ;
 	CODE:
 	    setFilter(filter_fetch_value) ;
-	OUTPUT:
-	    RETVAL
 
 SV *
 filter_store_value(db, code)
@@ -169,6 +164,4 @@ filter_store_value(db, code)
 	SV *		RETVAL =  &PL_sv_undef ;
 	CODE:
 	    setFilter(filter_store_value) ;
-	OUTPUT:
-	    RETVAL
 
diff --git a/ext/ODBM_File/ODBM_File.pm b/ext/ODBM_File/ODBM_File.pm
index 572318b0cd..0af875dc36 100644
--- a/ext/ODBM_File/ODBM_File.pm
+++ b/ext/ODBM_File/ODBM_File.pm
@@ -8,7 +8,7 @@ require DynaLoader;
 
 @ISA = qw(Tie::Hash DynaLoader);
 
-$VERSION = "1.01";
+$VERSION = "1.02";
 
 bootstrap ODBM_File $VERSION;
 
diff --git a/ext/ODBM_File/ODBM_File.xs b/ext/ODBM_File/ODBM_File.xs
index 9ad794da89..7601c3433b 100644
--- a/ext/ODBM_File/ODBM_File.xs
+++ b/ext/ODBM_File/ODBM_File.xs
@@ -158,7 +158,8 @@ odbm_NEXTKEY(db, key)
 #define setFilter(type)					\
 	{						\
 	    if (db->type)				\
-	        RETVAL = newSVsv(db->type) ; 		\
+	        RETVAL = sv_mortalcopy(db->type) ; 	\
+	    ST(0) = RETVAL ;				\
 	    if (db->type && (code == &PL_sv_undef)) {	\
                 SvREFCNT_dec(db->type) ;		\
 	        db->type = Nullsv ;			\
@@ -180,8 +181,6 @@ filter_fetch_key(db, code)
 	SV *		RETVAL = &PL_sv_undef ;
 	CODE:
 	    setFilter(filter_fetch_key) ;
-	OUTPUT:
-	    RETVAL
 
 SV *
 filter_store_key(db, code)
@@ -190,8 +189,6 @@ filter_store_key(db, code)
 	SV *		RETVAL =  &PL_sv_undef ;
 	CODE:
 	    setFilter(filter_store_key) ;
-	OUTPUT:
-	    RETVAL
 
 SV *
 filter_fetch_value(db, code)
@@ -200,8 +197,6 @@ filter_fetch_value(db, code)
 	SV *		RETVAL =  &PL_sv_undef ;
 	CODE:
 	    setFilter(filter_fetch_value) ;
-	OUTPUT:
-	    RETVAL
 
 SV *
 filter_store_value(db, code)
@@ -210,6 +205,4 @@ filter_store_value(db, code)
 	SV *		RETVAL =  &PL_sv_undef ;
 	CODE:
 	    setFilter(filter_store_value) ;
-	OUTPUT:
-	    RETVAL
 
diff --git a/ext/SDBM_File/SDBM_File.pm b/ext/SDBM_File/SDBM_File.pm
index 006bbbd17d..34c971734c 100644
--- a/ext/SDBM_File/SDBM_File.pm
+++ b/ext/SDBM_File/SDBM_File.pm
@@ -8,7 +8,7 @@ require DynaLoader;
 
 @ISA = qw(Tie::Hash DynaLoader);
 
-$VERSION = "1.01" ;
+$VERSION = "1.02" ;
 
 bootstrap SDBM_File $VERSION;
 
diff --git a/ext/SDBM_File/SDBM_File.xs b/ext/SDBM_File/SDBM_File.xs
index e8711f410b..c2e940bf6c 100644
--- a/ext/SDBM_File/SDBM_File.xs
+++ b/ext/SDBM_File/SDBM_File.xs
@@ -23,16 +23,13 @@ typedef datum datum_value ;
 	    if (db->filtering)					\
 	        croak("recursion detected in %s", name) ;	\
 	    db->filtering = TRUE ;				\
-	    /* SAVE_DEFSV ;*/   /* save $_ */			\
 	    save_defsv = newSVsv(DEFSV) ;			\
 	    sv_setsv(DEFSV, arg) ;				\
 	    PUSHMARK(sp) ;					\
 	    (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); 	\
-	    /* SPAGAIN ; */						\
 	    sv_setsv(arg, DEFSV) ;				\
 	    sv_setsv(DEFSV, save_defsv) ;				\
 	    SvREFCNT_dec(save_defsv) ;				\
-	    /* PUTBACK ; */						\
 	    db->filtering = FALSE ;				\
 	    /*printf("end of filtering %s\n", name) ;*/		\
 	}
@@ -143,7 +140,8 @@ sdbm_clearerr(db)
 #define setFilter(type)					\
 	{						\
 	    if (db->type)				\
-	        RETVAL = newSVsv(db->type) ; 		\
+	        RETVAL = sv_mortalcopy(db->type) ;	\
+	    ST(0) = RETVAL ;				\
 	    if (db->type && (code == &PL_sv_undef)) {	\
                 SvREFCNT_dec(db->type) ;		\
 	        db->type = NULL ;			\
@@ -165,8 +163,6 @@ filter_fetch_key(db, code)
 	SV *		RETVAL = &PL_sv_undef ;
 	CODE:
 	    setFilter(filter_fetch_key) ;
-	OUTPUT:
-	    RETVAL
 
 SV *
 filter_store_key(db, code)
@@ -175,8 +171,6 @@ filter_store_key(db, code)
 	SV *		RETVAL =  &PL_sv_undef ;
 	CODE:
 	    setFilter(filter_store_key) ;
-	OUTPUT:
-	    RETVAL
 
 SV *
 filter_fetch_value(db, code)
@@ -185,8 +179,6 @@ filter_fetch_value(db, code)
 	SV *		RETVAL =  &PL_sv_undef ;
 	CODE:
 	    setFilter(filter_fetch_value) ;
-	OUTPUT:
-	    RETVAL
 
 SV *
 filter_store_value(db, code)
@@ -195,6 +187,4 @@ filter_store_value(db, code)
 	SV *		RETVAL =  &PL_sv_undef ;
 	CODE:
 	    setFilter(filter_store_value) ;
-	OUTPUT:
-	    RETVAL
 
diff --git a/ext/re/Makefile.PL b/ext/re/Makefile.PL
index 040b085f4f..bd0f1f741c 100644
--- a/ext/re/Makefile.PL
+++ b/ext/re/Makefile.PL
@@ -5,7 +5,7 @@ WriteMakefile(
     MAN3PODS		=> {}, 	# Pods will be built by installman.
     XSPROTOARG		=> '-noprototypes',
     OBJECT		=> 're_exec$(OBJ_EXT) re_comp$(OBJ_EXT) re$(OBJ_EXT)',
-    DEFINE		=> '-DPERL_EXT_RE_BUILD',
+    DEFINE		=> '-DPERL_EXT_RE_BUILD -DPERL_EXT_RE_DEBUG',
     clean		=> { FILES => '*$(OBJ_EXT) *.c ../../lib/re.pm' },
 );
 
diff --git a/ext/re/re.xs b/ext/re/re.xs
index b49a110377..10e44f76de 100644
--- a/ext/re/re.xs
+++ b/ext/re/re.xs
@@ -11,6 +11,11 @@ extern regexp*	my_regcomp (pTHX_ char* exp, char* xend, PMOP* pm);
 extern I32	my_regexec (pTHX_ regexp* prog, char* stringarg, char* strend,
 			    char* strbeg, I32 minend, SV* screamer,
 			    void* data, U32 flags);
+extern void	my_regfree (pTHX_ struct regexp* r);
+extern char*	my_re_intuit_start (pTHX_ regexp *prog, SV *sv, char *strpos,
+				    char *strend, U32 flags,
+				    struct re_scream_pos_data_s *data);
+extern SV*	my_re_intuit_string (pTHX_ regexp *prog);
 
 static int oldfl;
 
@@ -20,8 +25,12 @@ static void
 deinstall(pTHX)
 {
     dTHR;
-    PL_regexecp = &Perl_regexec_flags;
-    PL_regcompp = &Perl_pregcomp;
+    PL_regexecp = FUNC_NAME_TO_PTR(Perl_regexec_flags);
+    PL_regcompp = FUNC_NAME_TO_PTR(Perl_pregcomp);
+    PL_regint_start = FUNC_NAME_TO_PTR(Perl_re_intuit_start);
+    PL_regint_string = FUNC_NAME_TO_PTR(Perl_re_intuit_string);
+    PL_regfree = FUNC_NAME_TO_PTR(Perl_pregfree);
+
     if (!oldfl)
 	PL_debug &= ~R_DB;
 }
@@ -33,6 +42,9 @@ install(pTHX)
     PL_colorset = 0;			/* Allow reinspection of ENV. */
     PL_regexecp = &my_regexec;
     PL_regcompp = &my_regcomp;
+    PL_regint_start = &my_re_intuit_start;
+    PL_regint_string = &my_re_intuit_string;
+    PL_regfree = &my_regfree;
     oldfl = PL_debug & R_DB;
     PL_debug |= R_DB;
 }