From: Simon Cozens Date: Mon, 22 Jan 2001 02:17:22 +0000 (+0000) Subject: Re: Announce : Tokener reporting patch X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=998054bdf809d3851d70e27bb38dba52850132a3;p=p5sagit%2Fp5-mst-13.2.git Re: Announce : Tokener reporting patch Message-ID: <20010122021722.A9334@pembro26.pmb.ox.ac.uk> p4raw-id: //depot/perl@8562 --- diff --git a/embed.h b/embed.h index 790f43b..f2a05c7 100644 --- a/embed.h +++ b/embed.h @@ -1131,6 +1131,7 @@ #define filter_gets S_filter_gets #define find_in_my_stash S_find_in_my_stash #define new_constant S_new_constant +#define tokereport S_tokereport #define ao S_ao #define depcom S_depcom #define incl_perldb S_incl_perldb @@ -2600,6 +2601,7 @@ #define filter_gets(a,b,c) S_filter_gets(aTHX_ a,b,c) #define find_in_my_stash(a,b) S_find_in_my_stash(aTHX_ a,b) #define new_constant(a,b,c,d,e,f) S_new_constant(aTHX_ a,b,c,d,e,f) +#define tokereport(a,b,c) S_tokereport(aTHX_ a,b,c) #define ao(a) S_ao(aTHX_ a) #define depcom() S_depcom(aTHX) #define incl_perldb() S_incl_perldb(aTHX) @@ -5058,6 +5060,8 @@ #define find_in_my_stash S_find_in_my_stash #define S_new_constant CPerlObj::S_new_constant #define new_constant S_new_constant +#define S_tokereport CPerlObj::S_tokereport +#define tokereport S_tokereport #define S_ao CPerlObj::S_ao #define ao S_ao #define S_depcom CPerlObj::S_depcom diff --git a/embed.pl b/embed.pl index e5ca87a..e71337b 100755 --- a/embed.pl +++ b/embed.pl @@ -2518,6 +2518,7 @@ s |char * |filter_gets |SV *sv|PerlIO *fp|STRLEN append s |HV * |find_in_my_stash|char *pkgname|I32 len s |SV* |new_constant |char *s|STRLEN len|const char *key|SV *sv \ |SV *pv|const char *type +s |void |tokereport |char *thing|char *s|I32 rv s |int |ao |int toketype s |void |depcom s |char* |incl_perldb diff --git a/proto.h b/proto.h index 97e7ba7..a1f0fee 100644 --- a/proto.h +++ b/proto.h @@ -1252,6 +1252,7 @@ STATIC I32 S_sublex_start(pTHX); STATIC char * S_filter_gets(pTHX_ SV *sv, PerlIO *fp, STRLEN append); STATIC HV * S_find_in_my_stash(pTHX_ char *pkgname, I32 len); STATIC SV* S_new_constant(pTHX_ char *s, STRLEN len, const char *key, SV *sv, SV *pv, const char *type); +STATIC void S_tokereport(pTHX_ char *thing, char *s, I32 rv); STATIC int S_ao(pTHX_ int toketype); STATIC void S_depcom(pTHX); STATIC char* S_incl_perldb(pTHX); diff --git a/toke.c b/toke.c index 398253c..d2dd026 100644 --- a/toke.c +++ b/toke.c @@ -126,31 +126,40 @@ int yyactlevel = -1; * Also see LOP and lop() below. */ -#define TOKEN(retval) return (PL_bufptr = s,(int)retval) -#define OPERATOR(retval) return (PL_expect = XTERM,PL_bufptr = s,(int)retval) -#define AOPERATOR(retval) return ao((PL_expect = XTERM,PL_bufptr = s,(int)retval)) -#define PREBLOCK(retval) return (PL_expect = XBLOCK,PL_bufptr = s,(int)retval) -#define PRETERMBLOCK(retval) return (PL_expect = XTERMBLOCK,PL_bufptr = s,(int)retval) -#define PREREF(retval) return (PL_expect = XREF,PL_bufptr = s,(int)retval) -#define TERM(retval) return (CLINE, PL_expect = XOPERATOR,PL_bufptr = s,(int)retval) -#define LOOPX(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LOOPEX) -#define FTST(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)UNIOP) -#define FUN0(f) return(yylval.ival = f,PL_expect = XOPERATOR,PL_bufptr = s,(int)FUNC0) -#define FUN1(f) return(yylval.ival = f,PL_expect = XOPERATOR,PL_bufptr = s,(int)FUNC1) -#define BOop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)BITOROP)) -#define BAop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)BITANDOP)) -#define SHop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)SHIFTOP)) -#define PWop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)POWOP)) -#define PMop(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)MATCHOP) -#define Aop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)ADDOP)) -#define Mop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)MULOP)) -#define Eop(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)EQOP) -#define Rop(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)RELOP) +#ifdef DEBUGGING /* Serve -DT. */ +# define REPORT(x,retval) tokereport(x,s,(int)retval) +# define REPORT2(x,retval) tokereport(x,s, yylval.ival) +#else +# define REPORT(x,retval) 1 +# define REPORT2(x,retval) 1 +#endif + +#define TOKEN(retval) return (REPORT2("token",retval), PL_bufptr = s,(int)retval) +#define OPERATOR(retval) return (REPORT2("operator",retval), PL_expect = XTERM, PL_bufptr = s,(int)retval) +#define AOPERATOR(retval) return ao((REPORT2("aop",retval), PL_expect = XTERM, PL_bufptr = s,(int)retval)) +#define PREBLOCK(retval) return (REPORT2("preblock",retval), PL_expect = XBLOCK,PL_bufptr = s,(int)retval) +#define PRETERMBLOCK(retval) return (REPORT2("pretermblock",retval), PL_expect = XTERMBLOCK,PL_bufptr = s,(int)retval) +#define PREREF(retval) return (REPORT2("preref",retval), PL_expect = XREF,PL_bufptr = s,(int)retval) +#define TERM(retval) return (CLINE, REPORT2("term",retval), PL_expect = XOPERATOR, PL_bufptr = s,(int)retval) +#define LOOPX(f) return(yylval.ival=f, REPORT("loopx",f), PL_expect = XTERM,PL_bufptr = s,(int)LOOPEX) +#define FTST(f) return(yylval.ival=f, REPORT("ftst",f), PL_expect = XTERM,PL_bufptr = s,(int)UNIOP) +#define FUN0(f) return(yylval.ival = f, REPORT("fun0",f), PL_expect = XOPERATOR,PL_bufptr = s,(int)FUNC0) +#define FUN1(f) return(yylval.ival = f, REPORT("fun1",f), PL_expect = XOPERATOR,PL_bufptr = s,(int)FUNC1) +#define BOop(f) return ao((yylval.ival=f, REPORT("bitorop",f), PL_expect = XTERM,PL_bufptr = s,(int)BITOROP)) +#define BAop(f) return ao((yylval.ival=f, REPORT("bitandop",f), PL_expect = XTERM,PL_bufptr = s,(int)BITANDOP)) +#define SHop(f) return ao((yylval.ival=f, REPORT("shiftop",f), PL_expect = XTERM,PL_bufptr = s,(int)SHIFTOP)) +#define PWop(f) return ao((yylval.ival=f, REPORT("powop",f), PL_expect = XTERM,PL_bufptr = s,(int)POWOP)) +#define PMop(f) return(yylval.ival=f, REPORT("matchop",f), PL_expect = XTERM,PL_bufptr = s,(int)MATCHOP) +#define Aop(f) return ao((yylval.ival=f, REPORT("add",f), PL_expect = XTERM,PL_bufptr = s,(int)ADDOP)) +#define Mop(f) return ao((yylval.ival=f, REPORT("mul",f), PL_expect = XTERM,PL_bufptr = s,(int)MULOP)) +#define Eop(f) return(yylval.ival=f, REPORT("eq",f), PL_expect = XTERM,PL_bufptr = s,(int)EQOP) +#define Rop(f) return(yylval.ival=f, REPORT("rel",f), PL_expect = XTERM,PL_bufptr = s,(int)RELOP) /* This bit of chicanery makes a unary function followed by * a parenthesis into a function with one argument, highest precedence. */ #define UNI(f) return(yylval.ival = f, \ + REPORT("uni",f), \ PL_expect = XTERM, \ PL_bufptr = s, \ PL_last_uni = PL_oldbufptr, \ @@ -158,6 +167,7 @@ int yyactlevel = -1; (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) ) #define UNIBRACK(f) return(yylval.ival = f, \ + REPORT("uni",f), \ PL_bufptr = s, \ PL_last_uni = PL_oldbufptr, \ (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) ) @@ -165,6 +175,24 @@ int yyactlevel = -1; /* grandfather return to old style */ #define OLDLOP(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LSTOP) +void +S_tokereport(char *thing, char* s, I32 rv) +{ + SV *report; + DEBUG_T({ + report = newSVpv(thing, 0); + sv_catpvf(report, ":line %i:%i:", CopLINE(PL_curcop), rv); + + if (s - PL_bufptr > 0) + sv_catpvn(report, PL_bufptr, s - PL_bufptr); + else { + if (PL_oldbufptr && *PL_oldbufptr) + sv_catpv(report, PL_tokenbuf); + } + PerlIO_printf(Perl_debug_log, "### %s\n", SvPV_nolen(report)); + }) +} + /* * S_ao * @@ -677,6 +705,7 @@ S_lop(pTHX_ I32 f, int x, char *s) { yylval.ival = f; CLINE; + REPORT("lop", f); PL_expect = x; PL_bufptr = s; PL_last_lop = PL_oldbufptr;