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