X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/61d42ce43847d6cea183d4f40e2921e53606f13f..ff36a2888e53279f5d5e02f24e556b77324953e4:/makedef.pl diff --git a/makedef.pl b/makedef.pl index 300f9e8..94a0e1a 100644 --- a/makedef.pl +++ b/makedef.pl @@ -1,105 +1,146 @@ +#./perl -w # # Create the export list for perl. # # Needed by WIN32 and OS/2 for creating perl.dll, # and by AIX for creating libperl.a when -Dusershrplib is in effect, -# 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 - -my $PLATFORM; -my $CCTYPE; - -my %bincompat5005 = - ( - Perl_call_atexit => "perl_atexit", - Perl_eval_sv => "perl_eval_sv", - Perl_eval_pv => "perl_eval_pv", - Perl_call_argv => "perl_call_argv", - Perl_call_method => "perl_call_method", - Perl_call_pv => "perl_call_pv", - Perl_call_sv => "perl_call_sv", - Perl_get_av => "perl_get_av", - Perl_get_cv => "perl_get_cv", - Perl_get_hv => "perl_get_hv", - Perl_get_sv => "perl_get_sv", - Perl_init_i18nl10n => "perl_init_i18nl10n", - Perl_init_i18nl14n => "perl_init_i18nl14n", - Perl_new_collate => "perl_new_collate", - Perl_new_ctype => "perl_new_ctype", - Perl_new_numeric => "perl_new_numeric", - Perl_require_pv => "perl_require_pv", - Perl_safesyscalloc => "Perl_safecalloc", - Perl_safesysfree => "Perl_safefree", - Perl_safesysmalloc => "Perl_safemalloc", - Perl_safesysrealloc => "Perl_saferealloc", - Perl_set_numeric_local => "perl_set_numeric_local", - Perl_set_numeric_standard => "perl_set_numeric_standard", - Perl_malloc => "malloc", - Perl_mfree => "free", - Perl_realloc => "realloc", - Perl_calloc => "calloc", - ); +# Reads from information stored in +# +# config.h +# config.sh +# global.sym +# globvar.sym +# intrpvar.h +# miniperl.map (on OS/2) +# perl5.def (on OS/2; this is the old version of the file being made) +# perlio.sym +# perlvars.h +# +# plus long lists of function names hard-coded directly in this script and +# in the DATA section. +# +# Writes the result to STDOUT. +# +# Normally this script is invoked from a makefile (e.g. win32/Makefile), +# which redirects STDOUT to a suitable file, such as: +# +# perl5.def OS/2 +# perldll.def Windows +# perl.exp AIX +# perl.imp NetWare + + +BEGIN { unshift @INC, "lib" } +use Config; +use strict; -my $bincompat5005 = join("|", keys %bincompat5005); +use vars qw($PLATFORM $CCTYPE $FILETYPE $CONFIG_ARGS $ARCHNAME $PATCHLEVEL); + +my (%define, %ordinal); 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+)$/); $PLATFORM = $1 if ($flag =~ /^PLATFORM=(\w+)$/); + if ($PLATFORM eq 'netware') { + $FILETYPE = $1 if ($flag =~ /^FILETYPE=(\w+)$/); + } } -my @PLATFORM = qw(aix win32 os2 MacOS); +my @PLATFORM = qw(aix win32 wince os2 netware); my %PLATFORM; @PLATFORM{@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 + + $ENV{PERL5LIB} = join $Config{path_sep}, @INC; + my $cmd = "$^X $opts -V"; + my $config = `$cmd` + or die "Couldn't run [$cmd]: $!"; + 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", + Perl_mfree => "free", + Perl_realloc => "realloc", + Perl_calloc => "calloc", + ); + +my $exportperlmalloc = $PLATFORM eq 'os2'; + my $config_sh = "config.sh"; my $config_h = "config.h"; -my $thrdvar_h = "thrdvar.h"; my $intrpvar_h = "intrpvar.h"; my $perlvars_h = "perlvars.h"; 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. } -elsif ($PLATFORM eq 'win32') { +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) { + foreach ($intrpvar_h, $perlvars_h, $global_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) { - s!^!::!; - } -} -unless ($PLATFORM eq 'win32' || $PLATFORM eq 'MacOS') { +unless ($PLATFORM eq 'win32' || $PLATFORM eq 'wince' || $PLATFORM eq 'netware') { open(CFG,$config_sh) || die "Cannot open $config_sh: $!\n"; while () { if (/^(?:ccflags|optimize)='(.+)'$/) { $_ = $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)='(.+)'$/; + $CONFIG_ARGS = $1 if /^config_args='(.+)'$/; + $ARCHNAME = $1 if /^archname='(.+)'$/; + $PATCHLEVEL = $1 if /^perl_patchlevel='(.+)'$/; } } 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 () { @@ -107,51 +148,70 @@ while () { $define{$1} = 1 if /^\s*#\s*define\s+(MULTIPLICITY)\b/; $define{$1} = 1 if /^\s*#\s*define\s+(PERL_\w+)\b/; $define{$1} = 1 if /^\s*#\s*define\s+(USE_\w+)\b/; + $define{$1} = 1 if /^\s*#\s*define\s+(HAS_\w+)\b/; } close(CFG); # perl.h logic duplication begins +if ($define{PERL_IMPLICIT_SYS}) { + $define{PL_OP_SLAB_ALLOC} = 1; +} + if ($define{USE_ITHREADS}) { - if (!$define{MULTIPLICITY} && !$define{PERL_OBJECT}) { + if (!$define{MULTIPLICITY}) { $define{MULTIPLICITY} = 1; } } $define{PERL_IMPLICIT_CONTEXT} ||= $define{USE_ITHREADS} || - $define{USE_5005THREADS} || $define{MULTIPLICITY} ; -if ($define{PERL_CAPI}) { - delete $define{PERL_OBJECT}; - $define{MULTIPLICITY} = 1; - $define{PERL_IMPLICIT_CONTEXT} = 1; - $define{PERL_IMPLICIT_SYS} = 1; -} - -if ($define{PERL_OBJECT}) { - $define{PERL_IMPLICIT_CONTEXT} = 1; - $define{PERL_IMPLICIT_SYS} = 1; +if ($define{USE_ITHREADS} && $PLATFORM ne 'win32' && $^O ne 'darwin') { + $define{USE_REENTRANT_API} = 1; } # perl.h logic duplication ends -if ($PLATFORM eq 'win32') { - warn join(' ',keys %define)."\n"; - print "LIBRARY Perl57\n"; - print "DESCRIPTION 'Perl interpreter'\n"; +my $sym_ord = 0; + +print STDERR "Defines: (" . join(' ', sort keys %define) . ")\n"; + +if ($PLATFORM =~ /^win(?:32|ce)$/) { + (my $dll = ($define{PERL_DLL} || "perl515")) =~ s/\.dll$//i; + print "LIBRARY $dll\n"; + # The DESCRIPTION module definition file statement is not supported + # by VC7 onwards. + if ($CCTYPE =~ /^(?:MSVC60|GCC|BORLAND)$/) { + print "DESCRIPTION 'Perl interpreter'\n"; + } print "EXPORTS\n"; if ($define{PERL_IMPLICIT_SYS}) { output_symbol("perl_get_host_info"); output_symbol("perl_alloc_override"); } + if ($define{USE_ITHREADS} and $define{PERL_IMPLICIT_SYS}) { + output_symbol("perl_clone_host"); + } } elsif ($PLATFORM eq 'os2') { - ($v = $]) =~ s/(\d\.\d\d\d)(\d\d)$/$1_$2/; + if (open my $fh, '<', 'perl5.def') { + while (<$fh>) { + last if /^\s*EXPORTS\b/; + } + while (<$fh>) { + $ordinal{$1} = $2 if /^\s*"(\w+)"\s*(?:=\s*"\w+"\s*)?\@(\d+)\s*$/; + # This allows skipping ordinals which were used in older versions + $sym_ord = $1 if /^\s*;\s*LAST_ORDINAL\s*=\s*(\d+)\s*$/; + } + $sym_ord < $_ and $sym_ord = $_ for values %ordinal; # Take the max + } + (my $v = $]) =~ s/(\d\.\d\d\d)(\d\d)$/$1_$2/; $v .= '-thread' if $ARCHNAME =~ /-thread/; - ($dll = $define{PERL_DLL}) =~ s/\.dll$//i; - $d = "DESCRIPTION '\@#perl5-porters\@perl.org:$v#\@ Perl interpreter, configured as $CONFIG_ARGS'"; + (my $dll = $define{PERL_DLL}) =~ s/\.dll$//i; + $v .= "\@$PATCHLEVEL" if $PATCHLEVEL; + my $d = "DESCRIPTION '\@#perl5-porters\@perl.org:$v#\@ Perl interpreter, configured as $CONFIG_ARGS'"; $d = substr($d, 0, 249) . "...'" if length $d > 253; print <<"---EOP---"; LIBRARY '$dll' INITINSTANCE TERMINSTANCE @@ -163,9 +223,9 @@ EXPORTS ---EOP--- } elsif ($PLATFORM eq 'aix') { - $OSVER = `uname -v`; + my $OSVER = `uname -v`; chop $OSVER; - $OSREL = `uname -r`; + my $OSREL = `uname -r`; chop $OSREL; if ($OSVER > 4 || ($OSVER == 4 && $OSREL >= 3)) { print "#! ..\n"; @@ -173,6 +233,18 @@ elsif ($PLATFORM eq 'aix') { print "#!\n"; } } +elsif ($PLATFORM eq 'netware') { + if ($FILETYPE eq 'def') { + print "LIBRARY perl515\n"; + print "DESCRIPTION 'Perl interpreter for NetWare'\n"; + print "EXPORTS\n"; + } + if ($define{PERL_IMPLICIT_SYS}) { + output_symbol("perl_get_host_info"); + output_symbol("perl_alloc_override"); + output_symbol("perl_clone_host"); + } +} my %skip; my %export; @@ -189,7 +261,7 @@ sub emit_symbols { foreach my $symbol (@$list) { my $skipsym = $symbol; # XXX hack - if ($define{PERL_OBJECT} || $define{MULTIPLICITY}) { + if ($define{MULTIPLICITY}) { $skipsym =~ s/^Perl_[GIT](\w+)_ptr$/PL_$1/; } emit_symbol($symbol) unless exists $skip{$skipsym}; @@ -207,7 +279,6 @@ if ($PLATFORM eq 'win32') { PL_linestart PL_modcount PL_pending_ident - PL_sortcxix PL_sublex_info PL_timesbuf main @@ -223,6 +294,83 @@ if ($PLATFORM eq 'win32') { Perl_dump_fds Perl_init_thread_intern Perl_my_bzero + Perl_my_bcopy + Perl_my_htonl + Perl_my_ntohl + Perl_my_swap + Perl_my_chsize + Perl_same_dirent + Perl_setenv_getix + Perl_unlnk + Perl_watch + Perl_safexcalloc + Perl_safexmalloc + Perl_safexfree + Perl_safexrealloc + Perl_my_memcmp + Perl_my_memset + PL_cshlen + PL_cshname + PL_opsave + Perl_do_exec + Perl_getenv_len + Perl_my_pclose + Perl_my_popen + Perl_my_sprintf + )]; +} +else { + skip_symbols [qw( + Perl_do_spawn + Perl_do_spawn_nowait + Perl_do_aspawn + )]; +} +if ($PLATFORM eq 'wince') { + skip_symbols [qw( + PL_statusvalue_vms + PL_archpat_auto + PL_cryptseen + PL_DBcv + PL_generation + PL_lastgotoprobe + PL_linestart + PL_modcount + PL_pending_ident + PL_sublex_info + PL_timesbuf + PL_collation_ix + PL_collation_name + PL_collation_standard + PL_collxfrm_base + PL_collxfrm_mult + PL_numeric_compat1 + PL_numeric_local + PL_numeric_name + PL_numeric_radix_sv + PL_numeric_standard + Perl_sv_collxfrm + setgid + setuid + win32_free_childdir + win32_free_childenv + win32_get_childdir + win32_get_childenv + win32_spawnvp + main + Perl_ErrorNo + Perl_GetVars + Perl_do_exec3 + Perl_do_ipcctl + Perl_do_ipcget + Perl_do_msgrcv + Perl_do_msgsnd + Perl_do_semop + Perl_do_shmio + Perl_dump_fds + Perl_init_thread_intern + Perl_my_bzero + Perl_my_bcopy Perl_my_htonl Perl_my_ntohl Perl_my_swap @@ -244,6 +392,7 @@ if ($PLATFORM eq 'win32') { Perl_getenv_len Perl_my_pclose Perl_my_popen + Perl_my_sprintf )]; } elsif ($PLATFORM eq 'aix') { @@ -268,33 +417,59 @@ 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 PL_sys_intern )]); + skip_symbols([qw( + Perl_signbit + )]) + if $define{'HAS_SIGNBIT'}; + emit_symbols([qw( + boot_DynaLoader + )]); } elsif ($PLATFORM eq 'os2') { emit_symbols([qw( ctermid get_sysinfo Perl_OS2_init + Perl_OS2_init3 + Perl_OS2_term OS2_Perl_data dlopen dlsym dlerror dlclose + dup2 + dup my_tmpfile my_tmpnam my_flock my_rmdir my_mkdir + my_getpwuid + my_getpwnam + my_getpwent + my_setpwent + my_endpwent + fork_with_resources + croak_with_os2error + setgrent + endgrent + getgrent malloc_mutex threads_mutex nthreads nthreads_cond os2_cond_wait os2_stat + os2_execname + async_mssleep + msCounter + InfoTable pthread_join pthread_create pthread_detach @@ -317,38 +492,97 @@ elsif ($PLATFORM eq 'os2') { init_PMWIN_entries PMWIN_entries Perl_hab_GET + loadByOrdinal + pExtFCN + 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( - Perl_GetVars - PL_cryptseen - PL_cshlen - PL_cshname - PL_statusvalue_vms - PL_sys_intern - PL_opsave - PL_timesbuf - Perl_dump_fds - Perl_my_bcopy - Perl_my_bzero - Perl_my_chsize - Perl_my_htonl - Perl_my_memcmp - Perl_my_memset - Perl_my_ntohl - Perl_my_swap - Perl_safexcalloc - Perl_safexfree - Perl_safexmalloc - Perl_safexrealloc - Perl_unlnk - Perl_sys_intern_clear - Perl_sys_intern_init - )]; +elsif ($PLATFORM eq 'netware') { + skip_symbols [qw( + PL_statusvalue_vms + PL_archpat_auto + PL_cryptseen + PL_DBcv + PL_generation + PL_lastgotoprobe + PL_linestart + PL_modcount + PL_pending_ident + PL_sublex_info + PL_timesbuf + main + Perl_ErrorNo + Perl_GetVars + Perl_do_exec3 + Perl_do_ipcctl + Perl_do_ipcget + Perl_do_msgrcv + Perl_do_msgsnd + Perl_do_semop + Perl_do_shmio + Perl_dump_fds + Perl_init_thread_intern + Perl_my_bzero + Perl_my_htonl + Perl_my_ntohl + Perl_my_swap + Perl_my_chsize + Perl_same_dirent + Perl_setenv_getix + Perl_unlnk + Perl_watch + Perl_safexcalloc + Perl_safexmalloc + Perl_safexfree + Perl_safexrealloc + Perl_my_memcmp + Perl_my_memset + PL_cshlen + PL_cshname + PL_opsave + Perl_do_exec + Perl_getenv_len + Perl_my_pclose + Perl_my_popen + Perl_sys_intern_init + Perl_sys_intern_dup + Perl_sys_intern_clear + Perl_my_bcopy + Perl_PerlIO_write + Perl_PerlIO_unread + Perl_PerlIO_tell + Perl_PerlIO_stdout + Perl_PerlIO_stdin + Perl_PerlIO_stderr + Perl_PerlIO_setlinebuf + Perl_PerlIO_set_ptrcnt + Perl_PerlIO_set_cnt + Perl_PerlIO_seek + Perl_PerlIO_read + Perl_PerlIO_get_ptr + Perl_PerlIO_get_cnt + Perl_PerlIO_get_bufsiz + Perl_PerlIO_get_base + Perl_PerlIO_flush + Perl_PerlIO_fill + Perl_PerlIO_fileno + Perl_PerlIO_error + Perl_PerlIO_eof + Perl_PerlIO_close + Perl_PerlIO_clearerr + PerlIO_perlio + )]; } - unless ($define{'DEBUGGING'}) { skip_symbols [qw( Perl_deb_growlevel @@ -356,11 +590,18 @@ unless ($define{'DEBUGGING'}) { Perl_debprofdump Perl_debstack Perl_debstackptrs - Perl_runops_debug - Perl_sv_peek + Perl_pad_sv + Perl_hv_assert PL_block_type PL_watchaddr PL_watchok + PL_watch_pvx + )]; +} + +if ($define{'PERL_IMPLICIT_CONTEXT'}) { + skip_symbols [qw( + PL_sig_sv )]; } @@ -385,11 +626,15 @@ else { )]; } -unless ($define{'PERL_FLEXIBLE_EXCEPTIONS'}) { +unless ($define{'PERL_OLD_COPY_ON_WRITE'}) { + skip_symbols [qw( + Perl_sv_setsv_cow + )]; +} + +unless ($define{'USE_REENTRANT_API'}) { skip_symbols [qw( - PL_protect - Perl_default_protect - Perl_vdefault_protect + PL_reentrant_buffer )]; } @@ -397,14 +642,12 @@ if ($define{'MYMALLOC'}) { emit_symbols [qw( Perl_dump_mstats Perl_get_mstats - Perl_malloc - Perl_mfree - Perl_realloc - Perl_calloc 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 )]; @@ -420,21 +663,26 @@ else { PL_malloc_mutex Perl_dump_mstats Perl_get_mstats - Perl_malloc - Perl_mfree - Perl_realloc - Perl_calloc Perl_malloced_size + Perl_malloc_good_size + MallocCfg_ptr + MallocCfgP_ptr )]; } -unless ($define{'USE_5005THREADS'} || $define{'USE_ITHREADS'}) { +if ($define{'PERL_USE_SAFE_PUTENV'}) { + skip_symbols [qw( + PL_use_safe_putenv + )]; +} + +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 @@ -461,12 +709,22 @@ unless ($define{'USE_5005THREADS'}) { Perl_magic_mutexfree Perl_sv_lock )]; -} 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_my_ctx_mutex + PL_perlio_mutex + PL_regdupe + Perl_clone_params_del + Perl_clone_params_new + Perl_parser_dup Perl_dirp_dup Perl_cx_dup Perl_si_dup @@ -476,24 +734,34 @@ unless ($define{'USE_ITHREADS'}) { Perl_gp_dup Perl_he_dup Perl_mg_dup - Perl_re_dup + Perl_mro_meta_dup + Perl_re_dup_guts Perl_sv_dup + Perl_sv_dup_inc + 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 + Perl_sharedsv_init + Perl_sharedsv_lock + Perl_sharedsv_new + Perl_sharedsv_thrcnt_dec + Perl_sharedsv_thrcnt_inc + Perl_sharedsv_unlock + Perl_stashpv_hvname_match + Perl_regdupe_internal + Perl_newPADOP )]; } unless ($define{'PERL_IMPLICIT_CONTEXT'}) { skip_symbols [qw( + 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 @@ -507,6 +775,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 )]; } @@ -521,6 +791,152 @@ unless ($define{'FAKE_THREADS'}) { skip_symbols [qw(PL_curthr)]; } +unless ($define{'PL_OP_SLAB_ALLOC'}) { + skip_symbols [qw( + PL_OpPtr + PL_OpSlab + PL_OpSpace + Perl_Slab_Alloc + Perl_Slab_Free + )]; +} + +unless ($define{'PERL_DEBUG_READONLY_OPS'}) { + skip_symbols [qw( + PL_slab_count + PL_slabs + )]; +} + +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'}) { + skip_symbols [qw( + PL_sv_serial + )]; +} + +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{'MULTIPLICITY'}) { + skip_symbols [qw( + PL_interp_size + PL_interp_size_5_16_0 + )]; +} + +unless ($define{'PERL_GLOBAL_STRUCT'}) { + skip_symbols [qw( + PL_global_struct_size + )]; +} + +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]" }; @@ -528,65 +944,122 @@ 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 -my @syms = ($global_sym, $globvar_sym); # $pp_sym is not part of the API +my @syms = ($global_sym, $globvar_sym); +# Symbols that are the public face of the PerlIO layers implementation +# 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_eof - PerlIOBase_error - PerlIOBase_fileno - PerlIOBase_setlinebuf - PerlIOBase_pushed - PerlIOBase_read - PerlIOBase_unread - PerlIOBuf_bufsiz - PerlIOBuf_fill - PerlIOBuf_flush - PerlIOBuf_get_cnt - PerlIOBuf_get_ptr - PerlIOBuf_open - PerlIOBuf_pushed - PerlIOBuf_read - PerlIOBuf_seek - PerlIOBuf_set_ptrcnt - PerlIOBuf_tell - PerlIOBuf_unread - PerlIOBuf_write - PerlIO_define_layer - PerlIO_arg_fetch - PerlIO_pending - PerlIO_allocate - PerlIO_push - PerlIO_unread + 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_find_layer + PerlIO_isutf8 + PerlIO_layer_fetch + PerlIO_list_alloc + 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_context_layers + 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'); +} if ($define{'USE_PERLIO'}) { + # Export the symols that make up the PerlIO abstraction, regardless + # of its implementation - read from a file push @syms, $perlio_sym; + + # This part is then dependent on how the abstraction is implemented 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 + # And emit them skip_symbols [qw( PerlIO_canset_cnt PerlIO_clearerr @@ -629,11 +1102,68 @@ if ($define{'USE_PERLIO'}) { PerlIO_ungetc PerlIO_vprintf PerlIO_write + 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 + PL_def_layerlist + PL_known_layers + PL_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 { - # Skip the PerlIO New Generation symbols. + # -Uuseperlio + # Skip the PerlIO layer symbols - although + # nothing should have exported them anyway. skip_symbols \@layer_syms; + 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 + # Remaining remnants that _may_ be functions + # are handled in } for my $syms (@syms) { @@ -652,13 +1182,13 @@ for my $syms (@syms) { # variables -if ($define{'PERL_OBJECT'} || $define{'MULTIPLICITY'}) { - for my $f ($perlvars_h, $intrpvar_h, $thrdvar_h) { +if ($define{'MULTIPLICITY'} && $define{PERL_GLOBAL_STRUCT}) { + for my $f ($perlvars_h) { my $glob = readvar($f, sub { "Perl_" . $_[1] . $_[2] . "_ptr" }); 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; } @@ -668,20 +1198,16 @@ else { my $glob = readvar($perlvars_h); emit_symbols $glob; } - unless ($define{'MULTIPLICITY'}) { + unless ($define{MULTIPLICITY}) { my $glob = readvar($intrpvar_h); emit_symbols $glob; } - unless ($define{'MULTIPLICITY'} || $define{'USE_5005THREADS'}) { - my $glob = readvar($thrdvar_h); - emit_symbols $glob; - } } sub try_symbol { my $symbol = shift; - return if $symbol !~ /^[A-Za-z]/; + return if $symbol !~ /^[A-Za-z_]/; return if $symbol =~ /^\#/; $symbol =~s/\r//g; chomp($symbol); @@ -693,7 +1219,7 @@ while () { try_symbol($_); } -if ($PLATFORM eq 'win32') { +if ($PLATFORM =~ /^win(?:32|ce)$/) { foreach my $symbol (qw( setuid setgid @@ -701,7 +1227,9 @@ if ($PLATFORM eq 'win32') { Perl_init_os_extras Perl_thread_create Perl_win32_init + Perl_win32_term RunPerl + win32_async_check win32_errno win32_environ win32_abort @@ -712,6 +1240,7 @@ if ($PLATFORM eq 'win32') { win32_pclose win32_rename win32_setmode + win32_chsize win32_lseek win32_tell win32_dup @@ -719,6 +1248,7 @@ if ($PLATFORM eq 'win32') { win32_open win32_close win32_eof + win32_isatty win32_read win32_write win32_spawnvp @@ -789,6 +1319,7 @@ if ($PLATFORM eq 'win32') { win32_link win32_unlink win32_utime + win32_gettimeofday win32_uname win32_wait win32_waitpid @@ -801,11 +1332,16 @@ if ($PLATFORM eq 'win32') { win32_rewinddir win32_closedir win32_longpath + win32_ansipath win32_os_id win32_getpid win32_crypt win32_dynaload - + win32_get_childenv + win32_free_childenv + win32_clearenv + win32_get_childdir + win32_free_childdir win32_stdin win32_stdout win32_stderr @@ -850,25 +1386,174 @@ if ($PLATFORM eq 'win32') { { try_symbol($symbol); } + if ($CCTYPE eq "BORLAND") { + try_symbol('_matherr'); + } } elsif ($PLATFORM eq 'os2') { + my (%mapped, @missing); open MAP, 'miniperl.map' or die 'Cannot read miniperl.map'; /^\s*[\da-f:]+\s+(\w+)/i and $mapped{$1}++ foreach ; close MAP or die 'Cannot close miniperl.map'; - @missing = grep { !exists $mapped{$_} and !exists $bincompat5005{$_} } + @missing = grep { !exists $mapped{$_} } keys %export; + @missing = grep { !exists $exportperlmalloc{$_} } @missing; delete $export{$_} foreach @missing; } -elsif ($PLATFORM eq 'MacOS') { - open MACSYMS, 'macperl.sym' or die 'Cannot read macperl.sym'; +elsif ($PLATFORM eq 'netware') { +foreach my $symbol (qw( + boot_DynaLoader + Perl_init_os_extras + Perl_thread_create + Perl_nw5_init + RunPerl + AllocStdPerl + FreeStdPerl + do_spawn2 + do_aspawn + nw_uname + nw_stdin + nw_stdout + nw_stderr + nw_feof + nw_ferror + nw_fopen + nw_fclose + nw_clearerr + nw_getc + nw_fgets + nw_fputc + nw_fputs + nw_fflush + nw_ungetc + nw_fileno + nw_fdopen + nw_freopen + nw_fread + nw_fwrite + nw_setbuf + nw_setvbuf + nw_vfprintf + nw_ftell + nw_fseek + nw_rewind + nw_tmpfile + nw_fgetpos + nw_fsetpos + nw_dup + nw_access + nw_chmod + nw_chsize + nw_close + nw_dup2 + nw_flock + nw_isatty + nw_link + nw_lseek + nw_stat + nw_mktemp + nw_open + nw_read + nw_rename + nw_setmode + nw_unlink + nw_utime + nw_write + nw_chdir + nw_rmdir + nw_closedir + nw_opendir + nw_readdir + nw_rewinddir + nw_seekdir + nw_telldir + nw_htonl + nw_htons + nw_ntohl + nw_ntohs + nw_accept + nw_bind + nw_connect + nw_endhostent + nw_endnetent + nw_endprotoent + nw_endservent + nw_gethostbyaddr + nw_gethostbyname + nw_gethostent + nw_gethostname + nw_getnetbyaddr + nw_getnetbyname + nw_getnetent + nw_getpeername + nw_getprotobyname + nw_getprotobynumber + nw_getprotoent + nw_getservbyname + nw_getservbyport + nw_getservent + nw_getsockname + nw_getsockopt + nw_inet_addr + nw_listen + nw_socket + nw_recv + nw_recvfrom + nw_select + nw_send + nw_sendto + nw_sethostent + nw_setnetent + nw_setprotoent + nw_setservent + nw_setsockopt + nw_inet_ntoa + nw_shutdown + nw_crypt + nw_execvp + nw_kill + nw_Popen + nw_Pclose + nw_Pipe + nw_times + nw_waitpid + nw_getpid + nw_spawnvp + nw_os_id + nw_open_osfhandle + nw_get_osfhandle + nw_abort + nw_sleep + nw_wait + nw_dynaload + nw_strerror + fnFpSetMode + fnInsertHashListAddrs + fnGetHashListAddrs + Perl_deb + Perl_sv_setsv + Perl_sv_catsv + Perl_sv_catpvn + Perl_sv_2pv + nw_freeenviron + Remove_Thread_Ctx + )) + { + try_symbol($symbol); + } +} - while () { - try_symbol($_); +# 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); } - close MACSYMS; -} +try_symbol("init_Win32CORE") if $static_ext =~ /\bWin32CORE\b/; # Now all symbols should be defined because # next we are going to output them. @@ -877,6 +1562,17 @@ foreach my $symbol (sort keys %export) { output_symbol($symbol); } +if ($PLATFORM eq 'os2') { + print <