X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/42bf233374727b85537d9f54530660285d5568d9..fd12ed88bcd2d456c2ca96ac23d9f838b34316d0:/makedef.pl diff --git a/makedef.pl b/makedef.pl index 6c6bafe..a839855 100644 --- a/makedef.pl +++ b/makedef.pl @@ -36,6 +36,25 @@ my %PLATFORM; defined $PLATFORM || die "PLATFORM undefined, must be one of: @PLATFORM\n"; exists $PLATFORM{$PLATFORM} || die "PLATFORM must be one of: @PLATFORM\n"; +if ($PLATFORM eq 'win32' or $PLATFORM eq 'wince' or $PLATFORM eq "aix") { + # Add the compile-time options that miniperl was built with to %define. + # On Win32 these are not the same options as perl itself will be built + # with since miniperl is built with a canned config (one of the win32/ + # config_H.*) and none of the BUILDOPT's that are set in the makefiles, + # but they do include some #define's that are hard-coded in various + # source files and header files and don't include any BUILDOPT's that + # the user might have chosen to disable because the canned configs are + # minimal configs that don't include any of those options. + my $opts = ($PLATFORM eq 'wince' ? '-MCross' : ''); # for wince need Cross.pm to get Config.pm + my $config = `$^X $opts -Ilib -V`; + my($options) = $config =~ /^ Compile-time options: (.*?)\n^ \S/ms; + $options =~ s/\s+/ /g; + print STDERR "Options: ($options)\n"; + foreach (split /\s+/, $options) { + $define{$_} = 1; + } +} + my %exportperlmalloc = ( Perl_malloc => "malloc", @@ -55,6 +74,7 @@ my $global_sym = "global.sym"; my $pp_sym = "pp.sym"; my $globvar_sym = "globvar.sym"; my $perlio_sym = "perlio.sym"; +my $static_ext = ""; if ($PLATFORM eq 'aix') { # Nothing for now. @@ -62,13 +82,13 @@ if ($PLATFORM eq 'aix') { elsif ($PLATFORM =~ /^win(?:32|ce)$/ || $PLATFORM eq 'netware') { $CCTYPE = "MSVC" unless defined $CCTYPE; foreach ($thrdvar_h, $intrpvar_h, $perlvars_h, $global_sym, - $pp_sym, $globvar_sym, $perlio_sym) { + $pp_sym, $globvar_sym, $perlio_sym) { s!^!..\\!; } } elsif ($PLATFORM eq 'MacOS') { foreach ($thrdvar_h, $intrpvar_h, $perlvars_h, $global_sym, - $pp_sym, $globvar_sym, $perlio_sym) { + $pp_sym, $globvar_sym, $perlio_sym) { s!^!::!; } } @@ -80,6 +100,9 @@ unless ($PLATFORM eq 'win32' || $PLATFORM eq 'wince' || $PLATFORM eq 'MacOS' || $_ = $1; $define{$1} = 1 while /-D(\w+)/g; } + if (/^(d_(?:mmap|sigaction))='(.+)'$/) { + $define{$1} = $2; + } if ($PLATFORM eq 'os2') { $CONFIG_ARGS = $1 if /^config_args='(.+)'$/; $ARCHNAME = $1 if /^archname='(.+)'$/; @@ -88,6 +111,13 @@ unless ($PLATFORM eq 'win32' || $PLATFORM eq 'wince' || $PLATFORM eq 'MacOS' || } close(CFG); } +if ($PLATFORM eq 'win32' || $PLATFORM eq 'wince') { + open(CFG,"<..\\$config_sh") || die "Cannot open ..\\$config_sh: $!\n"; + if ((join '', ) =~ /^static_ext='(.*)'$/m) { + $static_ext = $1; + } + close(CFG); +} open(CFG,$config_h) || die "Cannot open $config_h: $!\n"; while () { @@ -122,8 +152,9 @@ if ($define{USE_ITHREADS} && $PLATFORM ne 'win32' && $^O ne 'darwin') { my $sym_ord = 0; +print STDERR "Defines: (" . join(' ', sort keys %define) . ")\n"; + if ($PLATFORM =~ /^win(?:32|ce)$/) { - warn join(' ',keys %define)."\n"; ($dll = ($define{PERL_DLL} || "perl59")) =~ s/\.dll$//i; print "LIBRARY $dll\n"; print "DESCRIPTION 'Perl interpreter'\n"; @@ -220,7 +251,6 @@ if ($PLATFORM eq 'win32') { PL_linestart PL_modcount PL_pending_ident - PL_sortcxix PL_sublex_info PL_timesbuf main @@ -258,6 +288,7 @@ if ($PLATFORM eq 'win32') { Perl_getenv_len Perl_my_pclose Perl_my_popen + Perl_my_sprintf )]; } else { @@ -278,7 +309,6 @@ if ($PLATFORM eq 'wince') { PL_linestart PL_modcount PL_pending_ident - PL_sortcxix PL_sublex_info PL_timesbuf PL_collation_ix @@ -335,6 +365,7 @@ if ($PLATFORM eq 'wince') { Perl_getenv_len Perl_my_pclose Perl_my_popen + Perl_my_sprintf )]; } elsif ($PLATFORM eq 'aix') { @@ -359,6 +390,7 @@ elsif ($PLATFORM eq 'aix') { Perl_sys_intern_clear Perl_sys_intern_dup Perl_sys_intern_init + Perl_my_sprintf PL_cryptseen PL_opsave PL_statusvalue_vms @@ -377,6 +409,8 @@ elsif ($PLATFORM eq 'os2') { dlsym dlerror dlclose + dup2 + dup my_tmpfile my_tmpnam my_flock @@ -398,6 +432,10 @@ elsif ($PLATFORM eq 'os2') { nthreads_cond os2_cond_wait os2_stat + os2_execname + async_mssleep + msCounter + InfoTable pthread_join pthread_create pthread_detach @@ -473,7 +511,6 @@ elsif ($PLATFORM eq 'netware') { PL_linestart PL_modcount PL_pending_ident - PL_sortcxix PL_sublex_info PL_timesbuf main @@ -547,10 +584,19 @@ unless ($define{'DEBUGGING'}) { Perl_debprofdump Perl_debstack Perl_debstackptrs + Perl_pad_sv Perl_sv_peek + Perl_hv_assert PL_block_type PL_watchaddr PL_watchok + PL_watch_pvx + )]; +} + +if ($define{'PERL_IMPLICIT_CONTEXT'}) { + skip_symbols [qw( + PL_sig_sv )]; } @@ -575,21 +621,13 @@ else { )]; } -unless ($define{'PERL_COPY_ON_WRITE'}) { +unless ($define{'PERL_OLD_COPY_ON_WRITE'}) { skip_symbols [qw( Perl_sv_setsv_cow Perl_sv_release_IVX )]; } -unless ($define{'PERL_FLEXIBLE_EXCEPTIONS'}) { - skip_symbols [qw( - PL_protect - Perl_default_protect - Perl_vdefault_protect - )]; -} - unless ($define{'USE_REENTRANT_API'}) { skip_symbols [qw( PL_reentrant_buffer @@ -627,6 +665,12 @@ else { )]; } +if ($define{'PERL_USE_SAFE_PUTENV'}) { + skip_symbols [qw( + PL_use_safe_putenv + )]; +} + unless ($define{'USE_ITHREADS'}) { skip_symbols [qw( PL_thr_key @@ -663,13 +707,15 @@ unless ($define{'USE_ITHREADS'}) { unless ($define{'USE_ITHREADS'}) { skip_symbols [qw( - PL_ptr_table PL_op_mutex PL_regex_pad PL_regex_padav PL_sharedsv_space PL_sharedsv_space_mutex PL_dollarzero_mutex + PL_hints_mutex + PL_perlio_mutex + PL_regdupe Perl_dirp_dup Perl_cx_dup Perl_si_dup @@ -681,15 +727,9 @@ unless ($define{'USE_ITHREADS'}) { Perl_mg_dup Perl_re_dup Perl_sv_dup + Perl_rvpv_dup + Perl_hek_dup Perl_sys_intern_dup - Perl_ptr_table_clear - Perl_ptr_table_fetch - Perl_ptr_table_free - Perl_ptr_table_new - Perl_ptr_table_clear - Perl_ptr_table_free - Perl_ptr_table_split - Perl_ptr_table_store perl_clone perl_clone_using Perl_sharedsv_find @@ -699,11 +739,18 @@ unless ($define{'USE_ITHREADS'}) { Perl_sharedsv_thrcnt_dec Perl_sharedsv_thrcnt_inc Perl_sharedsv_unlock + Perl_stashpv_hvname_match + Perl_regdupe_internal )]; } unless ($define{'PERL_IMPLICIT_CONTEXT'}) { skip_symbols [qw( + PL_my_ctx_mutex + PL_my_cxt_index + PL_my_cxt_list + PL_my_cxt_size + PL_my_cxt_keys Perl_croak_nocontext Perl_die_nocontext Perl_deb_nocontext @@ -717,6 +764,8 @@ unless ($define{'PERL_IMPLICIT_CONTEXT'}) { Perl_sv_setpvf_nocontext Perl_sv_catpvf_mg_nocontext Perl_sv_setpvf_mg_nocontext + Perl_my_cxt_init + Perl_my_cxt_index )]; } @@ -745,6 +794,112 @@ unless ($define{'THREADS_HAVE_PIDS'}) { skip_symbols [qw(PL_ppid)]; } +unless ($define{'PERL_NEED_APPCTX'}) { + skip_symbols [qw( + PL_appctx + )]; +} + +unless ($define{'PERL_NEED_TIMESBASE'}) { + skip_symbols [qw( + PL_timesbase + )]; +} + +unless ($define{'DEBUG_LEAKING_SCALARS_FORK_DUMP'}) { + skip_symbols [qw( + PL_dumper_fd + )]; +} +unless ($define{'PERL_DONT_CREATE_GVSV'}) { + skip_symbols [qw( + Perl_gv_SVadd + )]; +} +if ($define{'SPRINTF_RETURNS_STRLEN'}) { + skip_symbols [qw( + Perl_my_sprintf + )]; +} +unless ($define{'PERL_USES_PL_PIDSTATUS'}) { + skip_symbols [qw( + Perl_pidgone + PL_pidstatus + )]; +} + +unless ($define{'PERL_TRACK_MEMPOOL'}) { + skip_symbols [qw( + PL_memory_debug_header + )]; +} + +if ($define{'PERL_MAD'}) { + skip_symbols [qw( + PL_nextval + PL_nexttype + )]; +} else { + skip_symbols [qw( + PL_madskills + PL_xmlfp + PL_lasttoke + PL_realtokenstart + PL_faketokens + PL_thismad + PL_thistoken + PL_thisopen + PL_thisstuff + PL_thisclose + PL_thiswhite + PL_nextwhite + PL_skipwhite + PL_endwhite + PL_curforce + Perl_pad_peg + Perl_xmldump_indent + Perl_xmldump_vindent + Perl_xmldump_all + Perl_xmldump_packsubs + Perl_xmldump_sub + Perl_xmldump_form + Perl_xmldump_eval + Perl_sv_catxmlsv + Perl_sv_catxmlpvn + Perl_sv_xmlpeek + Perl_do_pmop_xmldump + Perl_pmop_xmldump + Perl_do_op_xmldump + Perl_op_xmldump + )]; +} + +unless ($define{'PERL_GLOBAL_STRUCT_PRIVATE'}) { + skip_symbols [qw( + PL_my_cxt_keys + Perl_my_cxt_index + )]; +} + +unless ($define{'d_mmap'}) { + skip_symbols [qw( + PL_mmap_page_size + )]; +} + +if ($define{'d_sigaction'}) { + skip_symbols [qw( + PL_sig_trapped + )]; +} + +if ($^O ne 'vms') { + # VMS does its own thing for these symbols. + skip_symbols [qw(PL_sig_handlers_initted + PL_sig_ignoring + PL_sig_defaulting)]; +} + sub readvar { my $file = shift; my $proc = shift || sub { "PL_$_[2]" }; @@ -752,8 +907,9 @@ sub readvar { my @syms; while () { # All symbols have a Perl_ prefix because that's what embed.h - # sticks in front of them. - push(@syms, &$proc($1,$2,$3)) if (/\bPERLVAR(A?I?C?)\(([IGT])(\w+)/); + # sticks in front of them. The A?I?S?C? is strictly speaking + # wrong. + push(@syms, &$proc($1,$2,$3)) if (/\bPERLVAR(A?I?S?C?)\(([IGT])(\w+)/); } close(VARS); return \@syms; @@ -764,6 +920,8 @@ if ($define{'PERL_GLOBAL_STRUCT'}) { skip_symbols $global; emit_symbol('Perl_GetVars'); emit_symbols [qw(PL_Vars PL_VarsPtr)] unless $CCTYPE eq 'GCC'; +} else { + skip_symbols [qw(Perl_init_global_struct Perl_free_global_struct)]; } # functions from *.sym files @@ -823,6 +981,7 @@ my @layer_syms = qw( PerlIO_sv_dup Perl_PerlIO_clearerr Perl_PerlIO_close + Perl_PerlIO_context_layers Perl_PerlIO_eof Perl_PerlIO_error Perl_PerlIO_fileno @@ -857,6 +1016,7 @@ if ($define{'USE_PERLIO'}) { if ($define{'USE_SFIO'}) { # Old legacy non-stdio "PerlIO" skip_symbols \@layer_syms; + skip_symbols [qw(perlsio_binmode)]; # SFIO defines most of the PerlIO routines as macros # So undo most of what $perlio_sym has just done - d'oh ! # Perhaps it would be better to list the ones which do exist @@ -934,13 +1094,32 @@ if ($define{'USE_PERLIO'}) { else { # PerlIO with layers - export implementation emit_symbols \@layer_syms; + emit_symbols [qw(perlsio_binmode)]; + } + if ($define{'USE_ITHREADS'}) { + emit_symbols [qw( + PL_perlio_mutex + )]; + } + else { + skip_symbols [qw( + PL_perlio_mutex + )]; } } else { # -Uuseperlio # Skip the PerlIO layer symbols - although - # nothing should have exported them any way + # nothing should have exported them anyway. skip_symbols \@layer_syms; - skip_symbols [qw(PL_def_layerlist PL_known_layers PL_perlio)]; + skip_symbols [qw( + perlsio_binmode + PL_def_layerlist + PL_known_layers + PL_perlio + PL_perlio_debug_fd + PL_perlio_fd_refcnt + PL_perlio_fd_refcnt_size + )]; # Also do NOT add abstraction symbols from $perlio_sym # abstraction is done as #define to stdio @@ -1026,6 +1205,7 @@ if ($PLATFORM =~ /^win(?:32|ce)$/) { win32_pclose win32_rename win32_setmode + win32_chsize win32_lseek win32_tell win32_dup @@ -1116,6 +1296,7 @@ if ($PLATFORM =~ /^win(?:32|ce)$/) { win32_rewinddir win32_closedir win32_longpath + win32_ansipath win32_os_id win32_getpid win32_crypt @@ -1169,6 +1350,9 @@ if ($PLATFORM =~ /^win(?:32|ce)$/) { { try_symbol($symbol); } + if ($CCTYPE eq "BORLAND") { + try_symbol('_matherr'); + } } elsif ($PLATFORM eq 'os2') { open MAP, 'miniperl.map' or die 'Cannot read miniperl.map'; @@ -1332,6 +1516,15 @@ foreach my $symbol (qw( } } +# records of type boot_module for statically linked modules (except Dynaloader) +$static_ext =~ s/\//__/g; +$static_ext =~ s/\bDynaLoader\b//; +my @stat_mods = map {"boot_$_"} grep {/\S/} split /\s+/, $static_ext; +foreach my $symbol (@stat_mods) + { + try_symbol($symbol); + } + # Now all symbols should be defined because # next we are going to output them. @@ -1340,7 +1533,14 @@ foreach my $symbol (sort keys %export) { } if ($PLATFORM eq 'os2') { - print "; LAST_ORDINAL=$sym_ord\n"; + print <