Document toke.c.
[p5sagit/p5-mst-13.2.git] / regexec.c
index 75f3873..e69c4ff 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -39,6 +39,8 @@
 /* *These* symbols are masked to allow static link. */
 #  define Perl_pregexec my_pregexec
 #  define Perl_reginitcolors my_reginitcolors 
+
+#  define PERL_NO_GET_CONTEXT
 #endif 
 
 /*SUPPRESS 112*/
 #define PERL_IN_REGEXEC_C
 #include "perl.h"
 
+#ifdef PERL_IN_XSUB_RE
+#  if defined(PERL_CAPI) || defined(PERL_OBJECT)
+#    include "XSUB.h"
+#  endif
+#endif
+
 #include "regcomp.h"
 
 #define RF_tainted     1               /* tainted information used? */
 #define HOPc(pos,off) ((char*)HOP(pos,off))
 #define HOPMAYBEc(pos,off) ((char*)HOPMAYBE(pos,off))
 
+static void restore_pos(pTHXo_ void *arg);
+
+
 STATIC CHECKPOINT
 S_regcppush(pTHX_ I32 parenfloor)
 {
@@ -243,22 +254,6 @@ S_cache_re(pTHX_ regexp *prog)
     PL_reg_re = prog;    
 }
 
-STATIC void
-S_restore_pos(pTHX_ void *arg)
-{
-    dTHR;
-    if (PL_reg_eval_set) {
-       if (PL_reg_oldsaved) {
-           PL_reg_re->subbeg = PL_reg_oldsaved;
-           PL_reg_re->sublen = PL_reg_oldsavedlen;
-           RX_MATCH_COPIED_on(PL_reg_re);
-       }
-       PL_reg_magic->mg_len = PL_reg_oldpos;
-       PL_reg_eval_set = 0;
-       PL_curpm = PL_reg_oldcurpm;
-    }  
-}
-
 /* 
  * Need to implement the following flags for reg_anch:
  *
@@ -326,6 +321,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
                 && (sv && (strpos + SvCUR(sv) != strend)) )
                goto fail;
 
+           PL_regeol = strend;                 /* Used in HOP() */
            s = (char*)HOP((U8*)strpos, prog->check_offset_min);
            if (SvTAIL(prog->check_substr)) {
                slen = SvCUR(prog->check_substr);       /* >= 1 */
@@ -363,6 +359,8 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
     }
 
   restart:
+    if (end_shift < 0)
+       end_shift = 0; /* can happen when strend == strpos */
     if (flags & REXEC_SCREAM) {
        SV *c = prog->check_substr;
        char *strbeg = SvPVX(sv);       /* XXXX Assume PV_force() on SCREAM! */
@@ -1254,7 +1252,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
            break;
        case ASCII:
            while (s < strend) {
-               if (isASCII(*s)) {
+               if (isASCII(*(U8*)s)) {
                    if (tmp && regtry(prog, s))
                        goto got_it;
                    else
@@ -1267,7 +1265,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
            break;
        case NASCII:
            while (s < strend) {
-               if (!isASCII(*s)) {
+               if (!isASCII(*(U8*)s)) {
                    if (tmp && regtry(prog, s))
                        goto got_it;
                    else
@@ -2022,7 +2020,7 @@ got_it:
            sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
                                                  restored, the value remains
                                                  the same. */
-       restore_pos(0);
+       restore_pos(aTHXo_ 0);
     }
 
     /* make sure $`, $&, $', and $digit will work later */
@@ -2049,7 +2047,7 @@ got_it:
 
 phooey:
     if (PL_reg_eval_set)
-       restore_pos(0);
+       restore_pos(aTHXo_ 0);
     return 0;
 }
 
@@ -2098,7 +2096,7 @@ S_regtry(pTHX_ regexp *prog, char *startpos)
            }
            PL_reg_magic    = mg;
            PL_reg_oldpos   = mg->mg_len;
-           SAVEDESTRUCTOR(S_restore_pos, 0);
+           SAVEDESTRUCTOR(restore_pos, 0);
         }
        if (!PL_reg_curpm)
            New(22,PL_reg_curpm, 1, PMOP);
@@ -4455,3 +4453,25 @@ S_reghopmaybe(pTHX_ U8* s, I32 off)
     }
     return s;
 }
+
+#ifdef PERL_OBJECT
+#define NO_XSLOCKS
+#include "XSUB.h"
+#endif
+
+static void
+restore_pos(pTHXo_ void *arg)
+{
+    dTHR;
+    if (PL_reg_eval_set) {
+       if (PL_reg_oldsaved) {
+           PL_reg_re->subbeg = PL_reg_oldsaved;
+           PL_reg_re->sublen = PL_reg_oldsavedlen;
+           RX_MATCH_COPIED_on(PL_reg_re);
+       }
+       PL_reg_magic->mg_len = PL_reg_oldpos;
+       PL_reg_eval_set = 0;
+       PL_curpm = PL_reg_oldcurpm;
+    }  
+}
+