develooper Front page | perl.perl5.porters | Postings from June 2003

[PATCH] make -Dl show more scope info

From:
Dave Mitchell
Date:
June 27, 2003 15:00
Subject:
[PATCH] make -Dl show more scope info
Message ID:
20030627220036.GC12887@fdgroup.com
Currently the debug option -Dl shows where PL_scopestack_ix
is getting incremented or decremented by ENTER/LEAVE; this
patch makes it also show when PL_scopestack_ix is restored by POPBLOCK or
TOPBLOCK; this is expecially useful for debugging redo, goto etc.

Eg previously, you got lines like

(/tmp/p:7)	ENTER scope 6 at pp_ctl.c:1696
(/tmp/p:7)	LEAVE scope 6 at pp_ctl.c:1738

now in addition, you get lines like

(/tmp/p:0)	POPBLOCK scope 2 at pp_hot.c:1741
(/tmp/p:8)	TOPBLOCK scope 4 at pp_ctl.c:2087

Dave.

-- 
Technology is dominated by two types of people: those who understand what
they do not manage, and those who manage what they do not understand. 


# This is a patch for 19853 to update it to 19853-l
# 
# To apply this patch:
# STEP 1: Chdir to the source directory.
# STEP 2: Run the 'applypatch' program with this patch file as input.
#
# If you do not have 'applypatch', it is part of the 'makepatch' package
# that you can fetch from the Comprehensive Perl Archive Network:
# http://www.perl.com/CPAN/authors/Johan_Vromans/makepatch-x.y.tar.gz
# In the above URL, 'x' should be 2 or higher.
#
# To apply this patch without the use of 'applypatch':
# STEP 1: Chdir to the source directory.
# STEP 2: Run the 'patch' program with this file as input.
#
#### End of Preamble ####

#### Patch data follows ####
diff -up '19853/cop.h' '19853-l/cop.h'
Index: ./cop.h
--- ./cop.h	Wed Jun 25 22:29:18 2003
+++ ./cop.h	Fri Jun 27 22:35:24 2003
@@ -334,6 +334,7 @@ struct block {
 	PL_retstack_ix	 = cx->blk_oldretsp,				\
 	pm		 = cx->blk_oldpm,				\
 	gimme		 = cx->blk_gimme;				\
+	DEBUG_SCOPE("POPBLOCK");					\
 	DEBUG_l( PerlIO_printf(Perl_debug_log, "Leaving block %ld, type %s\n",		\
 		    (long)cxstack_ix+1,PL_block_type[CxTYPE(cx)]); )
 
@@ -343,7 +344,8 @@ struct block {
 	PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp,		\
 	PL_scopestack_ix = cx->blk_oldscopesp,				\
 	PL_retstack_ix	 = cx->blk_oldretsp,				\
-	PL_curpm         = cx->blk_oldpm
+	PL_curpm         = cx->blk_oldpm;				\
+	DEBUG_SCOPE("TOPBLOCK");
 
 /* substitution context */
 struct subst {
diff -up '19853/perl.h' '19853-l/perl.h'
Index: ./perl.h
--- ./perl.h	Wed Jun 25 22:29:18 2003
+++ ./perl.h	Fri Jun 27 22:30:40 2003
@@ -2623,6 +2623,13 @@ Gid_t getegid (void);
 #endif /* DEBUGGING */
 
 
+#define DEBUG_SCOPE(where) \
+    DEBUG_l(WITH_THR(Perl_deb(aTHX_ "%s scope %ld at %s:%d\n",	\
+		    where, PL_scopestack_ix, __FILE__, __LINE__)));
+
+
+
+
 /* These constants should be used in preference to raw characters
  * when using magic. Note that some perl guts still assume
  * certain character properties of these constants, namely that
diff -up '19853/scope.h' '19853-l/scope.h'
Index: ./scope.h
--- ./scope.h	Wed Jun 25 22:29:18 2003
+++ ./scope.h	Fri Jun 27 22:33:38 2003
@@ -96,13 +96,11 @@ Closing bracket on a callback.  See C<EN
 #define ENTER							\
     STMT_START {						\
 	push_scope();						\
-	DEBUG_l(WITH_THR(Perl_deb(aTHX_ "ENTER scope %ld at %s:%d\n",	\
-		    PL_scopestack_ix, __FILE__, __LINE__)));	\
+	DEBUG_SCOPE("ENTER")					\
     } STMT_END
 #define LEAVE							\
     STMT_START {						\
-	DEBUG_l(WITH_THR(Perl_deb(aTHX_ "LEAVE scope %ld at %s:%d\n",	\
-		    PL_scopestack_ix, __FILE__, __LINE__)));	\
+	DEBUG_SCOPE("LEAVE")					\
 	pop_scope();						\
     } STMT_END
 #else
#### End of Patch data ####

#### ApplyPatch data follows ####
# Data version        : 1.0
# Date generated      : Fri Jun 27 22:44:18 2003
# Generated by        : makepatch 2.00_05
# Recurse directories : Yes
# Excluded files      : keywords\.h|warnings\.h|regnodes\.h|perlapi\.c|perlapi\.h|global\.sym|embedvar\.h|embed\.h|pod\/perlapi\.pod|pod\/perlintern\.pod|proto\.h
# v 'patchlevel.h' 4640 1056576558 33188
# p 'cop.h' 17955 1056749724 0100644
# p 'perl.h' 125059 1056749440 0100644
# p 'scope.h' 13133 1056749618 0100644
#### End of ApplyPatch data ####

#### End of Patch kit [created: Fri Jun 27 22:44:18 2003] ####
#### Patch checksum: 76 2646 59618 ####
#### Checksum: 94 3319 49529 ####



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About