Skip to content

Commit 98f510b

Browse files
bulk88bulk88
committed
don't call vivifier macros Perl_error_log/Perl_debug_log in a loop
- macros Perl_error_log/Perl_debug_log internally call exported function PerlIO_stderr(my_perl) which may or may not call Newxz() or calloc(). A naive person would think these macros are PL_something my_perl->Isomething vars or they are C image globals vars. These 2 macros are not simple data var derefs, but are in fact vivifing function calls. Probably 20-30 years, before PerlIO was invented, I will guess Perl_error_log/Perl_debug_log where just "#define Perl_error_log 2". - Fix this by caching the PerlIO * ptrs to C autos. - Why the PerlIO API is NULL ptr, and why these vivifier function calls need to be called everywhere in all of core, at all PL_phases of execution, is beyond the scope of this commit.
1 parent 69b5e8a commit 98f510b

File tree

6 files changed

+69
-49
lines changed

6 files changed

+69
-49
lines changed

‎dump.c‎

Lines changed: 43 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -877,33 +877,36 @@ void
877877
Perl_dump_sub_perl(pTHX_ const GV *gv, bool justperl)
878878
{
879879
CV *cv;
880+
PerlIO * debug_log;
881+
bool is_gv;
880882

881883
PERL_ARGS_ASSERT_DUMP_SUB_PERL;
882884

883-
cv = isGV_with_GP(gv) ? GvCV(gv) : CV_FROM_REF((SV*)gv);
885+
cv = (is_gv = cBOOL(isGV_with_GP(gv))) ? GvCV(gv) : CV_FROM_REF((SV*)gv);
884886
if (justperl && (CvISXSUB(cv) || !CvROOT(cv)))
885887
return;
886888

887-
if (isGV_with_GP(gv)) {
889+
debug_log = Perl_debug_log;
890+
if (is_gv) {
888891
SV * const namesv = newSVpvs_flags("", SVs_TEMP);
889892
SV *escsv = newSVpvs_flags("", SVs_TEMP);
890893
const char *namepv;
891894
STRLEN namelen;
892895
gv_fullname3(namesv, gv, NULL);
893896
namepv = SvPV_const(namesv, namelen);
894-
Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ",
897+
Perl_dump_indent(aTHX_ 0, debug_log, "\nSUB %s = ",
895898
generic_pv_escape(escsv, namepv, namelen, SvUTF8(namesv)));
896899
} else {
897-
Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB = ");
900+
Perl_dump_indent(aTHX_ 0, debug_log, "\nSUB = ");
898901
}
899902
if (CvISXSUB(cv))
900-
Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%" UVxf " %d)\n",
903+
Perl_dump_indent(aTHX_ 0, debug_log, "(xsub 0x%" UVxf " %d)\n",
901904
PTR2UV(CvXSUB(cv)),
902905
(int)CvXSUBANY(cv).any_i32);
903906
else if (CvROOT(cv))
904907
op_dump(CvROOT(cv));
905908
else
906-
Perl_dump_indent(aTHX_ 0, Perl_debug_log, "<undef>\n");
909+
Perl_dump_indent(aTHX_ 0, debug_log, "<undef>\n");
907910
}
908911

909912
/*
@@ -1646,26 +1649,27 @@ Perl_gv_dump(pTHX_ GV *gv)
16461649
{
16471650
STRLEN len;
16481651
const char* name;
1652+
PerlIO * debug_log = Perl_debug_log;
16491653
SV *sv, *tmp = newSVpvs_flags("", SVs_TEMP);
16501654

16511655
if (!gv) {
1652-
PerlIO_printf(Perl_debug_log, "{}\n");
1656+
PerlIO_printf(debug_log, "{}\n");
16531657
return;
16541658
}
16551659
sv = sv_newmortal();
1656-
PerlIO_printf(Perl_debug_log, "{\n");
1660+
PerlIO_printf(debug_log, "{\n");
16571661
gv_fullname3(sv, gv, NULL);
16581662
name = SvPV_const(sv, len);
1659-
Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s",
1663+
Perl_dump_indent(aTHX_ 1, debug_log, "GV_NAME = %s",
16601664
generic_pv_escape( tmp, name, len, SvUTF8(sv) ));
16611665
if (gv != GvEGV(gv)) {
16621666
gv_efullname3(sv, GvEGV(gv), NULL);
16631667
name = SvPV_const(sv, len);
1664-
Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s",
1668+
Perl_dump_indent(aTHX_ 1, debug_log, "-> %s",
16651669
generic_pv_escape( tmp, name, len, SvUTF8(sv) ));
16661670
}
1667-
(void)PerlIO_putc(Perl_debug_log, '\n');
1668-
Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n");
1671+
(void)PerlIO_putc(debug_log, '\n');
1672+
Perl_dump_indent(aTHX_ 0, debug_log, "}\n");
16691673
}
16701674

16711675

@@ -3022,24 +3026,25 @@ S_deb_padvar(pTHX_ PADOFFSET off, int n, bool paren)
30223026
CV * const cv = deb_curcv(cxstack_ix);
30233027
PADNAMELIST *comppad = NULL;
30243028
int i;
3029+
PerlIO * debug_log = Perl_debug_log;
30253030

30263031
if (cv) {
30273032
PADLIST * const padlist = CvPADLIST(cv);
30283033
comppad = PadlistNAMES(padlist);
30293034
}
30303035
if (paren)
3031-
PerlIO_printf(Perl_debug_log, "(");
3036+
PerlIO_printf(debug_log, "(");
30323037
for (i = 0; i < n; i++) {
30333038
if (comppad && (sv = padnamelist_fetch(comppad, off + i)))
3034-
PerlIO_printf(Perl_debug_log, "%" PNf, PNfARG(sv));
3039+
PerlIO_printf(debug_log, "%" PNf, PNfARG(sv));
30353040
else
3036-
PerlIO_printf(Perl_debug_log, "[%" UVuf "]",
3041+
PerlIO_printf(debug_log, "[%" UVuf "]",
30373042
(UV)(off+i));
30383043
if (i < n - 1)
3039-
PerlIO_printf(Perl_debug_log, ",");
3044+
PerlIO_printf(debug_log, ",");
30403045
}
30413046
if (paren)
3042-
PerlIO_printf(Perl_debug_log, ")");
3047+
PerlIO_printf(debug_log, ")");
30433048
}
30443049

30453050

@@ -3297,12 +3302,15 @@ Implements B<-Dt> perl command line option on OP C<o>.
32973302
I32
32983303
Perl_debop(pTHX_ const OP *o)
32993304
{
3305+
PerlIO * debug_log;
3306+
33003307
PERL_ARGS_ASSERT_DEBOP;
33013308

33023309
if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
33033310
return 0;
33043311

33053312
Perl_deb(aTHX_ "%s", OP_NAME(o));
3313+
debug_log = Perl_debug_log;
33063314
switch (o->op_type) {
33073315
case OP_CONST:
33083316
case OP_HINTSEVAL:
@@ -3313,11 +3321,11 @@ Perl_debop(pTHX_ const OP *o)
33133321
#ifdef USE_ITHREADS
33143322
if ((((SVOP*)o)->op_sv) || !IN_PERL_COMPILETIME)
33153323
#endif
3316-
PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
3324+
PerlIO_printf(debug_log, "(%s)", SvPEEK(cSVOPo_sv));
33173325
break;
33183326
case OP_GVSV:
33193327
case OP_GV:
3320-
PerlIO_printf(Perl_debug_log, "(%" SVf ")",
3328+
PerlIO_printf(debug_log, "(%" SVf ")",
33213329
SVfARG(S_gv_display(aTHX_ cGVOPo_gv)));
33223330
break;
33233331

@@ -3334,19 +3342,19 @@ Perl_debop(pTHX_ const OP *o)
33343342
break;
33353343

33363344
case OP_MULTIDEREF:
3337-
PerlIO_printf(Perl_debug_log, "(%" SVf ")",
3345+
PerlIO_printf(debug_log, "(%" SVf ")",
33383346
SVfARG(multideref_stringify(o, deb_curcv(cxstack_ix))));
33393347
break;
33403348

33413349
case OP_MULTICONCAT:
3342-
PerlIO_printf(Perl_debug_log, "(%" SVf ")",
3350+
PerlIO_printf(debug_log, "(%" SVf ")",
33433351
SVfARG(multiconcat_stringify(o)));
33443352
break;
33453353

33463354
default:
33473355
break;
33483356
}
3349-
PerlIO_printf(Perl_debug_log, "\n");
3357+
PerlIO_printf(debug_log, "\n");
33503358
return 0;
33513359
}
33523360

@@ -3548,9 +3556,12 @@ S_debprof(pTHX_ const OP *o)
35483556

35493557
if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
35503558
return;
3551-
if (!PL_profiledata)
3552-
Newxz(PL_profiledata, MAXO, U32);
3553-
++PL_profiledata[o->op_type];
3559+
U32 * profiledata = PL_profiledata;
3560+
if (!profiledata) {
3561+
Newxz(profiledata, MAXO, U32);
3562+
PL_profiledata = profiledata;
3563+
}
3564+
++profiledata[o->op_type];
35543565
}
35553566

35563567
/*
@@ -3568,11 +3579,14 @@ Perl_debprofdump(pTHX)
35683579
unsigned i;
35693580
if (!PL_profiledata)
35703581
return;
3582+
PerlIO * debug_log = Perl_debug_log;
3583+
U32 * profiledata = PL_profiledata;
3584+
const char * const * const x_PL_op_names = PL_op_name;
35713585
for (i = 0; i < MAXO; i++) {
3572-
if (PL_profiledata[i])
3573-
PerlIO_printf(Perl_debug_log,
3574-
"%5lu %s\n", (unsigned long)PL_profiledata[i],
3575-
PL_op_name[i]);
3586+
if (profiledata[i])
3587+
PerlIO_printf(debug_log,
3588+
"%5lu %s\n", (unsigned long)profiledata[i],
3589+
x_PL_op_names[i]);
35763590
}
35773591
}
35783592

‎embed.fnc‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4616,6 +4616,7 @@ S |const char *|native_querylocale_i \
46164616
S |void |new_LC_ALL |NN const char *lc_all \
46174617
|bool force
46184618
S |void |output_check_environment_warning \
4619+
|NN PerlIO * const error_log \
46194620
|NULLOK const char * const language \
46204621
|NULLOK const char * const lc_all \
46214622
|NULLOK const char * const lang

‎embed.h‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1377,7 +1377,7 @@
13771377
# define mortalized_pv_copy(a) S_mortalized_pv_copy(aTHX_ a)
13781378
# define native_querylocale_i(a) S_native_querylocale_i(aTHX_ a)
13791379
# define new_LC_ALL(a,b) S_new_LC_ALL(aTHX_ a,b)
1380-
# define output_check_environment_warning(a,b,c) S_output_check_environment_warning(aTHX_ a,b,c)
1380+
# define output_check_environment_warning(a,b,c,d) S_output_check_environment_warning(aTHX_ a,b,c,d)
13811381
# define parse_LC_ALL_string(a,b,c,d,e,f) S_parse_LC_ALL_string(aTHX_ a,b,c,d,e,f)
13821382
# define save_to_buffer(a,b,c) S_save_to_buffer(aTHX_ a,b,c)
13831383
# define set_save_buffer_min_size(a,b,c) S_set_save_buffer_min_size(aTHX_ a,b,c)

‎locale.c‎

Lines changed: 15 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -8762,43 +8762,44 @@ S_give_perl_locale_control(pTHX_
87628762
}
87638763

87648764
STATIC void
8765-
S_output_check_environment_warning(pTHX_ const char * const language,
8765+
S_output_check_environment_warning(pTHX_ PerlIO * const error_log,
8766+
const char * const language,
87668767
const char * const lc_all,
87678768
const char * const lang)
87688769
{
8769-
PerlIO_printf(Perl_error_log,
8770+
PerlIO_printf(error_log,
87708771
"perl: warning: Please check that your locale settings:\n");
87718772

87728773
# ifdef __GLIBC__
87738774

8774-
PerlIO_printf(Perl_error_log, "\tLANGUAGE = %c%s%c,\n",
8775+
PerlIO_printf(error_log, "\tLANGUAGE = %c%s%c,\n",
87758776
language ? '"' : '(',
87768777
language ? language : "unset",
87778778
language ? '"' : ')');
87788779
# else
87798780
PERL_UNUSED_ARG(language);
87808781
# endif
87818782

8782-
PerlIO_printf(Perl_error_log, "\tLC_ALL = %c%s%c,\n",
8783+
PerlIO_printf(error_log, "\tLC_ALL = %c%s%c,\n",
87838784
lc_all ? '"' : '(',
87848785
lc_all ? lc_all : "unset",
87858786
lc_all ? '"' : ')');
87868787

87878788
for_all_individual_category_indexes(i) {
87888789
const char * value = PerlEnv_getenv(category_names[i]);
8789-
PerlIO_printf(Perl_error_log,
8790+
PerlIO_printf(error_log,
87908791
"\t%s = %c%s%c,\n",
87918792
category_names[i],
87928793
value ? '"' : '(',
87938794
value ? value : "unset",
87948795
value ? '"' : ')');
87958796
}
87968797

8797-
PerlIO_printf(Perl_error_log, "\tLANG = %c%s%c\n",
8798+
PerlIO_printf(error_log, "\tLANG = %c%s%c\n",
87988799
lang ? '"' : '(',
87998800
lang ? lang : "unset",
88008801
lang ? '"' : ')');
8801-
PerlIO_printf(Perl_error_log,
8802+
PerlIO_printf(error_log,
88028803
" are supported and installed on your system.\n");
88038804
}
88048805

@@ -9211,9 +9212,10 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
92119212
}
92129213

92139214
if (trial == 0 && locwarn) {
9214-
PerlIO_printf(Perl_error_log,
9215+
PerlIO * error_log = Perl_error_log;
9216+
PerlIO_printf(error_log,
92159217
"perl: warning: Setting locale failed.\n");
9216-
output_check_environment_warning(language, lc_all, lang);
9218+
output_check_environment_warning(error_log, language, lc_all, lang);
92179219
}
92189220

92199221
# else /* Below is ! LC_ALL */
@@ -9247,16 +9249,17 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
92479249
/* Here, this trial failed */
92489250

92499251
if (dowarn) {
9250-
PerlIO_printf(Perl_error_log,
9252+
PerlIO * error_log = Perl_error_log;
9253+
PerlIO_printf(error_log,
92519254
"perl: warning: Setting locale failed for the categories:\n");
92529255

92539256
for_all_individual_category_indexes(j) {
92549257
if (! curlocales[j]) {
9255-
PerlIO_printf(Perl_error_log, "\t%s\n", category_names[j]);
9258+
PerlIO_printf(error_log, "\t%s\n", category_names[j]);
92569259
}
92579260
}
92589261

9259-
output_check_environment_warning(language, lc_all, lang);
9262+
output_check_environment_warning(error_log, language, lc_all, lang);
92609263
} /* end of warning on first failure */
92619264

92629265
# endif /* LC_ALL */

‎proto.h‎

Lines changed: 3 additions & 2 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎util.c‎

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -4871,23 +4871,24 @@ Perl_debug_hash_seed(pTHX_ bool via_debug_h)
48714871
bool via_env = cBOOL(s && strNE(s, "0") && strNE(s,""));
48724872

48734873
if ( via_env != via_debug_h ) {
4874+
PerlIO * debug_log = Perl_debug_log;
48744875
const unsigned char *seed= PERL_HASH_SEED;
48754876
const unsigned char *seed_end= PERL_HASH_SEED + PERL_HASH_SEED_BYTES;
4876-
PerlIO_printf(Perl_debug_log, "HASH_FUNCTION = %s HASH_SEED = 0x", PERL_HASH_FUNC);
4877+
PerlIO_printf(debug_log, "HASH_FUNCTION = %s HASH_SEED = 0x", PERL_HASH_FUNC);
48774878
while (seed < seed_end) {
4878-
PerlIO_printf(Perl_debug_log, "%02x", *seed++);
4879+
PerlIO_printf(debug_log, "%02x", *seed++);
48794880
}
48804881
#ifdef PERL_HASH_RANDOMIZE_KEYS
4881-
PerlIO_printf(Perl_debug_log, " PERTURB_KEYS = %d (%s)",
4882+
PerlIO_printf(debug_log, " PERTURB_KEYS = %d (%s)",
48824883
PL_HASH_RAND_BITS_ENABLED,
48834884
PL_HASH_RAND_BITS_ENABLED == 0 ? "NO" :
48844885
PL_HASH_RAND_BITS_ENABLED == 1 ? "RANDOM"
48854886
: "DETERMINISTIC");
48864887
if (DEBUG_h_TEST)
4887-
PerlIO_printf(Perl_debug_log,
4888+
PerlIO_printf(debug_log,
48884889
" RAND_BITS=0x%" UVxf, PL_hash_rand_bits);
48894890
#endif
4890-
PerlIO_printf(Perl_debug_log, "\n");
4891+
PerlIO_printf(debug_log, "\n");
48914892
}
48924893
}
48934894
#endif /* #if (defined(USE_HASH_SEED) ... */

0 commit comments

Comments
 (0)