buncha MacPerl patches for bleadperl

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

diff --git a/toke.c b/toke.c
index a85a725..fd93c80 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -175,7 +175,7 @@ int yyactlevel = -1;
 /* grandfather return to old style */
 #define OLDLOP(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LSTOP)
 
-void
+STATIC void
 S_tokereport(pTHX_ char *thing, char* s, I32 rv)
 { 
     SV *report;
@@ -472,7 +472,7 @@ S_incline(pTHX_ char *s)
        s += 4;
     else
        return;
-    if (*s == ' ' || *s == '\t')
+    if (SPACE_OR_TAB(*s))
        s++;
     else
        return;
@@ -2115,9 +2115,6 @@ S_find_in_my_stash(pTHX_ char *pkgname, I32 len)
 */
 
 #ifdef USE_PURE_BISON
-#ifdef __SC__
-#pragma segment Perl_yylex_r
-#endif
 int
 Perl_yylex_r(pTHX_ YYSTYPE *lvalp, int *lcharp)
 {
@@ -2572,7 +2569,32 @@ Perl_yylex(pTHX)
        }
        do {
            bof = PL_rsfp ? TRUE : FALSE;
-           if (bof) {
+           if ((s = filter_gets(PL_linestr, PL_rsfp, 0)) == Nullch) {
+             fake_eof:
+               if (PL_rsfp) {
+                   if (PL_preprocess && !PL_in_eval)
+                       (void)PerlProc_pclose(PL_rsfp);
+                   else if ((PerlIO *)PL_rsfp == PerlIO_stdin())
+                       PerlIO_clearerr(PL_rsfp);
+                   else
+                       (void)PerlIO_close(PL_rsfp);
+                   PL_rsfp = Nullfp;
+                   PL_doextract = FALSE;
+               }
+               if (!PL_in_eval && (PL_minus_n || PL_minus_p)) {
+                   sv_setpv(PL_linestr,PL_minus_p ? ";}continue{print" : "");
+                   sv_catpv(PL_linestr,";}");
+                   PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
+                   PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
+                   PL_minus_n = PL_minus_p = 0;
+                   goto retry;
+               }
+               PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
+               sv_setpv(PL_linestr,"");
+               TOKEN(';');     /* not infinite loop because rsfp is NULL now */
+           }
+           /* if it looks like the start of a BOM, check if it in fact is */
+           else if (bof && (!*s || *(U8*)s == 0xEF || *(U8*)s >= 0xFE)) {
 #ifdef PERLIO_IS_STDIO
 #  ifdef __GNU_LIBRARY__
 #    if __GNU_LIBRARY__ == 1 /* Linux glibc5 */
@@ -2592,38 +2614,14 @@ Perl_yylex(pTHX)
                 * Workaround?  Maybe attach some extra state to PL_rsfp?
                 */
                if (!PL_preprocess)
-                   bof = PerlIO_tell(PL_rsfp) == 0;
+                   bof = PerlIO_tell(PL_rsfp) == SvCUR(PL_linestr);
 #else
-               bof = PerlIO_tell(PL_rsfp) == 0;
+               bof = PerlIO_tell(PL_rsfp) == SvCUR(PL_linestr);
 #endif
-           }
-           s = filter_gets(PL_linestr, PL_rsfp, 0);
-           if (s == Nullch) {
-             fake_eof:
-               if (PL_rsfp) {
-                   if (PL_preprocess && !PL_in_eval)
-                       (void)PerlProc_pclose(PL_rsfp);
-                   else if ((PerlIO *)PL_rsfp == PerlIO_stdin())
-                       PerlIO_clearerr(PL_rsfp);
-                   else
-                       (void)PerlIO_close(PL_rsfp);
-                   PL_rsfp = Nullfp;
-                   PL_doextract = FALSE;
-               }
-               if (!PL_in_eval && (PL_minus_n || PL_minus_p)) {
-                   sv_setpv(PL_linestr,PL_minus_p ? ";}continue{print" : "");
-                   sv_catpv(PL_linestr,";}");
-                   PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
+               if (bof) {
                    PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
-                   PL_minus_n = PL_minus_p = 0;
-                   goto retry;
+                   s = swallow_bom((U8*)s);
                }
-               PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
-               sv_setpv(PL_linestr,"");
-               TOKEN(';');     /* not infinite loop because rsfp is NULL now */
-           } else if (bof) {
-               PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
-               s = swallow_bom((U8*)s);
            }
            if (PL_doextract) {
                if (*s == '#' && s[1] == '!' && instr(s,"perl"))
@@ -3072,12 +3070,16 @@ Perl_yylex(pTHX)
                        CvLOCKED_on(PL_compcv);
                    else if (!PL_in_my && len == 6 && strnEQ(s, "method", len))
                        CvMETHOD_on(PL_compcv);
+#ifdef USE_ITHREADS
+                   else if (PL_in_my == KEY_our && len == 6 && strnEQ(s, "shared", len))
+                       GvSHARED_on(cGVOPx_gv(yylval.opval));
+#endif
                    /* After we've set the flags, it could be argued that
                       we don't need to do the attributes.pm-based setting
                       process, and shouldn't bother appending recognized
                       flags. To experiment with that, uncomment the
                       following "else": */
-                   /* else */
+                   else
                        attrs = append_elem(OP_LIST, attrs,
                                            newSVOP(OP_CONST, 0,
                                                    newSVpvn(s, len)));
@@ -4169,10 +4171,6 @@ Perl_yylex(pTHX)
                        (void)PerlIO_seek(PL_rsfp, 0L, 0);
                    }
                    if (PerlLIO_setmode(PerlIO_fileno(PL_rsfp), O_TEXT) != -1) {
-#if defined(__BORLANDC__)
-                       /* XXX see note in do_binmode() */
-                       ((FILE*)PL_rsfp)->flags |= _F_BIN;
-#endif
                        if (loc > 0)
                            PerlIO_seek(PL_rsfp, loc, 0);
                    }
@@ -7459,6 +7457,9 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
     return oldsavestack_ix;
 }
 
+#ifdef __SC__
+#pragma segment Perl_yylex
+#endif
 int
 Perl_yywarn(pTHX_ char *s)
 {
@@ -7547,6 +7548,9 @@ Perl_yyerror(pTHX_ char *s)
     PL_in_my_stash = Nullhv;
     return 0;
 }
+#ifdef __SC__
+#pragma segment Main
+#endif
 
 STATIC char*
 S_swallow_bom(pTHX_ U8 *s)