1#./perl -w
2#
3# Create the export list for perl.
4#
5# Needed by WIN32 and OS/2 for creating perl.dll,
6# and by AIX for creating libperl.a when -Duseshrplib is in effect,
7# and by VMS for creating perlshr.exe.
8#
9# Reads from information stored in
10#
11#    %Config::Config (ie config.sh)
12#    config.h
13#    embed.fnc
14#    globvar.sym
15#    intrpvar.h
16#    miniperl.map (on OS/2)
17#    perl5.def    (on OS/2; this is the old version of the file being made)
18#    perlio.sym
19#    perlvars.h
20#    regen/opcodes
21#
22# plus long lists of function names hard-coded directly in this script.
23#
24# Writes the result to STDOUT.
25#
26# Normally this script is invoked from a makefile (e.g. win32/Makefile),
27# which redirects STDOUT to a suitable file, such as:
28#
29#    perl5.def   OS/2
30#    perldll.def Windows
31#    perl.exp    AIX
32#    makedef.lis VMS
33
34use strict;
35use Config;
36
37my $fold;
38my %ARGS;
39my %define;
40
41BEGIN {
42    %ARGS = (CCTYPE => 'MSVC', TARG_DIR => '');
43
44    sub process_cc_flags {
45	foreach (map {split /\s+/, $_} @_) {
46	    $define{$1} = $2 // 1 if /^-D(\w+)(?:=(.+))?/;
47	}
48    }
49
50    while (@ARGV) {
51	my $flag = shift;
52	if ($flag =~ /^(?:CC_FLAGS=)?(-D\w.*)/) {
53	    process_cc_flags($1);
54	} elsif ($flag =~ /^(CCTYPE|FILETYPE|PLATFORM|TARG_DIR)=(.+)$/) {
55	    $ARGS{$1} = $2;
56	} elsif ($flag eq '--sort-fold') {
57	    ++$fold;
58	}
59    }
60    my @PLATFORM = qw(aix win32 os2 vms test);
61    my %PLATFORM;
62    @PLATFORM{@PLATFORM} = ();
63
64    die "PLATFORM undefined, must be one of: @PLATFORM\n"
65	unless defined $ARGS{PLATFORM};
66    die "PLATFORM must be one of: @PLATFORM\n"
67	unless exists $PLATFORM{$ARGS{PLATFORM}};
68}
69use constant PLATFORM => $ARGS{PLATFORM};
70
71require "./$ARGS{TARG_DIR}regen/embed_lib.pl";
72
73# Is the following guard strictly necessary? Added during refactoring
74# to keep the same behaviour when merging other code into here.
75process_cc_flags(@Config{qw(ccflags optimize)})
76    if $ARGS{PLATFORM} ne 'win32';
77
78# Add the compile-time options that miniperl was built with to %define.
79# On Win32 these are not the same options as perl itself will be built
80# with since miniperl is built with a canned config (one of the win32/
81# config_H.*) and none of the BUILDOPT's that are set in the makefiles,
82# but they do include some #define's that are hard-coded in various
83# source files and header files and don't include any BUILDOPT's that
84# the user might have chosen to disable because the canned configs are
85# minimal configs that don't include any of those options.
86
87my @options = sort(Config::bincompat_options(), Config::non_bincompat_options());
88print STDERR "Options: (@options)\n" unless $ARGS{PLATFORM} eq 'test';
89$define{$_} = 1 foreach @options;
90
91my %exportperlmalloc =
92    (
93       Perl_malloc		=>	"malloc",
94       Perl_mfree		=>	"free",
95       Perl_realloc		=>	"realloc",
96       Perl_calloc		=>	"calloc",
97    );
98
99my $exportperlmalloc = $ARGS{PLATFORM} eq 'os2';
100
101my $config_h = 'config.h';
102open(CFG, '<', $config_h) || die "Cannot open $config_h: $!\n";
103while (<CFG>) {
104    $define{$1} = 1 if /^\s*\#\s*define\s+(MYMALLOC|MULTIPLICITY
105                                           |KILL_BY_SIGPRC
106                                           |(?:PERL|USE|HAS)_\w+)\b/x;
107}
108close(CFG);
109
110# perl.h logic duplication begins
111
112if ($define{USE_ITHREADS}) {
113    if (!$define{MULTIPLICITY}) {
114        $define{MULTIPLICITY} = 1;
115    }
116}
117
118$define{MULTIPLICITY} ||=
119    $define{USE_ITHREADS} ||
120    $define{PERL_IMPLICIT_CONTEXT} ;
121
122if ($define{USE_ITHREADS} && $ARGS{PLATFORM} ne 'win32') {
123    $define{USE_REENTRANT_API} = 1;
124}
125
126if (! $define{NO_LOCALE}) {
127    if ( ! $define{NO_POSIX_2008_LOCALE}
128        && $define{HAS_NEWLOCALE}
129        && $define{HAS_USELOCALE}
130        && $define{HAS_DUPLOCALE}
131        && $define{HAS_FREELOCALE})
132    {
133        $define{HAS_POSIX_2008_LOCALE} = 1;
134        $define{USE_LOCALE} = 1;
135    }
136    elsif ($define{HAS_SETLOCALE}) {
137        $define{USE_LOCALE} = 1;
138    }
139}
140
141# https://en.wikipedia.org/wiki/Microsoft_Visual_C%2B%2B#Internal_version_numbering
142my $cctype = $ARGS{CCTYPE} =~ s/MSVC//r;
143if (! $define{HAS_SETLOCALE} && $define{HAS_POSIX_2008_LOCALE}) {
144    $define{USE_POSIX_2008_LOCALE} = 1;
145    $define{USE_THREAD_SAFE_LOCALE} = 1;
146}
147elsif (   ($define{USE_ITHREADS} || $define{USE_THREAD_SAFE_LOCALE})
148       && (    $define{HAS_POSIX_2008_LOCALE}
149           || ($ARGS{PLATFORM} eq 'win32' && (   $cctype !~ /\D/
150                                              && $cctype >= 80)))
151       && ! $define{NO_THREAD_SAFE_LOCALE})
152{
153    $define{USE_THREAD_SAFE_LOCALE} = 1 unless $define{USE_THREAD_SAFE_LOCALE};
154    $define{USE_POSIX_2008_LOCALE} = 1 if $define{HAS_POSIX_2008_LOCALE};
155}
156
157if (   $ARGS{PLATFORM} eq 'win32'
158    && $define{USE_THREAD_SAFE_LOCALE}
159    && $cctype < 140)
160{
161    $define{TS_W32_BROKEN_LOCALECONV} = 1;
162}
163
164# perl.h logic duplication ends
165
166print STDERR "Defines: (" . join(' ', sort keys %define) . ")\n"
167     unless $ARGS{PLATFORM} eq 'test';
168
169my $sym_ord = 0;
170my %ordinal;
171
172if ($ARGS{PLATFORM} eq 'os2') {
173    if (open my $fh, '<', 'perl5.def') {
174      while (<$fh>) {
175	last if /^\s*EXPORTS\b/;
176      }
177      while (<$fh>) {
178	$ordinal{$1} = $2 if /^\s*"(\w+)"\s*(?:=\s*"\w+"\s*)?\@(\d+)\s*$/;
179	# This allows skipping ordinals which were used in older versions
180	$sym_ord = $1 if /^\s*;\s*LAST_ORDINAL\s*=\s*(\d+)\s*$/;
181      }
182      $sym_ord < $_ and $sym_ord = $_ for values %ordinal; # Take the max
183    }
184}
185
186my %skip;
187# All platforms export boot_DynaLoader unconditionally.
188my %export = ( boot_DynaLoader => 1 );
189
190# d_thread_local not perl_thread_local - see hints/darwin.sh
191++$export{PL_current_context}
192    if defined $Config{d_thread_local} && $define{USE_ITHREADS};
193
194sub try_symbols {
195    foreach my $symbol (@_) {
196	++$export{$symbol} unless exists $skip{$symbol};
197    }
198}
199
200sub readvar {
201    # $hash is the hash that we're adding to. For one of our callers, it will
202    # actually be the skip hash but that doesn't affect the intent of what
203    # we're doing, as in that case we skip adding something to the skip hash
204    # for the second time.
205
206    my $file = $ARGS{TARG_DIR} . shift;
207    my $hash = shift;
208    my $proc = shift;
209    open my $vars, '<', $file or die "Cannot open $file: $!\n";
210
211    while (<$vars>) {
212	# All symbols have a Perl_ prefix because that's what embed.h sticks
213	# in front of them.  The A?I?S?C? is strictly speaking wrong.
214	next unless /\bPERLVAR(A?I?S?C?)\(([IGT]),\s*(\w+)/;
215
216	my $var = "PL_$3";
217	my $symbol = $proc ? &$proc($1,$2,$3) : $var;
218	++$hash->{$symbol} unless exists $skip{$var};
219    }
220}
221
222if ($ARGS{PLATFORM} ne 'os2') {
223    ++$skip{$_} foreach qw(
224		     PL_opsave
225		     Perl_dump_fds
226		     Perl_my_bcopy
227		     Perl_my_bzero
228		     Perl_my_chsize
229		     Perl_my_htonl
230		     Perl_my_memcmp
231		     Perl_my_memset
232		     Perl_my_ntohl
233		     Perl_my_swap
234			 );
235    if ($ARGS{PLATFORM} eq 'vms') {
236	++$skip{PL_statusvalue_posix};
237        # This is a wrapper if we have symlink, not a replacement
238        # if we don't.
239        ++$skip{Perl_my_symlink} unless $Config{d_symlink};
240    } else {
241	++$skip{PL_statusvalue_vms};
242	++$skip{PL_perllib_sep};
243	if ($ARGS{PLATFORM} ne 'aix') {
244	    ++$skip{$_} foreach qw(
245				PL_DBcv
246				PL_generation
247				PL_lastgotoprobe
248				PL_modcount
249				main
250				 );
251	}
252    }
253}
254
255if ($ARGS{PLATFORM} ne 'vms') {
256    # VMS does its own thing for these symbols.
257    ++$skip{$_} foreach qw(
258			PL_sig_handlers_initted
259			PL_sig_ignoring
260			PL_sig_defaulting
261			 );
262    if ($ARGS{PLATFORM} ne 'win32') {
263	++$skip{$_} foreach qw(
264			    Perl_do_spawn
265			    Perl_do_spawn_nowait
266			    Perl_do_aspawn
267			     );
268    }
269}
270
271if ($ARGS{PLATFORM} ne 'win32') {
272    ++$skip{$_} foreach qw(
273		    Perl_my_setlocale
274			 );
275}
276
277unless ($define{UNLINK_ALL_VERSIONS}) {
278    ++$skip{Perl_unlnk};
279}
280
281unless ($define{'DEBUGGING'}) {
282    ++$skip{$_} foreach qw(
283		    Perl_debop
284		    Perl_debprofdump
285		    Perl_debstack
286		    Perl_debstackptrs
287		    Perl_pad_sv
288		    Perl_pad_setsv
289                    Perl__setlocale_debug_string
290		    Perl_set_padlist
291		    Perl_hv_assert
292		    PL_watchaddr
293		    PL_watchok
294			 );
295}
296
297if ($define{'PERL_IMPLICIT_SYS'}) {
298    ++$skip{$_} foreach qw(
299		    Perl_my_popen
300		    Perl_my_pclose
301			 );
302    ++$export{$_} foreach qw(perl_get_host_info perl_alloc_override);
303    ++$export{perl_clone_host} if $define{USE_ITHREADS};
304}
305else {
306    ++$skip{$_} foreach qw(
307		    PL_Mem
308		    PL_MemShared
309		    PL_MemParse
310		    PL_Env
311		    PL_StdIO
312		    PL_LIO
313		    PL_Dir
314		    PL_Sock
315		    PL_Proc
316		    perl_alloc_using
317		    perl_clone_using
318			 );
319}
320
321if (!$define{'PERL_COPY_ON_WRITE'} || $define{'PERL_NO_COW'}) {
322    ++$skip{Perl_sv_setsv_cow};
323}
324
325unless ($define{PERL_SAWAMPERSAND}) {
326    ++$skip{PL_sawampersand};
327}
328
329unless ($define{'USE_REENTRANT_API'}) {
330    ++$skip{PL_reentrant_buffer};
331}
332
333if ($define{'MYMALLOC'}) {
334    try_symbols(qw(
335		    Perl_dump_mstats
336		    Perl_get_mstats
337		    Perl_strdup
338		    Perl_putenv
339		    MallocCfg_ptr
340		    MallocCfgP_ptr
341		    ));
342    unless ($define{USE_ITHREADS}) {
343	++$skip{PL_malloc_mutex}
344    }
345}
346else {
347    ++$skip{$_} foreach qw(
348		    PL_malloc_mutex
349		    Perl_dump_mstats
350		    Perl_get_mstats
351		    MallocCfg_ptr
352		    MallocCfgP_ptr
353			 );
354}
355
356if ($define{'PERL_USE_SAFE_PUTENV'}) {
357    ++$skip{PL_use_safe_putenv};
358}
359
360unless ($define{'USE_ITHREADS'}) {
361    ++$skip{PL_thr_key};
362    ++$skip{PL_user_prop_mutex};
363    ++$skip{PL_user_def_props_aTHX};
364}
365
366unless ($define{'USE_ITHREADS'}) {
367    ++$skip{$_} foreach qw(
368                    PL_keyword_plugin_mutex
369		    PL_check_mutex
370		    PL_op_mutex
371		    PL_regex_pad
372		    PL_regex_padav
373		    PL_dollarzero_mutex
374		    PL_env_mutex
375		    PL_hints_mutex
376		    PL_locale_mutex
377		    PL_lc_numeric_mutex
378		    PL_lc_numeric_mutex_depth
379		    PL_my_ctx_mutex
380		    PL_perlio_mutex
381		    PL_stashpad
382		    PL_stashpadix
383		    PL_stashpadmax
384		    Perl_alloccopstash
385		    Perl_allocfilegv
386		    Perl_clone_params_del
387		    Perl_clone_params_new
388		    Perl_parser_dup
389		    Perl_dirp_dup
390		    Perl_cx_dup
391		    Perl_si_dup
392		    Perl_any_dup
393		    Perl_ss_dup
394		    Perl_fp_dup
395		    Perl_gp_dup
396		    Perl_he_dup
397		    Perl_mg_dup
398		    Perl_re_dup_guts
399		    Perl_sv_dup
400		    Perl_sv_dup_inc
401		    Perl_rvpv_dup
402		    Perl_hek_dup
403		    Perl_sys_intern_dup
404		    perl_clone
405		    perl_clone_using
406		    Perl_stashpv_hvname_match
407		    Perl_regdupe_internal
408		    Perl_newPADOP
409			 );
410}
411
412if (      $define{NO_LOCALE}
413    || (! $define{USE_ITHREADS} && ! $define{USE_THREAD_SAFE_LOCALE}))
414{
415    ++$skip{$_} foreach qw(
416        PL_C_locale_obj
417        PL_curlocales
418    );
419}
420
421unless ( $define{'HAS_NEWLOCALE'}
422    &&   $define{'HAS_FREELOCALE'}
423    &&   $define{'HAS_USELOCALE'}
424    && ! $define{'NO_POSIX_2008_LOCALE'})
425{
426    ++$skip{$_} foreach qw(
427        PL_C_locale_obj
428        PL_underlying_numeric_obj
429    );
430}
431
432unless ($define{'MULTIPLICITY'}) {
433    ++$skip{$_} foreach qw(
434		    PL_my_cxt_index
435		    PL_my_cxt_list
436		    PL_my_cxt_size
437		    PL_my_cxt_keys
438		    PL_my_cxt_keys_size
439		    Perl_croak_nocontext
440		    Perl_die_nocontext
441		    Perl_deb_nocontext
442		    Perl_form_nocontext
443		    Perl_load_module_nocontext
444		    Perl_mess_nocontext
445		    Perl_warn_nocontext
446		    Perl_warner_nocontext
447		    Perl_newSVpvf_nocontext
448		    Perl_sv_catpvf_nocontext
449		    Perl_sv_setpvf_nocontext
450		    Perl_sv_catpvf_mg_nocontext
451		    Perl_sv_setpvf_mg_nocontext
452		    Perl_my_cxt_init
453		    Perl_my_cxt_index
454			 );
455}
456
457if ($define{USE_THREAD_SAFE_LOCALE}) {
458    ++$skip{PL_lc_numeric_mutex};
459    ++$skip{PL_lc_numeric_mutex_depth};
460}
461
462unless ($define{'USE_DTRACE'}) {
463    ++$skip{$_} foreach qw(
464                    Perl_dtrace_probe_call
465                    Perl_dtrace_probe_load
466                    Perl_dtrace_probe_op
467                    Perl_dtrace_probe_phase
468                );
469}
470
471unless ($define{'DEBUG_LEAKING_SCALARS'}) {
472    ++$skip{PL_sv_serial};
473}
474
475unless ($define{'DEBUG_LEAKING_SCALARS_FORK_DUMP'}) {
476    ++$skip{PL_dumper_fd};
477}
478
479unless ($define{'PERL_DONT_CREATE_GVSV'}) {
480    ++$skip{Perl_gv_SVadd};
481}
482
483unless ($define{'PERL_USES_PL_PIDSTATUS'}) {
484    ++$skip{PL_pidstatus};
485}
486
487unless ($define{'PERL_TRACK_MEMPOOL'}) {
488    ++$skip{PL_memory_debug_header};
489}
490
491unless ($define{'PERL_MEM_LOG'}) {
492    ++$skip{PL_mem_log};
493}
494
495unless ($define{'MULTIPLICITY'}) {
496    ++$skip{$_} foreach qw(
497		    PL_interp_size
498		    PL_interp_size_5_18_0
499                    PL_sv_yes
500                    PL_sv_undef
501                    PL_sv_no
502                    PL_sv_zero
503			 );
504}
505
506unless ($define{HAS_MMAP}) {
507    ++$skip{PL_mmap_page_size};
508}
509
510if ($define{HAS_SIGACTION}) {
511    ++$skip{PL_sig_trapped};
512
513    if ($ARGS{PLATFORM} eq 'vms') {
514        # FAKE_PERSISTENT_SIGNAL_HANDLERS defined as !defined(HAS_SIGACTION)
515        ++$skip{PL_sig_ignoring};
516        ++$skip{PL_sig_handlers_initted} unless $define{KILL_BY_SIGPRC};
517    }
518}
519
520if ($ARGS{PLATFORM} eq 'vms' && !$define{KILL_BY_SIGPRC}) {
521    # FAKE_DEFAULT_SIGNAL_HANDLERS defined as KILL_BY_SIGPRC
522    ++$skip{Perl_csighandler_init};
523    ++$skip{Perl_my_kill};
524    ++$skip{Perl_sig_to_vmscondition};
525    ++$skip{PL_sig_defaulting};
526    ++$skip{PL_sig_handlers_initted} unless !$define{HAS_SIGACTION};
527}
528
529if ($define{'HAS_STRNLEN'})
530{
531    ++$skip{Perl_my_strnlen};
532}
533
534unless ($define{USE_LOCALE_COLLATE}) {
535    ++$skip{$_} foreach qw(
536		    PL_collation_ix
537		    PL_collation_name
538		    PL_collation_standard
539		    PL_collxfrm_base
540		    PL_collxfrm_mult
541		    Perl_sv_collxfrm
542		    Perl_sv_collxfrm_flags
543                    PL_strxfrm_NUL_replacement
544                    PL_strxfrm_is_behaved
545                    PL_strxfrm_max_cp
546			 );
547}
548
549unless ($define{USE_LOCALE_NUMERIC}) {
550    ++$skip{$_} foreach qw(
551		    PL_numeric_local
552		    PL_numeric_name
553		    PL_numeric_radix_sv
554		    PL_numeric_standard
555                    PL_numeric_underlying
556                    PL_numeric_underlying_is_standard
557                    PL_underlying_numeric_obj
558			 );
559}
560
561unless ($define{'USE_C_BACKTRACE'}) {
562    ++$skip{Perl_get_c_backtrace_dump};
563    ++$skip{Perl_dump_c_backtrace};
564}
565
566unless ($define{HAVE_INTERP_INTERN}) {
567    ++$skip{$_} foreach qw(
568		    Perl_sys_intern_clear
569		    Perl_sys_intern_dup
570		    Perl_sys_intern_init
571		    PL_sys_intern
572			 );
573}
574
575if ($define{HAS_SIGNBIT}) {
576    ++$skip{Perl_signbit};
577}
578
579++$skip{PL_op_exec_cnt}
580    unless $define{PERL_TRACE_OPS};
581
582++$skip{PL_hash_chars}
583    unless $define{PERL_USE_SINGLE_CHAR_HASH_CACHE};
584
585# functions from *.sym files
586
587my @syms = qw(globvar.sym);
588
589# Symbols that are the public face of the PerlIO layers implementation
590# These are in _addition to_ the public face of the abstraction
591# and need to be exported to allow XS modules to implement layers
592my @layer_syms = qw(
593		    PerlIOBase_binmode
594		    PerlIOBase_clearerr
595		    PerlIOBase_close
596		    PerlIOBase_dup
597		    PerlIOBase_eof
598		    PerlIOBase_error
599		    PerlIOBase_fileno
600		    PerlIOBase_open
601		    PerlIOBase_noop_fail
602		    PerlIOBase_noop_ok
603		    PerlIOBase_popped
604		    PerlIOBase_pushed
605		    PerlIOBase_read
606		    PerlIOBase_setlinebuf
607		    PerlIOBase_unread
608		    PerlIOBuf_bufsiz
609		    PerlIOBuf_close
610		    PerlIOBuf_dup
611		    PerlIOBuf_fill
612		    PerlIOBuf_flush
613		    PerlIOBuf_get_base
614		    PerlIOBuf_get_cnt
615		    PerlIOBuf_get_ptr
616		    PerlIOBuf_open
617		    PerlIOBuf_popped
618		    PerlIOBuf_pushed
619		    PerlIOBuf_read
620		    PerlIOBuf_seek
621		    PerlIOBuf_set_ptrcnt
622		    PerlIOBuf_tell
623		    PerlIOBuf_unread
624		    PerlIOBuf_write
625		    PerlIO_allocate
626		    PerlIO_apply_layera
627		    PerlIO_apply_layers
628		    PerlIO_arg_fetch
629		    PerlIO_debug
630		    PerlIO_define_layer
631		    PerlIO_find_layer
632		    PerlIO_isutf8
633		    PerlIO_layer_fetch
634		    PerlIO_list_alloc
635		    PerlIO_list_free
636		    PerlIO_modestr
637		    PerlIO_parse_layers
638		    PerlIO_pending
639		    PerlIO_perlio
640		    PerlIO_pop
641		    PerlIO_push
642		    PerlIO_sv_dup
643		    Perl_PerlIO_clearerr
644		    Perl_PerlIO_close
645		    Perl_PerlIO_context_layers
646		    Perl_PerlIO_eof
647		    Perl_PerlIO_error
648		    Perl_PerlIO_fileno
649		    Perl_PerlIO_fill
650		    Perl_PerlIO_flush
651		    Perl_PerlIO_get_base
652		    Perl_PerlIO_get_bufsiz
653		    Perl_PerlIO_get_cnt
654		    Perl_PerlIO_get_ptr
655		    Perl_PerlIO_read
656		    Perl_PerlIO_restore_errno
657		    Perl_PerlIO_save_errno
658		    Perl_PerlIO_seek
659		    Perl_PerlIO_set_cnt
660		    Perl_PerlIO_set_ptrcnt
661		    Perl_PerlIO_setlinebuf
662		    Perl_PerlIO_stderr
663		    Perl_PerlIO_stdin
664		    Perl_PerlIO_stdout
665		    Perl_PerlIO_tell
666		    Perl_PerlIO_unread
667		    Perl_PerlIO_write
668);
669
670# Export the symbols that make up the PerlIO abstraction, regardless
671# of its implementation - read from a file
672push @syms, 'perlio.sym';
673
674# PerlIO with layers - export implementation
675try_symbols(@layer_syms, 'perlsio_binmode');
676
677
678unless ($define{'USE_QUADMATH'}) {
679  ++$skip{Perl_quadmath_format_needed};
680  ++$skip{Perl_quadmath_format_single};
681}
682
683unless ($Config{d_mbrlen}) {
684    ++$skip{PL_mbrlen_ps};
685}
686
687unless ($Config{d_mbrtowc}) {
688    ++$skip{PL_mbrtowc_ps};
689}
690
691unless ($Config{d_wcrtomb}) {
692    ++$skip{PL_wcrtomb_ps};
693}
694
695###############################################################################
696
697# At this point all skip lists should be completed, as we are about to test
698# many symbols against them.
699
700{
701    my %seen;
702    my ($embed) = setup_embed($ARGS{TARG_DIR});
703    my $excludedre = $define{'NO_MATHOMS'} ? qr/[emib]/ : qr/[emi]/;
704
705    foreach (@$embed) {
706	my ($flags, $retval, $func, @args) = @$_;
707	next unless $func;
708	if (($flags =~ /[AXC]/ && $flags !~ $excludedre)
709            || (!$define{'NO_MATHOMS'} && $flags =~ /b/))
710        {
711	    # public API, so export
712
713	    # If a function is defined twice, for example before and after
714	    # an #else, only export its name once. Important to do this test
715	    # within the block, as the *first* definition may have flags which
716	    # mean "don't export"
717	    next if $seen{$func}++;
718	    # Should we also skip adding the Perl_ prefix if $flags =~ /o/ ?
719	    $func = "Perl_$func" if ($flags =~ /[pX]/ && $func !~ /^Perl_/);
720	    ++$export{$func} unless exists $skip{$func};
721	}
722    }
723}
724
725foreach (@syms) {
726    my $syms = $ARGS{TARG_DIR} . $_;
727    open my $global, '<', $syms or die "failed to open $syms: $!\n";
728    while (<$global>) {
729	next unless /^([A-Za-z].*)/;
730	my $symbol = "$1";
731	++$export{$symbol} unless exists $skip{$symbol};
732    }
733}
734
735# variables
736
737readvar('perlvars.h', \%export);
738unless ($define{MULTIPLICITY}) {
739    readvar('intrpvar.h', \%export);
740}
741
742# Oddities from PerlIO
743# All have alternate implementations in perlio.c, so always exist.
744# Should they be considered to be part of the API?
745try_symbols(qw(
746		    PerlIO_binmode
747		    PerlIO_getpos
748		    PerlIO_init
749		    PerlIO_setpos
750		    PerlIO_tmpfile
751	     ));
752
753if ($ARGS{PLATFORM} eq 'win32') {
754    try_symbols(qw(
755		    win32_free_childdir
756		    win32_free_childenv
757		    win32_get_childdir
758		    win32_get_childenv
759		    win32_spawnvp
760		    Perl_init_os_extras
761		    Perl_win32_init
762		    Perl_win32_term
763		    RunPerl
764		    win32_async_check
765		    win32_errno
766		    win32_environ
767		    win32_abort
768		    win32_fstat
769		    win32_stat
770		    win32_pipe
771		    win32_popen
772		    win32_pclose
773		    win32_rename
774		    win32_setmode
775		    win32_chsize
776		    win32_lseek
777		    win32_tell
778		    win32_dup
779		    win32_dup2
780		    win32_open
781		    win32_close
782		    win32_eof
783		    win32_isatty
784		    win32_read
785		    win32_write
786		    win32_mkdir
787		    win32_rmdir
788		    win32_chdir
789		    win32_flock
790		    win32_execv
791		    win32_execvp
792		    win32_htons
793		    win32_ntohs
794		    win32_htonl
795		    win32_ntohl
796		    win32_inet_addr
797		    win32_inet_ntoa
798		    win32_socket
799		    win32_bind
800		    win32_listen
801		    win32_accept
802		    win32_connect
803		    win32_send
804		    win32_sendto
805		    win32_recv
806		    win32_recvfrom
807		    win32_shutdown
808		    win32_closesocket
809		    win32_ioctlsocket
810		    win32_setsockopt
811		    win32_getsockopt
812		    win32_getpeername
813		    win32_getsockname
814		    win32_gethostname
815		    win32_gethostbyname
816		    win32_gethostbyaddr
817		    win32_getprotobyname
818		    win32_getprotobynumber
819		    win32_getservbyname
820		    win32_getservbyport
821		    win32_select
822		    win32_endhostent
823		    win32_endnetent
824		    win32_endprotoent
825		    win32_endservent
826		    win32_getnetent
827		    win32_getnetbyname
828		    win32_getnetbyaddr
829		    win32_getprotoent
830		    win32_getservent
831		    win32_sethostent
832		    win32_setnetent
833		    win32_setprotoent
834		    win32_setservent
835		    win32_getenv
836		    win32_putenv
837		    win32_perror
838		    win32_malloc
839		    win32_calloc
840		    win32_realloc
841		    win32_free
842		    win32_sleep
843		    win32_pause
844		    win32_times
845		    win32_access
846		    win32_alarm
847		    win32_chmod
848		    win32_open_osfhandle
849		    win32_get_osfhandle
850		    win32_ioctl
851		    win32_link
852		    win32_unlink
853		    win32_utime
854		    win32_gettimeofday
855		    win32_uname
856		    win32_wait
857		    win32_waitpid
858		    win32_kill
859		    win32_str_os_error
860		    win32_opendir
861		    win32_readdir
862		    win32_telldir
863		    win32_seekdir
864		    win32_rewinddir
865		    win32_closedir
866		    win32_longpath
867		    win32_ansipath
868		    win32_os_id
869		    win32_getpid
870		    win32_crypt
871		    win32_dynaload
872		    win32_clearenv
873		    win32_stdin
874		    win32_stdout
875		    win32_stderr
876		    win32_ferror
877		    win32_feof
878		    win32_strerror
879		    win32_fprintf
880		    win32_printf
881		    win32_vfprintf
882		    win32_vprintf
883		    win32_fread
884		    win32_fwrite
885		    win32_fopen
886		    win32_fdopen
887		    win32_freopen
888		    win32_fclose
889		    win32_fputs
890		    win32_fputc
891		    win32_ungetc
892		    win32_getc
893		    win32_fileno
894		    win32_clearerr
895		    win32_fflush
896		    win32_ftell
897		    win32_fseek
898		    win32_fgetpos
899		    win32_fsetpos
900		    win32_rewind
901		    win32_tmpfile
902		    win32_setbuf
903		    win32_setvbuf
904		    win32_flushall
905		    win32_fcloseall
906		    win32_fgets
907		    win32_gets
908		    win32_fgetc
909		    win32_putc
910		    win32_puts
911		    win32_getchar
912		    win32_putchar
913                    win32_symlink
914                    win32_lstat
915                    win32_readlink
916		 ));
917}
918elsif ($ARGS{PLATFORM} eq 'vms') {
919    try_symbols(qw(
920		      Perl_cando
921		      Perl_cando_by_name
922		      Perl_closedir
923		      Perl_csighandler_init
924		      Perl_do_rmdir
925		      Perl_fileify_dirspec
926		      Perl_fileify_dirspec_ts
927		      Perl_fileify_dirspec_utf8
928		      Perl_fileify_dirspec_utf8_ts
929		      Perl_flex_fstat
930		      Perl_flex_lstat
931		      Perl_flex_stat
932		      Perl_kill_file
933		      Perl_my_chdir
934		      Perl_my_chmod
935		      Perl_my_crypt
936		      Perl_my_endpwent
937		      Perl_my_fclose
938		      Perl_my_fdopen
939		      Perl_my_fgetname
940		      Perl_my_flush
941		      Perl_my_fwrite
942		      Perl_my_gconvert
943		      Perl_my_getenv
944		      Perl_my_getenv_len
945		      Perl_my_getpwnam
946		      Perl_my_getpwuid
947		      Perl_my_gmtime
948		      Perl_my_kill
949		      Perl_my_killpg
950		      Perl_my_localtime
951		      Perl_my_mkdir
952		      Perl_my_sigaction
953		      Perl_my_symlink
954		      Perl_my_time
955		      Perl_my_tmpfile
956		      Perl_my_trnlnm
957		      Perl_my_utime
958		      Perl_my_waitpid
959		      Perl_opendir
960		      Perl_pathify_dirspec
961		      Perl_pathify_dirspec_ts
962		      Perl_pathify_dirspec_utf8
963		      Perl_pathify_dirspec_utf8_ts
964		      Perl_readdir
965		      Perl_readdir_r
966		      Perl_rename
967		      Perl_rmscopy
968		      Perl_rmsexpand
969		      Perl_rmsexpand_ts
970		      Perl_rmsexpand_utf8
971		      Perl_rmsexpand_utf8_ts
972		      Perl_seekdir
973		      Perl_sig_to_vmscondition
974		      Perl_telldir
975		      Perl_tounixpath
976		      Perl_tounixpath_ts
977		      Perl_tounixpath_utf8
978		      Perl_tounixpath_utf8_ts
979		      Perl_tounixspec
980		      Perl_tounixspec_ts
981		      Perl_tounixspec_utf8
982		      Perl_tounixspec_utf8_ts
983		      Perl_tovmspath
984		      Perl_tovmspath_ts
985		      Perl_tovmspath_utf8
986		      Perl_tovmspath_utf8_ts
987		      Perl_tovmsspec
988		      Perl_tovmsspec_ts
989		      Perl_tovmsspec_utf8
990		      Perl_tovmsspec_utf8_ts
991		      Perl_trim_unixpath
992		      Perl_vms_case_tolerant
993		      Perl_vms_do_aexec
994		      Perl_vms_do_exec
995		      Perl_vms_image_init
996		      Perl_vms_realpath
997		      Perl_vmssetenv
998		      Perl_vmssetuserlnm
999		      Perl_vmstrnenv
1000		      PerlIO_openn
1001		 ));
1002}
1003elsif ($ARGS{PLATFORM} eq 'os2') {
1004    try_symbols(qw(
1005		      ctermid
1006		      get_sysinfo
1007		      Perl_OS2_init
1008		      Perl_OS2_init3
1009		      Perl_OS2_term
1010		      OS2_Perl_data
1011		      dlopen
1012		      dlsym
1013		      dlerror
1014		      dlclose
1015		      dup2
1016		      dup
1017		      my_tmpfile
1018		      my_tmpnam
1019		      my_flock
1020		      my_rmdir
1021		      my_mkdir
1022		      my_getpwuid
1023		      my_getpwnam
1024		      my_getpwent
1025		      my_setpwent
1026		      my_endpwent
1027		      fork_with_resources
1028		      croak_with_os2error
1029		      setgrent
1030		      endgrent
1031		      getgrent
1032		      malloc_mutex
1033		      threads_mutex
1034		      nthreads
1035		      nthreads_cond
1036		      os2_cond_wait
1037		      os2_stat
1038		      os2_execname
1039		      async_mssleep
1040		      msCounter
1041		      InfoTable
1042		      pthread_join
1043		      pthread_create
1044		      pthread_detach
1045		      XS_Cwd_change_drive
1046		      XS_Cwd_current_drive
1047		      XS_Cwd_extLibpath
1048		      XS_Cwd_extLibpath_set
1049		      XS_Cwd_sys_abspath
1050		      XS_Cwd_sys_chdir
1051		      XS_Cwd_sys_cwd
1052		      XS_Cwd_sys_is_absolute
1053		      XS_Cwd_sys_is_relative
1054		      XS_Cwd_sys_is_rooted
1055		      XS_DynaLoader_mod2fname
1056		      XS_File__Copy_syscopy
1057		      Perl_Register_MQ
1058		      Perl_Deregister_MQ
1059		      Perl_Serve_Messages
1060		      Perl_Process_Messages
1061		      init_PMWIN_entries
1062		      PMWIN_entries
1063		      Perl_hab_GET
1064		      loadByOrdinal
1065		      pExtFCN
1066		      os2error
1067		      ResetWinError
1068		      CroakWinError
1069		      PL_do_undump
1070		 ));
1071}
1072
1073# When added this code was only run for Win32 (and WinCE at the time)
1074# Currently only Win32 links static extensions into the shared library.
1075# For *nix (and presumably OS/2) with a shared libperl, Makefile.SH compiles
1076# static extensions with -fPIC, but links them to perl, not libperl.so
1077# The VMS build scripts don't yet implement static extensions at all.
1078
1079if ($ARGS{PLATFORM} eq 'win32') {
1080    # records of type boot_module for statically linked modules (except Dynaloader)
1081    my $static_ext = $Config{static_ext} // "";
1082    $static_ext =~ s/\//__/g;
1083    $static_ext =~ s/\bDynaLoader\b//;
1084    try_symbols(map {"boot_$_"} grep {/\S/} split /\s+/, $static_ext);
1085    try_symbols("init_Win32CORE") if $static_ext =~ /\bWin32CORE\b/;
1086}
1087
1088if ($ARGS{PLATFORM} eq 'os2') {
1089    my (%mapped, @missing);
1090    open MAP, '<', 'miniperl.map' or die 'Cannot read miniperl.map';
1091    /^\s*[\da-f:]+\s+(\w+)/i and $mapped{$1}++ foreach <MAP>;
1092    close MAP or die 'Cannot close miniperl.map';
1093
1094    @missing = grep { !exists $mapped{$_} }
1095		    keys %export;
1096    @missing = grep { !exists $exportperlmalloc{$_} } @missing;
1097    delete $export{$_} foreach @missing;
1098}
1099
1100###############################################################################
1101
1102# Now all symbols should be defined because next we are going to output them.
1103
1104# Start with platform specific headers:
1105
1106if ($ARGS{PLATFORM} eq 'win32') {
1107    my $dll = $define{PERL_DLL} ? $define{PERL_DLL} =~ s/\.dll$//ir
1108	: "perl$Config{api_revision}$Config{api_version}";
1109    print "LIBRARY $dll\n";
1110    # The DESCRIPTION module definition file statement is not supported
1111    # by VC7 onwards.
1112    if ($ARGS{CCTYPE} eq 'GCC') {
1113	print "DESCRIPTION 'Perl interpreter'\n";
1114    }
1115    print "EXPORTS\n";
1116}
1117elsif ($ARGS{PLATFORM} eq 'os2') {
1118    (my $v = $]) =~ s/(\d\.\d\d\d)(\d\d)$/$1_$2/;
1119    $v .= '-thread' if $Config{archname} =~ /-thread/;
1120    (my $dll = $define{PERL_DLL}) =~ s/\.dll$//i;
1121    $v .= "\@$Config{perl_patchlevel}" if $Config{perl_patchlevel};
1122    my $d = "DESCRIPTION '\@#perl5-porters\@perl.org:$v#\@ Perl interpreter, configured as $Config{config_args}'";
1123    $d = substr($d, 0, 249) . "...'" if length $d > 253;
1124    print <<"---EOP---";
1125LIBRARY '$dll' INITINSTANCE TERMINSTANCE
1126$d
1127STACKSIZE 32768
1128CODE LOADONCALL
1129DATA LOADONCALL NONSHARED MULTIPLE
1130EXPORTS
1131---EOP---
1132}
1133elsif ($ARGS{PLATFORM} eq 'aix') {
1134    my $OSVER = `uname -v`;
1135    chop $OSVER;
1136    my $OSREL = `uname -r`;
1137    chop $OSREL;
1138    if ($OSVER > 4 || ($OSVER == 4 && $OSREL >= 3)) {
1139	print "#! ..\n";
1140    } else {
1141	print "#!\n";
1142    }
1143}
1144
1145# Then the symbols
1146
1147my @symbols = $fold ? sort {lc $a cmp lc $b} keys %export : sort keys %export;
1148foreach my $symbol (@symbols) {
1149    if (PLATFORM eq 'win32') {
1150	# Remembering the origin file of each symbol is an alternative to PL_ matching
1151	if (substr($symbol, 0, 3) eq 'PL_') {
1152	    print "\t$symbol DATA\n";
1153	}
1154	else {
1155	    print "\t$symbol\n";
1156	}
1157    }
1158    elsif (PLATFORM eq 'os2') {
1159	printf qq(    %-31s \@%s\n),
1160	  qq("$symbol"), $ordinal{$symbol} || ++$sym_ord;
1161	printf qq(    %-31s \@%s\n),
1162	  qq("$exportperlmalloc{$symbol}" = "$symbol"),
1163	  $ordinal{$exportperlmalloc{$symbol}} || ++$sym_ord
1164	  if $exportperlmalloc and exists $exportperlmalloc{$symbol};
1165    } else {
1166	print "$symbol\n";
1167    }
1168}
1169
1170# Then platform specific footers.
1171
1172if ($ARGS{PLATFORM} eq 'os2') {
1173    print <<EOP;
1174    dll_perlmain=main
1175    fill_extLibpath
1176    dir_subst
1177    Perl_OS2_handler_install
1178
1179; LAST_ORDINAL=$sym_ord
1180EOP
1181}
1182
11831;
1184