resync with mainline

p4raw-id: //depot/vmsperl@4249
author: Charles Bailey <bailey@newman.upenn.edu> 1999-09-29 02:21:31 +0000
committer: bailey <bailey@newman.upenn.edu> 1999-09-29 02:21:31 +0000
commit: c529f79d594c53d3968d464c57ac24a21137dd09 (patch)
tree: 1a391a0c329976fd8ae88a240da31051b926c681 /ext
parent: 424a8fe95d507998fe8750793da1b35bd6d7074b (diff)
download: perl-c529f79d594c53d3968d464c57ac24a21137dd09.tar.gz
44 files changed, 903 insertions, 277 deletions
diff --git a/ext/B/B.pm b/ext/B/B.pm
index e4730cd9c9..2187e59a72 100644
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -107,6 +107,11 @@ sub timing_info {
 }
 
 my %symtable;
+
+sub clearsym {
+    %symtable = ();
+}
+
 sub savesym {
     my ($obj, $value) = @_;
 #    warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug
diff --git a/ext/B/B.xs b/ext/B/B.xs
index 570b001853..2d6145da66 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -202,7 +202,7 @@ make_sv_object(pTHX_ SV *arg, SV *sv)
     }
     if (!type) {
 	type = svclassnames[SvTYPE(sv)];
-	iv = (IV)sv;
+	iv = PTR2IV(sv);
     }
     sv_setiv(newSVrv(arg, type), iv);
     return arg;
@@ -211,7 +211,7 @@ make_sv_object(pTHX_ SV *arg, SV *sv)
 static SV *
 make_mg_object(pTHX_ SV *arg, MAGIC *mg)
 {
-    sv_setiv(newSVrv(arg, "B::MAGIC"), (IV)mg);
+    sv_setiv(newSVrv(arg, "B::MAGIC"), PTR2IV(mg));
     return arg;
 }
 
@@ -317,7 +317,7 @@ walkoptree(pTHX_ SV *opsv, char *method)
     if (!SvROK(opsv))
 	croak("opsv is not a reference");
     opsv = sv_mortalcopy(opsv);
-    o = (OP*)SvIV((SV*)SvRV(opsv));
+    o = INT2PTR(OP*,SvIV((SV*)SvRV(opsv)));
     if (walkoptree_debug) {
 	PUSHMARK(sp);
 	XPUSHs(opsv);
@@ -332,7 +332,7 @@ walkoptree(pTHX_ SV *opsv, char *method)
 	OP *kid;
 	for (kid = ((UNOP*)o)->op_first; kid; kid = kid->op_sibling) {
 	    /* Use the same opsv. Rely on methods not to mess it up. */
-	    sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), (IV)kid);
+	    sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), PTR2IV(kid));
 	    walkoptree(aTHX_ opsv, method);
 	}
     }
@@ -437,7 +437,7 @@ walkoptree_debug(...)
     OUTPUT:
 	RETVAL
 
-#define address(sv) (IV)sv
+#define address(sv) PTR2IV(sv)
 
 IV
 address(sv)
@@ -647,10 +647,10 @@ PMOP_pmreplroot(o)
 	if (o->op_type == OP_PUSHRE) {
 	    sv_setiv(newSVrv(ST(0), root ?
 			     svclassnames[SvTYPE((SV*)root)] : "B::SV"),
-		     (IV)root);
+		     PTR2IV(root));
 	}
 	else {
-	    sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)), (IV)root);
+	    sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)), PTR2IV(root));
 	}
 
 B::OP
@@ -814,7 +814,11 @@ packiv(sv)
 	     * reach this code anyway (unless sizeof(IV) > 8 but then
 	     * everything else breaks too so I'm not fussed at the moment).
 	     */
-	    wp[0] = htonl(((U32)iv) >> (sizeof(IV)*4));
+#ifdef UV_IS_QUAD
+	    wp[0] = htonl(((UV)iv) >> (sizeof(UV)*4));
+#else
+	    wp[0] = htonl(((U32)iv) >> (sizeof(UV)*4));
+#endif
 	    wp[1] = htonl(iv & 0xffffffff);
 	    ST(0) = sv_2mortal(newSVpvn((char *)wp, 8));
 	} else {
@@ -1149,7 +1153,7 @@ void
 CvXSUB(cv)
 	B::CV	cv
     CODE:
-	ST(0) = sv_2mortal(newSViv((IV)CvXSUB(cv)));
+	ST(0) = sv_2mortal(newSViv(PTR2IV(CvXSUB(cv))));
 
 
 void
diff --git a/ext/B/B/Bblock.pm b/ext/B/B/Bblock.pm
index d2ef78f616..b914bc661b 100644
--- a/ext/B/B/Bblock.pm
+++ b/ext/B/B/Bblock.pm
@@ -129,6 +129,7 @@ sub B::PMOP::mark_if_leader {
 
 sub compile {
     my @options = @_;
+    B::clearsym();
     if (@options) {
 	return sub {
 	    my $objname;
diff --git a/ext/B/B/Bytecode.pm b/ext/B/B/Bytecode.pm
index a9e5d55573..56945316e8 100644
--- a/ext/B/B/Bytecode.pm
+++ b/ext/B/B/Bytecode.pm
@@ -392,7 +392,8 @@ sub B::PVIV::bytecode {
 }
 
 sub B::PVNV::bytecode {
-    my ($sv, $flag) = @_;
+    my $sv = shift;
+    my $flag = shift || 0;
     # The $flag argument is passed through PVMG::bytecode by BM::bytecode
     # and AV::bytecode and indicates special handling. $flag = 1 is used by
     # BM::bytecode and means that we should ensure we save the whole B-M
diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm
index c7547ad691..b9e005bf41 100644
--- a/ext/B/B/C.pm
+++ b/ext/B/B/C.pm
@@ -56,6 +56,9 @@ use B::Asmdata qw(@specialsv_name);
 use FileHandle;
 use Carp;
 use strict;
+use Config;
+my $handle_VC_problem = "";
+$handle_VC_problem="{0}," if $^O eq 'MSWin32' and $Config{cc} =~ /^cl/i;
 
 my $hv_index = 0;
 my $gv_index = 0;
@@ -162,7 +165,7 @@ sub B::OP::save {
 	$init->add(sprintf("(void)find_threadsv(%s);",
 			   cstring($threadsv_names[$op->targ])));
     }
-    $opsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x",
+    $opsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x",
 			 ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ,
 			 $type, $op_seq, $op->flags, $op->private));
     savesym($op, sprintf("&op_list[%d]", $opsect->index));
@@ -175,7 +178,7 @@ sub B::FAKEOP::new {
 
 sub B::FAKEOP::save {
     my ($op, $level) = @_;
-    $opsect->add(sprintf("%s, %s, %s, %u, %u, %u, 0x%x, 0x%x",
+    $opsect->add(sprintf("%s, %s, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x",
 			 $op->next, $op->sibling, $op->ppaddr, $op->targ,
 			 $op->type, $op_seq, $op->flags, $op->private));
     return sprintf("&op_list[%d]", $opsect->index);
@@ -193,7 +196,7 @@ sub B::UNOP::save {
     my ($op, $level) = @_;
     my $sym = objsym($op);
     return $sym if defined $sym;
-    $unopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x",
+    $unopsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, s\\_%x",
 			   ${$op->next}, ${$op->sibling}, $op->ppaddr,
 			   $op->targ, $op->type, $op_seq, $op->flags,
 			   $op->private, ${$op->first}));
@@ -204,7 +207,7 @@ sub B::BINOP::save {
     my ($op, $level) = @_;
     my $sym = objsym($op);
     return $sym if defined $sym;
-    $binopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x",
+    $binopsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x",
 			    ${$op->next}, ${$op->sibling}, $op->ppaddr,
 			    $op->targ, $op->type, $op_seq, $op->flags,
 			    $op->private, ${$op->first}, ${$op->last}));
@@ -215,7 +218,7 @@ sub B::LISTOP::save {
     my ($op, $level) = @_;
     my $sym = objsym($op);
     return $sym if defined $sym;
-    $listopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u",
+    $listopsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u",
 			     ${$op->next}, ${$op->sibling}, $op->ppaddr,
 			     $op->targ, $op->type, $op_seq, $op->flags,
 			     $op->private, ${$op->first}, ${$op->last},
@@ -227,7 +230,7 @@ sub B::LOGOP::save {
     my ($op, $level) = @_;
     my $sym = objsym($op);
     return $sym if defined $sym;
-    $logopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x",
+    $logopsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x",
 			    ${$op->next}, ${$op->sibling}, $op->ppaddr,
 			    $op->targ, $op->type, $op_seq, $op->flags,
 			    $op->private, ${$op->first}, ${$op->other}));
@@ -241,7 +244,7 @@ sub B::LOOP::save {
     #warn sprintf("LOOP: redoop %s, nextop %s, lastop %s\n",
     #		 peekop($op->redoop), peekop($op->nextop),
     #		 peekop($op->lastop)); # debug
-    $loopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u, s\\_%x, s\\_%x, s\\_%x",
+    $loopsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u, s\\_%x, s\\_%x, s\\_%x",
 			   ${$op->next}, ${$op->sibling}, $op->ppaddr,
 			   $op->targ, $op->type, $op_seq, $op->flags,
 			   $op->private, ${$op->first}, ${$op->last},
@@ -254,7 +257,7 @@ sub B::PVOP::save {
     my ($op, $level) = @_;
     my $sym = objsym($op);
     return $sym if defined $sym;
-    $pvopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, %s",
+    $pvopsect->add(sprintf("s\\_%x, s\\_%x, %s, $handle_VC_problem %u, %u, %u, 0x%x, 0x%x, %s",
 			   ${$op->next}, ${$op->sibling}, $op->ppaddr,
 			   $op->targ, $op->type, $op_seq, $op->flags,
 			   $op->private, cstring($op->pv)));
@@ -266,7 +269,7 @@ sub B::SVOP::save {
     my $sym = objsym($op);
     return $sym if defined $sym;
     my $svsym = $op->sv->save;
-    $svopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, %s",
+    $svopsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, %s",
 			   ${$op->next}, ${$op->sibling}, $op->ppaddr,
 			   $op->targ, $op->type, $op_seq, $op->flags,
 			   $op->private, "(SV*)$svsym"));
@@ -278,7 +281,7 @@ sub B::GVOP::save {
     my $sym = objsym($op);
     return $sym if defined $sym;
     my $gvsym = $op->gv->save;
-    $gvopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, Nullgv",
+    $gvopsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, Nullgv",
 			   ${$op->next}, ${$op->sibling}, $op->ppaddr,
 			   $op->targ, $op->type, $op_seq, $op->flags,
 			   $op->private));
@@ -294,7 +297,7 @@ sub B::COP::save {
     my $stashsym = $op->stash->save;
     warn sprintf("COP: line %d file %s\n", $op->line, $op->filegv->SV->PV)
 	if $debug_cops;
-    $copsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, %s, Nullhv, Nullgv, %u, %d, %u",
+    $copsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, %s, Nullhv, Nullgv, %u, %d, %u",
 			  ${$op->next}, ${$op->sibling}, $op->ppaddr,
 			  $op->targ, $op->type, $op_seq, $op->flags,
 			  $op->private, cstring($op->label), $op->cop_seq,
@@ -330,7 +333,7 @@ sub B::PMOP::save {
     # pmnext handling is broken in perl itself, I think. Bad op_pmnext
     # fields aren't noticed in perl's runtime (unless you try reset) but we
     # segfault when trying to dereference it to find op->op_pmnext->op_type
-    $pmopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u, %s, %s, 0, 0, 0x%x, 0x%x",
+    $pmopsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u, %s, %s, 0, 0, 0x%x, 0x%x",
 			   ${$op->next}, ${$op->sibling}, $ppaddr, $op->targ,
 			   $op->type, $op_seq, $op->flags, $op->private,
 			   ${$op->first}, ${$op->last}, $op->children,
@@ -372,7 +375,7 @@ sub B::NULL::save {
     #if ($$sv == 0) {
     #	warn "NULL::save for sv = 0 called from @{[(caller(1))[3]]}\n";
     #}
-    $svsect->add(sprintf("0, %u, 0x%x", $sv->REFCNT + 1, $sv->FLAGS));
+    $svsect->add(sprintf("0, %u, 0x%x", $sv->REFCNT , $sv->FLAGS));
     return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
 }
 
@@ -382,7 +385,7 @@ sub B::IV::save {
     return $sym if defined $sym;
     $xpvivsect->add(sprintf("0, 0, 0, %d", $sv->IVX));
     $svsect->add(sprintf("&xpviv_list[%d], %lu, 0x%x",
-			 $xpvivsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+			 $xpvivsect->index, $sv->REFCNT , $sv->FLAGS));
     return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
 }
 
@@ -394,7 +397,7 @@ sub B::NV::save {
     $val .= '.00' if $val =~ /^-?\d+$/;
     $xpvnvsect->add(sprintf("0, 0, 0, %d, %s", $sv->IVX, $val));
     $svsect->add(sprintf("&xpvnv_list[%d], %lu, 0x%x",
-			 $xpvnvsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+			 $xpvnvsect->index, $sv->REFCNT , $sv->FLAGS));
     return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
 }
 
@@ -410,7 +413,7 @@ sub B::PVLV::save {
 			    $pvsym, $len, $pvmax, $sv->IVX, $sv->NVX, 
 			    $sv->TARGOFF, $sv->TARGLEN, cchar($sv->TYPE)));
     $svsect->add(sprintf("&xpvlv_list[%d], %lu, 0x%x",
-			 $xpvlvsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+			 $xpvlvsect->index, $sv->REFCNT , $sv->FLAGS));
     if (!$pv_copy_on_grow) {
 	$init->add(sprintf("xpvlv_list[%d].xpv_pv = savepvn(%s, %u);",
 			   $xpvlvsect->index, cstring($pv), $len));
@@ -428,7 +431,7 @@ sub B::PVIV::save {
     my ($pvsym, $pvmax) = savepv($pv);
     $xpvivsect->add(sprintf("%s, %u, %u, %d", $pvsym, $len, $pvmax, $sv->IVX));
     $svsect->add(sprintf("&xpviv_list[%d], %u, 0x%x",
-			 $xpvivsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+			 $xpvivsect->index, $sv->REFCNT , $sv->FLAGS));
     if (!$pv_copy_on_grow) {
 	$init->add(sprintf("xpviv_list[%d].xpv_pv = savepvn(%s, %u);",
 			   $xpvivsect->index, cstring($pv), $len));
@@ -449,7 +452,7 @@ sub B::PVNV::save {
     $xpvnvsect->add(sprintf("%s, %u, %u, %d, %s",
 			    $pvsym, $len, $pvmax, $sv->IVX, $val));
     $svsect->add(sprintf("&xpvnv_list[%d], %lu, 0x%x",
-			 $xpvnvsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+			 $xpvnvsect->index, $sv->REFCNT , $sv->FLAGS));
     if (!$pv_copy_on_grow) {
 	$init->add(sprintf("xpvnv_list[%d].xpv_pv = savepvn(%s,%u);",
 			   $xpvnvsect->index, cstring($pv), $len));
@@ -467,7 +470,7 @@ sub B::BM::save {
 			    $len, $len + 258, $sv->IVX, $sv->NVX,
 			    $sv->USEFUL, $sv->PREVIOUS, $sv->RARE));
     $svsect->add(sprintf("&xpvbm_list[%d], %lu, 0x%x",
-			 $xpvbmsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+			 $xpvbmsect->index, $sv->REFCNT , $sv->FLAGS));
     $sv->save_magic;
     $init->add(sprintf("xpvbm_list[%d].xpv_pv = savepvn(%s, %u);",
 		       $xpvbmsect->index, cstring($pv), $len),
@@ -485,7 +488,7 @@ sub B::PV::save {
     my ($pvsym, $pvmax) = savepv($pv);
     $xpvsect->add(sprintf("%s, %u, %u", $pvsym, $len, $pvmax));
     $svsect->add(sprintf("&xpv_list[%d], %lu, 0x%x",
-			 $xpvsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+			 $xpvsect->index, $sv->REFCNT , $sv->FLAGS));
     if (!$pv_copy_on_grow) {
 	$init->add(sprintf("xpv_list[%d].xpv_pv = savepvn(%s, %u);",
 			   $xpvsect->index, cstring($pv), $len));
@@ -503,7 +506,7 @@ sub B::PVMG::save {
     $xpvmgsect->add(sprintf("%s, %u, %u, %d, %s, 0, 0",
 			    $pvsym, $len, $pvmax, $sv->IVX, $sv->NVX));
     $svsect->add(sprintf("&xpvmg_list[%d], %lu, 0x%x",
-			 $xpvmgsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+			 $xpvmgsect->index, $sv->REFCNT , $sv->FLAGS));
     if (!$pv_copy_on_grow) {
 	$init->add(sprintf("xpvmg_list[%d].xpv_pv = savepvn(%s, %u);",
 			   $xpvmgsect->index, cstring($pv), $len));
@@ -557,7 +560,7 @@ sub B::RV::save {
     $rv =~ s/^\([AGHS]V\s*\*\)\s*(\&sv_list.*)$/$1/;
     $xrvsect->add($rv);
     $svsect->add(sprintf("&xrv_list[%d], %lu, 0x%x",
-			 $xrvsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+			 $xrvsect->index, $sv->REFCNT , $sv->FLAGS));
     return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
 }
 
@@ -709,7 +712,7 @@ sub B::CV::save {
 		     $$stash, $$cv) if $debug_cv;
     }
     $symsect->add(sprintf("svix%d\t(XPVCV*)&xpvcv_list[%u], %lu, 0x%x",
-			  $sv_ix, $xpvcv_ix, $cv->REFCNT + 1, $cv->FLAGS));
+			  $sv_ix, $xpvcv_ix, $cv->REFCNT +1 , $cv->FLAGS));
     return $sym;
 }
 
@@ -816,7 +819,7 @@ sub B::AV::save {
     $xpvavsect->add(sprintf("0, -1, -1, 0, 0.0, 0, Nullhv, 0, 0, 0x%x",
 			    $avflags));
     $svsect->add(sprintf("&xpvav_list[%d], %lu, 0x%x",
-			 $xpvavsect->index, $av->REFCNT + 1, $av->FLAGS));
+			 $xpvavsect->index, $av->REFCNT  , $av->FLAGS));
     my $sv_list_index = $svsect->index;
     my $fill = $av->FILL;
     $av->save_magic;
@@ -882,7 +885,7 @@ sub B::HV::save {
     $xpvhvsect->add(sprintf("0, 0, %d, 0, 0.0, 0, Nullhv, %d, 0, 0, 0",
 			    $hv->MAX, $hv->RITER));
     $svsect->add(sprintf("&xpvhv_list[%d], %lu, 0x%x",
-			 $xpvhvsect->index, $hv->REFCNT + 1, $hv->FLAGS));
+			 $xpvhvsect->index, $hv->REFCNT  , $hv->FLAGS));
     my $sv_list_index = $svsect->index;
     my @contents = $hv->ARRAY;
     if (@contents) {
@@ -918,7 +921,7 @@ sub B::IO::save {
 			    cstring($io->BOTTOM_NAME), $io->SUBPROCESS,
 			    cchar($io->IoTYPE), $io->IoFLAGS));
     $svsect->add(sprintf("&xpvio_list[%d], %lu, 0x%x",
-			 $xpviosect->index, $io->REFCNT + 1, $io->FLAGS));
+			 $xpviosect->index, $io->REFCNT , $io->FLAGS));
     $sym = savesym($io, sprintf("(IO*)&sv_list[%d]", $svsect->index));
     my ($field, $fsym);
     foreach $field (qw(TOP_GV FMT_GV BOTTOM_GV)) {
diff --git a/ext/B/B/Debug.pm b/ext/B/B/Debug.pm
index 75636265e6..89100689a8 100644
--- a/ext/B/B/Debug.pm
+++ b/ext/B/B/Debug.pm
@@ -247,6 +247,7 @@ sub B::SPECIAL::debug {
 
 sub compile {
     my $order = shift;
+    B::clearsym();
     if ($order eq "exec") {
         return sub { walkoptree_exec(main_start, "debug") }
     } else {
diff --git a/ext/B/B/Terse.pm b/ext/B/B/Terse.pm
index 93757f34ce..bc9d9434c9 100644
--- a/ext/B/B/Terse.pm
+++ b/ext/B/B/Terse.pm
@@ -17,6 +17,7 @@ sub terse {
 sub compile {
     my $order = shift;
     my @options = @_;
+    B::clearsym();
     if (@options) {
 	return sub {
 	    my $objname;
@@ -78,7 +79,7 @@ sub B::COP::terse {
     if ($label) {
 	$label = " label ".cstring($label);
     }
-    print indent($level), peekop($op), $label, "\n";
+    print indent($level), peekop($op), $label || "", "\n";
 }
 
 sub B::PV::terse {
diff --git a/ext/B/Makefile.PL b/ext/B/Makefile.PL
index 9af85c9a62..dcff65a50b 100644
--- a/ext/B/Makefile.PL
+++ b/ext/B/Makefile.PL
@@ -16,7 +16,8 @@ if ($^O eq 'MSWin32') {
 WriteMakefile(
     NAME	=> "B",
     VERSION	=> "a5",
-    MAN3PODS => {},
+    PL_FILES	=> { 'defsubs_h.PL' => 'defsubs.h' },
+    MAN3PODS	=> {},
     clean	=> {
 	FILES		=> "perl$e *$o B.c defsubs.h *~"
     }
diff --git a/ext/B/defsubs.h.PL b/ext/B/defsubs_h.PL
index 2129c8c5bb..8dfa3a5fe2 100644
--- a/ext/B/defsubs.h.PL
+++ b/ext/B/defsubs_h.PL
@@ -4,6 +4,7 @@
 #!perl
 my ($out) = __FILE__ =~ /(^.*)\.PL/;
 if ($^O eq 'VMS') { ($out) = __FILE__ =~ /^(.+)_PL$/i; }
+$out =~ s/_h$/.h/;
 open(OUT,">$out") || die "Cannot open $file:$!";
 print "Extracting $out . . .\n";
 foreach my $const (qw(AVf_REAL 
diff --git a/ext/B/typemap b/ext/B/typemap
index 948fdcd977..febadf8d62 100644
--- a/ext/B/typemap
+++ b/ext/B/typemap
@@ -35,7 +35,7 @@ INPUT
 T_OP_OBJ
 	if (SvROK($arg)) {
 	    IV tmp = SvIV((SV*)SvRV($arg));
-	    $var = ($type) tmp;
+	    $var = INT2PTR($type,tmp);
 	}
 	else
 	    croak(\"$var is not a reference\")
@@ -43,7 +43,7 @@ T_OP_OBJ
 T_SV_OBJ
 	if (SvROK($arg)) {
 	    IV tmp = SvIV((SV*)SvRV($arg));
-	    $var = ($type) tmp;
+	    $var = INT2PTR($type,tmp);
 	}
 	else
 	    croak(\"$var is not a reference\")
@@ -51,18 +51,18 @@ T_SV_OBJ
 T_MG_OBJ
 	if (SvROK($arg)) {
 	    IV tmp = SvIV((SV*)SvRV($arg));
-	    $var = ($type) tmp;
+	    $var = INT2PTR($type,tmp);
 	}
 	else
 	    croak(\"$var is not a reference\")
 
 OUTPUT
 T_OP_OBJ
-	sv_setiv(newSVrv($arg, cc_opclassname(aTHX_ (OP*)$var)), (IV)$var);
+	sv_setiv(newSVrv($arg, cc_opclassname(aTHX_ (OP*)$var)), PTR2IV($var));
 
 T_SV_OBJ
 	make_sv_object(aTHX_ ($arg), (SV*)($var));
 
 
 T_MG_OBJ
-	sv_setiv(newSVrv($arg, "B::MAGIC"), (IV)$var);
+	sv_setiv(newSVrv($arg, "B::MAGIC"), PTR2IV($var));
diff --git a/ext/ByteLoader/bytecode.h b/ext/ByteLoader/bytecode.h
index 1dda7e6af1..5ca0d1afc6 100644
--- a/ext/ByteLoader/bytecode.h
+++ b/ext/ByteLoader/bytecode.h
@@ -43,7 +43,7 @@ typedef IV IV64;
 	BGET_U32(hi);					\
 	BGET_U32(lo);					\
 	if (sizeof(IV) == 8)				\
-	    arg = (IV) (hi << (sizeof(IV)*4) | lo);	\
+	    arg = ((IV)hi << (sizeof(IV)*4) | (IV)lo);	\
 	else if (((I32)hi == -1 && (I32)lo < 0)		\
 		 || ((I32)hi == 0 && (I32)lo >= 0)) {	\
 	    arg = (I32)lo;				\
diff --git a/ext/ByteLoader/byterun.h b/ext/ByteLoader/byterun.h
index bfe007c4b2..3b8f77642c 100644
--- a/ext/ByteLoader/byterun.h
+++ b/ext/ByteLoader/byterun.h
@@ -151,12 +151,7 @@ enum {
     OPt_COP		/* 10 */
 };
 
-#if defined(CYGWIN) || defined(VMS)
-extern
-#else
-EXT
-#endif
-void byterun(pTHXo_ struct bytestream bs);
+extern void byterun(pTHXo_ struct bytestream bs);
 
 #define INIT_SPECIALSV_LIST STMT_START { \
 	PL_specialsv_list[0] = Nullsv; \
diff --git a/ext/DB_File/Changes b/ext/DB_File/Changes
index 6d374bf1f1..8f364564a5 100644
--- a/ext/DB_File/Changes
+++ b/ext/DB_File/Changes
@@ -272,3 +272,10 @@
    * Added a BOOT check to test for equivalent versions of db.h &
      libdb.a/so.
 
+1.71 7th September 1999
+
+   * Fixed a bug that prevented 1.70 from compiling under win32
+
+   * Updated to support Berkeley DB 3.x
+
+   * Updated dbinfo for Berkeley DB 3.x file formats.
diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm
index e20a5621e7..44bdad61f6 100644
--- a/ext/DB_File/DB_File.pm
+++ b/ext/DB_File/DB_File.pm
@@ -1,8 +1,8 @@
 # DB_File.pm -- Perl 5 interface to Berkeley DB 
 #
 # written by Paul Marquess (Paul.Marquess@btinternet.com)
-# last modified 4th August 1999
-# version 1.70
+# last modified 4th September 1999
+# version 1.71
 #
 #     Copyright (c) 1995-1999 Paul Marquess. All rights reserved.
 #     This program is free software; you can redistribute it and/or
@@ -145,7 +145,7 @@ use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DB_BTREE $DB_HASH $DB_RECNO $db_ver
 use Carp;
 
 
-$VERSION = "1.70" ;
+$VERSION = "1.71" ;
 
 #typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE;
 $DB_BTREE = new DB_File::BTREEINFO ;
@@ -421,10 +421,10 @@ DB_File - Perl5 access to Berkeley DB version 1.x
 
 B<DB_File> is a module which allows Perl programs to make use of the
 facilities provided by Berkeley DB version 1.x (if you have a newer
-version of DB, see L<Using DB_File with Berkeley DB version 2>). It is
-assumed that you have a copy of the Berkeley DB manual pages at hand
-when reading this documentation. The interface defined here mirrors the
-Berkeley DB interface closely.
+version of DB, see L<Using DB_File with Berkeley DB version 2 or 3>).
+It is assumed that you have a copy of the Berkeley DB manual pages at
+hand when reading this documentation. The interface defined here
+mirrors the Berkeley DB interface closely.
 
 Berkeley DB is a C library which provides a consistent interface to a
 number of database formats.  B<DB_File> provides an interface to all
@@ -465,32 +465,33 @@ number.
 
 =back
 
-=head2 Using DB_File with Berkeley DB version 2
+=head2 Using DB_File with Berkeley DB version 2 or 3
 
 Although B<DB_File> is intended to be used with Berkeley DB version 1,
-it can also be used with version 2. In this case the interface is
+it can also be used with version 2.or 3 In this case the interface is
 limited to the functionality provided by Berkeley DB 1.x. Anywhere the
-version 2 interface differs, B<DB_File> arranges for it to work like
-version 1. This feature allows B<DB_File> scripts that were built with
-version 1 to be migrated to version 2 without any changes.
+version 2 or 3 interface differs, B<DB_File> arranges for it to work
+like version 1. This feature allows B<DB_File> scripts that were built
+with version 1 to be migrated to version 2 or 3 without any changes.
 
 If you want to make use of the new features available in Berkeley DB
-2.x, use the Perl module B<BerkeleyDB> instead.
+2.x or 3.x, use the Perl module B<BerkeleyDB> instead.
 
 At the time of writing this document the B<BerkeleyDB> module is still
 alpha quality (the version number is < 1.0), and so unsuitable for use
 in any serious development work. Once its version number is >= 1.0, it
 is considered stable enough for real work.
 
-B<Note:> The database file format has changed in Berkeley DB version 2.
-If you cannot recreate your databases, you must dump any existing
-databases with the C<db_dump185> utility that comes with Berkeley DB.
-Once you have rebuilt DB_File to use Berkeley DB version 2, your
+B<Note:> The database file format has changed in both Berkeley DB
+version 2 and 3. If you cannot recreate your databases, you must dump
+any existing databases with the C<db_dump185> utility that comes with
+Berkeley DB.
+Once you have rebuilt DB_File to use Berkeley DB version 2 or 3, your
 databases can be recreated using C<db_load>. Refer to the Berkeley DB
 documentation for further details.
 
-Please read L<"COPYRIGHT"> before using version 2.x of Berkeley DB with
-DB_File.
+Please read L<"COPYRIGHT"> before using version 2.x or 3.x of Berkeley
+DB with DB_File.
 
 =head2 Interface to Berkeley DB
 
@@ -1940,11 +1941,12 @@ date, so the most recent version can always be found on CPAN (see
 L<perlmod/CPAN> for details), in the directory
 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.
+This version of B<DB_File> will work with either version 1.x, 2.x or
+3.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>.
-Both versions 1 and 2 of Berkeley DB are available there.
+All versions 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>.
diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
index 2ee1e61f0f..ccb9b757fe 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 4th August 1999
- version 1.70
+ last modified 7th September 1999
+ version 1.71
 
  All comments/suggestions/problems are welcome
 
@@ -78,6 +78,9 @@
 		GV_ADD|GV_ADDMULT -- bug spotted by Nick Ing-Simmons.
 		Added a BOOT check to test for equivalent versions of db.h &
 		libdb.a/so.
+        1.71 -  Support for Berkeley DB version 3.
+		Support for Berkeley DB 2/3's backward compatability mode.
+		Rewrote push
 
 */
 
@@ -116,7 +119,12 @@
 #ifdef op
 #    undef op
 #endif
-#include <db.h>
+
+#ifdef COMPAT185
+#    include <db_185.h>
+#else
+#    include <db.h>
+#endif
 
 #ifndef pTHX
 #    define pTHX
@@ -134,10 +142,21 @@
 /* #define TRACE */
 #define DBM_FILTERING
 
+#ifdef TRACE
+#    define Trace(x)        printf x
+#else
+#    define Trace(x)
+#endif
+
 
+#define DBT_clear(x)	Zero(&x, 1, DBT) ;
 
 #ifdef DB_VERSION_MAJOR
 
+#if DB_VERSION_MAJOR == 2
+#    define BERKELEY_DB_1_OR_2
+#endif
+
 /* map version 2 features & constants onto their version 1 equivalent */
 
 #ifdef DB_Prefix_t
@@ -152,7 +171,11 @@
 
 /* DBTYPE stays the same */
 /* HASHINFO, RECNOINFO and BTREEINFO  map to DB_INFO */
-typedef DB_INFO	INFO ;
+#if DB_VERSION_MAJOR == 2
+    typedef DB_INFO	INFO ;
+#else /* DB_VERSION_MAJOR > 2 */
+#    define DB_FIXEDLEN	(0x8000)
+#endif /* DB_VERSION_MAJOR == 2 */
 
 /* version 2 has db_recno_t in place of recno_t	*/
 typedef db_recno_t	recno_t;
@@ -166,15 +189,18 @@ typedef db_recno_t	recno_t;
 #define R_NEXT          DB_NEXT
 #define R_NOOVERWRITE   DB_NOOVERWRITE
 #define R_PREV          DB_PREV
+
 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
-#define R_SETCURSOR     0x800000
+#  define R_SETCURSOR	0x800000
 #else
-#define R_SETCURSOR     (-100)
+#  define R_SETCURSOR	(-100)
 #endif
+
 #define R_RECNOSYNC     0
 #define R_FIXEDLEN	DB_FIXEDLEN
 #define R_DUP		DB_DUP
 
+
 #define db_HA_hash 	h_hash
 #define db_HA_ffactor	h_ffactor
 #define db_HA_nelem	h_nelem
@@ -209,13 +235,15 @@ typedef db_recno_t	recno_t;
 #define DB_flags(x, v)	x |= v 
 
 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
-#define flagSet(flags, bitmask)        ((flags) & (bitmask))
+#    define flagSet(flags, bitmask)	((flags) & (bitmask))
 #else
-#define flagSet(flags, bitmask)        (((flags) & DB_OPFLAGS_MASK) == (bitmask))
+#    define flagSet(flags, bitmask)	(((flags) & DB_OPFLAGS_MASK) == (bitmask))
 #endif
 
 #else /* db version 1.x */
 
+#define BERKELEY_DB_1_OR_2
+
 typedef union INFO {
         HASHINFO 	hash ;
         RECNOINFO 	recno ;
@@ -224,17 +252,17 @@ typedef union INFO {
 
 
 #ifdef mDB_Prefix_t 
-#ifdef DB_Prefix_t
-#undef DB_Prefix_t
-#endif
-#define DB_Prefix_t	mDB_Prefix_t 
+#  ifdef DB_Prefix_t
+#    undef DB_Prefix_t
+#  endif
+#  define DB_Prefix_t	mDB_Prefix_t 
 #endif
 
 #ifdef mDB_Hash_t
-#ifdef DB_Hash_t
-#undef DB_Hash_t
-#endif
-#define DB_Hash_t	mDB_Hash_t
+#  ifdef DB_Hash_t
+#    undef DB_Hash_t
+#  endif
+#  define DB_Hash_t	mDB_Hash_t
 #endif
 
 #define db_HA_hash 	hash.hash
@@ -281,20 +309,20 @@ typedef union INFO {
 
 #ifdef DB_VERSION_MAJOR
 #define db_DESTROY(db)                  ( db->cursor->c_close(db->cursor),\
-					  db->dbp->close(db->dbp, 0) )
+					  (db->dbp->close)(db->dbp, 0) )
 #define db_close(db)			((db->dbp)->close)(db->dbp, 0)
 #define db_del(db, key, flags)          (flagSet(flags, R_CURSOR) 					\
 						? ((db->cursor)->c_del)(db->cursor, 0)		\
 						: ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
 
-#else
+#else /* ! DB_VERSION_MAJOR */
 
 #define db_DESTROY(db)                  ((db->dbp)->close)(db->dbp)
 #define db_close(db)			((db->dbp)->close)(db->dbp)
 #define db_del(db, key, flags)          ((db->dbp)->del)(db->dbp, &key, flags)
 #define db_put(db, key, value, flags)   ((db->dbp)->put)(db->dbp, &key, &value, flags)
 
-#endif
+#endif /* ! DB_VERSION_MAJOR */
 
 
 #define db_seq(db, key, value, flags)   do_SEQ(db, key, value, flags)
@@ -306,7 +334,9 @@ typedef struct {
 	SV *	prefix ;
 	SV *	hash ;
 	int	in_memory ;
+#ifdef BERKELEY_DB_1_OR_2
 	INFO 	info ;
+#endif	
 #ifdef DB_VERSION_MAJOR
 	DBC *	cursor ;
 #endif
@@ -439,48 +469,6 @@ u_int		flags ;
 
 #endif /* DB_VERSION_MAJOR */
 
-static void
-GetVersionInfo(pTHX)
-{
-    SV * version_sv = perl_get_sv("DB_File::db_version", GV_ADD|GV_ADDMULTI) ;
-    SV * ver_sv = perl_get_sv("DB_File::db_ver", GV_ADD|GV_ADDMULTI) ;
-#ifdef DB_VERSION_MAJOR
-    int Major, Minor, Patch ;
-
-    (void)db_version(&Major, &Minor, &Patch) ;
-
-    /* Check that the versions of db.h and libdb.a are the same */
-    if (Major != DB_VERSION_MAJOR || Minor != DB_VERSION_MINOR 
-		|| Patch != DB_VERSION_PATCH)
-	croak("\nDB_File needs compatible versions of libdb & db.h\n\tyou have db.h version %d.%d.%d and libdb version %d.%d.%d\n",  
-		DB_VERSION_MAJOR, DB_VERSION_MINOR, DB_VERSION_PATCH, 
-		Major, Minor, Patch) ;
-    
-    /* check that libdb is recent enough  -- we need 2.3.4 or greater */
-    if (Major == 2 && (Minor < 3 || (Minor ==  3 && Patch < 4)))
-	croak("DB_File needs Berkeley DB 2.3.4 or greater, you have %d.%d.%d\n",
-		 Major, Minor, Patch) ;
- 
-#if PERL_VERSION > 3
-    sv_setpvf(version_sv, "%d.%d", Major, Minor) ;
-    sv_setpvf(ver_sv, "%d.%03d%03d", Major, Minor, Patch) ;
-#else
-    {
-        char buffer[40] ;
-        sprintf(buffer, "%d.%d", Major, Minor) ;
-        sv_setpv(version_sv, buffer) ; 
-        sprintf(buffer, "%d.%03d%03d", Major, Minor, Patch) ;
-        sv_setpv(ver_sv, buffer) ; 
-    }
-#endif
- 
-#else
-    sv_setiv(version_sv, 1) ;
-    sv_setiv(ver_sv, 1) ;
-#endif
-
-}
-
 
 static int
 #ifdef CAN_PROTOTYPE
@@ -641,7 +629,7 @@ size_t size ;
 }
 
 
-#ifdef TRACE
+#if defined(TRACE) && defined(BERKELEY_DB_1_OR_2)
 
 static void
 #ifdef CAN_PROTOTYPE
@@ -724,8 +712,8 @@ DB_File db ;
     DBT		value ;
     int		RETVAL ;
 
-    DBT_flags(key) ;
-    DBT_flags(value) ;
+    DBT_clear(key) ;
+    DBT_clear(value) ;
     RETVAL = do_SEQ(db, key, value, R_LAST) ;
     if (RETVAL == 0)
         RETVAL = *(I32 *)key.data ;
@@ -760,6 +748,7 @@ I32      value ;
     return value ;
 }
 
+
 static DB_File
 #ifdef CAN_PROTOTYPE
 ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv)
@@ -772,6 +761,9 @@ int    mode ;
 SV *   sv ;
 #endif
 {
+
+#ifdef BERKELEY_DB_1_OR_2 /* Berkeley DB Version 1  or 2 */
+
     SV **	svp;
     HV *	action ;
     DB_File	RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
@@ -1032,11 +1024,265 @@ SV *   sv ;
 
     }
 #else
+
+#if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2
+    RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ; 
+#else    
     RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ; 
+#endif /* DB_LIBRARY_COMPATIBILITY_API */
+
 #endif
 
     return (RETVAL) ;
-}
+
+#else /* Berkeley DB Version > 2 */
+
+    SV **	svp;
+    HV *	action ;
+    DB_File	RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
+    DB *	dbp ;
+    STRLEN	n_a;
+    int		status ;
+
+/* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ;  */
+    Zero(RETVAL, 1, DB_File_type) ;
+
+    /* Default to HASH */
+#ifdef DBM_FILTERING
+    RETVAL->filtering = 0 ;
+    RETVAL->filter_fetch_key = RETVAL->filter_store_key = 
+    RETVAL->filter_fetch_value = RETVAL->filter_store_value =
+#endif /* DBM_FILTERING */
+    RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
+    RETVAL->type = DB_HASH ;
+
+     /* DGH - Next line added to avoid SEGV on existing hash DB */
+    CurrentDB = RETVAL; 
+
+    /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
+    RETVAL->in_memory = (name == NULL) ;
+
+    status = db_create(&RETVAL->dbp, NULL,0) ;
+    /* printf("db_create returned %d %s\n", status, db_strerror(status)) ; */
+    if (status) {
+	RETVAL->dbp = NULL ;
+        return (RETVAL) ;
+    }	
+    dbp = RETVAL->dbp ;
+
+    if (sv)
+    {
+        if (! SvROK(sv) )
+            croak ("type parameter is not a reference") ;
+
+        svp  = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
+        if (svp && SvOK(*svp))
+            action  = (HV*) SvRV(*svp) ;
+	else
+	    croak("internal error") ;
+
+        if (sv_isa(sv, "DB_File::HASHINFO"))
+        {
+
+	    if (!isHASH)
+	        croak("DB_File can only tie an associative array to a DB_HASH database") ;
+
+            RETVAL->type = DB_HASH ;
+  
+            svp = hv_fetch(action, "hash", 4, FALSE); 
+
+            if (svp && SvOK(*svp))
+            {
+		(void)dbp->set_h_hash(dbp, hash_cb) ;
+		RETVAL->hash = newSVsv(*svp) ;
+            }
+
+           svp = hv_fetch(action, "ffactor", 7, FALSE);
+	   if (svp)
+	       (void)dbp->set_h_ffactor(dbp, SvIV(*svp)) ;
+         
+           svp = hv_fetch(action, "nelem", 5, FALSE);
+	   if (svp)
+               (void)dbp->set_h_nelem(dbp, SvIV(*svp)) ;
+         
+           svp = hv_fetch(action, "bsize", 5, FALSE);
+	   if (svp)
+               (void)dbp->set_pagesize(dbp, SvIV(*svp));
+           
+           svp = hv_fetch(action, "cachesize", 9, FALSE);
+	   if (svp)
+               (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
+         
+           svp = hv_fetch(action, "lorder", 6, FALSE);
+	   if (svp)
+               (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
+
+           PrintHash(info) ; 
+        }
+        else if (sv_isa(sv, "DB_File::BTREEINFO"))
+        {
+	    if (!isHASH)
+	        croak("DB_File can only tie an associative array to a DB_BTREE database");
+
+            RETVAL->type = DB_BTREE ;
+   
+            svp = hv_fetch(action, "compare", 7, FALSE);
+            if (svp && SvOK(*svp))
+            {
+                (void)dbp->set_bt_compare(dbp, btree_compare) ;
+		RETVAL->compare = newSVsv(*svp) ;
+            }
+
+            svp = hv_fetch(action, "prefix", 6, FALSE);
+            if (svp && SvOK(*svp))
+            {
+                (void)dbp->set_bt_prefix(dbp, btree_prefix) ;
+		RETVAL->prefix = newSVsv(*svp) ;
+            }
+
+           svp = hv_fetch(action, "flags", 5, FALSE);
+	   if (svp)
+	       (void)dbp->set_flags(dbp, SvIV(*svp)) ;
+   
+           svp = hv_fetch(action, "cachesize", 9, FALSE);
+	   if (svp)
+               (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
+         
+           svp = hv_fetch(action, "psize", 5, FALSE);
+	   if (svp)
+               (void)dbp->set_pagesize(dbp, SvIV(*svp)) ;
+         
+           svp = hv_fetch(action, "lorder", 6, FALSE);
+	   if (svp)
+               (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
+
+            PrintBtree(info) ;
+         
+        }
+        else if (sv_isa(sv, "DB_File::RECNOINFO"))
+        {
+	    int fixed = FALSE ;
+
+	    if (isHASH)
+	        croak("DB_File can only tie an array to a DB_RECNO database");
+
+            RETVAL->type = DB_RECNO ;
+
+           svp = hv_fetch(action, "flags", 5, FALSE);
+	   if (svp) {
+		int flags = SvIV(*svp) ;
+		/* remove FIXDLEN, if present */
+		if (flags & DB_FIXEDLEN) {
+		    fixed = TRUE ;
+		    flags &= ~DB_FIXEDLEN ;
+	   	}
+	   }
+
+           svp = hv_fetch(action, "cachesize", 9, FALSE);
+	   if (svp) {
+               status = dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
+	   }
+         
+           svp = hv_fetch(action, "psize", 5, FALSE);
+	   if (svp) {
+               status = dbp->set_pagesize(dbp, SvIV(*svp)) ;
+	    }
+         
+           svp = hv_fetch(action, "lorder", 6, FALSE);
+	   if (svp) {
+               status = dbp->set_lorder(dbp, SvIV(*svp)) ;
+	   }
+
+	    svp = hv_fetch(action, "bval", 4, FALSE);
+            if (svp && SvOK(*svp))
+            {
+		int value ;
+                if (SvPOK(*svp))
+		    value = (int)*SvPV(*svp, n_a) ;
+		else
+		    value = SvIV(*svp) ;
+
+		if (fixed) {
+		    status = dbp->set_re_pad(dbp, value) ;
+		}
+		else {
+		    status = dbp->set_re_delim(dbp, value) ;
+		}
+
+            }
+
+	   if (fixed) {
+               svp = hv_fetch(action, "reclen", 6, FALSE);
+	       if (svp) {
+		   u_int32_t len =  (u_int32_t)SvIV(*svp) ;
+                   status = dbp->set_re_len(dbp, len) ;
+	       }    
+	   }
+         
+	    if (name != NULL) {
+	        status = dbp->set_re_source(dbp, name) ;
+	        name = NULL ;
+	    }	
+
+            svp = hv_fetch(action, "bfname", 6, FALSE); 
+            if (svp && SvOK(*svp)) {
+		char * ptr = SvPV(*svp,n_a) ;
+		name = (char*) n_a ? ptr : NULL ;
+	    }
+	    else
+		name = NULL ;
+         
+
+	    status = dbp->set_flags(dbp, DB_RENUMBER) ;
+         
+		if (flags){
+	            (void)dbp->set_flags(dbp, flags) ;
+		}
+            PrintRecno(info) ;
+        }
+        else
+            croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
+    }
+
+    {
+        int	 	Flags = 0 ;
+        int		status ;
+
+        /* Map 1.x flags to 3.x flags */
+        if ((flags & O_CREAT) == O_CREAT)
+            Flags |= DB_CREATE ;
+
+#if O_RDONLY == 0
+        if (flags == O_RDONLY)
+#else
+        if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
+#endif
+            Flags |= DB_RDONLY ;
+
+#ifdef O_TRUNC
+        if ((flags & O_TRUNC) == O_TRUNC)
+            Flags |= DB_TRUNCATE ;
+#endif
+
+        status = RETVAL->dbp->open(RETVAL->dbp, name, NULL, RETVAL->type, 
+	    			Flags, mode) ; 
+	/* printf("open returned %d %s\n", status, db_strerror(status)) ; */
+
+        if (status == 0)
+            status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
+			0) ;
+	/* printf("cursor returned %d %s\n", status, db_strerror(status)) ; */
+
+        if (status)
+	    RETVAL->dbp = NULL ;
+
+    }
+
+    return (RETVAL) ;
+
+#endif /* Berkeley DB Version > 2 */
+
+} /* ParseOpenInfo */
 
 
 static double 
@@ -1279,11 +1525,11 @@ MODULE = DB_File	PACKAGE = DB_File	PREFIX = db_
 
 BOOT:
   {
-    GetVersionInfo(aTHX) ;
+    __getBerkeleyDBInfo() ;
  
+    DBT_clear(empty) ; 
     empty.data = &zero ;
     empty.size =  sizeof(recno_t) ;
-    DBT_flags(empty) ; 
   }
 
 double
@@ -1363,7 +1609,7 @@ db_EXISTS(db, key)
 	{
           DBT		value ;
 	
-	  DBT_flags(value) ; 
+	  DBT_clear(value) ; 
 	  CurrentDB = db ;
 	  RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
 	}
@@ -1379,7 +1625,7 @@ db_FETCH(db, key, flags=0)
 	{
             DBT		value ;
 
-	    DBT_flags(value) ; 
+	    DBT_clear(value) ; 
 	    CurrentDB = db ;
 	    /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */
 	    RETVAL = db_get(db, key, value, flags) ;
@@ -1405,8 +1651,8 @@ db_FIRSTKEY(db)
 	    DBTKEY	key ;
 	    DBT		value ;
 
-	    DBT_flags(key) ; 
-	    DBT_flags(value) ; 
+	    DBT_clear(key) ; 
+	    DBT_clear(value) ; 
 	    CurrentDB = db ;
 	    RETVAL = do_SEQ(db, key, value, R_FIRST) ;
 	    ST(0) = sv_newmortal();
@@ -1421,7 +1667,7 @@ db_NEXTKEY(db, key)
 	{
 	    DBT		value ;
 
-	    DBT_flags(value) ; 
+	    DBT_clear(value) ; 
 	    CurrentDB = db ;
 	    RETVAL = do_SEQ(db, key, value, R_NEXT) ;
 	    ST(0) = sv_newmortal();
@@ -1445,8 +1691,8 @@ unshift(db, ...)
 	    DB *	Db = db->dbp ;
 	    STRLEN	n_a;
 
-	    DBT_flags(key) ; 
-	    DBT_flags(value) ; 
+	    DBT_clear(key) ; 
+	    DBT_clear(value) ; 
 	    CurrentDB = db ;
 #ifdef DB_VERSION_MAJOR
 	    /* get the first value */
@@ -1483,8 +1729,8 @@ pop(db)
 	    DBTKEY	key ;
 	    DBT		value ;
 
-	    DBT_flags(key) ; 
-	    DBT_flags(value) ; 
+	    DBT_clear(key) ; 
+	    DBT_clear(value) ; 
 	    CurrentDB = db ;
 
 	    /* First get the final value */
@@ -1510,8 +1756,8 @@ shift(db)
 	    DBT		value ;
 	    DBTKEY	key ;
 
-	    DBT_flags(key) ; 
-	    DBT_flags(value) ; 
+	    DBT_clear(key) ; 
+	    DBT_clear(value) ; 
 	    CurrentDB = db ;
 	    /* get the first value */
 	    RETVAL = do_SEQ(db, key, value, R_FIRST) ;	 
@@ -1539,45 +1785,37 @@ push(db, ...)
 	    DB *	Db = db->dbp ;
 	    int		i ;
 	    STRLEN	n_a;
+	    int		keyval ;
 
 	    DBT_flags(key) ; 
 	    DBT_flags(value) ; 
 	    CurrentDB = db ;
-#ifdef DB_VERSION_MAJOR
-	    	RETVAL = do_SEQ(db, key, value, DB_LAST) ;
-	   	RETVAL = 0 ;
-		key = empty ;
-	        for (i = 1 ; i < items  ; ++i)
-	        {
-	            value.data = SvPV(ST(i), n_a) ;
-	            value.size = n_a ;
-	            RETVAL = (Db->put)(Db, NULL, &key, &value, DB_APPEND) ;
-	            if (RETVAL != 0)
-	                break;
-		}
-#else		
-	    
 	    /* Set the Cursor to the Last element */
 	    RETVAL = do_SEQ(db, key, value, R_LAST) ;
+#ifndef DB_VERSION_MAJOR		    		    
 	    if (RETVAL >= 0)
+#endif	    
 	    {
-		if (RETVAL == 1)
-		    key = empty ;
-	        for (i = items - 1 ; i > 0 ; --i)
+	    	if (RETVAL == 0)
+		    keyval = *(int*)key.data ;
+		else
+		    keyval = 0 ;
+	        for (i = 1 ; i < items ; ++i)
 	        {
 	            value.data = SvPV(ST(i), n_a) ;
 	            value.size = n_a ;
-	            RETVAL = (Db->put)(Db, &key, &value, R_IAFTER) ;
+		    ++ keyval ;
+	            key.data = &keyval ;
+	            key.size = sizeof(int) ;
+		    RETVAL = (Db->put)(Db, TXN &key, &value, 0) ;
 	            if (RETVAL != 0)
 	                break;
 	        }
 	    }
-#endif
 	}
 	OUTPUT:
 	    RETVAL
 
-
 I32
 length(db)
 	DB_File		db
@@ -1619,7 +1857,7 @@ db_get(db, key, value, flags=0)
 	u_int		flags
 	CODE:
 	  CurrentDB = db ;
-	  DBT_flags(value) ; 
+	  DBT_clear(value) ; 
 	  RETVAL = db_get(db, key, value, flags) ;
 #ifdef DB_VERSION_MAJOR
 	  if (RETVAL > 0)
@@ -1694,7 +1932,7 @@ db_seq(db, key, value, flags)
 	u_int		flags
 	CODE:
 	  CurrentDB = db ;
-	  DBT_flags(value) ; 
+	  DBT_clear(value) ; 
 	  RETVAL = db_seq(db, key, value, flags);
 #ifdef DB_VERSION_MAJOR
 	  if (RETVAL > 0)
diff --git a/ext/DB_File/Makefile.PL b/ext/DB_File/Makefile.PL
index 1a13e0bbd8..a247924ec8 100644
--- a/ext/DB_File/Makefile.PL
+++ b/ext/DB_File/Makefile.PL
@@ -14,7 +14,15 @@ WriteMakefile(
         MAN3PODS        => {},         # Pods will be built by installman.
 	#INC		=> '-I/usr/local/include',
 	VERSION_FROM	=> 'DB_File.pm',
+	OBJECT		=> 'version$(OBJ_EXT) DB_File$(OBJ_EXT)',
 	XSPROTOARG	=> '-noprototypes',
 	DEFINE		=> "$OS2",
 	);
 
+sub MY::postamble {
+      '
+version$(OBJ_EXT):	version.c
+
+' ;
+}
+
diff --git a/ext/DB_File/dbinfo b/ext/DB_File/dbinfo
index 24a794448f..701ac612b6 100644
--- a/ext/DB_File/dbinfo
+++ b/ext/DB_File/dbinfo
@@ -4,8 +4,8 @@
 #			  a database file
 #
 # Author:	Paul Marquess  <Paul.Marquess@btinternet.com>
-# Version: 	1.01 
-# Date		16th April 1998
+# Version: 	1.02 
+# Date		20th August 1999
 #
 #     Copyright (c) 1998 Paul Marquess. All rights reserved.
 #     This program is free software; you can redistribute it and/or
@@ -19,7 +19,7 @@ use strict ;
 my %Data =
 	(
 	0x053162 =>	{
-			  Type 	=> "Btree",
+			  Type 	   => "Btree",
 			  Versions => 
 				{
 				  1	=> "Unknown (older than 1.71)",
@@ -27,18 +27,27 @@ my %Data =
 				  3	=> "1.71 -> 1.85, 1.86",
 				  4	=> "Unknown",
 				  5	=> "2.0.0 -> 2.3.0",
-				  6	=> "2.3.1 or greater",
+				  6	=> "2.3.1 -> 2.7.7",
+				  7	=> "3.0.0 or greater",
 				}
 			},
 	0x061561 => 	{
-			  Type => "Hash",
+			  Type     => "Hash",
 			  Versions =>
 				{
 				  1	=> "Unknown (older than 1.71)",
         			  2     => "1.71 -> 1.85",
         			  3     => "1.86",
         			  4     => "2.0.0 -> 2.1.0",
-        			  5     => "2.2.6 or greater",
+        			  5     => "2.2.6 -> 2.7.7",
+        			  6     => "3.0.0 or greater",
+				}
+			},
+	0x042253 => 	{
+			  Type     => "Queue",
+			  Versions =>
+				{
+				  1	=> "3.0.0 or greater",
 				}
 			},
 	) ;
diff --git a/ext/DB_File/typemap b/ext/DB_File/typemap
index a614cc4c29..41a24f4a86 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 6th June 1999
-# version 1.67
+# last modified 7th September 1999
+# version 1.71
 #
 #################################### DB SECTION
 #
@@ -16,22 +16,21 @@ DBTKEY			T_dbtkeydatum
 INPUT
 T_dbtkeydatum
 	ckFilter($arg, filter_store_key, \"filter_store_key\");
+	DBT_clear($var) ;
 	if (db->type != DB_RECNO) {
 	    $var.data = SvPV($arg, PL_na);
 	    $var.size = (int)PL_na;
-	    DBT_flags($var);
 	}
 	else {
 	    Value =  GetRecnoKey(aTHX_ db, SvIV($arg)) ; 
 	    $var.data = & Value; 
 	    $var.size = (int)sizeof(recno_t);
-	    DBT_flags($var);
 	}
 T_dbtdatum
 	ckFilter($arg, filter_store_value, \"filter_store_value\");
+	DBT_clear($var) ;
 	$var.data = SvPV($arg, PL_na);
 	$var.size = (int)PL_na;
-	DBT_flags($var);
 
 
 OUTPUT
diff --git a/ext/DB_File/version.c b/ext/DB_File/version.c
new file mode 100644
index 0000000000..23c96a6804
--- /dev/null
+++ b/ext/DB_File/version.c
@@ -0,0 +1,70 @@
+/* 
+
+ version.c -- Perl 5 interface to Berkeley DB 
+
+ written by Paul Marquess <Paul.Marquess@btinternet.com>
+ last modified 7th September 1999
+ version 1.71
+
+ All comments/suggestions/problems are welcome
+
+     Copyright (c) 1995-9 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.
+
+ Changes:
+        1.71 -  Support for Berkeley DB version 3.
+		Support for Berkeley DB 2/3's backward compatability mode.
+
+*/
+
+#include "EXTERN.h"  
+#include "perl.h"
+#include "XSUB.h"
+
+#include <db.h>
+
+void
+__getBerkeleyDBInfo()
+{
+    SV * version_sv = perl_get_sv("DB_File::db_version", GV_ADD|GV_ADDMULTI) ;
+    SV * ver_sv = perl_get_sv("DB_File::db_ver", GV_ADD|GV_ADDMULTI) ;
+    SV * compat_sv = perl_get_sv("DB_File::db_185_compat", GV_ADD|GV_ADDMULTI) ;
+
+#ifdef DB_VERSION_MAJOR
+    int Major, Minor, Patch ;
+
+    (void)db_version(&Major, &Minor, &Patch) ;
+
+    /* Check that the versions of db.h and libdb.a are the same */
+    if (Major != DB_VERSION_MAJOR || Minor != DB_VERSION_MINOR 
+		|| Patch != DB_VERSION_PATCH)
+	croak("\nDB_File needs compatible versions of libdb & db.h\n\tyou have db.h version %d.%d.%d and libdb version %d.%d.%d\n",  
+		DB_VERSION_MAJOR, DB_VERSION_MINOR, DB_VERSION_PATCH, 
+		Major, Minor, Patch) ;
+    
+    /* check that libdb is recent enough  -- we need 2.3.4 or greater */
+    if (Major == 2 && (Minor < 3 || (Minor ==  3 && Patch < 4)))
+	croak("DB_File needs Berkeley DB 2.3.4 or greater, you have %d.%d.%d\n",
+		 Major, Minor, Patch) ;
+ 
+    {
+        char buffer[40] ;
+        sprintf(buffer, "%d.%d", Major, Minor) ;
+        sv_setpv(version_sv, buffer) ; 
+        sprintf(buffer, "%d.%03d%03d", Major, Minor, Patch) ;
+        sv_setpv(ver_sv, buffer) ; 
+    }
+ 
+#else /* ! DB_VERSION_MAJOR */
+    sv_setiv(version_sv, 1) ;
+    sv_setiv(ver_sv, 1) ;
+#endif /* ! DB_VERSION_MAJOR */
+
+#ifdef COMPAT185
+    sv_setiv(compat_sv, 1) ;
+#else /* ! COMPAT185 */
+    sv_setiv(compat_sv, 0) ;
+#endif /* ! COMPAT185 */
+
+}
diff --git a/ext/Data/Dumper/Changes b/ext/Data/Dumper/Changes
index 9a96edab8d..161aba940b 100644
--- a/ext/Data/Dumper/Changes
+++ b/ext/Data/Dumper/Changes
@@ -6,6 +6,21 @@ HISTORY - public release history for Data::Dumper
 
 =over 8
 
+=item 2.11  (unreleased)
+
+C<0> is now dumped as such, not as C<'0'>.
+
+qr// objects are now dumped correctly (provided a post-5.005_58)
+overload.pm exists).
+
+Implemented $Data::Dumper::Maxdepth, which was on the Todo list.
+Thanks to John Nolan <jpnolan@Op.Net>.
+
+=item 2.101 (30 Apr 1999)
+
+Minor release to sync with version in 5.005_03.  Fixes dump of
+dummy coderefs.
+
 =item 2.10  (31 Oct 1998)
 
 Bugfixes for dumping related undef values, globs, and better double
diff --git a/ext/Data/Dumper/Dumper.pm b/ext/Data/Dumper/Dumper.pm
index 3828d7b390..c37e6b54dd 100644
--- a/ext/Data/Dumper/Dumper.pm
+++ b/ext/Data/Dumper/Dumper.pm
@@ -13,7 +13,7 @@ $VERSION = $VERSION = '2.101';
 
 #$| = 1;
 
-require 5.004;
+require 5.004_02;
 require Exporter;
 require DynaLoader;
 require overload;
@@ -39,7 +39,7 @@ $Deepcopy = 0 unless defined $Deepcopy;
 $Quotekeys = 1 unless defined $Quotekeys;
 $Bless = "bless" unless defined $Bless;
 #$Expdepth = 0 unless defined $Expdepth;
-#$Maxdepth = 0 unless defined $Maxdepth;
+$Maxdepth = 0 unless defined $Maxdepth;
 
 #
 # expects an arrayref of values to be dumped.
@@ -74,7 +74,7 @@ sub new {
              quotekeys	=> $Quotekeys,  # quote hash keys
              'bless'	=> $Bless,	# keyword to use for "bless"
 #	     expdepth   => $Expdepth,   # cutoff depth for explicit dumping
-#	     maxdepth	=> $Maxdepth,   # depth beyond which we give up
+	     maxdepth	=> $Maxdepth,   # depth beyond which we give up
 	   };
 
   if ($Indent > 0) {
@@ -214,14 +214,13 @@ sub _dump {
   if ($type) {
 
     # prep it, if it looks like an object
-    if ($type =~ /[a-z_:]/) {
-      my $freezer = $s->{freezer};
-      $val->$freezer() if $freezer && UNIVERSAL::can($val, $freezer);
+    if (my $freezer = $s->{freezer}) {
+      $val->$freezer() if UNIVERSAL::can($val, $freezer);
     }
 
     ($realpack, $realtype, $id) =
       (overload::StrVal($val) =~ /^(?:(.*)\=)?([^=]*)\(([^\(]*)\)$/);
-    
+
     # if it has a name, we need to either look it up, or keep a tab
     # on it so we know when we hit it later
     if (defined($name) and length($name)) {
@@ -259,17 +258,28 @@ sub _dump {
       }
     }
 
-    if ($realpack) {
-      if ($realpack eq 'Regexp') {
+    if ($realpack and $realpack eq 'Regexp') {
 	$out = "$val";
 	$out =~ s,/,\\/,g;
 	return "qr/$out/";
-      }
-      else {          # we have a blessed ref
-	$out = $s->{'bless'} . '( ';
-	$blesspad = $s->{apad};
-	$s->{apad} .= '       ' if ($s->{indent} >= 2);
-      }
+    }
+
+    # If purity is not set and maxdepth is set, then check depth: 
+    # if we have reached maximum depth, return the string
+    # representation of the thing we are currently examining
+    # at this depth (i.e., 'Foo=ARRAY(0xdeadbeef)'). 
+    if (!$s->{purity}
+	and $s->{maxdepth} > 0
+	and $s->{level} >= $s->{maxdepth})
+    {
+      return qq['$val'];
+    }
+
+    # we have a blessed ref
+    if ($realpack) {
+      $out = $s->{'bless'} . '( ';
+      $blesspad = $s->{apad};
+      $s->{apad} .= '       ' if ($s->{indent} >= 2);
     }
 
     $s->{level}++;
@@ -519,6 +529,12 @@ sub Bless {
   defined($v) ? (($s->{'bless'} = $v), return $s) : $s->{'bless'};
 }
 
+sub Maxdepth {
+  my($s, $v) = @_;
+  defined($v) ? (($s->{'maxdepth'} = $v), return $s) : $s->{'maxdepth'};
+}
+
+
 # used by qquote below
 my %esc = (  
     "\a" => "\\a",
@@ -822,6 +838,14 @@ builtin operator used to create objects.  A function with the specified
 name should exist, and should accept the same arguments as the builtin.
 Default is C<bless>.
 
+=item $Data::Dumper::Maxdepth  I<or>  $I<OBJ>->Maxdepth(I<[NEWVAL]>)
+
+Can be set to a positive integer that specifies the depth beyond which
+which we don't venture into a structure.  Has no effect when
+C<Data::Dumper::Purity> is set.  (Useful in debugger when we often don't
+want to see more than enough).  Default is 0, which means there is 
+no maximum depth. 
+
 =back
 
 =head2 Exports
@@ -904,6 +928,21 @@ distribution for more examples.)
     $Data::Dumper::Purity = 0;         # avoid cross-refs
     print Data::Dumper->Dump([$b, $a], [qw(*b a)]);
     
+    ########
+    # deep structures
+    ########
+    
+    $a = "pearl";
+    $b = [ $a ];
+    $c = { 'b' => $b };
+    $d = [ $c ];
+    $e = { 'd' => $d };
+    $f = { 'e' => $e };
+    print Data::Dumper->Dump([$f], [qw(f)]);
+
+    $Data::Dumper::Maxdepth = 3;       # no deeper than 3 refs down
+    print Data::Dumper->Dump([$f], [qw(f)]);
+
     
     ########
     # object-oriented usage
@@ -999,7 +1038,7 @@ modify it under the same terms as Perl itself.
 
 =head1 VERSION
 
-Version 2.10    (31 Oct 1998)
+Version 2.11   (unreleased)
 
 =head1 SEE ALSO
 
diff --git a/ext/Data/Dumper/Dumper.xs b/ext/Data/Dumper/Dumper.xs
index 3cbc7c5412..054e0a970d 100644
--- a/ext/Data/Dumper/Dumper.xs
+++ b/ext/Data/Dumper/Dumper.xs
@@ -27,7 +27,8 @@ static I32 DD_dump (pTHX_ SV *val, char *name, STRLEN namelen, SV *retval,
 		    HV *seenhv, AV *postav, I32 *levelp, I32 indent,
 		    SV *pad, SV *xpad, SV *apad, SV *sep,
 		    SV *freezer, SV *toaster,
-		    I32 purity, I32 deepcopy, I32 quotekeys, SV *bless);
+		    I32 purity, I32 deepcopy, I32 quotekeys, SV *bless,
+		    I32 maxdepth);
 
 /* does a string need to be protected? */
 static I32
@@ -130,7 +131,7 @@ static I32
 DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
 	AV *postav, I32 *levelp, I32 indent, SV *pad, SV *xpad,
 	SV *apad, SV *sep, SV *freezer, SV *toaster, I32 purity,
-	I32 deepcopy, I32 quotekeys, SV *bless)
+	I32 deepcopy, I32 quotekeys, SV *bless, I32 maxdepth)
 {
     char tmpbuf[128];
     U32 i;
@@ -253,33 +254,46 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
 	    }
 	}
 
-	if (realpack) {
-	    if (*realpack == 'R' && strEQ(realpack, "Regexp")) {
-		STRLEN rlen;
-		char *rval = SvPV(val, rlen);
-		char *slash = strchr(rval, '/');
-		sv_catpvn(retval, "qr/", 3);
-		while (slash) {
-		    sv_catpvn(retval, rval, slash-rval);
-		    sv_catpvn(retval, "\\/", 2);
-		    rlen -= slash-rval+1;
-		    rval = slash+1;
-		    slash = strchr(rval, '/');
-		}
-		sv_catpvn(retval, rval, rlen);
-		sv_catpvn(retval, "/", 1);
-		return 1;
+	if (realpack && *realpack == 'R' && strEQ(realpack, "Regexp")) {
+	    STRLEN rlen;
+	    char *rval = SvPV(val, rlen);
+	    char *slash = strchr(rval, '/');
+	    sv_catpvn(retval, "qr/", 3);
+	    while (slash) {
+		sv_catpvn(retval, rval, slash-rval);
+		sv_catpvn(retval, "\\/", 2);
+		rlen -= slash-rval+1;
+		rval = slash+1;
+		slash = strchr(rval, '/');
 	    }
-	    else {				/* we have a blessed ref */
-		STRLEN blesslen;
-		char *blessstr = SvPV(bless, blesslen);
-		sv_catpvn(retval, blessstr, blesslen);
-		sv_catpvn(retval, "( ", 2);
-		if (indent >= 2) {
-		    blesspad = apad;
-		    apad = newSVsv(apad);
-		    sv_x(aTHX_ apad, " ", 1, blesslen+2);
-		}
+	    sv_catpvn(retval, rval, rlen);
+	    sv_catpvn(retval, "/", 1);
+	    return 1;
+	}
+
+	/* If purity is not set and maxdepth is set, then check depth:
+	 * if we have reached maximum depth, return the string
+	 * representation of the thing we are currently examining
+	 * at this depth (i.e., 'Foo=ARRAY(0xdeadbeef)'). 
+	 */
+	if (!purity && maxdepth > 0 && *levelp >= maxdepth) {
+	    STRLEN vallen;
+	    char *valstr = SvPV(val,vallen);
+	    sv_catpvn(retval, "'", 1);
+	    sv_catpvn(retval, valstr, vallen);
+	    sv_catpvn(retval, "'", 1);
+	    return 1;
+	}
+
+	if (realpack) {				/* we have a blessed ref */
+	    STRLEN blesslen;
+	    char *blessstr = SvPV(bless, blesslen);
+	    sv_catpvn(retval, blessstr, blesslen);
+	    sv_catpvn(retval, "( ", 2);
+	    if (indent >= 2) {
+		blesspad = apad;
+		apad = newSVsv(apad);
+		sv_x(aTHX_ apad, " ", 1, blesslen+2);
 	    }
 	}
 
@@ -294,14 +308,16 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
 		sv_catpvn(retval, "do{\\(my $o = ", 13);
 		DD_dump(aTHX_ ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv,
 			postav, levelp,	indent, pad, xpad, apad, sep,
-			freezer, toaster, purity, deepcopy, quotekeys, bless);
+			freezer, toaster, purity, deepcopy, quotekeys, bless,
+			maxdepth);
 		sv_catpvn(retval, ")}", 2);
 	    }						     /* plain */
 	    else {
 		sv_catpvn(retval, "\\", 1);
 		DD_dump(aTHX_ ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv,
 			postav, levelp,	indent, pad, xpad, apad, sep,
-			freezer, toaster, purity, deepcopy, quotekeys, bless);
+			freezer, toaster, purity, deepcopy, quotekeys, bless,
+			maxdepth);
 	    }
 	    SvREFCNT_dec(namesv);
 	}
@@ -312,7 +328,8 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
 	    sv_catpvn(retval, "\\", 1);
 	    DD_dump(aTHX_ ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv,
 		    postav, levelp,	indent, pad, xpad, apad, sep,
-		    freezer, toaster, purity, deepcopy, quotekeys, bless);
+		    freezer, toaster, purity, deepcopy, quotekeys, bless,
+		    maxdepth);
 	    SvREFCNT_dec(namesv);
 	}
 	else if (realtype == SVt_PVAV) {
@@ -380,7 +397,8 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
 		sv_catsv(retval, ipad);
 		DD_dump(aTHX_ elem, iname, ilen, retval, seenhv, postav,
 			levelp,	indent, pad, xpad, apad, sep,
-			freezer, toaster, purity, deepcopy, quotekeys, bless);
+			freezer, toaster, purity, deepcopy, quotekeys, bless,
+			maxdepth);
 		if (ix < ixmax)
 		    sv_catpvn(retval, ",", 1);
 	    }
@@ -486,7 +504,8 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
 
 		DD_dump(aTHX_ hval, SvPVX(sname), SvCUR(sname), retval, seenhv,
 			postav, levelp,	indent, pad, xpad, newapad, sep,
-			freezer, toaster, purity, deepcopy, quotekeys, bless);
+			freezer, toaster, purity, deepcopy, quotekeys, bless,
+			maxdepth);
 		SvREFCNT_dec(sname);
 		Safefree(nkey);
 		if (indent >= 2)
@@ -626,7 +645,7 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
 			DD_dump(aTHX_ e, SvPVX(nname), SvCUR(nname), postentry,
 				seenhv, postav, &nlevel, indent, pad, xpad,
 				newapad, sep, freezer, toaster, purity,
-				deepcopy, quotekeys, bless);
+				deepcopy, quotekeys, bless, maxdepth);
 			SvREFCNT_dec(e);
 		    }
 		}
@@ -686,7 +705,7 @@ Data_Dumper_Dumpxs(href, ...)
 	    SV **svp;
 	    SV *val, *name, *pad, *xpad, *apad, *sep, *tmp, *varname;
 	    SV *freezer, *toaster, *bless;
-	    I32 purity, deepcopy, quotekeys;
+	    I32 purity, deepcopy, quotekeys, maxdepth;
 	    char tmpbuf[1024];
 	    I32 gimme = GIMME;
 
@@ -769,6 +788,8 @@ Data_Dumper_Dumpxs(href, ...)
 		    quotekeys = SvTRUE(*svp);
 		if ((svp = hv_fetch(hv, "bless", 5, FALSE)))
 		    bless = *svp;
+		if ((svp = hv_fetch(hv, "maxdepth", 8, FALSE)))
+		    maxdepth = SvIV(*svp);
 		postav = newAV();
 
 		if (todumpav)
@@ -834,7 +855,7 @@ Data_Dumper_Dumpxs(href, ...)
 		    DD_dump(aTHX_ val, SvPVX(name), SvCUR(name), valstr, seenhv,
 			    postav, &level, indent, pad, xpad, newapad, sep,
 			    freezer, toaster, purity, deepcopy, quotekeys,
-			    bless);
+			    bless, maxdepth);
 		    
 		    if (indent >= 2)
 			SvREFCNT_dec(newapad);
diff --git a/ext/Data/Dumper/Todo b/ext/Data/Dumper/Todo
index 7dcd40b8e3..bd76e65b03 100644
--- a/ext/Data/Dumper/Todo
+++ b/ext/Data/Dumper/Todo
@@ -8,12 +8,6 @@ The following functionality will be supported in the next few releases.
 
 =over 4
 
-=item $Data::Dumper::Maxdepth I<or> $I<OBJ>->Maxdepth(I<NEWVAL>)
-
-Depth beyond which we don't venture into a structure.  Has no effect when
-C<Data::Dumper::Purity> is set.  (useful in debugger when we often don't
-want to see more than enough).
-
 =item  $Data::Dumper::Expdepth I<or> $I<OBJ>->Expdepth(I<NEWVAL>)
 
 Dump contents explicitly up to a certain depth and then use names for
diff --git a/ext/Devel/DProf/DProf.xs b/ext/Devel/DProf/DProf.xs
index e5b7788d30..69f0b899a3 100644
--- a/ext/Devel/DProf/DProf.xs
+++ b/ext/Devel/DProf/DProf.xs
@@ -292,7 +292,7 @@ prof_mark( opcode ptype )
 	    static U32 lastid;
 	    CV *cv;
 
-	    cv = (CV*)SvIVX(Sub);
+	    cv = INT2PTR(CV*,SvIVX(Sub));
 	    svp = hv_fetch(cv_hash, (char*)&cv, sizeof(CV*), TRUE);
 	    if (!SvOK(*svp)) {
 		GV *gv = CvGV(cv);
@@ -568,7 +568,7 @@ XS(XS_DB_sub)
         PUSHMARK( ORIGMARK );
 
 #ifdef G_NODEBUG
-        perl_call_sv( (SV*)SvIV(Sub), GIMME | G_NODEBUG);
+        perl_call_sv( INT2PTR(SV*,SvIV(Sub)), GIMME | G_NODEBUG);
 #else
         curstash = debstash;    /* To disable debugging of perl_call_sv */
 #ifdef PERLDBf_NONAME
diff --git a/ext/DynaLoader/dl_aix.xs b/ext/DynaLoader/dl_aix.xs
index 877b28543a..96bce4e1d4 100644
--- a/ext/DynaLoader/dl_aix.xs
+++ b/ext/DynaLoader/dl_aix.xs
@@ -590,7 +590,7 @@ dl_load_file(filename, flags=0)
 	if (RETVAL == NULL)
 	    SaveError(aTHX_ "%s",dlerror()) ;
 	else
-	    sv_setiv( ST(0), (IV)RETVAL);
+	    sv_setiv( ST(0), PTR2IV(RETVAL) );
 
 
 void *
@@ -606,7 +606,7 @@ dl_find_symbol(libhandle, symbolname)
 	if (RETVAL == NULL)
 	    SaveError(aTHX_ "%s",dlerror()) ;
 	else
-	    sv_setiv( ST(0), (IV)RETVAL);
+	    sv_setiv( ST(0), PTR2IV(RETVAL));
 
 
 void
diff --git a/ext/DynaLoader/dl_beos.xs b/ext/DynaLoader/dl_beos.xs
index 1bd16a69a1..c26824e34e 100644
--- a/ext/DynaLoader/dl_beos.xs
+++ b/ext/DynaLoader/dl_beos.xs
@@ -54,7 +54,7 @@ dl_load_file(filename, flags=0)
 	PerlIO_printf(PerlIO_stderr(), "load_add_on(%s) : %d (%s)\n", path, bogo, strerror(bogo));
     } else {
 	RETVAL = (void *) bogo;
-	sv_setiv( ST(0), (IV)RETVAL);
+	sv_setiv( ST(0), PTR2IV(RETVAL) );
     }
     free(path);
 }
@@ -83,7 +83,7 @@ dl_find_symbol(libhandle, symbolname)
 	SaveError(aTHX_ "%s", strerror(retcode)) ;
 	PerlIO_printf(PerlIO_stderr(), "retcode = %p (%s)\n", retcode, strerror(retcode));
     } else
-	sv_setiv( ST(0), (IV)RETVAL);
+	sv_setiv( ST(0), PTR2IV(RETVAL));
 
 
 void
diff --git a/ext/DynaLoader/dl_cygwin.xs b/ext/DynaLoader/dl_cygwin.xs
index 0054afaae7..7f74cdd83f 100644
--- a/ext/DynaLoader/dl_cygwin.xs
+++ b/ext/DynaLoader/dl_cygwin.xs
@@ -95,7 +95,7 @@ dl_load_file(filename,flags=0)
     if (RETVAL == NULL){
 	SaveError(aTHX_ "%d",GetLastError()) ;
     } else {
-	sv_setiv( ST(0), (IV)RETVAL);
+	sv_setiv( ST(0), PTR2IV(RETVAL) );
     }
    }
 	
@@ -114,7 +114,7 @@ dl_find_symbol(libhandle, symbolname)
     if (RETVAL == NULL)
 	SaveError(aTHX_ "%d",GetLastError()) ;
     else
-	sv_setiv( ST(0), (IV)RETVAL);
+	sv_setiv( ST(0), PTR2IV(RETVAL));
 
 
 void
diff --git a/ext/DynaLoader/dl_dld.xs b/ext/DynaLoader/dl_dld.xs
index 1ddc443cfa..d427efa1d0 100644
--- a/ext/DynaLoader/dl_dld.xs
+++ b/ext/DynaLoader/dl_dld.xs
@@ -118,7 +118,7 @@ dl_load_file(filename, flags=0)
 haverror:
     ST(0) = sv_newmortal() ;
     if (dlderr == 0)
-	sv_setiv(ST(0), (IV)RETVAL);
+	sv_setiv(ST(0), PTR2IV(RETVAL));
 
 
 void *
@@ -135,7 +135,7 @@ dl_find_symbol(libhandle, symbolname)
     if (RETVAL == NULL)
 	SaveError(aTHX_ "dl_find_symbol: Unable to find '%s' symbol", symbolname) ;
     else
-	sv_setiv(ST(0), (IV)RETVAL);
+	sv_setiv(ST(0), PTR2IV(RETVAL));
 
 
 void
diff --git a/ext/DynaLoader/dl_dlopen.xs b/ext/DynaLoader/dl_dlopen.xs
index a3172088c2..641db33514 100644
--- a/ext/DynaLoader/dl_dlopen.xs
+++ b/ext/DynaLoader/dl_dlopen.xs
@@ -166,7 +166,7 @@ dl_load_file(filename, flags=0)
     if (RETVAL == NULL)
 	SaveError(aTHX_ "%s",dlerror()) ;
     else
-	sv_setiv( ST(0), (IV)RETVAL);
+	sv_setiv( ST(0), PTR2IV(RETVAL));
 
 
 void *
@@ -187,7 +187,7 @@ dl_find_symbol(libhandle, symbolname)
     if (RETVAL == NULL)
 	SaveError(aTHX_ "%s",dlerror()) ;
     else
-	sv_setiv( ST(0), (IV)RETVAL);
+	sv_setiv( ST(0), PTR2IV(RETVAL));
 
 
 void
diff --git a/ext/DynaLoader/dl_hpux.xs b/ext/DynaLoader/dl_hpux.xs
index ce454598c0..180679fb71 100644
--- a/ext/DynaLoader/dl_hpux.xs
+++ b/ext/DynaLoader/dl_hpux.xs
@@ -92,7 +92,7 @@ end:
     if (obj == NULL)
         SaveError(aTHX_ "%s",Strerror(errno));
     else
-        sv_setiv( ST(0), (IV)obj);
+        sv_setiv( ST(0), PTR2IV(obj) );
 
 
 void *
@@ -124,7 +124,7 @@ dl_find_symbol(libhandle, symbolname)
     if (status == -1) {
 	SaveError(aTHX_ "%s",(errno) ? Strerror(errno) : "Symbol not found") ;
     } else {
-	sv_setiv( ST(0), (IV)symaddr);
+	sv_setiv( ST(0), PTR2IV(symaddr) );
     }
 
 
diff --git a/ext/DynaLoader/dl_mpeix.xs b/ext/DynaLoader/dl_mpeix.xs
index 4c5d17635a..913e259cd9 100644
--- a/ext/DynaLoader/dl_mpeix.xs
+++ b/ext/DynaLoader/dl_mpeix.xs
@@ -74,7 +74,7 @@ flags));
     if (obj == NULL)
         SaveError(aTHX_"%s",Strerror(errno));
     else
-        sv_setiv( ST(0), (IV)obj);
+        sv_setiv( ST(0), PTR2IV(obj) );
 
 void *
 dl_find_symbol(libhandle, symbolname)
@@ -100,7 +100,7 @@ dl_find_symbol(libhandle, symbolname)
     if (status != 0) {
         SaveError(aTHX_"%s",(errno) ? Strerror(errno) : "Symbol not found") ;
     } else {
-        sv_setiv( ST(0), (IV)symaddr);
+        sv_setiv( ST(0), PTR2IV(symaddr) );
     }
 
 void
diff --git a/ext/DynaLoader/dl_next.xs b/ext/DynaLoader/dl_next.xs
index ec01d608f4..54d4be07ab 100644
--- a/ext/DynaLoader/dl_next.xs
+++ b/ext/DynaLoader/dl_next.xs
@@ -252,7 +252,7 @@ dl_load_file(filename, flags=0)
     if (RETVAL == NULL)
 	SaveError(aTHX_ "%s",dlerror()) ;
     else
-	sv_setiv( ST(0), (IV)RETVAL);
+	sv_setiv( ST(0), PTR2IV(RETVAL) );
 
 
 void *
@@ -273,7 +273,7 @@ dl_find_symbol(libhandle, symbolname)
     if (RETVAL == NULL)
 	SaveError(aTHX_ "%s",dlerror()) ;
     else
-	sv_setiv( ST(0), (IV)RETVAL);
+	sv_setiv( ST(0), PTR2IV(RETVAL) );
 
 
 void
diff --git a/ext/DynaLoader/dl_rhapsody.xs b/ext/DynaLoader/dl_rhapsody.xs
index 223d7f68b5..a56452ed7d 100644
--- a/ext/DynaLoader/dl_rhapsody.xs
+++ b/ext/DynaLoader/dl_rhapsody.xs
@@ -166,7 +166,7 @@ dl_load_file(filename, flags=0)
     if (RETVAL == NULL)
 	SaveError(aTHX_ "%s",dlerror()) ;
     else
-	sv_setiv( ST(0), (IV)RETVAL);
+	sv_setiv( ST(0), PTR2IV(RETVAL) );
 
 
 void *
@@ -185,7 +185,7 @@ dl_find_symbol(libhandle, symbolname)
     if (RETVAL == NULL)
 	SaveError(aTHX_ "%s",dlerror()) ;
     else
-	sv_setiv( ST(0), (IV)RETVAL);
+	sv_setiv( ST(0), PTR2IV(RETVAL) );
 
 
 void
diff --git a/ext/DynaLoader/dl_vmesa.xs b/ext/DynaLoader/dl_vmesa.xs
index ff1b60bedf..9e4908cecd 100644
--- a/ext/DynaLoader/dl_vmesa.xs
+++ b/ext/DynaLoader/dl_vmesa.xs
@@ -123,7 +123,7 @@ dl_load_file(filename, flags=0)
     if (RETVAL == NULL)
 	SaveError(aTHX_ "%s",dlerror()) ;
     else
-	sv_setiv( ST(0), (IV)RETVAL);
+	sv_setiv( ST(0), PTR2IV(RETVAL) );
  
  
 void *
@@ -141,7 +141,7 @@ dl_find_symbol(libhandle, symbolname)
     if (RETVAL == NULL)
 	SaveError(aTHX_ "%s",dlerror()) ;
     else
-	sv_setiv( ST(0), (IV)RETVAL);
+	sv_setiv( ST(0), PTR2IV(RETVAL) );
  
  
 void
diff --git a/ext/DynaLoader/dl_vms.xs b/ext/DynaLoader/dl_vms.xs
index 1024c41f96..409d586ae7 100644
--- a/ext/DynaLoader/dl_vms.xs
+++ b/ext/DynaLoader/dl_vms.xs
@@ -301,7 +301,7 @@ dl_load_file(filespec, flags)
       ST(0) = &PL_sv_undef;
     }
     else {
-      ST(0) = sv_2mortal(newSViv((IV) dlptr));
+      ST(0) = sv_2mortal(newSViv(PTR2IV(dlptr)));
     }
 
 
@@ -328,7 +328,7 @@ dl_find_symbol(librefptr,symname)
       /* error message already saved by findsym_handler */
       ST(0) = &PL_sv_undef;
     }
-    else ST(0) = sv_2mortal(newSViv((IV) entry));
+    else ST(0) = sv_2mortal(newSViv(PTR2IV(entry)));
 
 
 void
diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c
index 6da532392f..73911565d9 100644
--- a/ext/DynaLoader/dlutils.c
+++ b/ext/DynaLoader/dlutils.c
@@ -55,7 +55,7 @@ SaveError(pTHXo_ char* pat, ...)
     /* This code is based on croak/warn, see mess() in util.c */
 
     va_start(args, pat);
-    msv = mess(pat, &args);
+    msv = vmess(pat, &args);
     va_end(args);
 
     message = SvPV(msv,len);
diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm
index 38c8e6559b..ff3899f835 100644
--- a/ext/Opcode/Opcode.pm
+++ b/ext/Opcode/Opcode.pm
@@ -336,7 +336,7 @@ invert_opset function.
 
     rv2cv anoncode prototype
 
-    entersub leavesub return method method_named -- XXX loops via recursion?
+    entersub leavesub leavesublv return method method_named -- XXX loops via recursion?
 
     leaveeval -- needed for Safe to operate, is safe without entereval
 
diff --git a/ext/Opcode/Safe.pm b/ext/Opcode/Safe.pm
index 2d09c2e5c7..00ee85dbeb 100644
--- a/ext/Opcode/Safe.pm
+++ b/ext/Opcode/Safe.pm
@@ -235,7 +235,7 @@ sub rdo {
 
 1;
 
-__DATA__
+__END__
 
 =head1 NAME
 
diff --git a/ext/POSIX/POSIX.pod b/ext/POSIX/POSIX.pod
index 6ad74b74b9..08300e4337 100644
--- a/ext/POSIX/POSIX.pod
+++ b/ext/POSIX/POSIX.pod
@@ -1024,7 +1024,8 @@ If you want your code to be portable, your format (C<fmt>) argument
 should use only the conversion specifiers defined by the ANSI C
 standard.  These are C<aAbBcdHIjmMpSUwWxXyYZ%>.
 The given arguments are made consistent
-by calling C<mktime()> before calling your system's C<strftime()> function.
+as though by calling C<mktime()> before calling your system's
+C<strftime()> function, except that the C<isdst> value is not affected.
 
 The string for Tuesday, December 12, 1995.
 
diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index cc3f0c10d6..23c38b5e20 100644
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -332,6 +332,196 @@ init_tm(struct tm *ptm)		/* see mktime, strftime and asctime	*/
 # define init_tm(ptm)
 #endif
 
+/*
+ * mini_mktime - normalise struct tm values without the localtime()
+ * semantics (and overhead) of mktime().
+ */
+static void
+mini_mktime(struct tm *ptm)
+{
+    int yearday;
+    int secs;
+    int month, mday, year, jday;
+    int odd_cent, odd_year;
+
+#define	DAYS_PER_YEAR	365
+#define	DAYS_PER_QYEAR	(4*DAYS_PER_YEAR+1)
+#define	DAYS_PER_CENT	(25*DAYS_PER_QYEAR-1)
+#define	DAYS_PER_QCENT	(4*DAYS_PER_CENT+1)
+#define	SECS_PER_HOUR	(60*60)
+#define	SECS_PER_DAY	(24*SECS_PER_HOUR)
+/* parentheses deliberately absent on these two, otherwise they don't work */
+#define	MONTH_TO_DAYS	153/5
+#define	DAYS_TO_MONTH	5/153
+/* offset to bias by March (month 4) 1st between month/mday & year finding */
+#define	YEAR_ADJUST	(4*MONTH_TO_DAYS+1)
+/* as used here, the algorithm leaves Sunday as day 1 unless we adjust it */
+#define	WEEKDAY_BIAS	6	/* (1+6)%7 makes Sunday 0 again */
+
+/*
+ * Year/day algorithm notes:
+ *
+ * With a suitable offset for numeric value of the month, one can find
+ * an offset into the year by considering months to have 30.6 (153/5) days,
+ * using integer arithmetic (i.e., with truncation).  To avoid too much
+ * messing about with leap days, we consider January and February to be
+ * the 13th and 14th month of the previous year.  After that transformation,
+ * we need the month index we use to be high by 1 from 'normal human' usage,
+ * so the month index values we use run from 4 through 15.
+ *
+ * Given that, and the rules for the Gregorian calendar (leap years are those
+ * divisible by 4 unless also divisible by 100, when they must be divisible
+ * by 400 instead), we can simply calculate the number of days since some
+ * arbitrary 'beginning of time' by futzing with the (adjusted) year number,
+ * the days we derive from our month index, and adding in the day of the
+ * month.  The value used here is not adjusted for the actual origin which
+ * it normally would use (1 January A.D. 1), since we're not exposing it.
+ * We're only building the value so we can turn around and get the
+ * normalised values for the year, month, day-of-month, and day-of-year.
+ *
+ * For going backward, we need to bias the value we're using so that we find
+ * the right year value.  (Basically, we don't want the contribution of
+ * March 1st to the number to apply while deriving the year).  Having done
+ * that, we 'count up' the contribution to the year number by accounting for
+ * full quadracenturies (400-year periods) with their extra leap days, plus
+ * the contribution from full centuries (to avoid counting in the lost leap
+ * days), plus the contribution from full quad-years (to count in the normal
+ * leap days), plus the leftover contribution from any non-leap years.
+ * At this point, if we were working with an actual leap day, we'll have 0
+ * days left over.  This is also true for March 1st, however.  So, we have
+ * to special-case that result, and (earlier) keep track of the 'odd'
+ * century and year contributions.  If we got 4 extra centuries in a qcent,
+ * or 4 extra years in a qyear, then it's a leap day and we call it 29 Feb.
+ * Otherwise, we add back in the earlier bias we removed (the 123 from
+ * figuring in March 1st), find the month index (integer division by 30.6),
+ * and the remainder is the day-of-month.  We then have to convert back to
+ * 'real' months (including fixing January and February from being 14/15 in
+ * the previous year to being in the proper year).  After that, to get
+ * tm_yday, we work with the normalised year and get a new yearday value for
+ * January 1st, which we subtract from the yearday value we had earlier,
+ * representing the date we've re-built.  This is done from January 1
+ * because tm_yday is 0-origin.
+ *
+ * Since POSIX time routines are only guaranteed to work for times since the
+ * UNIX epoch (00:00:00 1 Jan 1970 UTC), the fact that this algorithm
+ * applies Gregorian calendar rules even to dates before the 16th century
+ * doesn't bother me.  Besides, you'd need cultural context for a given
+ * date to know whether it was Julian or Gregorian calendar, and that's
+ * outside the scope for this routine.  Since we convert back based on the
+ * same rules we used to build the yearday, you'll only get strange results
+ * for input which needed normalising, or for the 'odd' century years which
+ * were leap years in the Julian calander but not in the Gregorian one.
+ * I can live with that.
+ *
+ * This algorithm also fails to handle years before A.D. 1 gracefully, but
+ * that's still outside the scope for POSIX time manipulation, so I don't
+ * care.
+ */
+
+    year = 1900 + ptm->tm_year;
+    month = ptm->tm_mon;
+    mday = ptm->tm_mday;
+    /* allow given yday with no month & mday to dominate the result */
+    if (ptm->tm_yday >= 0 && mday <= 0 && month <= 0) {
+	month = 0;
+	mday = 0;
+	jday = 1 + ptm->tm_yday;
+    }
+    else {
+	jday = 0;
+    }
+    if (month >= 2)
+	month+=2;
+    else
+	month+=14, year--;
+    yearday = DAYS_PER_YEAR * year + year/4 - year/100 + year/400;
+    yearday += month*MONTH_TO_DAYS + mday + jday;
+    /*
+     * Note that we don't know when leap-seconds were or will be,
+     * so we have to trust the user if we get something which looks
+     * like a sensible leap-second.  Wild values for seconds will
+     * be rationalised, however.
+     */
+    if ((unsigned) ptm->tm_sec <= 60) {
+	secs = 0;
+    }
+    else {
+	secs = ptm->tm_sec;
+	ptm->tm_sec = 0;
+    }
+    secs += 60 * ptm->tm_min;
+    secs += SECS_PER_HOUR * ptm->tm_hour;
+    if (secs < 0) {
+	if (secs-(secs/SECS_PER_DAY*SECS_PER_DAY) < 0) {
+	    /* got negative remainder, but need positive time */
+	    /* back off an extra day to compensate */
+	    yearday += (secs/SECS_PER_DAY)-1;
+	    secs -= SECS_PER_DAY * (secs/SECS_PER_DAY - 1);
+	}
+	else {
+	    yearday += (secs/SECS_PER_DAY);
+	    secs -= SECS_PER_DAY * (secs/SECS_PER_DAY);
+	}
+    }
+    else if (secs >= SECS_PER_DAY) {
+	yearday += (secs/SECS_PER_DAY);
+	secs %= SECS_PER_DAY;
+    }
+    ptm->tm_hour = secs/SECS_PER_HOUR;
+    secs %= SECS_PER_HOUR;
+    ptm->tm_min = secs/60;
+    secs %= 60;
+    ptm->tm_sec += secs;
+    /* done with time of day effects */
+    /*
+     * The algorithm for yearday has (so far) left it high by 428.
+     * To avoid mistaking a legitimate Feb 29 as Mar 1, we need to
+     * bias it by 123 while trying to figure out what year it
+     * really represents.  Even with this tweak, the reverse
+     * translation fails for years before A.D. 0001.
+     * It would still fail for Feb 29, but we catch that one below.
+     */
+    jday = yearday;	/* save for later fixup vis-a-vis Jan 1 */
+    yearday -= YEAR_ADJUST;
+    year = (yearday / DAYS_PER_QCENT) * 400;
+    yearday %= DAYS_PER_QCENT;
+    odd_cent = yearday / DAYS_PER_CENT;
+    year += odd_cent * 100;
+    yearday %= DAYS_PER_CENT;
+    year += (yearday / DAYS_PER_QYEAR) * 4;
+    yearday %= DAYS_PER_QYEAR;
+    odd_year = yearday / DAYS_PER_YEAR;
+    year += odd_year;
+    yearday %= DAYS_PER_YEAR;
+    if (!yearday && (odd_cent==4 || odd_year==4)) { /* catch Feb 29 */
+	month = 1;
+	yearday = 29;
+    }
+    else {
+	yearday += YEAR_ADJUST;	/* recover March 1st crock */
+	month = yearday*DAYS_TO_MONTH;
+	yearday -= month*MONTH_TO_DAYS;
+	/* recover other leap-year adjustment */
+	if (month > 13) {
+	    month-=14;
+	    year++;
+	}
+	else {
+	    month-=2;
+	}
+    }
+    ptm->tm_year = year - 1900;
+    ptm->tm_mon = month;
+    ptm->tm_mday = yearday;
+    /* re-build yearday based on Jan 1 to get tm_yday */
+    year--;
+    yearday = year*DAYS_PER_YEAR + year/4 - year/100 + year/400;
+    yearday += 14*MONTH_TO_DAYS + 1;
+    ptm->tm_yday = jday - yearday;
+    /* fix tm_wday if not overridden by caller */
+    if ((unsigned)ptm->tm_wday > 6)
+	ptm->tm_wday = (jday + WEEKDAY_BIAS) % 7;
+}
 
 #ifdef HAS_LONG_DOUBLE
 #  if LONG_DOUBLESIZE > DOUBLESIZE
@@ -3274,7 +3464,7 @@ INIT:
 	}
 	else if (sv_derived_from(ST(2), "POSIX::SigSet")) {
 	    IV tmp = SvIV((SV*)SvRV(ST(2)));
-	    oldsigset = (POSIX__SigSet) tmp;
+	    oldsigset = INT2PTR(POSIX__SigSet,tmp);
 	}
 	else {
 	    New(0, oldsigset, 1, sigset_t);
@@ -3455,10 +3645,12 @@ strtol(str, base = 0)
 	char *unparsed;
     PPCODE:
 	num = strtol(str, &unparsed, base);
-	if (num >= IV_MIN && num <= IV_MAX)
-	    PUSHs(sv_2mortal(newSViv((IV)num)));
-	else
+#if IVSIZE <= LONGSIZE
+	if (num < IV_MIN || num > IV_MAX)
 	    PUSHs(sv_2mortal(newSVnv((double)num)));
+	else
+#endif
+	    PUSHs(sv_2mortal(newSViv((IV)num)));
 	if (GIMME == G_ARRAY) {
 	    EXTEND(SP, 1);
 	    if (unparsed)
@@ -3650,7 +3842,7 @@ strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
 	    mytm.tm_wday = wday;
 	    mytm.tm_yday = yday;
 	    mytm.tm_isdst = isdst;
-	    (void) mktime(&mytm);
+	    mini_mktime(&mytm);
 	    len = strftime(tmpbuf, sizeof tmpbuf, fmt, &mytm);
 	    /*
 	    ** The following is needed to handle to the situation where 
diff --git a/ext/SDBM_File/sdbm/sdbm.c b/ext/SDBM_File/sdbm/sdbm.c
index 499871dfab..5952d719e7 100644
--- a/ext/SDBM_File/sdbm/sdbm.c
+++ b/ext/SDBM_File/sdbm/sdbm.c
@@ -431,9 +431,12 @@ getdbit(register DBM *db, register long int dbit)
 	dirb = c / DBLKSIZ;
 
 	if (dirb != db->dirbno) {
+		int got;
 		if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0
-		    || read(db->dirf, db->dirbuf, DBLKSIZ) < 0)
+		    || (got=read(db->dirf, db->dirbuf, DBLKSIZ)) < 0)
 			return 0;
+		if (got==0) 
+			memset(db->dirbuf,0,DBLKSIZ);
 		db->dirbno = dirb;
 
 		debug(("dir read: %d\n", dirb));
@@ -452,10 +455,12 @@ setdbit(register DBM *db, register long int dbit)
 	dirb = c / DBLKSIZ;
 
 	if (dirb != db->dirbno) {
-		(void) memset(db->dirbuf, 0, DBLKSIZ);
+		int got;
 		if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0
-		    || read(db->dirf, db->dirbuf, DBLKSIZ) < 0)
+		    || (got=read(db->dirf, db->dirbuf, DBLKSIZ)) < 0)
 			return 0;
+		if (got==0) 
+			memset(db->dirbuf,0,DBLKSIZ);
 		db->dirbno = dirb;
 
 		debug(("dir read: %d\n", dirb));
@@ -463,8 +468,13 @@ setdbit(register DBM *db, register long int dbit)
 
 	db->dirbuf[c % DBLKSIZ] |= (1 << dbit % BYTESIZ);
 
+#if 0
 	if (dbit >= db->maxbno)
 		db->maxbno += DBLKSIZ * BYTESIZ;
+#else
+	if (OFF_DIR((dirb+1))*BYTESIZ > db->maxbno) 
+		db->maxbno=OFF_DIR((dirb+1))*BYTESIZ;
+#endif
 
 	if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0
 	    || write(db->dirf, db->dirbuf, DBLKSIZ) < 0)
diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs
index 772d41a495..e01f29de06 100644
--- a/ext/Thread/Thread.xs
+++ b/ext/Thread/Thread.xs
@@ -181,6 +181,7 @@ threadstart(void *arg)
     SvREFCNT_dec(PL_rs);
     SvREFCNT_dec(PL_nrs);
     SvREFCNT_dec(PL_statname);
+    SvREFCNT_dec(PL_errors);
     Safefree(PL_screamfirst);
     Safefree(PL_screamnext);
     Safefree(PL_reg_start_tmp);
diff --git a/ext/attrs/attrs.pm b/ext/attrs/attrs.pm
index fe2bf356e4..e97fa1ee39 100644
--- a/ext/attrs/attrs.pm
+++ b/ext/attrs/attrs.pm
@@ -46,6 +46,11 @@ execution. The semantics of the lock are exactly those of one
 explicitly taken with the C<lock> operator immediately after the
 subroutine is entered.
 
+=item lvalue
+
+Setting this attribute enables the subroutine to be used in
+lvalue context.  See L<perlsub/"Lvalue subroutines">.
+
 =back
 
 =cut
diff --git a/ext/attrs/attrs.xs b/ext/attrs/attrs.xs
index 53ba5354e2..a92922d497 100644
--- a/ext/attrs/attrs.xs
+++ b/ext/attrs/attrs.xs
@@ -10,6 +10,8 @@ get_flag(char *attr)
 	return CVf_METHOD;
     else if (strnEQ(attr, "locked", 6))
 	return CVf_LOCKED;
+    else if (strnEQ(attr, "lvalue", 6))
+	return CVf_LVALUE;
     else
 	return 0;
 }
author	Charles Bailey <bailey@newman.upenn.edu>	1999-09-29 02:21:31 +0000
committer	bailey <bailey@newman.upenn.edu>	1999-09-29 02:21:31 +0000
commit	c529f79d594c53d3968d464c57ac24a21137dd09 (patch)
tree	1a391a0c329976fd8ae88a240da31051b926c681 /ext
parent	424a8fe95d507998fe8750793da1b35bd6d7074b (diff)
download	perl-c529f79d594c53d3968d464c57ac24a21137dd09.tar.gz