6 files changed, 0 insertions, 778 deletions
diff --git a/ext/Devel/DProf/DProf.pm b/ext/Devel/DProf/DProf.pm
deleted file mode 100644
index 8ec82d04f2..0000000000
--- a/ext/Devel/DProf/DProf.pm
+++ /dev/null
@@ -1,106 +0,0 @@
-# Devel::DProf - a Perl code profiler
-#  5apr95
-#  Dean Roehrich
-#
-# changes/bugs fixed since 01mar95 version:
-#  - record $pwd and build pathname for tmon.out
-#      (so the profile doesn't get lost if the process chdir's)
-# changes/bugs fixed since 03feb95 version:
-#  - fixed some doc bugs
-#  - added require 5.000
-#  - added -w note to bugs section of pod
-# changes/bugs fixed since 31dec94 version:
-#  - podified
-#
-
-require 5.000;
-
-=head1 NAME
-
-Devel::DProf - a Perl code profiler
-
-=head1 SYNOPSIS
-
-	PERL5DB="use Devel::DProf;"
-	export PERL5DB
-
-	perl5 -d test.pl
-
-=head1 DESCRIPTION
-
-The Devel::DProf package is a Perl code profiler.  This will collect
-information on the execution time of a Perl script and of the subs in that
-script.  This information can be used to determine which subroutines are
-using the most time and which subroutines are being called most often.  This
-information can also be used to create an execution graph of the script,
-showing subroutine relationships.
-
-To use this package the PERL5DB environment variable must be set to the
-following value:
-
-	PERL5DB="use Devel::DProf;"
-	export PERL5DB
-
-To profile a Perl script run the perl interpreter with the B<-d> debugging
-switch.  The profiler uses the debugging hooks.  So to profile script
-"test.pl" the following command should be used:
-
-	perl5 -d test.pl
-
-When the script terminates the profiler will dump the profile information
-to a file called I<tmon.out>.  The supplied I<dprofpp> tool can be used to
-interpret the information which is in that profile.  The following command
-will print the top 15 subroutines which used the most time:
-
-	dprofpp
-
-To print an execution graph of the subroutines in the script use the
-following command:
-
-	dprofpp -T
-
-Consult the "dprofpp" manpage for other options.
-
-=head1 BUGS
-
-If perl5 is invoked with the B<-w> (warnings) flag then Devel::DProf will
-cause a large quantity of warnings to be printed.
-
-=head1 SEE ALSO
-
-L<perl>, L<dprofpp>, times(2)
-
-=cut
-
-package DB;
-
-# So Devel::DProf knows where to drop tmon.out.
-chop($pwd = `pwd`);
-$tmon = "$pwd/tmon.out";
-
-# This sub is replaced by an XS version after the profiler is bootstrapped.
-sub sub {
-#	print "nonXS DBsub($sub)\n";
-	$single = 0; # disable DB single-stepping
-	if( wantarray ){
-		@a = &$sub;
-		@a;
-	}
-	else{
-		$a = &$sub;
-		$a;
-	}
-}
-
-# This sub is needed during startup.
-sub DB { 
-#	print "nonXS DBDB\n";
-}
-
-
-require DynaLoader;
-@Devel::DProf::ISA = qw(DynaLoader);
-
-bootstrap Devel::DProf;
-
-1;
diff --git a/ext/Devel/DProf/DProf.xs b/ext/Devel/DProf/DProf.xs
deleted file mode 100644
index 8670481a35..0000000000
--- a/ext/Devel/DProf/DProf.xs
+++ /dev/null
@@ -1,247 +0,0 @@
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-
-/*
-# Devel::DProf - a Perl code profiler
-#  5apr95
-#  Dean Roehrich
-#
-# changes/bugs fixed since 2apr95 version:
-#  -now mallocing an extra byte for the \0 :)
-# changes/bugs fixed since 01mar95 version:
-#  -stringified code ref is used for name of anonymous sub.
-#  -include stash name with stringified code ref.
-#  -use perl.c's DBsingle and DBsub.
-#  -now using croak() and warn().
-#  -print "timer is on" before turning timer on.
-#  -use safefree() instead of free().
-#  -rely on PM to provide full path name to tmon.out.
-#  -print errno if unable to write tmon.out.
-# changes/bugs fixed since 03feb95 version:
-#  -comments
-# changes/bugs fixed since 31dec94 version:
-#  -added patches from Andy.
-#
-*/
-
-/*#define DBG_SUB 1	/* */
-/*#define DBG_TIMER 1	/* */
-
-#ifdef DBG_SUB
-#  define DBG_SUB_NOTIFY(A,B) warn( A, B )
-#else
-#  define DBG_SUB_NOTIFY(A,B)  /* nothing */
-#endif
-
-#ifdef DBG_TIMER
-#  define DBG_TIMER_NOTIFY(A) warn( A )
-#else
-#  define DBG_TIMER_NOTIFY(A)  /* nothing */
-#endif
-
-/* HZ == clock ticks per second */
-#ifndef HZ
-#define HZ 60
-#endif
-
-static SV * Sub;	/* pointer to $DB::sub */
-static char *Tmon;	/* name of tmon.out */
-
-/* Everything is built on times(2).  See its manpage for a description
- * of the timings.
- */
-
-static
-struct tms	prof_start,
-		prof_end;
-
-static
-clock_t		rprof_start, /* elapsed real time, in ticks */
-		rprof_end;
-
-union prof_any {
-	clock_t tms_utime;  /* cpu time spent in user space */
-	clock_t tms_stime;  /* cpu time spent in system */
-	clock_t realtime;   /* elapsed real time, in ticks */
-	char *name;
-	opcode ptype;
-};
-
-typedef union prof_any PROFANY;
-
-static PROFANY	*profstack;
-static int	profstack_max = 128;
-static int	profstack_ix = 0;
-
-
-static void
-prof_mark( ptype )
-opcode ptype;
-{
-	struct tms t;
-	clock_t realtime;
-	char *name, *pv;
-	char *hvname;
-	STRLEN len;
-	SV *sv;
-
-	if( profstack_ix + 5 > profstack_max ){
-		profstack_max = profstack_max * 3 / 2;
-		Renew( profstack, profstack_max, PROFANY );
-	}
-
-	realtime = times(&t);
-	pv = SvPV( Sub, len );
-
-	if( SvROK(Sub) ){
-		/* Attempt to make CODE refs identifiable by
-		 * including their package name.
-		 */
-		sv = (SV*)SvRV(Sub);
-		if( sv && SvTYPE(sv) == SVt_PVCV ){
-			hvname = HvNAME(CvSTASH(sv));
-			len += strlen( hvname ) + 2;  /* +2 for more ::'s */
-
-		}
-		else {
-			croak( "DProf prof_mark() lost on supposed CODE ref %s.\n", pv );
-		}
-		name = (char *)safemalloc( len * sizeof(char) + 1 );
-		strcpy( name, hvname );
-		strcat( name, "::" );
-		strcat( name, pv );
-	}
-	else{
-		name = (char *)safemalloc( len * sizeof(char) + 1 );
-		strcpy( name, pv );
-	}
-
-	profstack[profstack_ix++].ptype = ptype;
-	profstack[profstack_ix++].tms_utime = t.tms_utime;
-	profstack[profstack_ix++].tms_stime = t.tms_stime;
-	profstack[profstack_ix++].realtime = realtime;
-	profstack[profstack_ix++].name = name;
-}
-
-static void
-prof_record(){
-	FILE *fp;
-	char *name;
-	int base = 0;
-	opcode ptype;
-	clock_t tms_utime;
-	clock_t tms_stime;
-	clock_t realtime;
-
-	if( (fp = fopen( Tmon, "w" )) == NULL ){
-		warn("DProf: unable to write %s, errno = %d\n", Tmon, errno );
-		return;
-	}
-
-	fprintf(fp, "#fOrTyTwO\n" );
-	fprintf(fp, "$hz=%d;\n", HZ );
-	fprintf(fp, "# All values are given in HZ\n" );
-	fprintf(fp, "$rrun_utime=%ld; $rrun_stime=%ld; $rrun_rtime=%ld\n",
-		prof_end.tms_utime - prof_start.tms_utime,
-		prof_end.tms_stime - prof_start.tms_stime,
-		rprof_end - rprof_start );
-	fprintf(fp, "PART2\n" );
-
-	while( base < profstack_ix ){
-		ptype = profstack[base++].ptype;
-		tms_utime = profstack[base++].tms_utime;
-		tms_stime = profstack[base++].tms_stime;
-		realtime = profstack[base++].realtime;
-		name = profstack[base++].name;
-
-		switch( ptype ){
-		case OP_LEAVESUB:
-			fprintf(fp,"- %ld %ld %ld %s\n",
-				tms_utime, tms_stime, realtime, name );
-			break;
-		case OP_ENTERSUB:
-			fprintf(fp,"+ %ld %ld %ld %s\n",
-				tms_utime, tms_stime, realtime, name );
-			break;
-		default:
-			fprintf(fp,"Profiler unknown prof code %d\n", ptype);
-		}
-	}
-	fclose( fp );
-}
-
-#define for_real
-#ifdef for_real
-
-XS(XS_DB_sub)
-{
-	dXSARGS;
-	dORIGMARK;
-	SP -= items;
-
-	DBG_SUB_NOTIFY( "XS DBsub(%s)\n", SvPV(Sub, na) );
-
-	sv_setiv( DBsingle, 0 ); /* disable DB single-stepping */
-
-	prof_mark( OP_ENTERSUB );
-	PUSHMARK( ORIGMARK );
-
-	perl_call_sv( Sub, GIMME );
-
-	prof_mark( OP_LEAVESUB );
-	SPAGAIN;
-	PUTBACK;
-	return;
-}
-
-#endif /* for_real */
-
-#ifdef testing
-
-	MODULE = Devel::DProf		PACKAGE = DB
-
-	void
-	sub(...)
-		PPCODE:
-
-		dORIGMARK;
-		/* SP -= items;  added by xsubpp */
-		DBG_SUB_NOTIFY( "XS DBsub(%s)\n", SvPV(Sub, na) );
-
-		sv_setiv( DBsingle, 0 ); /* disable DB single-stepping */
-
-		prof_mark( OP_ENTERSUB );
-		PUSHMARK( ORIGMARK );
-
-		perl_call_sv( Sub, GIMME );
-
-		prof_mark( OP_LEAVESUB );
-		SPAGAIN;
-		/* PUTBACK;  added by xsubpp */
-
-#endif /* testing */
-
-
-MODULE = Devel::DProf		PACKAGE = Devel::DProf
-
-void
-END()
-	PPCODE:
-	rprof_end = times(&prof_end);
-	DBG_TIMER_NOTIFY("Profiler timer is off.\n");
-	prof_record();
-
-BOOT:
-	newXS("DB::sub", XS_DB_sub, file);
-	Sub = GvSV(DBsub);	 /* name of current sub */
-	sv_setiv( DBsingle, 0 ); /* disable DB single-stepping */
-	{ /* obtain name of tmon.out file */
-	 SV *sv;
-	 sv = perl_get_sv( "DB::tmon", FALSE );
-	 Tmon = (char *)safemalloc( SvCUR(sv) * sizeof(char) );
-	 strcpy( Tmon, SvPVX(sv) );
-	}
-	New( 0, profstack, profstack_max, PROFANY );
-	DBG_TIMER_NOTIFY("Profiler timer is on.\n");
-	rprof_start = times(&prof_start);
diff --git a/ext/Devel/DProf/Makefile.PL b/ext/Devel/DProf/Makefile.PL
deleted file mode 100644
index a1d7b0774d..0000000000
--- a/ext/Devel/DProf/Makefile.PL
+++ /dev/null
@@ -1,8 +0,0 @@
-use ExtUtils::MakeMaker;
-WriteMakefile(
-	'NAME'		=> 'Devel::DProf',
-	'VERSION'	=> 'Apr5,1995',
-	'clean'		=> {'FILES' => "tmon.out"},
-	'EXE_FILES'	=> ['dprofpp'],
-
-);
diff --git a/ext/Devel/DProf/README b/ext/Devel/DProf/README
deleted file mode 100644
index 970e26b46e..0000000000
--- a/ext/Devel/DProf/README
+++ /dev/null
@@ -1,3 +0,0 @@
-Please consult the pod in DProf.pm.
-
-Dean Roehrich
diff --git a/ext/Devel/DProf/dprofpp b/ext/Devel/DProf/dprofpp
deleted file mode 100644
index 6b6c0e70f2..0000000000
--- a/ext/Devel/DProf/dprofpp
+++ /dev/null
@@ -1,394 +0,0 @@
-#!/usr/local/bin/perl
-
-require 5.000;
-
-
-# dprofpp - display perl profile data
-#  5apr95
-#  Dean Roehrich
-#
-# changes/bugs fixed since 10feb95 version:
-#  - summary info is printed by default, opt_c is gone.
-#  - fixed some doc bugs
-#  - changed name to dprofpp
-# changes/bugs fixed since 03feb95 version:
-#  - fixed division by zero.
-#  - replace many local()s with my().
-#  - now prints user+system times by default
-#     now -u prints user time, -U prints unsorted.
-#  - fixed documentation
-#  - fixed output, to clarify that times are given in seconds.
-#  - can now fake exit timestamps if the profile is garbled.
-# changes/bugs fixed since 17jun94 version:
-#  - podified.
-#  - correct old documentation flaws.
-#  - added Andy's patches.
-#
- 
-
-=head1 NAME
-
-dprofpp - display perl profile data
-
-=head1 SYNOPSIS
-
-dprofpp [B<-a|-t|-l|-v|-U|-T>] [B<-s|-r|-u>] [B<-q>] [B<-F>] [B<-O cnt>] [profile]
-
-=head1 DESCRIPTION
-
-The I<dprofpp> command interprets a profile file produced by the Devel::DProf
-profiler.  By default dprofpp will read the file I<tmon.out> and will display
-the 15 subroutines which are using the most time.
-
-=head1 OPTIONS
-
-=over 5
-
-=item B<-a>
-
-Sort alphabetically by subroutine names.
-
-=item B<-t>
-
-(default) Sort by amount of user+system time used.  The first few lines
-should show you which subroutines are using the most time.
-
-=item B<-l>
-
-Sort by number of calls to the subroutines.  This may help identify
-candidates for inlining.
-
-=item B<-v>
-
-Sort by average time spent in subroutines during each call.  This may help
-identify candidates for inlining. 
-
-=item B<-U>
-
-Do not sort.  Display in the order found in the raw profile.
-
-=item B<-F>
-
-Force the generation of fake exit timestamps if dprofpp reports that the
-profile is garbled.  This is only useful if dprofpp determines that the
-profile is garbled due to missing exit timestamps.  You're on your own if
-you do this.  Consult the BUGS section.
-
-=item B<-T>
-
-Display subroutine call tree to stdout.  Subroutine statistics are
-not displayed.
-
-=item B<-q>
-
-Do not display column headers.  Does nothing if B<-T> is used.
-
-=item B<-O cnt>
-
-Show only I<cnt> subroutines.  The default is 15.  Does nothing if B<-T>
-is used.
-
-=item B<-r>
-
-Display elapsed real times rather than user+system times.
-
-=item B<-s>
-
-Display system times rather than user+system times.
-
-=item B<-u>
-
-Display user times rather than user+system times.
-
-=back
-
-=head1 BUGS
-
-Applications which call I<die> from within an eval for exception handling
-(catch/throw) or for setjmp/longjmp may not generate a readable profile.
-
-Applications which call I<exit> from within a subroutine will leave an
-incomplete profile.
-
-=head1 FILES
-
-	dprofpp		- profile processor
-	tmon.out	- raw profile
-
-=head1 SEE ALSO
-
-L<perl>, L<Devel::DProf>, times(2)
-
-=cut
-
-use Getopt::Std 'getopts';
-
-Setup: {
-	getopts('O:ltavuTqrsUF');
-
-# -O cnt	Specifies maximum number of subroutines to display.
-# -a		Sort by alphabetic name of subroutines.
-# -t		Sort by user+system time spent in subroutines. (default)
-# -l		Sort by number of calls to subroutines.
-# -v		Sort by average amount of time spent in subroutines.
-# -T		Show call tree.
-# -q		Do not print column headers.
-# -u		Use user time rather than user+system time.
-# -s		Use system time rather than user+system time.
-# -r		Use real elapsed time rather than user+system time.
-# -U		Do not sort subroutines.
-
-	$cnt = $opt_O || 15;
-	$sort = 'by_time';
-	$sort = 'by_calls' if defined $opt_l;
-	$sort = 'by_alpha' if defined $opt_a;
-	$sort = 'by_avgcpu' if defined $opt_v;
-	$whichtime = "User+System";
-	$whichtime = "System" if defined $opt_s;
-	$whichtime = "Real" if defined $opt_r;
-	$whichtime = "User" if defined $opt_u;
-}
-
-Main: {
-	my $monout = shift || "tmon.out";
-	my $fh = "main::fh";
-	local $names = {};
-	local $times = {};  # times in hz
-	local $calls = {};
-	local $persecs = {}; # times in seconds
-	local $idkeys = [];
-	local $runtime; # runtime in seconds
-	my @a = ();
-	my $a;
-	local $rrun_utime = 0;	# user time in hz
-	local $rrun_stime = 0;	# system time in hz
-	local $rrun_rtime = 0;	# elapsed run time in hz
-	local $rrun_ustime = 0;	# user+system time in hz
-	local $hz = 0;
-
-	open( $fh, "<$monout" ) || die "Unable to open $monout\n";
-
-	header($fh);
-
-	$rrun_ustime = $rrun_utime + $rrun_stime;
-
-	settime( \$runtime, $hz );
-
-	$~ = 'STAT';
-	if( ! $opt_q ){
-		$^ = 'CSTAT_top';
-	}
-
-	parsestack( $fh, $names, $calls, $times, $idkeys );
-
-	exit(0) if $opt_T;
-
-	if( $opt_v ){
-		percalc( $calls, $times, $persecs, $idkeys );
-	}
-	if( ! $opt_U ){
-		@a = sort $sort @$idkeys;
-		$a = \@a;
-	}
-	else {
-		$a = $idkeys;
-	}
-	display( $runtime, $hz, $names, $calls, $times, $cnt, $a );
-}
-
-
-# Sets $runtime to user, system, real, or user+system time.  The
-# result is given in seconds.
-#
-sub settime {
-	my( $runtime, $hz ) = @_;
-
-	if( $opt_r ){
-		$$runtime = $rrun_rtime/$hz;
-	}
-	elsif( $opt_s ){
-		$$runtime = $rrun_stime/$hz;
-	}
-	elsif( $opt_u ){
-		$$runtime = $rrun_utime/$hz;
-	}
-	else{
-		$$runtime = $rrun_ustime/$hz;
-	}
-}
-
-
-# Report the times in seconds.
-sub display {
-	my( $runtime, $hz, $names, $calls , $times, $cnt, $idkeys ) = @_;
-	my( $x, $key, $s );
-	#format: $ncalls, $name, $secs, $percall, $pcnt
-
-	for( $x = 0; $x < @$idkeys; ++$x ){
-		$key = $idkeys->[$x];
-		$ncalls = $calls->{$key};
-		$name = $names->{$key};
-		$s = $times->{$key}/$hz;
-		$secs = sprintf("%.3f", $s );
-		$percall = sprintf("%.4f", $s/$ncalls );
-		$pcnt = sprintf("%.2f",
-			$runtime ?
-				(($secs / $runtime) * 100.0) :
-				0 );
-		write;
-		$pcnt = $secs = $ncalls = $percall = "";
-		write while( length $name );
-		last unless --$cnt;
-	}
-}
-
-
-sub parsestack {
-	my( $fh, $names, $calls, $times, $idkeys ) = @_;
-	my( $dir, $name );
-	my( $t, $syst, $realt, $usert );
-	my( $x, $z, $c );
-	my @stack = ();
-	my @tstack = ();
-	my $tab = 3;
-	my $in = 0;
-
-	while(<$fh>){
-		next if /^#/o;
-		last if /^PART/o;
-		chop;
-		($dir, $usert, $syst, $realt, $name) = split;
-
-		if   ( $opt_u )	{	$t = $usert		}
-		elsif( $opt_s )	{	$t = $syst		}
-		elsif( $opt_r )	{	$t = $realt		}
-		else		{	$t = $usert + $syst	}
-
-		if( $dir eq '+' ){
-			if( $opt_T ){
-				print " " x $in, "$name\n";
-				$in += $tab;
-			}
-			if(! defined $names->{$name} ){
-				$names->{$name} = $name;
-				$times->{$name} = 0;
-				push( @$idkeys, $name );
-			}
-			$calls->{$name}++;
-			$x = [ $name, $t ];
-			push( @stack, $x );
-
-			# my children will put their time here
-			push( @tstack, 0 );
-
-			next;
-		}
-		if( $dir eq '-' ){
-			exitstamp( \@stack, \@tstack, $t, $times,
-				  $name, \$in, $tab );
-			next;
-		}
-		die "Bad profile: $_";
-	}
-	if( @stack ){
-		my @astack;
-
-		warn "Garbled profile is missing some exit time stamps:\n";
-		foreach (@stack) {
-			printf "${$_}[0]\n";
-			push( @astack, @stack );
-		}
-		if( ! $opt_F ){
-			die "Garbled profile";
-		}
-		else{
-			warn( "Faking " . scalar( @astack ) . " exit timestamp(s) . . .\n");
-
-			foreach $x ( @astack ){
-				$name = $x->[0];
-				exitstamp( \@stack, \@tstack, $t, $times,
-					  $name, \$in, $tab );
-			}
-		}
-	}
-}
-
-sub exitstamp {
-	my( $stack, $tstack, $t, $times, $name, $in, $tab ) = @_;
-
-	my( $x, $c, $z );
-
-	$x = pop( @$stack );
-	if( ! defined $x ){
-		die "Garbled profile, missing an enter time stamp";
-	}
-	if( $x->[0] ne $name ){
-		die "Garbled profile, unexpected exit time stamp";
-	}
-	if( $opt_T ){
-		$$in -= $tab;
-	}
-	# collect childtime
-	$c = pop( @$tstack );
-	# total time this func has been active
-	$z = $t - $x->[1];
-	# less time spent in child funcs.
-	#   prepare to accept that the children may account
-	#   for all my time.
-	$times->{$name} += ($z > $c)? $z - $c: $c - $z;
-
-	# pass my time to my parent
-	if( @$tstack ){
-		$c = pop( @$tstack );
-		push( @$tstack, $c + $z );
-	}
-}
-
-
-sub header {
-	my $fh = shift;
-	chop($_ = <$fh>);
-	if( ! /^#fOrTyTwO$/ ){
-		die "Not a perl profile";
-	}
-	while(<$fh>){
-		next if /^#/o;
-		last if /^PART/o;
-		eval;
-	}
-}
-
-
-# Report avg time-per-function in seconds
-sub percalc {
-	my( $calls, $times, $persecs, $idkeys ) = @_;
-	my( $x, $t, $n, $key );
-
-	for( $x = 0; $x < @$idkeys; ++$x ){
-		$key = $idkeys->[$x];
-		$n = $calls->{$key};
-		$t = $times->{$key} / $hz;
-		$persecs->{$key} = $t ? $t / $n : 0;
-	}
-}
-
-
-sub by_time { $times->{$b} <=> $times->{$a} }
-sub by_calls { $calls->{$b} <=> $calls->{$a} }
-sub by_alpha { $names->{$a} cmp $names->{$b} }
-sub by_avgcpu { $persecs->{$b} <=> $persecs->{$a} }
-
-
-format CSTAT_top =
-Total Elapsed Time = @>>>>>> Seconds
-($rrun_rtime / $hz)
-  @>>>>>>>>>> Time = @>>>>>> Seconds
-$whichtime, $runtime
-%Time Seconds     #Calls sec/call Name
-.
-
-format STAT =
- ^>>>   ^>>>> ^>>>>>>>>>   ^>>>>> ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-$pcnt, $secs, $ncalls, $percall, $name
-.
-
diff --git a/ext/Devel/DProf/test.pl b/ext/Devel/DProf/test.pl
deleted file mode 100644
index 8fa0f41043..0000000000
--- a/ext/Devel/DProf/test.pl
+++ /dev/null
@@ -1,20 +0,0 @@
-#!./perl
-
-sub foo {
-	print "in sub foo\n";
-	bar();
-}
-
-sub bar {
-	print "in sub bar\n";
-}
-
-sub baz {
-	print "in sub baz\n";
-	bar();
-	foo();
-}
-
-bar();
-baz();
-foo();