Skip to content

Commit f1e500f

Browse files
committed
makedef.pl: Eliminate need for embed.fnc sync
makedef.pl has to manually be kept in sync with various other pieces of code. It has to know the conditionals that various symbols are compiled under. This is extra work, and error prone. This commit eliminates that need for embed.fnc syncing. The relatively new HeaderParser already returns the information about what conditionals are in effect that we need in its object for each entry. This commit just takes advantage of that, and removes the many lines that were previously needed for this purpose. Running this under Linux with PLATFORM=test revealed about a dozen symbols that would have been needlessly exported, such as Perl_grok_bslash_x(), which is only defined in certain files, and not globally.
1 parent 5034cac commit f1e500f

File tree

1 file changed

+65
-156
lines changed

1 file changed

+65
-156
lines changed

makedef.pl

Lines changed: 65 additions & 156 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,9 @@
22
#
33
# Create the export list for perl.
44
#
5+
# WARNING: This file duplicates information from some of its source files, and
6+
# must be kept in sync with changes to them.
7+
#
58
# Needed by WIN32 and OS/2 for creating perl.dll,
69
# and by AIX for creating libperl.a when -Duseshrplib is in effect,
710
# and by VMS for creating perlshr.exe.
@@ -19,7 +22,7 @@
1922
# perlvars.h
2023
# regen/opcodes
2124
#
22-
# plus long lists of function names hard-coded directly in this script.
25+
# plus long lists of function names (sadly) hard-coded directly in this script.
2326
#
2427
# Writes the result to STDOUT.
2528
#
@@ -37,7 +40,7 @@
3740

3841
my $fold;
3942
my %ARGS;
40-
my %define;
43+
our %define;
4144
BEGIN {
4245
%ARGS = (CCTYPE => 'MSVC', TARG_DIR => '');
4346

@@ -282,15 +285,6 @@ sub readvar {
282285
if (PLATFORM ne 'os2') {
283286
++$skip{$_} foreach qw(
284287
PL_opsave
285-
Perl_dump_fds
286-
Perl_my_bcopy
287-
Perl_my_bzero
288-
Perl_my_chsize
289-
Perl_my_htonl
290-
Perl_my_memcmp
291-
Perl_my_memset
292-
Perl_my_ntohl
293-
Perl_my_swap
294288
);
295289
if (PLATFORM eq 'vms') {
296290
++$skip{PL_statusvalue_posix};
@@ -319,48 +313,16 @@ sub readvar {
319313
PL_sig_ignoring
320314
PL_sig_defaulting
321315
);
322-
if (PLATFORM ne 'win32') {
323-
++$skip{$_} foreach qw(
324-
Perl_do_spawn
325-
Perl_do_spawn_nowait
326-
Perl_do_aspawn
327-
);
328-
}
329-
}
330-
331-
if (PLATFORM ne 'win32') {
332-
++$skip{$_} foreach qw(
333-
Perl_get_context
334-
Perl_get_win32_message_utf8ness
335-
Perl_Win_utf8_string_to_wstring
336-
Perl_Win_wstring_to_utf8_string
337-
);
338-
}
339-
340-
unless ($define{UNLINK_ALL_VERSIONS}) {
341-
++$skip{Perl_unlnk};
342316
}
343317

344318
unless ($define{'DEBUGGING'}) {
345319
++$skip{$_} foreach qw(
346-
Perl_debop
347-
Perl_debprofdump
348-
Perl_debstack
349-
Perl_debstackptrs
350-
Perl_pad_sv
351-
Perl_pad_setsv
352-
Perl_set_padlist
353-
Perl_hv_assert
354320
PL_watchaddr
355321
PL_watchok
356322
);
357323
}
358324

359325
if ($define{'PERL_IMPLICIT_SYS'}) {
360-
++$skip{$_} foreach qw(
361-
Perl_my_popen
362-
Perl_my_pclose
363-
);
364326
++$export{$_} foreach qw(perl_get_host_info perl_alloc_override);
365327
++$export{perl_clone_host} if $define{USE_ITHREADS};
366328
}
@@ -375,8 +337,6 @@ sub readvar {
375337
PL_Dir
376338
PL_Sock
377339
PL_Proc
378-
perl_alloc_using
379-
perl_clone_using
380340
);
381341
}
382342

@@ -390,10 +350,6 @@ sub readvar {
390350

391351
if ($define{'MYMALLOC'}) {
392352
try_symbols(qw(
393-
Perl_dump_mstats
394-
Perl_get_mstats
395-
Perl_strdup
396-
Perl_putenv
397353
MallocCfg_ptr
398354
MallocCfgP_ptr
399355
));
@@ -404,8 +360,6 @@ sub readvar {
404360
else {
405361
++$skip{$_} foreach qw(
406362
PL_malloc_mutex
407-
Perl_dump_mstats
408-
Perl_get_mstats
409363
MallocCfg_ptr
410364
MallocCfgP_ptr
411365
);
@@ -436,39 +390,9 @@ sub readvar {
436390
PL_stashpadix
437391
PL_stashpadmax
438392
PL_veto_switch_non_tTHX_context
439-
Perl_alloccopstash
440-
Perl_allocfilegv
441-
Perl_clone_params_del
442-
Perl_clone_params_new
443-
Perl_parser_dup
444-
Perl_dirp_dup
445-
Perl_cx_dup
446-
Perl_si_dup
447-
Perl_any_dup
448-
Perl_ss_dup
449-
Perl_fp_dup
450-
Perl_gp_dup
451-
Perl_he_dup
452-
Perl_mg_dup
453-
Perl_re_dup_guts
454-
Perl_sv_dup
455-
Perl_sv_dup_inc
456-
Perl_rvpv_dup
457-
Perl_hek_dup
458-
Perl_sys_intern_dup
459-
perl_clone
460-
perl_clone_using
461-
Perl_stashpv_hvname_match
462-
Perl_regdupe_internal
463-
Perl_newPADOP
464393
);
465394
}
466395

467-
unless ($define{'USE_THREADS'}) {
468-
++$skip{Perl_thread_locale_init};
469-
++$skip{Perl_thread_locale_term};
470-
}
471-
472396
if (!$define{USE_ITHREADS} || $define{WIN32}) {
473397
++$skip{PL_main_thread};
474398
}
@@ -495,13 +419,6 @@ sub readvar {
495419
);
496420
}
497421

498-
unless ($define{USE_PERL_SWITCH_LOCALE_CONTEXT})
499-
{
500-
++$skip{$_} foreach qw(
501-
Perl_switch_locale_context
502-
);
503-
}
504-
505422
unless ($define{'MULTIPLICITY'}) {
506423
++$skip{$_} foreach qw(
507424
PL_cur_locale_obj
@@ -510,33 +427,9 @@ sub readvar {
510427
PL_my_cxt_size
511428
PL_my_cxt_keys
512429
PL_my_cxt_keys_size
513-
Perl_croak_nocontext
514-
Perl_die_nocontext
515-
Perl_deb_nocontext
516-
Perl_form_nocontext
517-
Perl_load_module_nocontext
518-
Perl_mess_nocontext
519-
Perl_warn_nocontext
520-
Perl_warner_nocontext
521-
Perl_newSVpvf_nocontext
522-
Perl_sv_catpvf_nocontext
523-
Perl_sv_setpvf_nocontext
524-
Perl_sv_catpvf_mg_nocontext
525-
Perl_sv_setpvf_mg_nocontext
526-
Perl_my_cxt_init
527-
Perl_my_cxt_index
528430
);
529431
}
530432

531-
unless ($define{'USE_DTRACE'}) {
532-
++$skip{$_} foreach qw(
533-
Perl_dtrace_probe_call
534-
Perl_dtrace_probe_load
535-
Perl_dtrace_probe_op
536-
Perl_dtrace_probe_phase
537-
);
538-
}
539-
540433
unless ($define{'DEBUG_LEAKING_SCALARS'}) {
541434
++$skip{PL_sv_serial};
542435
}
@@ -545,10 +438,6 @@ sub readvar {
545438
++$skip{PL_dumper_fd};
546439
}
547440

548-
unless ($define{'PERL_DONT_CREATE_GVSV'}) {
549-
++$skip{Perl_gv_SVadd};
550-
}
551-
552441
unless ($define{'PERL_USES_PL_PIDSTATUS'}) {
553442
++$skip{PL_pidstatus};
554443
}
@@ -560,11 +449,6 @@ sub readvar {
560449
unless ($define{'PERL_MEM_LOG'}) {
561450
++$skip{$_} foreach qw(
562451
PL_mem_log
563-
Perl_mem_log_alloc
564-
Perl_mem_log_realloc
565-
Perl_mem_log_free
566-
Perl_mem_log_new_sv
567-
Perl_mem_log_del_sv
568452
);
569453
}
570454

@@ -602,20 +486,13 @@ sub readvar {
602486
++$skip{PL_sig_handlers_initted} unless !$define{HAS_SIGACTION};
603487
}
604488

605-
if ($define{'HAS_STRNLEN'})
606-
{
607-
++$skip{Perl_my_strnlen};
608-
}
609-
610489
unless ($define{USE_LOCALE_COLLATE}) {
611490
++$skip{$_} foreach qw(
612491
PL_collation_ix
613492
PL_collation_name
614493
PL_collation_standard
615494
PL_collxfrm_base
616495
PL_collxfrm_mult
617-
Perl_sv_collxfrm
618-
Perl_sv_collxfrm_flags
619496
PL_strxfrm_NUL_replacement
620497
PL_strxfrm_is_behaved
621498
PL_strxfrm_max_cp
@@ -649,38 +526,17 @@ sub readvar {
649526
);
650527
}
651528

652-
unless ($define{'USE_C_BACKTRACE'}) {
653-
++$skip{Perl_get_c_backtrace_dump};
654-
++$skip{Perl_dump_c_backtrace};
655-
}
656-
657529
unless ($define{HAVE_INTERP_INTERN}) {
658530
++$skip{$_} foreach qw(
659-
Perl_sys_intern_clear
660-
Perl_sys_intern_dup
661-
Perl_sys_intern_init
662531
PL_sys_intern
663532
);
664533
}
665-
666-
if ($define{HAS_SIGNBIT}) {
667-
++$skip{Perl_signbit};
668-
}
669-
670534
++$skip{PL_op_exec_cnt}
671535
unless $define{PERL_TRACE_OPS};
672536

673537
++$skip{PL_hash_chars}
674538
unless $define{PERL_USE_SINGLE_CHAR_HASH_CACHE};
675539

676-
unless ($define{PERL_RC_STACK}) {
677-
++$skip{$_} foreach qw(
678-
Perl_pp_wrap
679-
Perl_xs_wrap
680-
Perl_runops_wrap
681-
);
682-
}
683-
684540
# functions from *.sym files
685541

686542
my @syms = qw(globvar.sym);
@@ -773,12 +629,6 @@ sub readvar {
773629
# PerlIO with layers - export implementation
774630
try_symbols(@layer_syms, 'perlsio_binmode');
775631

776-
777-
unless ($define{'USE_QUADMATH'}) {
778-
++$skip{Perl_quadmath_format_needed};
779-
++$skip{Perl_quadmath_format_single};
780-
}
781-
782632
unless ($Config{d_mbrlen}) {
783633
++$skip{PL_mbrlen_ps};
784634
}
@@ -819,7 +669,66 @@ sub readvar {
819669
# mean "don't export"
820670
next if $seen{$func}++;
821671
$func = "Perl_$func" if ($flags =~ /[psX]/ && $func !~ /^Perl_/);
822-
++$export{$func} unless exists $skip{$func};
672+
673+
# If no conditions, export unconditionally.
674+
if ($entry->{cond}->@* == 0) {
675+
++$export{$func} unless exists $skip{$func};
676+
}
677+
else {
678+
# Replace what the HeaderLine object thinks is the output line
679+
# with this trailing portion of a condition, with a marker
680+
$entry->{line} =
681+
") { ++\$export{$func} unless exists \$skip{$func} }MAKEDEF_XXX";
682+
683+
# And get HeaderParser to surround that with any #if's that it
684+
# found when parsing embed.fnc
685+
my $hp= HeaderParser->new();
686+
my $group = $hp->group_content([$entry]);
687+
my $lines = $hp->lines_as_str($group);
688+
689+
# What that returns is something like
690+
# #if defined(USE_THREADS
691+
# ) { ++$export{foo} }MAKEDEF_XXX
692+
# #endif
693+
694+
# The #if may have continuations; get rid of them; they
695+
# confuse perl
696+
$lines =~ s/ \\ $ //mxg;
697+
698+
# Get rid of everything after the marker
699+
$lines =~ s/ MAKEDEF_XXX .* //xs;
700+
701+
# Convert the C conditional(s) to be like
702+
# $define{USE_THREADS}
703+
$lines =~ s: \b defined \( ( [^)]+ ) \) :\$define{$1}:xg;
704+
705+
# And change the #if so that the result (on a single line)
706+
# looks like
707+
# if ($define{USE_THREADS} { ++export{foo}; }
708+
$lines =~ s/ \#if / if ( /x;
709+
710+
# Unfortunately, we have to deal specially with some functions
711+
# that have both the E and X flags.
712+
my $is_EX = $flags =~ tr/EX// > 1;
713+
714+
# These should be visible to Perl extensions, so they need to
715+
# be exported. And the regular expression handling is quite
716+
# special. That is turned into a special module that has
717+
# copies of the related .c files, and those need access to
718+
# certain functions that normally aren't enabled outside those
719+
# .c files. What we do here is to locally override these few
720+
# %define entries for just these flags. (It might be that
721+
# this could globally be done, but it is safer to restrict it
722+
# to here.)
723+
local $define{PERL_EXT} = 1 if $is_EX;
724+
local $define{PERL_IN_REGCOMP_C} = 1 if $is_EX;
725+
local $define{PERL_IN_REGEXEC_C} = 1 if $is_EX;
726+
local $define{PERL_IN_REGCOMP_ANY} = 1 if $is_EX;
727+
728+
# And eval to do the export depending on the conditions
729+
eval $lines;
730+
die "eval '$lines' failed: $@" if $@;
731+
}
823732
}
824733
}
825734
}

0 commit comments

Comments
 (0)