uninitialized warnings in regcomp
[p5sagit/p5-mst-13.2.git] / embed.pl
index ac0822f..612e19c 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -274,7 +274,7 @@ sub readvars(\%$$@) {
        or die "embed.pl: Can't open $file: $!\n";
     while (<FILE>) {
        s/[ \t]*#.*//;          # Delete comments.
-       if (/PERLVARA?I?C?\($pre(\w+)/) {
+       if (/PERLVARA?I?S?C?\($pre(\w+)/) {
            my $sym = $1;
            $sym = $pre . $sym if $keep_pre;
            warn "duplicate symbol $sym while processing $file\n"
@@ -344,8 +344,19 @@ print EM do_not_edit ("embed.h"), <<'END';
 
 END
 
+# Try to elimiate lots of repeated
+# #ifdef PERL_CORE
+# foo
+# #endif
+# #ifdef PERL_CORE
+# bar
+# #endif
+# by tracking state and merging foo and bar into one block.
+my $ifdef_state = '';
+
 walk_table {
     my $ret = "";
+    my $new_ifdef_state = '';
     if (@_ == 1) {
        my $arg = shift;
        $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifn?def|else|endif)\b/;
@@ -362,15 +373,31 @@ walk_table {
        }
        if ($ret ne '' && $flags !~ /A/) {
            if ($flags =~ /E/) {
-               $ret = "#if defined(PERL_CORE) || defined(PERL_EXT)\n$ret#endif\n";
-           } else {
-               $ret = "#ifdef PERL_CORE\n$ret#endif\n";
+               $new_ifdef_state
+                   = "#if defined(PERL_CORE) || defined(PERL_EXT)\n";
+           }
+           else {
+               $new_ifdef_state = "#ifdef PERL_CORE\n";
+           }
+
+           if ($new_ifdef_state ne $ifdef_state) {
+               $ret = $new_ifdef_state . $ret;
            }
         }
     }
+    if ($ifdef_state && $new_ifdef_state ne $ifdef_state) {
+       # Close the old one ahead of opening the new one.
+       $ret = "#endif\n$ret";
+    }
+    # Remember the new state.
+    $ifdef_state = $new_ifdef_state;
     $ret;
 } \*EM, "";
 
+if ($ifdef_state) {
+    print EM "#endif\n";
+}
+
 for $sym (sort keys %ppsym) {
     $sym =~ s/^Perl_//;
     print EM hide($sym, "Perl_$sym");
@@ -384,8 +411,10 @@ END
 
 my @az = ('a'..'z');
 
+$ifdef_state = '';
 walk_table {
     my $ret = "";
+    my $new_ifdef_state = '';
     if (@_ == 1) {
        my $arg = shift;
        $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifn?def|else|endif)\b/;
@@ -420,17 +449,33 @@ walk_table {
                $ret .= $alist . ")\n";
            }
        }
-         unless ($flags =~ /A/) {
+       unless ($flags =~ /A/) {
            if ($flags =~ /E/) {
-               $ret = "#if defined(PERL_CORE) || defined(PERL_EXT)\n$ret#endif\n";
-           } else {
-               $ret = "#ifdef PERL_CORE\n$ret#endif\n";
+               $new_ifdef_state
+                   = "#if defined(PERL_CORE) || defined(PERL_EXT)\n";
+           }
+           else {
+               $new_ifdef_state = "#ifdef PERL_CORE\n";
+           }
+
+           if ($new_ifdef_state ne $ifdef_state) {
+               $ret = $new_ifdef_state . $ret;
            }
         }
     }
+    if ($ifdef_state && $new_ifdef_state ne $ifdef_state) {
+       # Close the old one ahead of opening the new one.
+       $ret = "#endif\n$ret";
+    }
+    # Remember the new state.
+    $ifdef_state = $new_ifdef_state;
     $ret;
 } \*EM, "";
 
+if ($ifdef_state) {
+    print EM "#endif\n";
+}
+
 for $sym (sort keys %ppsym) {
     $sym =~ s/^Perl_//;
     if ($sym =~ /^ck_/) {
@@ -609,7 +654,8 @@ print EM <<'END';
 END
 
 for $sym (sort keys %globvar) {
-    print EM multon($sym,'G','PL_Vars.');
+    print EM multon($sym,   'G','my_vars->');
+    print EM multon("G$sym",'', 'my_vars->');
 }
 
 print EM <<'END';
@@ -662,11 +708,14 @@ START_EXTERN_C
 #undef PERLVARA
 #undef PERLVARI
 #undef PERLVARIC
+#undef PERLVARISC
 #define PERLVAR(v,t)   EXTERN_C t* Perl_##v##_ptr(pTHX);
 #define PERLVARA(v,n,t)        typedef t PL_##v##_t[n];                        \
                        EXTERN_C PL_##v##_t* Perl_##v##_ptr(pTHX);
 #define PERLVARI(v,t,i)        PERLVAR(v,t)
 #define PERLVARIC(v,t,i) PERLVAR(v, const t)
+#define PERLVARISC(v,i)        typedef const char PL_##v##_t[sizeof(i)];       \
+                       EXTERN_C PL_##v##_t* Perl_##v##_ptr(pTHX);
 
 #include "thrdvar.h"
 #include "intrpvar.h"
@@ -676,6 +725,16 @@ START_EXTERN_C
 #undef PERLVARA
 #undef PERLVARI
 #undef PERLVARIC
+#undef PERLVARISC
+
+#ifndef PERL_GLOBAL_STRUCT
+EXTERN_C Perl_ppaddr_t** Perl_Gppaddr_ptr(pTHX);
+EXTERN_C Perl_check_t**  Perl_Gcheck_ptr(pTHX);
+EXTERN_C unsigned char** Perl_Gfold_locale_ptr(pTHX);
+#define Perl_ppaddr_ptr      Perl_Gppaddr_ptr
+#define Perl_check_ptr       Perl_Gcheck_ptr
+#define Perl_fold_locale_ptr Perl_Gfold_locale_ptr
+#endif
 
 END_EXTERN_C
 
@@ -691,9 +750,9 @@ END_EXTERN_C
 START_EXTERN_C
 
 #ifndef DOINIT
-EXT void *PL_force_link_funcs[];
+EXTCONST void * const PL_force_link_funcs[];
 #else
-EXT void *PL_force_link_funcs[] = {
+EXTCONST void * const PL_force_link_funcs[] = {
 #undef PERLVAR
 #undef PERLVARA
 #undef PERLVARI
@@ -702,6 +761,7 @@ EXT void *PL_force_link_funcs[] = {
 #define PERLVARA(v,n,t)        PERLVAR(v,t)
 #define PERLVARI(v,t,i)        PERLVAR(v,t)
 #define PERLVARIC(v,t,i) PERLVAR(v,t)
+#define PERLVARISC(v,i) PERLVAR(v,char)
 
 #include "thrdvar.h"
 #include "intrpvar.h"
@@ -711,6 +771,7 @@ EXT void *PL_force_link_funcs[] = {
 #undef PERLVARA
 #undef PERLVARI
 #undef PERLVARIC
+#undef PERLVARISC
 };
 #endif /* DOINIT */
 
@@ -759,14 +820,17 @@ START_EXTERN_C
 #undef PERLVARA
 #undef PERLVARI
 #undef PERLVARIC
+#undef PERLVARISC
 
 #define PERLVAR(v,t)   t* Perl_##v##_ptr(pTHX)                         \
-                       { return &(aTHX->v); }
+                       { dVAR; return &(aTHX->v); }
 #define PERLVARA(v,n,t)        PL_##v##_t* Perl_##v##_ptr(pTHX)                \
-                       { return &(aTHX->v); }
+                       { dVAR; return &(aTHX->v); }
 
 #define PERLVARI(v,t,i)        PERLVAR(v,t)
 #define PERLVARIC(v,t,i) PERLVAR(v, const t)
+#define PERLVARISC(v,i)        PL_##v##_t* Perl_##v##_ptr(pTHX)                \
+                       { dVAR; return &(aTHX->v); }
 
 #include "thrdvar.h"
 #include "intrpvar.h"
@@ -774,18 +838,42 @@ START_EXTERN_C
 #undef PERLVAR
 #undef PERLVARA
 #define PERLVAR(v,t)   t* Perl_##v##_ptr(pTHX)                         \
-                       { return &(PL_##v); }
+                       { dVAR; return &(PL_##v); }
 #define PERLVARA(v,n,t)        PL_##v##_t* Perl_##v##_ptr(pTHX)                \
-                       { return &(PL_##v); }
+                       { dVAR; return &(PL_##v); }
 #undef PERLVARIC
-#define PERLVARIC(v,t,i)       const t* Perl_##v##_ptr(pTHX)           \
+#undef PERLVARISC
+#define PERLVARIC(v,t,i)       \
+                       const t* Perl_##v##_ptr(pTHX)           \
                        { return (const t *)&(PL_##v); }
+#define PERLVARISC(v,i)        PL_##v##_t* Perl_##v##_ptr(pTHX)        \
+                       { dVAR; return &(PL_##v); }
 #include "perlvars.h"
 
 #undef PERLVAR
 #undef PERLVARA
 #undef PERLVARI
 #undef PERLVARIC
+#undef PERLVARISC
+
+#ifndef PERL_GLOBAL_STRUCT
+/* A few evil special cases.  Could probably macrofy this. */
+#undef PL_ppaddr
+#undef PL_check
+#undef PL_fold_locale
+Perl_ppaddr_t** Perl_Gppaddr_ptr(pTHX) {
+    static const Perl_ppaddr_t* ppaddr_ptr = PL_ppaddr;
+    return (Perl_ppaddr_t**)&ppaddr_ptr;
+}
+Perl_check_t**  Perl_Gcheck_ptr(pTHX) {
+    static const Perl_check_t* check_ptr  = PL_check;
+    return (Perl_check_t**)&check_ptr;
+}
+unsigned char** Perl_Gfold_locale_ptr(pTHX) {
+    static const unsigned char* fold_locale_ptr = PL_fold_locale;
+    return (unsigned char**)&fold_locale_ptr;
+}
+#endif
 
 END_EXTERN_C