X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/f1791e53cb2920e7259f77ab71f78f70e73e7968..6f89893b2484795e1e84a5309f71d72cb34d2640:/makedef.pl

diff --git a/makedef.pl b/makedef.pl
index f401675..810a4c8 100644
--- a/makedef.pl
+++ b/makedef.pl
@@ -1,3 +1,4 @@
+#./perl -w
 #
 # Create the export list for perl.
 #
@@ -5,11 +6,40 @@
 # 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 and the previous version of perl5.def as well
+# Reads from information stored in
+#
+#    config.h
+#    config.sh
+#    global.sym
+#    globvar.sym
+#    intrpvar.h
+#    macperl.sym  (on MacOS)
+#    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
+
 
-my $PLATFORM;
-my $CCTYPE;
+BEGIN { unshift @INC, "lib" }
+use Config;
+use strict;
+
+use vars qw($PLATFORM $CCTYPE $FILETYPE $CONFIG_ARGS $ARCHNAME $PATCHLEVEL);
+
+my (%define, %ordinal);
 
 while (@ARGV) {
     my $flag = shift;
@@ -46,7 +76,11 @@ if ($PLATFORM eq 'win32' or $PLATFORM eq 'wince' or $PLATFORM eq "aix") {
 	# 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`;
+
+	$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";
@@ -67,7 +101,6 @@ 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";
@@ -81,13 +114,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,
+    foreach ($intrpvar_h, $perlvars_h, $global_sym,
 	     $pp_sym, $globvar_sym, $perlio_sym) {
 	s!^!..\\!;
     }
 }
 elsif ($PLATFORM eq 'MacOS') {
-    foreach ($thrdvar_h, $intrpvar_h, $perlvars_h, $global_sym,
+    foreach ($intrpvar_h, $perlvars_h, $global_sym,
 	     $pp_sym, $globvar_sym, $perlio_sym) {
 	s!^!::!;
     }
@@ -125,6 +158,7 @@ while (<CFG>) {
     $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);
 
@@ -155,9 +189,13 @@ my $sym_ord = 0;
 print STDERR "Defines: (" . join(' ', sort keys %define) . ")\n";
 
 if ($PLATFORM =~ /^win(?:32|ce)$/) {
-    ($dll = ($define{PERL_DLL} || "perl59")) =~ s/\.dll$//i;
+    (my $dll = ($define{PERL_DLL} || "perl513")) =~ s/\.dll$//i;
     print "LIBRARY $dll\n";
-    print "DESCRIPTION 'Perl interpreter'\n";
+    # The DESCRIPTION module definition file statement is not supported
+    # by VC7 onwards.
+    if ($CCTYPE !~ /^MSVC7/ && $CCTYPE !~ /^MSVC8/ && $CCTYPE !~ /^MSVC9/) {
+	print "DESCRIPTION 'Perl interpreter'\n";
+    }
     print "EXPORTS\n";
     if ($define{PERL_IMPLICIT_SYS}) {
 	output_symbol("perl_get_host_info");
@@ -179,11 +217,11 @@ elsif ($PLATFORM eq 'os2') {
       }
       $sym_ord < $_ and $sym_ord = $_ for values %ordinal; # Take the max
     }
-    ($v = $]) =~ s/(\d\.\d\d\d)(\d\d)$/$1_$2/;
+    (my $v = $]) =~ s/(\d\.\d\d\d)(\d\d)$/$1_$2/;
     $v .= '-thread' if $ARCHNAME =~ /-thread/;
-    ($dll = $define{PERL_DLL}) =~ s/\.dll$//i;
+    (my $dll = $define{PERL_DLL}) =~ s/\.dll$//i;
     $v .= "\@$PATCHLEVEL" if $PATCHLEVEL;
-    $d = "DESCRIPTION '\@#perl5-porters\@perl.org:$v#\@ Perl interpreter, configured as $CONFIG_ARGS'";
+    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
@@ -195,9 +233,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";
@@ -207,7 +245,7 @@ elsif ($PLATFORM eq 'aix') {
 }
 elsif ($PLATFORM eq 'netware') {
 	if ($FILETYPE eq 'def') {
-	print "LIBRARY perl59\n";
+	print "LIBRARY perl513\n";
 	print "DESCRIPTION 'Perl interpreter for NetWare'\n";
 	print "EXPORTS\n";
 	}
@@ -390,11 +428,19 @@ 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(
@@ -584,7 +630,6 @@ unless ($define{'DEBUGGING'}) {
 		    Perl_debstack
 		    Perl_debstackptrs
 		    Perl_pad_sv
-		    Perl_sv_peek
 		    Perl_hv_assert
 		    PL_block_type
 		    PL_watchaddr
@@ -623,7 +668,6 @@ else {
 unless ($define{'PERL_OLD_COPY_ON_WRITE'}) {
     skip_symbols [qw(
 		    Perl_sv_setsv_cow
-		    Perl_sv_release_IVX
 		  )];
 }
 
@@ -659,6 +703,7 @@ else {
 		    Perl_dump_mstats
 		    Perl_get_mstats
 		    Perl_malloced_size
+		    Perl_malloc_good_size
 		    MallocCfg_ptr
 		    MallocCfgP_ptr
 		    )];
@@ -706,9 +751,6 @@ unless ($define{'USE_ITHREADS'}) {
 
 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
@@ -716,8 +758,12 @@ unless ($define{'USE_ITHREADS'}) {
 		    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
@@ -727,19 +773,13 @@ 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
@@ -750,16 +790,17 @@ unless ($define{'USE_ITHREADS'}) {
 		    Perl_sharedsv_thrcnt_inc
 		    Perl_sharedsv_unlock
 		    Perl_stashpv_hvname_match
-		    Perl_regdupe
+		    Perl_regdupe_internal
+		    Perl_newPADOP
 		    )];
 }
 
 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
@@ -774,6 +815,7 @@ unless ($define{'PERL_IMPLICIT_CONTEXT'}) {
 		    Perl_sv_catpvf_mg_nocontext
 		    Perl_sv_setpvf_mg_nocontext
 		    Perl_my_cxt_init
+		    Perl_my_cxt_index
 		    )];
 }
 
@@ -798,6 +840,13 @@ unless ($define{'PL_OP_SLAB_ALLOC'}) {
                     )];
 }
 
+unless ($define{'PERL_DEBUG_READONLY_OPS'}) {
+    skip_symbols [qw(
+		    PL_slab_count
+		    PL_slabs
+                  )];
+}
+
 unless ($define{'THREADS_HAVE_PIDS'}) {
     skip_symbols [qw(PL_ppid)];
 }
@@ -814,6 +863,12 @@ unless ($define{'PERL_NEED_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
@@ -882,6 +937,26 @@ if ($define{'PERL_MAD'}) {
 		    )];
 }
 
+unless ($define{'MULTIPLICITY'}) {
+    skip_symbols [qw(
+		    PL_interp_size
+		    PL_interp_size_5_10_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
@@ -970,8 +1045,10 @@ my @layer_syms = qw(
 		    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
@@ -1112,8 +1189,15 @@ if ($define{'USE_PERLIO'}) {
 	# Skip the PerlIO layer symbols - although
 	# 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)];
+	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
@@ -1138,10 +1222,14 @@ for my $syms (@syms) {
 # variables
 
 if ($define{'MULTIPLICITY'}) {
-    for my $f ($perlvars_h, $intrpvar_h, $thrdvar_h) {
+    for my $f ($perlvars_h, $intrpvar_h) {
 	my $glob = readvar($f, sub { "Perl_" . $_[1] . $_[2] . "_ptr" });
 	emit_symbols $glob;
     }
+    unless ($define{'USE_ITHREADS'}) {
+	# XXX needed for XS extensions that define PERL_CORE
+	emit_symbol("PL_curinterp");
+    }
     # XXX AIX seems to want the perlvars.h symbols, for some reason
     if ($PLATFORM eq 'aix' or $PLATFORM eq 'os2') {	# OS/2 needs PL_thr_key
 	my $glob = readvar($perlvars_h);
@@ -1153,14 +1241,8 @@ else {
 	my $glob = readvar($perlvars_h);
 	emit_symbols $glob;
     }
-    unless ($define{'MULTIPLICITY'}) {
-	my $glob = readvar($intrpvar_h);
-	emit_symbols $glob;
-    }
-    unless ($define{'MULTIPLICITY'}) {
-	my $glob = readvar($thrdvar_h);
-	emit_symbols $glob;
-    }
+    my $glob = readvar($intrpvar_h);
+    emit_symbols $glob;
 }
 
 sub try_symbol {
@@ -1207,6 +1289,7 @@ if ($PLATFORM =~ /^win(?:32|ce)$/) {
 			    win32_open
 			    win32_close
 			    win32_eof
+			    win32_isatty
 			    win32_read
 			    win32_write
 			    win32_spawnvp
@@ -1290,6 +1373,7 @@ if ($PLATFORM =~ /^win(?:32|ce)$/) {
 			    win32_rewinddir
 			    win32_closedir
 			    win32_longpath
+			    win32_ansipath
 			    win32_os_id
 			    win32_getpid
 			    win32_crypt
@@ -1348,6 +1432,7 @@ if ($PLATFORM =~ /^win(?:32|ce)$/) {
     }
 }
 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 <MAP>;
     close MAP or die 'Cannot close miniperl.map';
@@ -1518,6 +1603,8 @@ foreach my $symbol (@stat_mods)
 	try_symbol($symbol);
     }
 
+try_symbol("init_Win32CORE") if $static_ext =~ /\bWin32CORE\b/;
+
 # Now all symbols should be defined because
 # next we are going to output them.