Add taint rethink to the todo list.

[p5sagit/p5-mst-13.2.git] / makedef.pl

diff --git a/makedef.pl b/makedef.pl
index 178c229..4ee99f3 100644 (file)
--- a/makedef.pl
+++ b/makedef.pl
@@ -97,8 +97,9 @@ unless ($PLATFORM eq 'win32' || $PLATFORM eq 'MacOS' || $PLATFORM eq 'netware')
            $define{$1} = 1 while /-D(\w+)/g;
        }
        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);
@@ -115,6 +116,10 @@ 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{MULTIPLICITY} = 1;
@@ -126,23 +131,41 @@ $define{PERL_IMPLICIT_CONTEXT} ||=
     $define{USE_5005THREADS}  ||
     $define{MULTIPLICITY} ;
 
+if ($define{USE_ITHREADS} && $PLATFORM ne 'win32' && $^O ne 'darwin') {
+    $define{USE_REENTRANT_API} = 1;
+}
+
 # perl.h logic duplication ends
 
+my $sym_ord = 0;
+
 if ($PLATFORM eq 'win32') {
     warn join(' ',keys %define)."\n";
-    print "LIBRARY Perl57\n";
+    print "LIBRARY perl58\n";
     print "DESCRIPTION 'Perl interpreter'\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");
+       output_symbol("perl_clone_host");
     }
 }
 elsif ($PLATFORM eq 'os2') {
+    if (open my $fh, '<', 'perl5.def') {
+      while (<$fh>) {
+       last if /^\s*EXPORTS\b/;
+      }
+      while (<$fh>) {
+       $ordinal{$1} = $2 if /^\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
+    }
     ($v = $]) =~ s/(\d\.\d\d\d)(\d\d)$/$1_$2/;
     $v .= '-thread' if $ARCHNAME =~ /-thread/;
     ($dll = $define{PERL_DLL}) =~ s/\.dll$//i;
+    $v .= "\@$PATCHLEVEL" if $PATCHLEVEL;
     $d = "DESCRIPTION '\@#perl5-porters\@perl.org:$v#\@ Perl interpreter, configured as $CONFIG_ARGS'";
     $d = substr($d, 0, 249) . "...'" if length $d > 253;
     print <<"---EOP---";
@@ -167,14 +190,14 @@ elsif ($PLATFORM eq 'aix') {
 }
 elsif ($PLATFORM eq 'netware') {
        if ($FILETYPE eq 'def') {
-       print "LIBRARY Perl57\n";
+       print "LIBRARY perl58\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");
+           output_symbol("perl_get_host_info");
+           output_symbol("perl_alloc_override");
+           output_symbol("perl_clone_host");
        }
 }
 
@@ -334,6 +357,9 @@ elsif ($PLATFORM eq 'os2') {
                    Perl_hab_GET
                    loadByOrdinal
                    pExtFCN
+                   os2error
+                   ResetWinError
+                   CroakWinError
                    )]);
 }
 elsif ($PLATFORM eq 'MacOS') {
@@ -412,6 +438,33 @@ elsif ($PLATFORM eq 'netware') {
                        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
                        )];
 }
 
@@ -595,6 +648,14 @@ unless ($define{'FAKE_THREADS'}) {
     skip_symbols [qw(PL_curthr)];
 }
 
+unless ($define{'PL_OP_SLAB_ALLOC'}) {
+    skip_symbols [qw(
+                     PL_OpPtr
+                     PL_OpSlab
+                     PL_OpSpace
+                    )];
+}
+
 sub readvar {
     my $file = shift;
     my $proc = shift || sub { "PL_$_[2]" };
@@ -708,6 +769,29 @@ 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
                         )];
     }
 } else {
@@ -1084,6 +1168,10 @@ foreach my $symbol (qw(
                        fnInsertHashListAddrs
                        fnGetHashListAddrs
                        Perl_deb
+                       Perl_sv_setsv
+                       Perl_sv_catsv
+                       Perl_sv_catpvn
+                       Perl_sv_2pv
                           ))
     {
        try_symbol($symbol);
@@ -1097,11 +1185,8 @@ foreach my $symbol (sort keys %export) {
     output_symbol($symbol);
 }
 
-if ($PLATFORM eq 'netware') {
-       # This may not be the right way to do.  This is to make sure
-       # that the last symbol will not contain a comma else
-       # Watcom linker cribs
-       print "\tdummy\n";
+if ($PLATFORM eq 'os2') {
+       print "; LAST_ORDINAL=$sym_ord\n";
 }
 
 sub emit_symbol {
@@ -1110,8 +1195,6 @@ sub emit_symbol {
     $export{$symbol} = 1;
 }
 
-my $sym_ord = 0;
-
 sub output_symbol {
     my $symbol = shift;
     $symbol = $bincompat5005{$symbol}
@@ -1142,7 +1225,8 @@ sub output_symbol {
 #      }
     }
     elsif ($PLATFORM eq 'os2') {
-       printf qq(    %-31s \@%s\n), qq("$symbol"), ++$sym_ord;
+       printf qq(    %-31s \@%s\n),
+         qq("$symbol"), $ordinal{$symbol} || ++$sym_ord;
     }
     elsif ($PLATFORM eq 'aix' || $PLATFORM eq 'MacOS') {
        print "$symbol\n";
@@ -1196,7 +1280,9 @@ PerlIO_define_layer
 PerlIO_define_layer
 PerlIO_getpos
 PerlIO_init
+PerlIO_modestr
 PerlIO_pending
+PerlIO_perlio
 PerlIO_push
 PerlIO_setpos
 PerlIO_sprintf