From: Nicholas Clark Date: Thu, 9 Mar 2006 15:13:49 +0000 (+0000) Subject: MAD changes for bare skipspace() X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=29595ff298b9b71b7461c2281943b6a1566c9e45;p=p5sagit%2Fp5-mst-13.2.git MAD changes for bare skipspace() p4raw-id: //depot/perl@27439 --- diff --git a/embed.fnc b/embed.fnc index 0414b72..698bba6 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1699,6 +1699,12 @@ Mp |void |addmad |MADPROP* tm|MADPROP** root|char slot Mp |MADPROP*|newMADsv |char key|SV* sv Mp |MADPROP*|newMADPROP |char key|char type|void* val|I32 vlen Mp |void |mad_free |MADPROP* mp + +# if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT) +s |char* |skipspace0 |NN char *s +s |char* |skipspace1 |NN char *s +s |char* |skipspace2 |NN char *s|NULLOK SV **sv +# endif #endif END_EXTERN_C diff --git a/embed.h b/embed.h index bbe8b90..c2205b1 100644 --- a/embed.h +++ b/embed.h @@ -1783,6 +1783,13 @@ #define newMADPROP Perl_newMADPROP #define mad_free Perl_mad_free #endif +# if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT) +#ifdef PERL_CORE +#define skipspace0 S_skipspace0 +#define skipspace1 S_skipspace1 +#define skipspace2 S_skipspace2 +#endif +# endif #endif #define ck_anoncode Perl_ck_anoncode #define ck_bitop Perl_ck_bitop @@ -3919,6 +3926,13 @@ #define newMADPROP(a,b,c,d) Perl_newMADPROP(aTHX_ a,b,c,d) #define mad_free(a) Perl_mad_free(aTHX_ a) #endif +# if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT) +#ifdef PERL_CORE +#define skipspace0(a) S_skipspace0(aTHX_ a) +#define skipspace1(a) S_skipspace1(aTHX_ a) +#define skipspace2(a,b) S_skipspace2(aTHX_ a,b) +#endif +# endif #endif #define ck_anoncode(a) Perl_ck_anoncode(aTHX_ a) #define ck_bitop(a) Perl_ck_bitop(aTHX_ a) diff --git a/proto.h b/proto.h index 5e7785b..3be3750 100644 --- a/proto.h +++ b/proto.h @@ -4354,6 +4354,18 @@ PERL_CALLCONV void Perl_addmad(pTHX_ MADPROP* tm, MADPROP** root, char slot); PERL_CALLCONV MADPROP* Perl_newMADsv(pTHX_ char key, SV* sv); PERL_CALLCONV MADPROP* Perl_newMADPROP(pTHX_ char key, char type, void* val, I32 vlen); PERL_CALLCONV void Perl_mad_free(pTHX_ MADPROP* mp); + +# if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT) +STATIC char* S_skipspace0(pTHX_ char *s) + __attribute__nonnull__(pTHX_1); + +STATIC char* S_skipspace1(pTHX_ char *s) + __attribute__nonnull__(pTHX_1); + +STATIC char* S_skipspace2(pTHX_ char *s, SV **sv) + __attribute__nonnull__(pTHX_1); + +# endif #endif END_EXTERN_C diff --git a/toke.c b/toke.c index 13582da..b0cadfe 100644 --- a/toke.c +++ b/toke.c @@ -35,6 +35,24 @@ static I32 utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen); static I32 utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen); #endif +#ifdef PERL_MAD +/* XXX these probably need to be made into PL vars */ +static I32 realtokenstart; +static I32 faketokens = 0; +static MADPROP *thismad; +static SV *thistoken; +static SV *thisopen; +static SV *thisstuff; +static SV *thisclose; +static SV *thiswhite; +static SV *nextwhite; +static SV *skipwhite; +static SV *endwhite; +static I32 curforce = -1; + +# define CURMAD(slot,sv) if (PL_madskills) { curmad(slot,sv); sv = 0; } +#endif + #define XFAKEBRACK 128 #define XENUMMASK 127 @@ -108,6 +126,18 @@ static const char* const lex_state_names[] = { #endif #define CLINE (PL_copline = (CopLINE(PL_curcop) < PL_copline ? CopLINE(PL_curcop) : PL_copline)) +#if 0 && defined(PERL_MAD) +# define SKIPSPACE0(s) skipspace0(s) +# define SKIPSPACE1(s) skipspace1(s) +# define SKIPSPACE2(s,tsv) skipspace2(s,&tsv) +# define PEEKSPACE(s) skipspace2(s,0) +#else +# define SKIPSPACE0(s) skipspace(s) +# define SKIPSPACE1(s) skipspace(s) +# define SKIPSPACE2(s,tsv) skipspace(s) +# define PEEKSPACE(s) skipspace(s) +#endif + /* * Convenience functions to return different tokens and prime the * lexer for the next token. They all take an argument. @@ -176,7 +206,7 @@ static const char* const lex_state_names[] = { PL_last_lop_op = f; \ if (*s == '(') \ return REPORT( (int)FUNC1 ); \ - s = skipspace(s); \ + s = PEEKSPACE(s); \ return REPORT( *s=='(' ? (int)FUNC1 : (int)UNIOP ); \ } #define UNI(f) UNI2(f,XTERM) @@ -188,7 +218,7 @@ static const char* const lex_state_names[] = { PL_last_uni = PL_oldbufptr; \ if (*s == '(') \ return REPORT( (int)FUNC1 ); \ - s = skipspace(s); \ + s = PEEKSPACE(s); \ return REPORT( (*s == '(') ? (int)FUNC1 : (int)UNIOP ); \ } @@ -739,6 +769,81 @@ S_incline(pTHX_ char *s) CopLINE_set(PL_curcop, atoi(n)-1); } +#ifdef PERL_MAD +/* skip space before thistoken */ + +STATIC char * +S_skipspace0(pTHX_ register char *s) +{ + s = skipspace(s); + if (!PL_madskills) + return s; + if (skipwhite) { + if (!thiswhite) + thiswhite = newSVpvn("",0); + sv_catsv(thiswhite, skipwhite); + sv_free(skipwhite); + skipwhite = 0; + } + realtokenstart = s - SvPVX(PL_linestr); + return s; +} + +/* skip space after thistoken */ + +STATIC char * +S_skipspace1(pTHX_ register char *s) +{ + char *start = s; + I32 startoff = start - SvPVX(PL_linestr); + + s = skipspace(s); + if (!PL_madskills) + return s; + start = SvPVX(PL_linestr) + startoff; + if (!thistoken && realtokenstart >= 0) { + char *tstart = SvPVX(PL_linestr) + realtokenstart; + thistoken = newSVpvn(tstart, start - tstart); + } + realtokenstart = -1; + if (skipwhite) { + if (!nextwhite) + nextwhite = newSVpvn("",0); + sv_catsv(nextwhite, skipwhite); + sv_free(skipwhite); + skipwhite = 0; + } + return s; +} + +STATIC char * +S_skipspace2(pTHX_ register char *s, SV **svp) +{ + char *start = s; + I32 bufptroff = PL_bufptr - SvPVX(PL_linestr); + I32 startoff = start - SvPVX(PL_linestr); + s = skipspace(s); + PL_bufptr = SvPVX(PL_linestr) + bufptroff; + if (!PL_madskills || !svp) + return s; + start = SvPVX(PL_linestr) + startoff; + if (!thistoken && realtokenstart >= 0) { + char *tstart = SvPVX(PL_linestr) + realtokenstart; + thistoken = newSVpvn(tstart, start - tstart); + realtokenstart = -1; + } + if (skipwhite) { + if (!*svp) + *svp = newSVpvn("",0); + sv_setsv(*svp, skipwhite); + sv_free(skipwhite); + skipwhite = 0; + } + + return s; +} +#endif + /* * S_skipspace * Called to gobble the appropriate amount and type of whitespace. @@ -923,7 +1028,7 @@ S_lop(pTHX_ I32 f, int x, char *s) return REPORT(LSTOP); if (*s == '(') return REPORT(FUNC); - s = skipspace(s); + s = PEEKSPACE(s); if (*s == '(') return REPORT(FUNC); else @@ -985,7 +1090,7 @@ S_force_word(pTHX_ register char *start, int token, int check_keyword, int allow register char *s; STRLEN len; - start = skipspace(start); + start = SKIPSPACE1(start); s = start; if (isIDFIRST_lazy_if(s,UTF) || (allow_pack && *s == ':') || @@ -995,7 +1100,7 @@ S_force_word(pTHX_ register char *start, int token, int check_keyword, int allow if (check_keyword && keyword(PL_tokenbuf, len)) return start; if (token == METHOD) { - s = skipspace(s); + s = SKIPSPACE1(s); if (*s == '(') PL_expect = XTERM; else { @@ -1086,7 +1191,7 @@ S_force_version(pTHX_ char *s, int guessing) OP *version = NULL; char *d; - s = skipspace(s); + s = SKIPSPACE1(s); d = s; if (*d == 'v') @@ -2162,7 +2267,7 @@ S_intuit_method(pTHX_ char *start, GV *gv, CV *cv) if (*start == '$') { if (gv || PL_last_lop_op == OP_PRINT || isUPPER(*PL_tokenbuf)) return 0; - s = skipspace(s); + s = PEEKSPACE(s); PL_bufptr = start; PL_expect = XREF; return *s == '(' ? FUNCMETH : METHOD; @@ -2178,7 +2283,7 @@ S_intuit_method(pTHX_ char *start, GV *gv, CV *cv) return 0; /* filehandle or package name makes it a method */ if (!gv || GvIO(indirgv) || gv_stashpvn(tmpbuf, len, FALSE)) { - s = skipspace(s); + s = PEEKSPACE(s); if ((PL_bufend - s) >= 2 && *s == '=' && *(s+1) == '>') return 0; /* no assumptions -- "=>" quotes bearword */ bare_package: @@ -2395,10 +2500,10 @@ S_tokenize_use(pTHX_ int is_use, char *s) { if (PL_expect != XSTATE) yyerror(Perl_form(aTHX_ "\"%s\" not allowed in expression", is_use ? "use" : "no")); - s = skipspace(s); + s = SKIPSPACE1(s); if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) { s = force_version(s, TRUE); - if (*s == ';' || (s = skipspace(s), *s == ';')) { + if (*s == ';' || (s = SKIPSPACE1(s), *s == ';')) { PL_nextval[PL_nexttoke].opval = NULL; force_next(WORD); } @@ -3166,7 +3271,7 @@ Perl_yylex(pTHX) } else if (*s == '>') { s++; - s = skipspace(s); + s = SKIPSPACE1(s); if (isIDFIRST_lazy_if(s,UTF)) { s = force_word(s,METHOD,FALSE,TRUE,FALSE); TOKEN(ARROW); @@ -3271,7 +3376,7 @@ Perl_yylex(pTHX) case XATTRTERM: PL_expect = XTERMBLOCK; grabattrs: - s = skipspace(s); + s = PEEKSPACE(s); attrs = NULL; while (isIDFIRST_lazy_if(s,UTF)) { I32 tmp; @@ -3350,11 +3455,12 @@ Perl_yylex(pTHX) newSVOP(OP_CONST, 0, newSVpvn(s, len))); } - s = skipspace(d); + s = PEEKSPACE(d); if (*s == ':' && s[1] != ':') - s = skipspace(s+1); + s = PEEKSPACE(s+1); else if (s == d) break; /* require real whitespace or :'s */ + /* XXX losing whitespace on sequential attributes here */ } { const char tmp @@ -3395,7 +3501,7 @@ Perl_yylex(pTHX) PL_oldbufptr = PL_oldoldbufptr; /* allow print(STDOUT 123) */ else PL_expect = XTERM; - s = skipspace(s); + s = SKIPSPACE1(s); TOKEN('('); case ';': CLINE; @@ -3406,7 +3512,7 @@ Perl_yylex(pTHX) case ')': { const char tmp = *s++; - s = skipspace(s); + s = SKIPSPACE1(s); if (*s == '{') PREBLOCK(tmp); TERM(tmp); @@ -3481,7 +3587,7 @@ Perl_yylex(pTHX) PL_lex_brackstack[PL_lex_brackets++] = XTERM; else PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR; - s = skipspace(s); + s = SKIPSPACE1(s); if (*s == '}') { if (PL_expect == XREF && PL_lex_state == LEX_INTERPNORMAL) { PL_expect = XTERM; @@ -3816,7 +3922,7 @@ Perl_yylex(pTHX) { const char tmp = *s; if (PL_lex_state == LEX_NORMAL) - s = skipspace(s); + s = SKIPSPACE1(s); if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop) && intuit_more(s)) { @@ -3828,7 +3934,7 @@ Perl_yylex(pTHX) isSPACE(*t) || isALNUM_lazy_if(t,UTF) || *t == '$'; t++) ; if (*t++ == ',') { - PL_bufptr = skipspace(PL_bufptr); + PL_bufptr = PEEKSPACE(PL_bufptr); /* XXX can realloc */ while (t < PL_bufend && *t != ']') t++; Perl_warner(aTHX_ packWARN(WARN_SYNTAX), @@ -3922,7 +4028,7 @@ Perl_yylex(pTHX) PREREF('@'); } if (PL_lex_state == LEX_NORMAL) - s = skipspace(s); + s = SKIPSPACE1(s); if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop) && intuit_more(s)) { if (*s == '{') PL_tokenbuf[0] = '%'; @@ -3935,7 +4041,7 @@ Perl_yylex(pTHX) t++; if (*t == '}' || *t == ']') { t++; - PL_bufptr = skipspace(PL_bufptr); + PL_bufptr = PEEKSPACE(PL_bufptr); /* XXX can realloc */ Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Scalar value %.*s better written as $%.*s", (int)(t-PL_bufptr), PL_bufptr, @@ -4362,7 +4468,7 @@ Perl_yylex(pTHX) bool immediate_paren = *s == '('; /* (Now we can afford to cross potential line boundary.) */ - s = skipspace(s); + s = SKIPSPACE2(s,nextnextwhite); /* Two barewords in a row may indicate method call. */ @@ -4741,7 +4847,7 @@ Perl_yylex(pTHX) PREBLOCK(DEFAULT); case KEY_do: - s = skipspace(s); + s = SKIPSPACE1(s); if (*s == '{') PRETERMBLOCK(DO); if (*s != '\'') @@ -4792,7 +4898,7 @@ Perl_yylex(pTHX) UNI(OP_EXIT); case KEY_eval: - s = skipspace(s); + s = SKIPSPACE1(s); PL_expect = (*s == '{') ? XTERMBLOCK : XTERM; UNIBRACK(OP_ENTEREVAL); @@ -4833,7 +4939,7 @@ Perl_yylex(pTHX) case KEY_for: case KEY_foreach: yylval.ival = CopLINE(PL_curcop); - s = skipspace(s); + s = SKIPSPACE1(s); if (PL_expect == XSTATE && isIDFIRST_lazy_if(s,UTF)) { char *p = s; if ((PL_bufend - p) >= 3 && @@ -4842,11 +4948,11 @@ Perl_yylex(pTHX) else if ((PL_bufend - p) >= 4 && strnEQ(p, "our", 3) && isSPACE(*(p + 3))) p += 3; - p = skipspace(p); + p = PEEKSPACE(p); if (isIDFIRST_lazy_if(p,UTF)) { p = scan_ident(p, PL_bufend, PL_tokenbuf, sizeof PL_tokenbuf, TRUE); - p = skipspace(p); + p = PEEKSPACE(p); } if (*p != '$') Perl_croak(aTHX_ "Missing $ on loop variable"); @@ -5061,7 +5167,7 @@ Perl_yylex(pTHX) case KEY_our: case KEY_my: PL_in_my = tmp; - s = skipspace(s); + s = SKIPSPACE1(s); if (isIDFIRST_lazy_if(s,UTF)) { s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len); if (len == 3 && strnEQ(PL_tokenbuf, "sub", 3)) @@ -5089,13 +5195,13 @@ Perl_yylex(pTHX) OPERATOR(USE); case KEY_not: - if (*s == '(' || (s = skipspace(s), *s == '(')) + if (*s == '(' || (s = SKIPSPACE1(s), *s == '(')) FUN1(OP_NOT); else OPERATOR(NOTOP); case KEY_open: - s = skipspace(s); + s = SKIPSPACE1(s); if (isIDFIRST_lazy_if(s,UTF)) { const char *t; for (d = s; isALNUM_lazy_if(d,UTF); d++) ; @@ -5241,7 +5347,7 @@ Perl_yylex(pTHX) OLDLOP(OP_RETURN); case KEY_require: - s = skipspace(s); + s = SKIPSPACE1(s); if (isDIGIT(*s)) { s = force_version(s, FALSE); } @@ -5413,7 +5519,7 @@ Perl_yylex(pTHX) case KEY_sort: checkcomma(s,PL_tokenbuf,"subroutine name"); - s = skipspace(s); + s = SKIPSPACE1(s); if (*s == ';' || *s == ')') /* probably a close */ Perl_croak(aTHX_ "sort is now a reserved word"); PL_expect = XTERM; @@ -9403,7 +9509,7 @@ S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRL register char * const e = d + destlen + 3; /* two-character token, ending NUL */ if (isSPACE(*s)) - s = skipspace(s); + s = PEEKSPACE(s); if (isDIGIT(*s)) { while (isDIGIT(*s)) { if (d >= e) @@ -10159,8 +10265,9 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) char *last = NULL; /* last position for nesting bracket */ /* skip space before the delimiter */ - if (isSPACE(*s)) - s = skipspace(s); + if (isSPACE(*s)) { + s = PEEKSPACE(s); + } /* mark where we are, in case we need to report errors */ CLINE;