Skip to content

Commit 4abb0f2

Browse files
khwilliamsonkhwilliamson
committed
makedef.pl: Eliminate need for embed.fnc sync
makedef.pl has to manually be kept in sync with various other pieces of code. This is extra work, and error prone. This commit eliminates that need for embed.fnc syncing. The relatively new HeaderParser already returns the information 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 Linuxs with PLATFORM=test revealed nearly 50 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 4176141 commit 4abb0f2

File tree

1 file changed

+44
-164
lines changed

1 file changed

+44
-164
lines changed

‎makedef.pl‎

Lines changed: 44 additions & 164 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 in 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
#
@@ -273,15 +276,6 @@ sub readvar {
273276
if (PLATFORM ne 'os2') {
274277
++$skip{$_} foreach qw(
275278
PL_opsave
276-
Perl_dump_fds
277-
Perl_my_bcopy
278-
Perl_my_bzero
279-
Perl_my_chsize
280-
Perl_my_htonl
281-
Perl_my_memcmp
282-
Perl_my_memset
283-
Perl_my_ntohl
284-
Perl_my_swap
285279
);
286280
if (PLATFORM eq 'vms') {
287281
++$skip{PL_statusvalue_posix};
@@ -310,48 +304,16 @@ sub readvar {
310304
PL_sig_ignoring
311305
PL_sig_defaulting
312306
);
313-
if (PLATFORM ne 'win32') {
314-
++$skip{$_} foreach qw(
315-
Perl_do_spawn
316-
Perl_do_spawn_nowait
317-
Perl_do_aspawn
318-
);
319-
}
320-
}
321-
322-
if (PLATFORM ne 'win32') {
323-
++$skip{$_} foreach qw(
324-
Perl_get_context
325-
Perl_get_win32_message_utf8ness
326-
Perl_Win_utf8_string_to_wstring
327-
Perl_Win_wstring_to_utf8_string
328-
);
329-
}
330-
331-
unless ($define{UNLINK_ALL_VERSIONS}) {
332-
++$skip{Perl_unlnk};
333307
}
334308

335309
unless ($define{'DEBUGGING'}) {
336310
++$skip{$_} foreach qw(
337-
Perl_debop
338-
Perl_debprofdump
339-
Perl_debstack
340-
Perl_debstackptrs
341-
Perl_pad_sv
342-
Perl_pad_setsv
343-
Perl_set_padlist
344-
Perl_hv_assert
345311
PL_watchaddr
346312
PL_watchok
347313
);
348314
}
349315

350316
if ($define{'PERL_IMPLICIT_SYS'}) {
351-
++$skip{$_} foreach qw(
352-
Perl_my_popen
353-
Perl_my_pclose
354-
);
355317
++$export{$_} foreach qw(perl_get_host_info perl_alloc_override);
356318
++$export{perl_clone_host} if $define{USE_ITHREADS};
357319
}
@@ -366,15 +328,9 @@ sub readvar {
366328
PL_Dir
367329
PL_Sock
368330
PL_Proc
369-
perl_alloc_using
370-
perl_clone_using
371331
);
372332
}
373333

374-
if (!$define{'PERL_COPY_ON_WRITE'} || $define{'PERL_NO_COW'}) {
375-
++$skip{Perl_sv_setsv_cow};
376-
}
377-
378334
unless ($define{PERL_SAWAMPERSAND}) {
379335
++$skip{PL_sawampersand};
380336
}
@@ -385,10 +341,6 @@ sub readvar {
385341

386342
if ($define{'MYMALLOC'}) {
387343
try_symbols(qw(
388-
Perl_dump_mstats
389-
Perl_get_mstats
390-
Perl_strdup
391-
Perl_putenv
392344
MallocCfg_ptr
393345
MallocCfgP_ptr
394346
));
@@ -399,8 +351,6 @@ sub readvar {
399351
else {
400352
++$skip{$_} foreach qw(
401353
PL_malloc_mutex
402-
Perl_dump_mstats
403-
Perl_get_mstats
404354
MallocCfg_ptr
405355
MallocCfgP_ptr
406356
);
@@ -431,39 +381,9 @@ sub readvar {
431381
PL_stashpadix
432382
PL_stashpadmax
433383
PL_veto_switch_non_tTHX_context
434-
Perl_alloccopstash
435-
Perl_allocfilegv
436-
Perl_clone_params_del
437-
Perl_clone_params_new
438-
Perl_parser_dup
439-
Perl_dirp_dup
440-
Perl_cx_dup
441-
Perl_si_dup
442-
Perl_any_dup
443-
Perl_ss_dup
444-
Perl_fp_dup
445-
Perl_gp_dup
446-
Perl_he_dup
447-
Perl_mg_dup
448-
Perl_re_dup_guts
449-
Perl_sv_dup
450-
Perl_sv_dup_inc
451-
Perl_rvpv_dup
452-
Perl_hek_dup
453-
Perl_sys_intern_dup
454-
perl_clone
455-
perl_clone_using
456-
Perl_stashpv_hvname_match
457-
Perl_regdupe_internal
458-
Perl_newPADOP
459384
);
460385
}
461386

462-
unless ($define{'USE_THREADS'}) {
463-
++$skip{Perl_thread_locale_init};
464-
++$skip{Perl_thread_locale_term};
465-
}
466-
467387
if (!$define{USE_ITHREADS} || $define{WIN32}) {
468388
++$skip{PL_main_thread};
469389
}
@@ -490,13 +410,6 @@ sub readvar {
490410
);
491411
}
492412

493-
unless ($define{USE_PERL_SWITCH_LOCALE_CONTEXT})
494-
{
495-
++$skip{$_} foreach qw(
496-
Perl_switch_locale_context
497-
);
498-
}
499-
500413
unless ($define{'MULTIPLICITY'}) {
501414
++$skip{$_} foreach qw(
502415
PL_cur_locale_obj
@@ -505,33 +418,9 @@ sub readvar {
505418
PL_my_cxt_size
506419
PL_my_cxt_keys
507420
PL_my_cxt_keys_size
508-
Perl_croak_nocontext
509-
Perl_die_nocontext
510-
Perl_deb_nocontext
511-
Perl_form_nocontext
512-
Perl_load_module_nocontext
513-
Perl_mess_nocontext
514-
Perl_warn_nocontext
515-
Perl_warner_nocontext
516-
Perl_newSVpvf_nocontext
517-
Perl_sv_catpvf_nocontext
518-
Perl_sv_setpvf_nocontext
519-
Perl_sv_catpvf_mg_nocontext
520-
Perl_sv_setpvf_mg_nocontext
521-
Perl_my_cxt_init
522-
Perl_my_cxt_index
523421
);
524422
}
525423

526-
unless ($define{'USE_DTRACE'}) {
527-
++$skip{$_} foreach qw(
528-
Perl_dtrace_probe_call
529-
Perl_dtrace_probe_load
530-
Perl_dtrace_probe_op
531-
Perl_dtrace_probe_phase
532-
);
533-
}
534-
535424
unless ($define{'DEBUG_LEAKING_SCALARS'}) {
536425
++$skip{PL_sv_serial};
537426
}
@@ -540,10 +429,6 @@ sub readvar {
540429
++$skip{PL_dumper_fd};
541430
}
542431

543-
unless ($define{'PERL_DONT_CREATE_GVSV'}) {
544-
++$skip{Perl_gv_SVadd};
545-
}
546-
547432
unless ($define{'PERL_USES_PL_PIDSTATUS'}) {
548433
++$skip{PL_pidstatus};
549434
}
@@ -555,11 +440,6 @@ sub readvar {
555440
unless ($define{'PERL_MEM_LOG'}) {
556441
++$skip{$_} foreach qw(
557442
PL_mem_log
558-
Perl_mem_log_alloc
559-
Perl_mem_log_realloc
560-
Perl_mem_log_free
561-
Perl_mem_log_new_sv
562-
Perl_mem_log_del_sv
563443
);
564444
}
565445

@@ -597,20 +477,13 @@ sub readvar {
597477
++$skip{PL_sig_handlers_initted} unless !$define{HAS_SIGACTION};
598478
}
599479

600-
if ($define{'HAS_STRNLEN'})
601-
{
602-
++$skip{Perl_my_strnlen};
603-
}
604-
605480
unless ($define{USE_LOCALE_COLLATE}) {
606481
++$skip{$_} foreach qw(
607482
PL_collation_ix
608483
PL_collation_name
609484
PL_collation_standard
610485
PL_collxfrm_base
611486
PL_collxfrm_mult
612-
Perl_sv_collxfrm
613-
Perl_sv_collxfrm_flags
614487
PL_strxfrm_NUL_replacement
615488
PL_strxfrm_is_behaved
616489
PL_strxfrm_max_cp
@@ -644,38 +517,12 @@ sub readvar {
644517
);
645518
}
646519

647-
unless ($define{'USE_C_BACKTRACE'}) {
648-
++$skip{Perl_get_c_backtrace_dump};
649-
++$skip{Perl_dump_c_backtrace};
650-
}
651-
652-
unless ($define{HAVE_INTERP_INTERN}) {
653-
++$skip{$_} foreach qw(
654-
Perl_sys_intern_clear
655-
Perl_sys_intern_dup
656-
Perl_sys_intern_init
657-
PL_sys_intern
658-
);
659-
}
660-
661-
if ($define{HAS_SIGNBIT}) {
662-
++$skip{Perl_signbit};
663-
}
664-
665520
++$skip{PL_op_exec_cnt}
666521
unless $define{PERL_TRACE_OPS};
667522

668523
++$skip{PL_hash_chars}
669524
unless $define{PERL_USE_SINGLE_CHAR_HASH_CACHE};
670525

671-
unless ($define{PERL_RC_STACK}) {
672-
++$skip{$_} foreach qw(
673-
Perl_pp_wrap
674-
Perl_xs_wrap
675-
Perl_runops_wrap
676-
);
677-
}
678-
679526
# functions from *.sym files
680527

681528
my @syms = qw(globvar.sym);
@@ -768,12 +615,6 @@ sub readvar {
768615
# PerlIO with layers - export implementation
769616
try_symbols(@layer_syms, 'perlsio_binmode');
770617

771-
772-
unless ($define{'USE_QUADMATH'}) {
773-
++$skip{Perl_quadmath_format_needed};
774-
++$skip{Perl_quadmath_format_single};
775-
}
776-
777618
unless ($Config{d_mbrlen}) {
778619
++$skip{PL_mbrlen_ps};
779620
}
@@ -817,8 +658,47 @@ sub readvar {
817658
: ($flags =~ /O/) ? 'perl_'
818659
: "";
819660
$func = "$prefix$func" if $prefix && $func !~ /^$prefix/;
820-
++$export{$func} unless exists $skip{$func};
821661

662+
# If no conditions, export unconditionally.
663+
if ($entry->{cond}->@* == 0) {
664+
++$export{$func} unless exists $skip{$func};
665+
}
666+
else {
667+
# Replace what the HeaderLine object thinks is the output line
668+
# with this trailing portion of a condition, with a marker
669+
$entry->{line} =
670+
") { ++\$export{$func} unless exists \$skip{$func} }MAKEDEF_XXX";
671+
672+
# And get HeaderParser to surround that with any #if's that it
673+
# found when parsing embed.fnc
674+
my $hp= HeaderParser->new();
675+
my $group = $hp->group_content([$entry]);
676+
my $lines = $hp->lines_as_str($group);
677+
678+
# What that returns is something like
679+
# #if defined(USE_THREADS
680+
# ) { ++$export{foo} }MAKEDEF_XXX
681+
# #endif
682+
683+
# The #if may have continuations; get rid of them; they
684+
# confuse perl
685+
$lines =~ s/ \\ $ //mxg;
686+
687+
# Get rid of everything after the marker
688+
$lines =~ s/ MAKEDEF_XXX .* //xs;
689+
690+
# Convert the C conditional(s) to be like
691+
# $define{USE_THREADS}
692+
$lines =~ s: \b defined \( ( [^)]+ ) \) :\$define{$1}:xg;
693+
694+
# And the #if so that the result (on a single line) looks like
695+
# if ($define{USE_THREADS} { ++export{foo}; }
696+
$lines =~ s/ \#if / if ( /x;
697+
698+
# And eval to do the export depending on the conditions
699+
eval $lines;
700+
die "eval '$lines' failed: $@" if $@;
701+
}
822702
}
823703
}
824704
}

0 commit comments

Comments
 (0)