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.
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#
3740
3841my $fold ;
3942my %ARGS ;
40- my %define ;
43+ our %define ;
4144BEGIN {
4245 %ARGS = (CCTYPE => ' MSVC' , TARG_DIR => ' ' );
4346
@@ -282,15 +285,6 @@ sub readvar {
282285if (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
344318unless ($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
359325if ($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
391351if ($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 {
404360else {
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-
472396if (!$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-
505422unless ($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-
540433unless ($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-
552441unless ($define {' PERL_USES_PL_PIDSTATUS' }) {
553442 ++$skip {PL_pidstatus };
554443}
@@ -560,11 +449,6 @@ sub readvar {
560449unless ($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-
610489unless ($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-
657529unless ($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
686542my @syms = qw( globvar.sym) ;
@@ -773,12 +629,6 @@ sub readvar {
773629# PerlIO with layers - export implementation
774630try_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-
782632unless ($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