cvs commit: ponie/perl perl.c perl.h regcomp.c sv.c sv.h
[email protected] (Nicholas Clark) 17 Jun 2004 14:51:38 -0000
| Newsgroups | perl.ponie.changes |
|---|---|
| Message-ID | <[email protected]> |
cvsuser 04/06/17 07:51:37
Modified: perl perl.c perl.h regcomp.c sv.c sv.h
Log:
Change the regexp debug pad from SV heads embedded in the interpreter structure
to pointers to SVs in the interpreter structure.
(Need to remove all explicitly created SV heads to be able to make SV *
be a PMC *, as we can't embed PMC structures)
Revision Changes Path
1.8 +11 -13 ponie/perl/perl.c
Index: perl.c
===================================================================
RCS file: /cvs/public/ponie/perl/perl.c,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -w -r1.7 -r1.8
--- perl.c 13 Jun 2004 16:40:05 -0000 1.7
+++ perl.c 17 Jun 2004 14:51:37 -0000 1.8
@@ -250,9 +250,9 @@
PL_fdpid = newAV(); /* for remembering popen pids by fd */
PL_modglobal = newHV(); /* pointers to per-interpreter module globals */
PL_errors = newSVpvn("",0);
- sv_setpvn(PERL_DEBUG_PAD(0), "", 0); /* For regex debugging. */
- sv_setpvn(PERL_DEBUG_PAD(1), "", 0); /* ext/re needs these */
- sv_setpvn(PERL_DEBUG_PAD(2), "", 0); /* even without DEBUGGING. */
+ PERL_DEBUG_PAD(0) = newSVpvn("", 0); /* For regex debugging. */
+ PERL_DEBUG_PAD(1) = newSVpvn("", 0); /* ext/re needs these */
+ PERL_DEBUG_PAD(2) = newSVpvn("", 0); /* even without DEBUGGING. */
#ifdef USE_ITHREADS
PL_regex_padav = newAV();
av_push(PL_regex_padav,(SV*)newAV()); /* First entry is an array of empty elements */
@@ -711,6 +711,14 @@
SvFLAGS(PL_fdpid) |= SVTYPEMASK; /* don't clean out pid table now */
SvFLAGS(PL_strtab) |= SVTYPEMASK; /* don't clean out strtab now */
+ {
+ int i;
+ for (i=0; i<=2; i++) {
+ SvREFCNT_dec(PERL_DEBUG_PAD(i));
+ PERL_DEBUG_PAD(i) = Nullsv;
+ }
+ }
+
/* the 2 is for PL_fdpid and PL_strtab */
while (PL_sv_count > 2 && sv_clean_all())
;
@@ -777,16 +785,6 @@
SvANY(&PL_sv_no) = NULL;
SvFLAGS(&PL_sv_no) = 0;
- {
- int i;
- for (i=0; i<=2; i++) {
- SvREFCNT(PERL_DEBUG_PAD(i)) = 0;
- sv_clear(PERL_DEBUG_PAD(i));
- SvANY(PERL_DEBUG_PAD(i)) = NULL;
- SvFLAGS(PERL_DEBUG_PAD(i)) = 0;
- }
- }
-
if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL))
Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Scalars leaked: %ld\n", (long)PL_sv_count);
1.7 +2 -2 ponie/perl/perl.h
Index: perl.h
===================================================================
RCS file: /cvs/public/ponie/perl/perl.h,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- perl.h 7 Apr 2004 10:37:27 -0000 1.6
+++ perl.h 17 Jun 2004 14:51:37 -0000 1.7
@@ -3383,10 +3383,10 @@
* constructing debug output are included. Needed always,
* not just when DEBUGGING, though, because of the re extension. c*/
struct perl_debug_pad {
- SV pad[3];
+ SV *pad[3];
};
-#define PERL_DEBUG_PAD(i) &(PL_debug_pad.pad[i])
+#define PERL_DEBUG_PAD(i) (PL_debug_pad.pad[i])
#define PERL_DEBUG_PAD_ZERO(i) (SvPVX(PERL_DEBUG_PAD(i))[0] = 0, SvCUR(PERL_DEBUG_PAD(i)) = 0, PERL_DEBUG_PAD(i))
/* Enable variables which are pointers to functions */
1.2 +15 -17 ponie/perl/regcomp.c
Index: regcomp.c
===================================================================
RCS file: /cvs/public/ponie/perl/regcomp.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- regcomp.c 9 Sep 2003 11:58:55 -0000 1.1
+++ regcomp.c 17 Jun 2004 14:51:37 -0000 1.2
@@ -2253,13 +2253,13 @@
}
else { /* First pass */
if (PL_reginterp_cnt < ++RExC_seen_evals
- && PL_curcop != &PL_compiling)
+ && IN_PERL_RUNTIME)
/* No compiled RE interpolated, has runtime
components ===> unsafe. */
FAIL("Eval-group not allowed at runtime, use re 'eval'");
if (PL_tainting && PL_tainted)
FAIL("Eval-group in insecure regular expression");
- if (PL_curcop == &PL_compiling)
+ if (IN_PERL_COMPILETIME)
PL_cv_has_eval = 1;
}
@@ -2511,8 +2511,8 @@
if (paren == '>')
node = SUSPEND, flag = 0;
reginsert(pRExC_state, node,ret);
- Set_Node_Offset(ret, oregcomp_parse);
- Set_Node_Length(ret, RExC_parse - oregcomp_parse + 2);
+ Set_Node_Cur_Length(ret);
+ Set_Node_Offset(ret, parse_start + 1);
ret->flags = flag;
regtail(pRExC_state, ret, reg_node(pRExC_state, TAIL));
}
@@ -2793,7 +2793,7 @@
{
register regnode *ret = 0;
I32 flags;
- char *parse_start = 0;
+ char *parse_start = RExC_parse;
*flagp = WORST; /* Tentatively. */
@@ -3056,6 +3056,7 @@
default:
/* Do not generate `unrecognized' warnings here, we fall
back into the quick-grab loop below */
+ parse_start--;
goto defchar;
}
break;
@@ -3162,11 +3163,6 @@
ender = grok_hex(p + 1, &numlen, &flags, NULL);
if (ender > 0xff)
RExC_utf8 = 1;
- /* numlen is generous */
- if (numlen + len >= 127) {
- p--;
- goto loopdone;
- }
p = e + 1;
}
}
@@ -3310,7 +3306,7 @@
}
if (len > 0)
*flagp |= HASWIDTH;
- if (len == 1)
+ if (len == 1 && UNI_IS_INVARIANT(ender))
*flagp |= SIMPLE;
if (!SIZE_ONLY)
STR_LEN(ret) = len;
@@ -4430,6 +4426,7 @@
RExC_parse - RExC_start,
RExC_offsets[0]));
Set_Node_Offset(place, RExC_parse);
+ Set_Node_Length(place, 1);
}
src = NEXTOPER(place);
FILL_ADVANCE_NODE(place, op);
@@ -4907,7 +4904,8 @@
Perl_pregfree(pTHX_ struct regexp *r)
{
#ifdef DEBUGGING
- SV *dsv = PERL_DEBUG_PAD_ZERO(0);
+ /* FIXME May go boom if someone runs with -Dr */
+ SV *dsv = PERL_DEBUG_PAD(0) ? PERL_DEBUG_PAD_ZERO(0) : Nullsv;
#endif
if (!r || (--r->refcnt > 0))
@@ -5048,7 +5046,7 @@
if (l1 > 512)
l1 = 512;
Copy(message, buf, l1 , char);
- buf[l1] = '\0'; /* Overwrite \n */
+ buf[l1-1] = '\0'; /* Overwrite \n */
Perl_croak(aTHX_ "%s", buf);
}
1.35 +4 -0 ponie/perl/sv.c
Index: sv.c
===================================================================
RCS file: /cvs/public/ponie/perl/sv.c,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -w -r1.34 -r1.35
--- sv.c 16 Jun 2004 10:22:20 -0000 1.34
+++ sv.c 17 Jun 2004 14:51:37 -0000 1.35
@@ -11499,6 +11499,8 @@
PL_savestack_max = -1;
PL_retstack = 0;
PL_sig_pending = 0;
+ /* XXX not needed for ponie */
+ croak("perl_clone_using called in ponie");
Zero(&PL_debug_pad, 1, struct perl_debug_pad);
# else /* !DEBUGGING */
Zero(my_perl, 1, PerlInterpreter);
@@ -11532,6 +11534,8 @@
PL_savestack_max = -1;
PL_retstack = 0;
PL_sig_pending = 0;
+ /* XXX not needed for ponie */
+ croak("perl_clone called in ponie");
Zero(&PL_debug_pad, 1, struct perl_debug_pad);
# else /* !DEBUGGING */
Zero(my_perl, 1, PerlInterpreter);
1.20 +1 -1 ponie/perl/sv.h
Index: sv.h
===================================================================
RCS file: /cvs/public/ponie/perl/sv.h,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -w -r1.19 -r1.20
--- sv.h 13 Jun 2004 20:38:53 -0000 1.19
+++ sv.h 17 Jun 2004 14:51:37 -0000 1.20
@@ -168,7 +168,7 @@
#endif
#define SVTYPEMASK 0xff
-#define SvTYPE(sv) ((sv)->sv_flags & SVTYPEMASK)
+#define SvTYPE(sv) (SvFLAGS(sv) & SVTYPEMASK)
#define SvUPGRADE(sv, mt) (SvTYPE(sv) >= mt || sv_upgrade(sv, mt))