This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
rename unop_aux_stringify to multideref_stringify
[perl5.git] / makedef.pl
index 83f0c91..b31d8a0 100644 (file)
 #    perl.imp    NetWare
 #    makedef.lis VMS
 
-BEGIN { unshift @INC, "lib" }
-use Config;
-use strict;
-
-my %ARGS = (CCTYPE => 'MSVC', TARG_DIR => '');
-
+my $fold;
+my %ARGS;
 my %define;
 
-my $fold;
+BEGIN {
+    BEGIN { unshift @INC, "lib" }
+    use Config;
+    use strict;
 
-sub process_cc_flags {
-    foreach (map {split /\s+/, $_} @_) {
-       $define{$1} = $2 // 1 if /^-D(\w+)(?:=(.+))?/;
-    }
-}
+    %ARGS = (CCTYPE => 'MSVC', TARG_DIR => '');
 
-while (@ARGV) {
-    my $flag = shift;
-    if ($flag =~ /^(?:CC_FLAGS=)?(-D\w.*)/) {
-       process_cc_flags($1);
-    } elsif ($flag =~ /^(CCTYPE|FILETYPE|PLATFORM|TARG_DIR)=(.+)$/) {
-       $ARGS{$1} = $2;
-    } elsif ($flag eq '--sort-fold') {
-       ++$fold;
+    sub process_cc_flags {
+       foreach (map {split /\s+/, $_} @_) {
+           $define{$1} = $2 // 1 if /^-D(\w+)(?:=(.+))?/;
+       }
     }
-}
 
-require "$ARGS{TARG_DIR}regen/embed_lib.pl";
-
-{
+    while (@ARGV) {
+       my $flag = shift;
+       if ($flag =~ /^(?:CC_FLAGS=)?(-D\w.*)/) {
+           process_cc_flags($1);
+       } elsif ($flag =~ /^(CCTYPE|FILETYPE|PLATFORM|TARG_DIR)=(.+)$/) {
+           $ARGS{$1} = $2;
+       } elsif ($flag eq '--sort-fold') {
+           ++$fold;
+       }
+    }
     my @PLATFORM = qw(aix win32 wince os2 netware vms test);
     my %PLATFORM;
     @PLATFORM{@PLATFORM} = ();
@@ -71,6 +68,9 @@ require "$ARGS{TARG_DIR}regen/embed_lib.pl";
     die "PLATFORM must be one of: @PLATFORM\n"
        unless exists $PLATFORM{$ARGS{PLATFORM}};
 }
+use constant PLATFORM => $ARGS{PLATFORM};
+
+require "$ARGS{TARG_DIR}regen/embed_lib.pl";
 
 # Is the following guard strictly necessary? Added during refactoring
 # to keep the same behaviour when merging other code into here.
@@ -253,6 +253,7 @@ unless ($define{'DEBUGGING'}) {
                    Perl_debstackptrs
                    Perl_pad_sv
                    Perl_pad_setsv
+                   Perl_set_padlist
                    Perl_hv_assert
                    PL_watchaddr
                    PL_watchok
@@ -420,6 +421,20 @@ unless ($define{'PERL_IMPLICIT_CONTEXT'}) {
                    Perl_my_cxt_index
                         );
 }
+if ($define{'NO_MATHOMS'}) {
+    # win32 builds happen in the win32/ subdirectory, but vms builds happen
+    # at the top level, so we need to look in two candidate locations for
+    # the mathoms.c file.
+    my ($file) = grep { -f } qw( mathoms.c ../mathoms.c )
+        or die "No mathoms.c file found in . or ..\n";
+    open my $mathoms, '<', $file
+        or die "Cannot open $file: $!\n";
+    while (<$mathoms>) {
+        ++$skip{$1} if /\A ( NATIVE_TO_NEED
+                           | ASCII_TO_NEED
+                           | Perl_\w+ ) \s* \( /axms;
+    }
+}
 
 unless ($define{'PERL_NEED_APPCTX'}) {
     ++$skip{PL_appctx};
@@ -619,6 +634,8 @@ my @layer_syms = qw(
                    Perl_PerlIO_get_cnt
                    Perl_PerlIO_get_ptr
                    Perl_PerlIO_read
+                   Perl_PerlIO_restore_errno
+                   Perl_PerlIO_save_errno
                    Perl_PerlIO_seek
                    Perl_PerlIO_set_cnt
                    Perl_PerlIO_set_ptrcnt
@@ -662,6 +679,11 @@ if ($define{'USE_PERLIO'}) {
        # Remaining remnants that _may_ be functions are handled below.
 }
 
+unless ($define{'USE_QUADMATH'}) {
+  ++$skip{Perl_quadmath_format_needed};
+  ++$skip{Perl_quadmath_format_single};
+}
+
 ###############################################################################
 
 # At this point all skip lists should be completed, as we are about to test
@@ -692,12 +714,9 @@ if ($define{'USE_PERLIO'}) {
 foreach (@syms) {
     my $syms = $ARGS{TARG_DIR} . $_;
     open my $global, '<', $syms or die "failed to open $syms: $!\n";
-    # Functions already have a Perl_ prefix
-    # Variables need a PL_ prefix
-    my $prefix = $syms =~ /var\.sym$/i ? 'PL_' : '';
     while (<$global>) {
        next unless /^([A-Za-z].*)/;
-       my $symbol = "$prefix$1";
+       my $symbol = "$1";
        ++$export{$symbol} unless exists $skip{$symbol};
     }
 }
@@ -1282,10 +1301,16 @@ elsif ($ARGS{PLATFORM} eq 'netware') {
 
 my @symbols = $fold ? sort {lc $a cmp lc $b} keys %export : sort keys %export;
 foreach my $symbol (@symbols) {
-    if ($ARGS{PLATFORM} =~ /^win(?:32|ce)$/) {
-       print "\t$symbol\n";
+    if (PLATFORM eq 'win32' || PLATFORM eq 'wince') {
+       # Remembering the origin file of each symbol is an alternative to PL_ matching
+       if (substr($symbol, 0, 3) eq 'PL_') {
+           print "\t$symbol DATA\n";
+       }
+       else {
+           print "\t$symbol\n";
+       }
     }
-    elsif ($ARGS{PLATFORM} eq 'os2') {
+    elsif (PLATFORM eq 'os2') {
        printf qq(    %-31s \@%s\n),
          qq("$symbol"), $ordinal{$symbol} || ++$sym_ord;
        printf qq(    %-31s \@%s\n),
@@ -1293,7 +1318,7 @@ foreach my $symbol (@symbols) {
          $ordinal{$exportperlmalloc{$symbol}} || ++$sym_ord
          if $exportperlmalloc and exists $exportperlmalloc{$symbol};
     }
-    elsif ($ARGS{PLATFORM} eq 'netware') {
+    elsif (PLATFORM eq 'netware') {
        print "\t$symbol,\n";
     } else {
        print "$symbol\n";