X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=makedef.pl;h=c2344e13b61a4136fef7d7636577713376573494;hb=9137345a080bfc646c2f9440cdb7bd90b8b37428;hp=86a18087dc94a4572e651dac72126b908faca128;hpb=d97afc04e7e0c6020364b80d930005281e90a032;p=p5sagit%2Fp5-mst-13.2.git diff --git a/makedef.pl b/makedef.pl index 86a1808..c2344e1 100644 --- a/makedef.pl +++ b/makedef.pl @@ -6,13 +6,20 @@ # and by MacOS Classic. # # reads global.sym, pp.sym, perlvars.h, intrpvar.h, thrdvar.h, config.h -# On OS/2 reads miniperl.map as well +# On OS/2 reads miniperl.map and the previous version of perl5.def as well my $PLATFORM; my $CCTYPE; while (@ARGV) { my $flag = shift; + if ($flag =~ s/^CC_FLAGS=/ /) { + for my $fflag ($flag =~ /(?:^|\s)-D(\S+)/g) { + $fflag .= '=1' unless $fflag =~ /^(\w+)=/; + $define{$1} = $2 if $fflag =~ /^(\w+)=(.+)$/; + } + next; + } $define{$1} = 1 if ($flag =~ /^-D(\w+)$/); $define{$1} = $2 if ($flag =~ /^-D(\w+)=(.+)$/); $CCTYPE = $1 if ($flag =~ /^CCTYPE=(\w+)$/); @@ -48,6 +55,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. @@ -55,13 +63,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!^!::!; } } @@ -73,6 +81,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='(.+)'$/; @@ -81,6 +92,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 () { @@ -105,7 +123,6 @@ if ($define{USE_ITHREADS}) { $define{PERL_IMPLICIT_CONTEXT} ||= $define{USE_ITHREADS} || - $define{USE_5005THREADS} || $define{MULTIPLICITY} ; if ($define{USE_ITHREADS} && $PLATFORM ne 'win32' && $^O ne 'darwin') { @@ -289,7 +306,6 @@ if ($PLATFORM eq 'wince') { Perl_sv_collxfrm setgid setuid - win32_async_check win32_free_childdir win32_free_childenv win32_get_childdir @@ -372,6 +388,8 @@ elsif ($PLATFORM eq 'os2') { dlsym dlerror dlclose + dup2 + dup my_tmpfile my_tmpnam my_flock @@ -382,6 +400,8 @@ elsif ($PLATFORM eq 'os2') { my_getpwent my_setpwent my_endpwent + fork_with_resources + croak_with_os2error setgrent endgrent getgrent @@ -391,6 +411,10 @@ elsif ($PLATFORM eq 'os2') { nthreads_cond os2_cond_wait os2_stat + os2_execname + async_mssleep + msCounter + InfoTable pthread_join pthread_create pthread_detach @@ -418,7 +442,14 @@ elsif ($PLATFORM eq 'os2') { os2error ResetWinError CroakWinError + PL_do_undump )]); + emit_symbols([qw(os2_cond_wait + pthread_join + pthread_create + pthread_detach + )]) + if $define{'USE_5005THREADS'} or $define{'USE_ITHREADS'}; } elsif ($PLATFORM eq 'MacOS') { skip_symbols [qw( @@ -537,6 +568,13 @@ unless ($define{'DEBUGGING'}) { PL_block_type PL_watchaddr PL_watchok + PL_watch_pvx + )]; +} + +if ($define{'PERL_IMPLICIT_CONTEXT'}) { + skip_symbols [qw( + PL_sig_sv )]; } @@ -561,12 +599,11 @@ else { )]; } -unless ($define{'PERL_FLEXIBLE_EXCEPTIONS'}) { +unless ($define{'PERL_OLD_COPY_ON_WRITE'}) { skip_symbols [qw( - PL_protect - Perl_default_protect - Perl_vdefault_protect - )]; + Perl_sv_setsv_cow + Perl_sv_release_IVX + )]; } unless ($define{'USE_REENTRANT_API'}) { @@ -581,8 +618,10 @@ if ($define{'MYMALLOC'}) { Perl_get_mstats Perl_strdup Perl_putenv + MallocCfg_ptr + MallocCfgP_ptr )]; - if ($define{'USE_5005THREADS'} || $define{'USE_ITHREADS'}) { + if ($define{'USE_ITHREADS'}) { emit_symbols [qw( PL_malloc_mutex )]; @@ -599,16 +638,24 @@ else { Perl_dump_mstats Perl_get_mstats Perl_malloced_size + MallocCfg_ptr + MallocCfgP_ptr )]; } -unless ($define{'USE_5005THREADS'} || $define{'USE_ITHREADS'}) { +unless ($define{'PERL_MALLOC_WRAP'}) { + skip_symbols [qw( + PL_memory_wrap + )]; +} + +unless ($define{'USE_ITHREADS'}) { skip_symbols [qw( PL_thr_key )]; } -unless ($define{'USE_5005THREADS'}) { +# USE_5005THREADS symbols. Kept as reference for easier removal skip_symbols [qw( PL_sv_mutex PL_strtab_mutex @@ -635,16 +682,18 @@ unless ($define{'USE_5005THREADS'}) { Perl_magic_mutexfree Perl_sv_lock )]; -} unless ($define{'USE_ITHREADS'}) { skip_symbols [qw( PL_ptr_table + PL_pte_root + PL_pte_arenaroot PL_op_mutex PL_regex_pad PL_regex_padav PL_sharedsv_space PL_sharedsv_space_mutex + PL_dollarzero_mutex Perl_dirp_dup Perl_cx_dup Perl_si_dup @@ -656,6 +705,8 @@ 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 @@ -711,6 +762,8 @@ unless ($define{'PL_OP_SLAB_ALLOC'}) { PL_OpPtr PL_OpSlab PL_OpSpace + Perl_Slab_Alloc + Perl_Slab_Free )]; } @@ -718,6 +771,37 @@ 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{'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]" }; @@ -725,23 +809,21 @@ 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; } -if ($define{'USE_5005THREADS'}) { - my $thrd = readvar($thrdvar_h); - skip_symbols $thrd; -} - if ($define{'PERL_GLOBAL_STRUCT'}) { my $global = readvar($perlvars_h); 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 @@ -752,73 +834,75 @@ my @syms = ($global_sym, $globvar_sym); # $pp_sym is not part of the API # These are in _addition to_ the public face of the abstraction # and need to be exported to allow XS modules to implement layers my @layer_syms = qw( - PerlIOBase_clearerr - PerlIOBase_close - PerlIOBase_dup - PerlIOBase_eof - PerlIOBase_error - PerlIOBase_fileno - PerlIOBase_pushed - PerlIOBase_binmode - PerlIOBase_popped - PerlIOBase_read - PerlIOBase_setlinebuf - PerlIOBase_unread - PerlIOBuf_bufsiz - PerlIOBuf_fill - PerlIOBuf_flush - PerlIOBuf_get_base - PerlIOBuf_get_cnt - PerlIOBuf_get_ptr - PerlIOBuf_open - PerlIOBuf_pushed - PerlIOBuf_popped - PerlIOBuf_read - PerlIOBuf_seek - PerlIOBuf_set_ptrcnt - PerlIOBuf_tell - PerlIOBuf_unread - PerlIOBuf_write - PerlIO_debug - PerlIO_allocate - PerlIO_apply_layera - PerlIO_apply_layers - PerlIO_arg_fetch - PerlIO_define_layer - PerlIO_modestr - PerlIO_parse_layers - PerlIO_layer_fetch - PerlIO_list_free - PerlIO_apply_layera - PerlIO_pending - PerlIO_push - PerlIO_pop - PerlIO_sv_dup - PerlIO_perlio - -Perl_PerlIO_clearerr -Perl_PerlIO_close -Perl_PerlIO_eof -Perl_PerlIO_error -Perl_PerlIO_fileno -Perl_PerlIO_fill -Perl_PerlIO_flush -Perl_PerlIO_get_base -Perl_PerlIO_get_bufsiz -Perl_PerlIO_get_cnt -Perl_PerlIO_get_ptr -Perl_PerlIO_read -Perl_PerlIO_seek -Perl_PerlIO_set_cnt -Perl_PerlIO_set_ptrcnt -Perl_PerlIO_setlinebuf -Perl_PerlIO_stderr -Perl_PerlIO_stdin -Perl_PerlIO_stdout -Perl_PerlIO_tell -Perl_PerlIO_unread -Perl_PerlIO_write - + PerlIOBase_binmode + PerlIOBase_clearerr + PerlIOBase_close + PerlIOBase_dup + PerlIOBase_eof + PerlIOBase_error + PerlIOBase_fileno + PerlIOBase_noop_fail + PerlIOBase_noop_ok + PerlIOBase_popped + PerlIOBase_pushed + PerlIOBase_read + PerlIOBase_setlinebuf + PerlIOBase_unread + PerlIOBuf_bufsiz + PerlIOBuf_close + PerlIOBuf_dup + PerlIOBuf_fill + PerlIOBuf_flush + PerlIOBuf_get_base + PerlIOBuf_get_cnt + PerlIOBuf_get_ptr + PerlIOBuf_open + PerlIOBuf_popped + PerlIOBuf_pushed + PerlIOBuf_read + PerlIOBuf_seek + PerlIOBuf_set_ptrcnt + PerlIOBuf_tell + PerlIOBuf_unread + PerlIOBuf_write + PerlIO_allocate + PerlIO_apply_layera + PerlIO_apply_layers + PerlIO_arg_fetch + PerlIO_debug + PerlIO_define_layer + PerlIO_isutf8 + PerlIO_layer_fetch + PerlIO_list_free + PerlIO_modestr + PerlIO_parse_layers + PerlIO_pending + PerlIO_perlio + PerlIO_pop + PerlIO_push + PerlIO_sv_dup + Perl_PerlIO_clearerr + Perl_PerlIO_close + Perl_PerlIO_eof + Perl_PerlIO_error + Perl_PerlIO_fileno + Perl_PerlIO_fill + Perl_PerlIO_flush + Perl_PerlIO_get_base + Perl_PerlIO_get_bufsiz + Perl_PerlIO_get_cnt + Perl_PerlIO_get_ptr + Perl_PerlIO_read + Perl_PerlIO_seek + Perl_PerlIO_set_cnt + Perl_PerlIO_set_ptrcnt + Perl_PerlIO_setlinebuf + Perl_PerlIO_stderr + Perl_PerlIO_stdin + Perl_PerlIO_stdout + Perl_PerlIO_tell + Perl_PerlIO_unread + Perl_PerlIO_write ); if ($PLATFORM eq 'netware') { push(@layer_syms,'PL_def_layerlist','PL_known_layers','PL_perlio'); @@ -833,6 +917,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 @@ -910,12 +995,14 @@ if ($define{'USE_PERLIO'}) { else { # PerlIO with layers - export implementation emit_symbols \@layer_syms; + emit_symbols [qw(perlsio_binmode)]; } } 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(perlsio_binmode)]; skip_symbols [qw(PL_def_layerlist PL_known_layers PL_perlio)]; # Also do NOT add abstraction symbols from $perlio_sym @@ -946,7 +1033,7 @@ if ($define{'MULTIPLICITY'}) { emit_symbols $glob; } # XXX AIX seems to want the perlvars.h symbols, for some reason - if ($PLATFORM eq 'aix') { + if ($PLATFORM eq 'aix' or $PLATFORM eq 'os2') { # OS/2 needs PL_thr_key my $glob = readvar($perlvars_h); emit_symbols $glob; } @@ -960,7 +1047,7 @@ else { my $glob = readvar($intrpvar_h); emit_symbols $glob; } - unless ($define{'MULTIPLICITY'} || $define{'USE_5005THREADS'}) { + unless ($define{'MULTIPLICITY'}) { my $glob = readvar($thrdvar_h); emit_symbols $glob; } @@ -989,6 +1076,7 @@ if ($PLATFORM =~ /^win(?:32|ce)$/) { Perl_init_os_extras Perl_thread_create Perl_win32_init + Perl_win32_term RunPerl win32_async_check win32_errno @@ -1001,6 +1089,7 @@ if ($PLATFORM =~ /^win(?:32|ce)$/) { win32_pclose win32_rename win32_setmode + win32_chsize win32_lseek win32_tell win32_dup @@ -1307,6 +1396,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. @@ -1315,7 +1413,14 @@ foreach my $symbol (sort keys %export) { } if ($PLATFORM eq 'os2') { - print "; LAST_ORDINAL=$sym_ord\n"; + print <