buncha MacPerl patches for bleadperl

[p5sagit/p5-mst-13.2.git] / util.c

diff --git a/util.c b/util.c
index 27c6953..b6a8719 100644 (file)
--- a/util.c
+++ b/util.c
@@ -575,11 +575,18 @@ Perl_set_numeric_radix(pTHX)
     struct lconv* lc;
 
     lc = localeconv();
-    if (lc && lc->decimal_point)
-       /* We assume that decimal separator aka the radix
-        * character is always a single character.  If it
-        * ever is a string, this needs to be rethunk. */
-       PL_numeric_radix = *lc->decimal_point;
+    if (lc && lc->decimal_point) {
+       if (lc->decimal_point[0] == '.' && lc->decimal_point[1] == 0) {
+           SvREFCNT_dec(PL_numeric_radix);
+           PL_numeric_radix = 0;
+       }
+       else {
+           if (PL_numeric_radix)
+               sv_setpv(PL_numeric_radix, lc->decimal_point);
+           else
+               PL_numeric_radix = newSVpv(lc->decimal_point, 0);
+       }
+    }
     else
        PL_numeric_radix = 0;
 # endif /* HAS_LOCALECONV */
@@ -658,7 +665,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
      *   -1 = fallback to C locale failed
      */
 
-#ifdef USE_LOCALE
+#if defined(USE_LOCALE) && defined(USE_ENVIRON_ARRAY)
 
 #ifdef USE_LOCALE_CTYPE
     char *curctype   = NULL;
@@ -884,7 +891,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
 #endif /* USE_LOCALE_NUMERIC */
     }
 
-#endif /* USE_LOCALE */
+#endif /* USE_LOCALE && USE_ENVIRON_ARRAY */
 
 #ifdef USE_LOCALE_CTYPE
     if (curctype != NULL)
@@ -2548,8 +2555,10 @@ Perl_rsignal(pTHX_ int signo, Sighandler_t handler)
     sigemptyset(&act.sa_mask);
     act.sa_flags = 0;
 #ifdef SA_RESTART
+#if !defined(USE_PERLIO) || defined(PERL_OLD_SIGNALS)
     act.sa_flags |= SA_RESTART;        /* SVR4, 4.3+BSD */
 #endif
+#endif
 #ifdef SA_NOCLDWAIT
     if (signo == SIGCHLD && handler == (Sighandler_t)SIG_IGN)
        act.sa_flags |= SA_NOCLDWAIT;
@@ -2580,8 +2589,10 @@ Perl_rsignal_save(pTHX_ int signo, Sighandler_t handler, Sigsave_t *save)
     sigemptyset(&act.sa_mask);
     act.sa_flags = 0;
 #ifdef SA_RESTART
+#if !defined(USE_PERLIO) || defined(PERL_OLD_SIGNALS)
     act.sa_flags |= SA_RESTART;        /* SVR4, 4.3+BSD */
 #endif
+#endif
 #ifdef SA_NOCLDWAIT
     if (signo == SIGCHLD && handler == (Sighandler_t)SIG_IGN)
        act.sa_flags |= SA_NOCLDWAIT;
@@ -3645,9 +3656,9 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t)
     PL_tainted = t->Ttainted;
     PL_curpm = t->Tcurpm;         /* XXX No PMOP ref count */
     PL_nrs = newSVsv(t->Tnrs);
-    PL_rs = SvREFCNT_inc(PL_nrs);
+    PL_rs = t->Tnrs ? SvREFCNT_inc(PL_nrs) : Nullsv;
     PL_last_in_gv = Nullgv;
-    PL_ofs_sv = SvREFCNT_inc(PL_ofs_sv);
+    PL_ofs_sv = t->Tofs_sv ? SvREFCNT_inc(PL_ofs_sv) : Nullsv;
     PL_defoutgv = (GV*)SvREFCNT_inc(t->Tdefoutgv);
     PL_chopset = t->Tchopset;
     PL_bodytarget = newSVsv(t->Tbodytarget);
@@ -3986,3 +3997,40 @@ Perl_report_evil_fh(pTHX_ GV *gv, IO *io, I32 op)
                        func, pars);
     }
 }
+
+#ifdef EBCDIC
+int
+Perl_ebcdic_control(pTHX_ int ch)
+{
+       if (ch > 'a') {
+               char *ctlp;
+ 
+              if (islower(ch))
+                     ch = toupper(ch);
+ 
+              if ((ctlp = strchr(controllablechars, ch)) == 0) {
+                     Perl_die(aTHX_ "unrecognised control character '%c'\n", ch);
+              }
+ 
+               if (ctlp == controllablechars)
+                      return('\177'); /* DEL */
+               else
+                      return((unsigned char)(ctlp - controllablechars - 1));
+       } else { /* Want uncontrol */
+               if (ch == '\177' || ch == -1)
+                       return('?');
+               else if (ch == '\157')
+                       return('\177');
+               else if (ch == '\174')
+                       return('\000');
+               else if (ch == '^')    /* '\137' in 1047, '\260' in 819 */
+                       return('\036');
+               else if (ch == '\155')
+                       return('\037');
+               else if (0 < ch && ch < (sizeof(controllablechars) - 1))
+                       return(controllablechars[ch+1]);
+               else
+                       Perl_die(aTHX_ "invalid control request: '\\%03o'\n", ch & 0xFF);
+       }
+}
+#endif