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