From 1ee4443ef86044197a528722ecac29fb7559656a Mon Sep 17 00:00:00 2001 From: Ilya Zakharevich Date: Tue, 13 Jul 1999 01:44:28 -0400 Subject: [PATCH] Segfaults if $^P Message-Id: <199907130944.FAA04473@monk.mps.ohio-state.edu> p4raw-id: //depot/perl@3683 --- embed.h | 8 ++++---- embed.pl | 2 +- global.sym | 1 + mg.c | 2 ++ objXSUB.h | 4 ++++ perl.c | 9 ++++++--- perlapi.c | 7 +++++++ proto.h | 2 +- 8 files changed, 26 insertions(+), 9 deletions(-) diff --git a/embed.h b/embed.h index 7789679..c90f50d 100644 --- a/embed.h +++ b/embed.h @@ -205,6 +205,7 @@ #define ibcmp Perl_ibcmp #define ibcmp_locale Perl_ibcmp_locale #define ingroup Perl_ingroup +#define init_debugger Perl_init_debugger #define init_stacks Perl_init_stacks #define intro_my Perl_intro_my #define instr Perl_instr @@ -782,7 +783,6 @@ #define incpush S_incpush #define init_interp S_init_interp #define init_ids S_init_ids -#define init_debugger S_init_debugger #define init_lexer S_init_lexer #define init_main_stash S_init_main_stash #define init_perllib S_init_perllib @@ -1525,6 +1525,7 @@ #define ibcmp(a,b,c) Perl_ibcmp(aTHX_ a,b,c) #define ibcmp_locale(a,b,c) Perl_ibcmp_locale(aTHX_ a,b,c) #define ingroup(a,b) Perl_ingroup(aTHX_ a,b) +#define init_debugger() Perl_init_debugger(aTHX) #define init_stacks() Perl_init_stacks(aTHX) #define intro_my() Perl_intro_my(aTHX) #define instr(a,b) Perl_instr(aTHX_ a,b) @@ -2093,7 +2094,6 @@ #define incpush(a,b) S_incpush(aTHX_ a,b) #define init_interp() S_init_interp(aTHX) #define init_ids() S_init_ids(aTHX) -#define init_debugger() S_init_debugger(aTHX) #define init_lexer() S_init_lexer(aTHX) #define init_main_stash() S_init_main_stash(aTHX) #define init_perllib() S_init_perllib(aTHX) @@ -3027,6 +3027,8 @@ #define ibcmp_locale Perl_ibcmp_locale #define Perl_ingroup CPerlObj::Perl_ingroup #define ingroup Perl_ingroup +#define Perl_init_debugger CPerlObj::Perl_init_debugger +#define init_debugger Perl_init_debugger #define Perl_init_stacks CPerlObj::Perl_init_stacks #define init_stacks Perl_init_stacks #define Perl_intro_my CPerlObj::Perl_intro_my @@ -4139,8 +4141,6 @@ #define init_interp S_init_interp #define S_init_ids CPerlObj::S_init_ids #define init_ids S_init_ids -#define S_init_debugger CPerlObj::S_init_debugger -#define init_debugger S_init_debugger #define S_init_lexer CPerlObj::S_init_lexer #define init_lexer S_init_lexer #define S_init_main_stash CPerlObj::S_init_main_stash diff --git a/embed.pl b/embed.pl index 1af25ad..cbd2294 100755 --- a/embed.pl +++ b/embed.pl @@ -1192,6 +1192,7 @@ p |void |hv_undef |HV* tb p |I32 |ibcmp |const char* a|const char* b|I32 len p |I32 |ibcmp_locale |const char* a|const char* b|I32 len p |I32 |ingroup |I32 testgid|I32 effective +p |void |init_debugger p |void |init_stacks p |U32 |intro_my p |char* |instr |const char* big|const char* little @@ -1820,7 +1821,6 @@ s |void |forbid_setid |char * s |void |incpush |char *|int s |void |init_interp s |void |init_ids -s |void |init_debugger s |void |init_lexer s |void |init_main_stash s |void |init_perllib diff --git a/global.sym b/global.sym index 8a3e725..fba0306 100644 --- a/global.sym +++ b/global.sym @@ -179,6 +179,7 @@ Perl_hv_undef Perl_ibcmp Perl_ibcmp_locale Perl_ingroup +Perl_init_debugger Perl_init_stacks Perl_intro_my Perl_instr diff --git a/mg.c b/mg.c index 2b6459f..695272d 100644 --- a/mg.c +++ b/mg.c @@ -1676,6 +1676,8 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) break; case '\020': /* ^P */ PL_perldb = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); + if (PL_perldb && !PL_DBsingle) + init_debugger(); break; case '\024': /* ^T */ #ifdef BIG_TIME diff --git a/objXSUB.h b/objXSUB.h index 9728482..8134c17 100644 --- a/objXSUB.h +++ b/objXSUB.h @@ -1529,6 +1529,10 @@ #define Perl_ingroup pPerl->Perl_ingroup #undef ingroup #define ingroup Perl_ingroup +#undef Perl_init_debugger +#define Perl_init_debugger pPerl->Perl_init_debugger +#undef init_debugger +#define init_debugger Perl_init_debugger #undef Perl_init_stacks #define Perl_init_stacks pPerl->Perl_init_stacks #undef init_stacks diff --git a/perl.c b/perl.c index 8db7c21..23aec97 100644 --- a/perl.c +++ b/perl.c @@ -2478,23 +2478,26 @@ S_forbid_setid(pTHX_ char *s) Perl_croak(aTHX_ "No %s allowed while running setgid", s); } -STATIC void -S_init_debugger(pTHX) +void +Perl_init_debugger(pTHX) { dTHR; + HV *ostash = PL_curstash; + PL_curstash = PL_debstash; PL_dbargs = GvAV(gv_AVadd((gv_fetchpv("args", GV_ADDMULTI, SVt_PVAV)))); AvREAL_off(PL_dbargs); PL_DBgv = gv_fetchpv("DB", GV_ADDMULTI, SVt_PVGV); PL_DBline = gv_fetchpv("dbline", GV_ADDMULTI, SVt_PVAV); PL_DBsub = gv_HVadd(gv_fetchpv("sub", GV_ADDMULTI, SVt_PVHV)); + sv_upgrade(GvSV(PL_DBsub), SVt_IV); /* IVX accessed if PERLDB_SUB_NN */ PL_DBsingle = GvSV((gv_fetchpv("single", GV_ADDMULTI, SVt_PV))); sv_setiv(PL_DBsingle, 0); PL_DBtrace = GvSV((gv_fetchpv("trace", GV_ADDMULTI, SVt_PV))); sv_setiv(PL_DBtrace, 0); PL_DBsignal = GvSV((gv_fetchpv("signal", GV_ADDMULTI, SVt_PV))); sv_setiv(PL_DBsignal, 0); - PL_curstash = PL_defstash; + PL_curstash = ostash; } #ifndef STRESS_REALLOC diff --git a/perlapi.c b/perlapi.c index 037ad3d..fb078f3 100755 --- a/perlapi.c +++ b/perlapi.c @@ -1349,6 +1349,13 @@ Perl_ingroup(pTHXo_ I32 testgid, I32 effective) return ((CPerlObj*)pPerl)->Perl_ingroup(testgid, effective); } +#undef Perl_init_debugger +void +Perl_init_debugger(pTHXo) +{ + ((CPerlObj*)pPerl)->Perl_init_debugger(); +} + #undef Perl_init_stacks void Perl_init_stacks(pTHXo) diff --git a/proto.h b/proto.h index e4a9db8..ed2fdb1 100644 --- a/proto.h +++ b/proto.h @@ -198,6 +198,7 @@ VIRTUAL void Perl_hv_undef(pTHX_ HV* tb); VIRTUAL I32 Perl_ibcmp(pTHX_ const char* a, const char* b, I32 len); VIRTUAL I32 Perl_ibcmp_locale(pTHX_ const char* a, const char* b, I32 len); VIRTUAL I32 Perl_ingroup(pTHX_ I32 testgid, I32 effective); +VIRTUAL void Perl_init_debugger(pTHX); VIRTUAL void Perl_init_stacks(pTHX); VIRTUAL U32 Perl_intro_my(pTHX); VIRTUAL char* Perl_instr(pTHX_ const char* big, const char* little); @@ -791,7 +792,6 @@ STATIC void S_forbid_setid(pTHX_ char *); STATIC void S_incpush(pTHX_ char *, int); STATIC void S_init_interp(pTHX); STATIC void S_init_ids(pTHX); -STATIC void S_init_debugger(pTHX); STATIC void S_init_lexer(pTHX); STATIC void S_init_main_stash(pTHX); STATIC void S_init_perllib(pTHX); -- 2.7.4