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