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