This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
PL_scopestack_name is only defined in DEBUGGING perl
[perl5.git] / makedef.pl
index 256eddd..cef774e 100644 (file)
@@ -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
+
+
+BEGIN { unshift @INC, "lib" }
+use Config;
+use strict;
 
-my $PLATFORM;
-my $CCTYPE;
+use vars qw($PLATFORM $CCTYPE $FILETYPE $CONFIG_ARGS $ARCHNAME $PATCHLEVEL);
+
+my (%define, %ordinal);
 
 while (@ARGV) {
     my $flag = shift;
@@ -36,6 +66,29 @@ 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
+
+       $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",
@@ -48,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";
@@ -62,14 +114,14 @@ 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) {
+    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,
-               $pp_sym, $globvar_sym, $perlio_sym) {
+    foreach ($intrpvar_h, $perlvars_h, $global_sym,
+            $pp_sym, $globvar_sym, $perlio_sym) {
        s!^!::!;
     }
 }
@@ -81,6 +133,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='(.+)'$/;
@@ -103,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);
 
@@ -130,11 +186,16 @@ 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;
+    (my $dll = ($define{PERL_DLL} || "perl511")) =~ 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");
@@ -156,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
@@ -172,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";
@@ -184,7 +245,7 @@ elsif ($PLATFORM eq 'aix') {
 }
 elsif ($PLATFORM eq 'netware') {
        if ($FILETYPE eq 'def') {
-       print "LIBRARY perl59\n";
+       print "LIBRARY perl511\n";
        print "DESCRIPTION 'Perl interpreter for NetWare'\n";
        print "EXPORTS\n";
        }
@@ -228,7 +289,6 @@ if ($PLATFORM eq 'win32') {
                     PL_linestart
                     PL_modcount
                     PL_pending_ident
-                    PL_sortcxix
                     PL_sublex_info
                     PL_timesbuf
                     main
@@ -266,6 +326,7 @@ if ($PLATFORM eq 'win32') {
                     Perl_getenv_len
                     Perl_my_pclose
                     Perl_my_popen
+                    Perl_my_sprintf
                     )];
 }
 else {
@@ -286,7 +347,6 @@ if ($PLATFORM eq 'wince') {
                     PL_linestart
                     PL_modcount
                     PL_pending_ident
-                    PL_sortcxix
                     PL_sublex_info
                     PL_timesbuf
                     PL_collation_ix
@@ -343,6 +403,7 @@ if ($PLATFORM eq 'wince') {
                     Perl_getenv_len
                     Perl_my_pclose
                     Perl_my_popen
+                    Perl_my_sprintf
                     )];
 }
 elsif ($PLATFORM eq 'aix') {
@@ -367,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(
@@ -487,7 +556,6 @@ elsif ($PLATFORM eq 'netware') {
                        PL_linestart
                        PL_modcount
                        PL_pending_ident
-                       PL_sortcxix
                        PL_sublex_info
                        PL_timesbuf
                        main
@@ -561,10 +629,19 @@ unless ($define{'DEBUGGING'}) {
                    Perl_debprofdump
                    Perl_debstack
                    Perl_debstackptrs
-                   Perl_sv_peek
+                   Perl_pad_sv
+                   Perl_hv_assert
                    PL_block_type
+                   PL_scopestack_name
                    PL_watchaddr
                    PL_watchok
+                   PL_watch_pvx
+                   )];
+}
+
+if ($define{'PERL_IMPLICIT_CONTEXT'}) {
+    skip_symbols [qw(
+                   PL_sig_sv
                    )];
 }
 
@@ -589,10 +666,9 @@ 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
                  )];
 }
 
@@ -628,15 +704,16 @@ else {
                    Perl_dump_mstats
                    Perl_get_mstats
                    Perl_malloced_size
+                   Perl_malloc_good_size
                    MallocCfg_ptr
                    MallocCfgP_ptr
                    )];
 }
 
-if ($define{'PERL_MALLOC_WRAP'}) {
-    emit_symbols [qw(
-                   PL_memory_wrap
-                   )];
+if ($define{'PERL_USE_SAFE_PUTENV'}) {
+    skip_symbols [qw(
+                   PL_use_safe_putenv
+                  )];
 }
 
 unless ($define{'USE_ITHREADS'}) {
@@ -675,13 +752,16 @@ 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_parser_dup
                    Perl_dirp_dup
                    Perl_cx_dup
                    Perl_si_dup
@@ -691,17 +771,12 @@ 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_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
@@ -711,11 +786,19 @@ unless ($define{'USE_ITHREADS'}) {
                    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_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
@@ -729,6 +812,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
                    )];
 }
 
@@ -753,10 +838,142 @@ 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)];
 }
 
+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_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
+                   )];
+}
+
+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]" };
@@ -764,8 +981,9 @@ sub readvar {
     my @syms;
     while (<VARS>) {
        # 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;
@@ -776,6 +994,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,8 +1043,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
@@ -835,6 +1057,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
@@ -869,6 +1092,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
@@ -946,13 +1170,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
@@ -977,7 +1220,7 @@ 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;
     }
@@ -996,10 +1239,6 @@ else {
        my $glob = readvar($intrpvar_h);
        emit_symbols $glob;
     }
-    unless ($define{'MULTIPLICITY'}) {
-       my $glob = readvar($thrdvar_h);
-       emit_symbols $glob;
-    }
 }
 
 sub try_symbol {
@@ -1129,6 +1368,7 @@ if ($PLATFORM =~ /^win(?:32|ce)$/) {
                            win32_rewinddir
                            win32_closedir
                            win32_longpath
+                           win32_ansipath
                            win32_os_id
                            win32_getpid
                            win32_crypt
@@ -1182,8 +1422,12 @@ if ($PLATFORM =~ /^win(?:32|ce)$/) {
     {
        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 <MAP>;
     close MAP or die 'Cannot close miniperl.map';
@@ -1354,6 +1598,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.
 
@@ -1423,17 +1669,6 @@ sub output_symbol {
 
 1;
 __DATA__
-# extra globals not included above.
-Perl_cxinc
-perl_alloc
-perl_alloc_using
-perl_clone
-perl_clone_using
-perl_construct
-perl_destruct
-perl_free
-perl_parse
-perl_run
 # Oddities from PerlIO
 PerlIO_binmode
 PerlIO_getpos
@@ -1443,4 +1678,3 @@ PerlIO_sprintf
 PerlIO_sv_dup
 PerlIO_tmpfile
 PerlIO_vsprintf
-perlsio_binmode