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