expect = XREF, \
bufptr = s, \
last_lop = oldbufptr, \
+ last_lop_op = f, \
(*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC : (int)LSTOP) )
/* grandfather return to old style */
#define OLDLOP(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)LSTOP)
-void
-no_op(what)
+static void
+no_op(what, s)
char *what;
+char *s;
{
- warn("%s found where operator expected", what);
+ char tmpbuf[128];
+ char *oldbufptr = bufptr;
+ bufptr = s;
+ sprintf(tmpbuf, "%s found where operator expected", what);
+ yywarn(tmpbuf);
if (bufptr == SvPVX(linestr))
warn("\t(Missing semicolon on previous line?)\n", what);
+ bufptr = oldbufptr;
+}
+
+static void
+missingterm(s)
+char *s;
+{
+ char tmpbuf[3];
+ char q;
+ if (s) {
+ char *nl = strrchr(s,'\n');
+ if (nl)
+ *nl = '\0';
+ }
+ else if (multi_close < 32 || multi_close == 127) {
+ *tmpbuf = '^';
+ tmpbuf[1] = multi_close ^ 64;
+ s = "\\n";
+ tmpbuf[2] = '\0';
+ s = tmpbuf;
+ }
+ else {
+ *tmpbuf = multi_close;
+ tmpbuf[1] = '\0';
+ s = tmpbuf;
+ }
+ q = strchr(s,'"') ? '\'' : '"';
+ croak("Can't find string terminator %c%s%c anywhere before EOF",q,s,q);
}
void
-lex_start()
+lex_start(line)
+SV *line;
{
- ENTER;
+ char *s;
+ STRLEN len;
+
SAVEINT(lex_dojoin);
SAVEINT(lex_brackets);
SAVEINT(lex_fakebrack);
SAVEINT(lex_inwhat);
SAVEINT(curcop->cop_line);
SAVESPTR(bufptr);
+ SAVESPTR(bufend);
SAVESPTR(oldbufptr);
SAVESPTR(oldoldbufptr);
SAVESPTR(linestr);
SAVESPTR(lex_brackstack);
+ SAVESPTR(rsfp);
lex_state = LEX_NORMAL;
lex_defer = 0;
- lex_expect = XBLOCK;
+ expect = XSTATE;
lex_brackets = 0;
lex_fakebrack = 0;
if (lex_brackstack)
SAVESPTR(lex_brackstack);
- lex_brackstack = malloc(120);
+ New(899, lex_brackstack, 120, char);
+ SAVEFREEPV(lex_brackstack);
lex_casemods = 0;
lex_dojoin = 0;
lex_starts = 0;
if (lex_stuff)
- sv_free(lex_stuff);
+ SvREFCNT_dec(lex_stuff);
lex_stuff = Nullsv;
if (lex_repl)
- sv_free(lex_repl);
+ SvREFCNT_dec(lex_repl);
lex_repl = Nullsv;
lex_inpat = 0;
lex_inwhat = 0;
+ linestr = line;
+ if (SvREADONLY(linestr))
+ linestr = sv_2mortal(newSVsv(linestr));
+ s = SvPV(linestr, len);
+ if (len && s[len-1] != ';') {
+ if (!(SvFLAGS(linestr) & SVs_TEMP));
+ linestr = sv_2mortal(newSVsv(linestr));
+ sv_catpvn(linestr, "\n;", 2);
+ }
+ SvTEMP_off(linestr);
oldoldbufptr = oldbufptr = bufptr = SvPVX(linestr);
bufend = bufptr + SvCUR(linestr);
rs = "\n";
rslen = 1;
rschar = '\n';
rspara = 0;
+ rsfp = 0;
}
void
lex_end()
{
- free(lex_brackstack);
- lex_brackstack = 0;
- LEAVE;
}
static void
curcop->cop_line = atoi(n)-1;
}
-char *
+static char *
skipspace(s)
register char *s;
{
if (s < bufend || !rsfp)
return s;
if ((s = sv_gets(linestr, rsfp, 0)) == Nullch) {
- sv_setpv(linestr,"");
- bufend = oldoldbufptr = oldbufptr = bufptr = s = SvPVX(linestr);
+ sv_setpv(linestr,";");
+ oldoldbufptr = oldbufptr = bufptr = s = SvPVX(linestr);
+ bufend = s+1;
+ if (preprocess)
+ (void)my_pclose(rsfp);
+ else if ((FILE*)rsfp == stdin)
+ clearerr(stdin);
+ else
+ (void)fclose(rsfp);
+ rsfp = Nullfp;
return s;
}
oldoldbufptr = oldbufptr = bufptr = s;
bufend = bufptr + SvCUR(linestr);
+ if (perldb && curstash != debstash) {
+ SV *sv = NEWSV(85,0);
+
+ sv_upgrade(sv, SVt_PVMG);
+ sv_setsv(sv,linestr);
+ av_store(GvAV(curcop->cop_filegv),(I32)curcop->cop_line,sv);
+ }
incline(s);
}
}
-void
+static void
check_uni() {
char *s;
char ch;
#define UNI(f) return uni(f,s)
#define LOP(f) return lop(f,s)
-int
+static int
uni(f,s)
I32 f;
char *s;
return UNIOP;
}
-I32
+static I32
lop(f,s)
I32 f;
char *s;
CLINE;
expect = XREF;
bufptr = s;
- last_uni = oldbufptr;
+ last_lop = oldbufptr;
+ last_lop_op = f;
if (*s == '(')
return FUNC;
s = skipspace(s);
#endif /* CRIPPLED_CC */
-void
+static void
force_next(type)
I32 type;
{
}
}
-char *
+static char *
force_word(start,token,check_keyword,allow_tick)
register char *start;
int token;
}
}
nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST,0, newSVpv(tokenbuf,0));
+ nextval[nexttoke].opval->op_private |= OPpCONST_BARE;
force_next(token);
}
return s;
}
-void
+static void
force_ident(s)
register char *s;
{
}
}
-SV *
+static SV *
q(sv)
SV *sv;
{
return sv;
}
-I32
+static I32
sublex_start()
{
register I32 op_type = yylval.ival;
bufend = bufptr = oldbufptr = oldoldbufptr = SvPVX(linestr);
bufend += SvCUR(linestr);
+ SAVEFREESV(linestr);
lex_dojoin = FALSE;
lex_brackets = 0;
lex_fakebrack = 0;
- lex_brackstack = malloc(120);
+ New(899, lex_brackstack, 120, char);
+ SAVEFREEPV(lex_brackstack);
lex_casemods = 0;
lex_starts = 0;
lex_state = LEX_INTERPCONCAT;
return FUNC;
}
-I32
+static I32
sublex_done()
{
if (!lex_starts++) {
return yylex();
}
- sv_free(linestr);
/* Is there a right-hand side to take care of? */
if (lex_repl && (lex_inwhat == OP_SUBST || lex_inwhat == OP_TRANS)) {
linestr = lex_repl;
lex_inpat = 0;
bufend = bufptr = oldbufptr = oldoldbufptr = SvPVX(linestr);
bufend += SvCUR(linestr);
+ SAVEFREESV(linestr);
lex_dojoin = FALSE;
lex_brackets = 0;
lex_fakebrack = 0;
return ',';
}
else {
- if (lex_brackstack)
- free(lex_brackstack);
- lex_brackstack = 0;
-
pop_scope();
bufend = SvPVX(linestr);
bufend += SvCUR(linestr);
}
}
-char *
+static char *
scan_const(start)
char *start;
{
if (s > bufptr)
yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
else
- sv_free(sv);
+ SvREFCNT_dec(sv);
return s;
}
/* This is the one truly awful dwimmer necessary to conflate C and sed. */
-int
+static int
intuit_more(s)
register char *s;
{
return TRUE;
}
-static char* exp_name[] = { "OPERATOR", "TERM", "BLOCK", "REF" };
+static char* exp_name[] = { "OPERATOR", "TERM", "REF", "STATE", "BLOCK" };
extern int yychar; /* last token */
if (perldb) {
char *pdb = getenv("PERLDB");
- sv_catpv(linestr,"{");
- sv_catpv(linestr, pdb ? pdb : "require 'perldb.pl'");
- sv_catpv(linestr, "}");
+ sv_catpv(linestr, pdb ? pdb : "BEGIN { require 'perldb.pl' }");
}
if (minus_n || minus_p) {
sv_catpv(linestr, "LINE: while (<>) {");
incline(s);
} while (doextract);
oldoldbufptr = oldbufptr = bufptr = s;
- if (perldb) {
+ if (perldb && curstash != debstash) {
SV *sv = NEWSV(85,0);
sv_upgrade(sv, SVt_PVMG);
s++;
s = skipspace(s);
if (isIDFIRST(*s)) {
- s = force_word(s,METHOD,TRUE,FALSE);
+ s = force_word(s,METHOD,FALSE,TRUE);
TOKEN(ARROW);
}
else
/* FALL THROUGH */
case '~':
case ',':
- case '(':
case ':':
tmp = *s++;
OPERATOR(tmp);
+ case '(':
+ s++;
+ if (last_lop == oldoldbufptr)
+ oldbufptr = oldoldbufptr; /* allow print(STDOUT 123) */
+ OPERATOR('(');
case ';':
if (curcop->cop_line < copline)
copline = curcop->cop_line;
if (in_format == 2)
in_format = 0;
s++;
- if (lex_brackets > 100)
- realloc(lex_brackstack, lex_brackets + 1);
+ if (lex_brackets > 100) {
+ char* newlb = (char*)realloc(lex_brackstack, lex_brackets + 1);
+ if (newlb != lex_brackstack) {
+ SAVEFREEPV(newlb);
+ lex_brackstack = newlb;
+ }
+ }
if (oldoldbufptr == last_lop)
lex_brackstack[lex_brackets++] = XTERM;
else
lex_brackstack[lex_brackets++] = XOPERATOR;
if (expect == XTERM)
OPERATOR(HASHBRACK);
- else if (expect == XREF) {
+ else if (expect == XBLOCK || expect == XOPERATOR) {
+ lex_brackstack[lex_brackets-1] = XBLOCK;
+ expect = XBLOCK;
+ }
+ else {
char *t;
s = skipspace(s);
if (*s == '}')
t++) ;
if (*t == ',' || (*t == '=' && t[1] == '>'))
OPERATOR(HASHBRACK);
- expect = XTERM;
- }
- else {
- lex_brackstack[lex_brackets-1] = XBLOCK;
- expect = XBLOCK;
+ if (expect == XREF)
+ expect = XTERM;
+ else {
+ lex_brackstack[lex_brackets-1] = XSTATE;
+ expect = XSTATE;
+ }
}
yylval.ival = curcop->cop_line;
if (isSPACE(*s) || *s == '#')
Rop(OP_GT);
case '$':
- if (expect == XOPERATOR) {
- if (in_format)
- OPERATOR(','); /* grandfather non-comma-format format */
- else
- no_op("Scalar");
- }
if (s[1] == '#' && (isALPHA(s[2]) || s[2] == '_' || s[2] == '{')) {
s = scan_ident(s+1, bufend, tokenbuf, FALSE);
+ if (expect == XOPERATOR) {
+ if (in_format)
+ OPERATOR(','); /* grandfather non-comma-format format */
+ else
+ no_op("Array length",s);
+ }
expect = XOPERATOR;
force_ident(tokenbuf);
TOKEN(DOLSHARP);
}
s = scan_ident(s, bufend, tokenbuf+1, FALSE);
+ if (expect == XOPERATOR) {
+ if (in_format)
+ OPERATOR(','); /* grandfather non-comma-format format */
+ else
+ no_op("Scalar",s);
+ }
if (tokenbuf[1]) {
tokenbuf[0] = '$';
if (dowarn && *s == '[') {
if (lex_state == LEX_NORMAL && isSPACE(*s)) {
bool islop = (last_lop == oldoldbufptr);
s = skipspace(s);
- if (strchr("$@\"'`q", *s))
- expect = XTERM; /* e.g. print $fh "foo" */
- else if (!islop)
+ if (!islop)
expect = XOPERATOR;
+ else if (strchr("$@\"'`q", *s))
+ expect = XTERM; /* e.g. print $fh "foo" */
else if (strchr("&*<%", *s) && isIDFIRST(s[1]))
expect = XTERM; /* e.g. print $fh &sub */
else if (isDIGIT(*s))
TOKEN('$');
case '@':
- if (expect == XOPERATOR)
- no_op("Array");
s = scan_ident(s, bufend, tokenbuf+1, FALSE);
+ if (expect == XOPERATOR)
+ no_op("Array",s);
if (tokenbuf[1]) {
tokenbuf[0] = '@';
expect = XOPERATOR;
}
if (dowarn && *s == '[') {
char *t;
- for (t = s+1; isSPACE(*t) || isALNUM(*t) || *t == '$'; t++) ;
+ for (t = s+1; *t && (isALNUM(*t) || strchr(" \t$#+-", *t)); t++)
+ ;
if (*t++ == ']') {
bufptr = skipspace(bufptr);
warn("Scalar value %.*s better written as $%.*s",
case '.':
if (in_format == 2) {
in_format = 0;
- expect = XBLOCK;
+ expect = XSTATE;
goto rightbracket;
}
if (expect == XOPERATOR || !isDIGIT(s[1])) {
/* FALL THROUGH */
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
- if (expect == XOPERATOR)
- no_op("Number");
s = scan_num(s);
+ if (expect == XOPERATOR)
+ no_op("Number",s);
TERM(THING);
case '\'':
+ s = scan_str(s);
if (expect == XOPERATOR) {
if (in_format)
OPERATOR(','); /* grandfather non-comma-format format */
else
- no_op("String");
+ no_op("String",s);
}
- s = scan_str(s);
if (!s)
- croak("EOF in string");
+ missingterm(0);
yylval.ival = OP_CONST;
TERM(sublex_start());
case '"':
+ s = scan_str(s);
if (expect == XOPERATOR) {
if (in_format)
OPERATOR(','); /* grandfather non-comma-format format */
else
- no_op("String");
+ no_op("String",s);
}
- s = scan_str(s);
if (!s)
- croak("EOF in string");
+ missingterm(0);
yylval.ival = OP_SCALAR;
TERM(sublex_start());
case '`':
- if (expect == XOPERATOR)
- no_op("Backticks");
s = scan_str(s);
+ if (expect == XOPERATOR)
+ no_op("Backticks",s);
if (!s)
- croak("EOF in backticks");
+ missingterm(0);
yylval.ival = OP_BACKTICK;
set_csh();
TERM(sublex_start());
case '\\':
- if (expect == XOPERATOR)
- no_op("Backslash");
s++;
+ if (expect == XOPERATOR)
+ no_op("Backslash",s);
OPERATOR(REFGEN);
case 'x':
default: /* not a keyword */
just_a_word: {
GV *gv;
+
+ /* Get the rest if it looks like a package qualifier */
+
if (*s == '\'' || *s == ':')
s = scan_word(s, tokenbuf + len, TRUE, &len);
- if (expect == XBLOCK) { /* special case: start of statement */
+
+ /* Do special processing at start of statement. */
+
+ if (expect == XSTATE) {
while (isSPACE(*s)) s++;
- if (*s == ':') {
+ if (*s == ':') { /* It's a label. */
yylval.pval = savestr(tokenbuf);
s++;
CLINE;
curcop->cop_line++;
}
else
- no_op("Bare word");
+ no_op("Bare word",s);
}
+
+ /* Look for a subroutine with this name in current package. */
+
gv = gv_fetchpv(tokenbuf,FALSE);
- if (gv && GvCV(gv)) {
- nextval[nexttoke].opval =
- (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
- nextval[nexttoke].opval->op_private = OPpCONST_BARE;
- s = skipspace(s);
- if (*s == '(') {
- expect = XTERM;
- force_next(WORD);
- TOKEN('&');
- }
- else {
- last_lop = oldbufptr;
- expect = XBLOCK;
- force_next(WORD);
- TOKEN(NOAMP);
- }
- }
- expect = XOPERATOR;
+
+ /* See if it's the indirect object for a list operator. */
+
if (oldoldbufptr && oldoldbufptr < bufptr) {
- if (oldoldbufptr == last_lop) {
+ if (oldoldbufptr == last_lop &&
+ (!gv || !GvCV(gv) || last_lop_op == OP_SORT))
+ {
expect = XTERM;
CLINE;
yylval.opval = (OP*)newSVOP(OP_CONST, 0,
TOKEN(WORD);
}
}
- while (s < bufend && isSPACE(*s))
- s++;
+
+ /* If followed by a paren, it's certainly a subroutine. */
+
+ expect = XOPERATOR;
+ s = skipspace(s);
if (*s == '(') {
CLINE;
nextval[nexttoke].opval =
yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
yylval.opval->op_private = OPpCONST_BARE;
- if (*s == '$' || *s == '{') {
+ /* If followed by var or block, call it a method (maybe). */
+
+ if ((*s == '$' || *s == '{') && (!gv || !GvCV(gv))) {
last_lop = oldbufptr;
+ last_lop_op = OP_METHOD;
PREBLOCK(METHOD);
}
+ /* If followed by a bareword, see if it looks like indir obj. */
+
if (isALPHA(*s)) {
char *olds = s;
char tmpbuf[1024];
+ GV* indirgv;
s = scan_word(s, tmpbuf, TRUE, &len);
if (!keyword(tmpbuf, len)) {
- gv = gv_fetchpv(tmpbuf,FALSE);
- if (!gv || !GvCV(gv)) {
- nextval[nexttoke].opval =
- (OP*)newSVOP(OP_CONST, 0, newSVpv(tmpbuf,0));
- nextval[nexttoke].opval->op_private = OPpCONST_BARE;
- expect = XBLOCK;
- force_next(WORD);
- TOKEN(METHOD);
+ SV* tmpsv = newSVpv(tmpbuf,0);
+ indirgv = gv_fetchpv(tmpbuf,FALSE);
+ if (!indirgv || !GvCV(indirgv)) {
+ if (!gv || !GvCV(gv) || fetch_stash(tmpsv, FALSE)) {
+ nextval[nexttoke].opval =
+ (OP*)newSVOP(OP_CONST, 0, tmpsv);
+ nextval[nexttoke].opval->op_private =
+ OPpCONST_BARE;
+ expect = XTERM;
+ force_next(WORD);
+ TOKEN(METHOD);
+ }
}
+ SvREFCNT_dec(tmpsv);
}
s = olds;
}
+ /* Not a method, so call it a subroutine (if defined) */
+
+ if (gv && GvCV(gv)) {
+ nextval[nexttoke].opval = yylval.opval;
+ if (*s == '(') {
+ expect = XTERM;
+ force_next(WORD);
+ TOKEN('&');
+ }
+ last_lop = oldbufptr;
+ last_lop_op = OP_ENTERSUBR;
+ expect = XTERM;
+ force_next(WORD);
+ TOKEN(NOAMP);
+ }
+
+ /* Call it a bare word */
+
for (d = tokenbuf; *d && isLOWER(*d); d++) ;
if (dowarn && !*d)
warn(warn_reserved, tokenbuf);
SvMULTI_on(gv);
if (!GvIO(gv))
GvIO(gv) = newIO();
- GvIO(gv)->ifp = rsfp;
+ IoIFP(GvIO(gv)) = rsfp;
#if defined(HAS_FCNTL) && defined(FFt_SETFD)
fd = fileno(rsfp);
fcntl(fd,FFt_SETFD,fd >= 3);
#endif
if (preprocess)
- GvIO(gv)->type = '|';
+ IoTYPE(GvIO(gv)) = '|';
else if ((FILE*)rsfp == stdin)
- GvIO(gv)->type = '-';
+ IoTYPE(GvIO(gv)) = '-';
else
- GvIO(gv)->type = '<';
+ IoTYPE(GvIO(gv)) = '<';
rsfp = Nullfp;
}
goto fake_eof;
}
+ case KEY_AUTOLOAD:
case KEY_DESTROY:
case KEY_BEGIN:
case KEY_END:
s = skipspace(s);
- if (expect == XBLOCK && (minus_p || minus_n || *s == '{' )) {
+ if (expect == XSTATE && (minus_p || minus_n || *s == '{' )) {
s = bufptr;
goto really_sub;
}
case KEY_chmod:
s = skipspace(s);
if (dowarn && *s != '0' && isDIGIT(*s))
- warn("chmod: mode argument is missing initial 0");
+ yywarn("chmod: mode argument is missing initial 0");
LOP(OP_CHMOD);
case KEY_chown:
UNI(OP_DBMCLOSE);
case KEY_dump:
+ s = force_word(s,WORD,TRUE,FALSE);
LOOPX(OP_DUMP);
case KEY_else:
LOP(OP_GREPSTART);
case KEY_goto:
+ s = force_word(s,WORD,TRUE,FALSE);
LOOPX(OP_GOTO);
case KEY_gmtime:
case KEY_q:
s = scan_str(s);
if (!s)
- croak("EOF in string");
+ missingterm(0);
yylval.ival = OP_CONST;
TERM(sublex_start());
+ case KEY_qw:
+ s = scan_str(s);
+ if (!s)
+ missingterm(0);
+ force_next(')');
+ nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, q(lex_stuff));
+ lex_stuff = Nullsv;
+ force_next(THING);
+ force_next(',');
+ nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(" ",1));
+ force_next(THING);
+ force_next('(');
+ LOP(OP_SPLIT);
+
case KEY_qq:
s = scan_str(s);
if (!s)
- croak("EOF in string");
+ missingterm(0);
yylval.ival = OP_SCALAR;
if (SvIVX(lex_stuff) == '\'')
SvIVX(lex_stuff) = 0; /* qq'$foo' should intepolate */
case KEY_qx:
s = scan_str(s);
if (!s)
- croak("EOF in string");
+ missingterm(0);
yylval.ival = OP_BACKTICK;
set_csh();
TERM(sublex_start());
OLDLOP(OP_RETURN);
case KEY_require:
+ s = force_word(s,WORD,TRUE,FALSE);
UNI(OP_REQUIRE);
case KEY_reset:
case KEY_format:
case KEY_sub:
really_sub:
- yylval.ival = savestack_ix; /* restore stuff on reduce */
- save_I32(&subline);
- save_item(subname);
- SAVEINT(padix);
- SAVESPTR(curpad);
- SAVESPTR(comppad);
- SAVESPTR(comppadname);
- SAVEINT(comppadnamefill);
- comppad = newAV();
- comppadname = newAV();
- comppadnamefill = -1;
- av_push(comppad, Nullsv);
- curpad = AvARRAY(comppad);
- padix = 0;
-
- subline = curcop->cop_line;
+ yylval.ival = start_subparse();
s = skipspace(s);
if (tmp == KEY_format)
expect = XTERM;
sv_setpv(subname, tmpbuf);
else {
sv_setsv(subname,curstname);
- sv_catpvn(subname,"'",1);
+ sv_catpvn(subname,"::",2);
sv_catpvn(subname,tmpbuf,len);
}
s = force_word(s,WORD,FALSE,TRUE);
if (strEQ(d,"__END__")) return KEY___END__;
}
break;
+ case 'A':
+ if (strEQ(d,"AUTOLOAD")) return KEY_AUTOLOAD;
+ break;
case 'a':
switch (len) {
case 3:
if (len <= 2) {
if (strEQ(d,"q")) return KEY_q;
if (strEQ(d,"qq")) return KEY_qq;
+ if (strEQ(d,"qw")) return KEY_qw;
if (strEQ(d,"qx")) return KEY_qx;
}
break;
return 0;
}
-void
+static void
checkcomma(s,name,what)
register char *s;
char *name;
}
}
-char *
+static char *
scan_word(s, dest, allow_package, slp)
register char *s;
char *dest;
}
}
-char *
+static char *
scan_ident(s,send,dest,ck_uni)
register char *s;
register char *send;
return s;
}
if (isSPACE(*s) ||
- (*s == '$' && (isALPHA(s[1]) || s[1] == '$' || s[1] == '_')))
- return s;
+ (*s == '$' && s[1] && (isALPHA(s[1]) || strchr("$_{", s[1]))))
+ return s;
if (*s == '{') {
bracket = s;
s++;
*d = *s++;
d[1] = '\0';
if (*d == '^' && (isUPPER(*s) || strchr("[\\]^_?", *s))) {
- if (*s == 'D')
- debug |= 32768;
*d = *s++ ^ 64;
}
if (bracket) {
}
}
if (d == t) {
- sv_free(tmpstr);
+ SvREFCNT_dec(tmpstr);
return;
}
*d = '\0';
pm->op_pmslen = d - t;
}
-char *
+static char *
scan_pat(start)
char *start;
{
s = scan_str(start);
if (!s) {
if (lex_stuff)
- sv_free(lex_stuff);
+ SvREFCNT_dec(lex_stuff);
lex_stuff = Nullsv;
croak("Search pattern not terminated");
}
return s;
}
-char *
+static char *
scan_subst(start)
char *start;
{
if (!s) {
if (lex_stuff)
- sv_free(lex_stuff);
+ SvREFCNT_dec(lex_stuff);
lex_stuff = Nullsv;
croak("Substitution pattern not terminated");
}
s = scan_str(s);
if (!s) {
if (lex_stuff)
- sv_free(lex_stuff);
+ SvREFCNT_dec(lex_stuff);
lex_stuff = Nullsv;
if (lex_repl)
- sv_free(lex_repl);
+ SvREFCNT_dec(lex_repl);
lex_repl = Nullsv;
croak("Substitution replacement not terminated");
}
sv_catsv(repl, lex_repl);
sv_catpvn(repl, " };", 2);
SvCOMPILED_on(repl);
- sv_free(lex_repl);
+ SvREFCNT_dec(lex_repl);
lex_repl = repl;
}
pm->op_pmflags |= PMf_SCANFIRST;
else if (pm->op_pmflags & PMf_FOLD)
return;
- pm->op_pmshort = sv_ref(pm->op_pmregexp->regstart);
+ pm->op_pmshort = SvREFCNT_inc(pm->op_pmregexp->regstart);
}
else if (pm->op_pmregexp->regmust) {/* is there a better short-circuit? */
if (pm->op_pmshort &&
sv_eq(pm->op_pmshort,pm->op_pmregexp->regmust))
{
if (pm->op_pmflags & PMf_SCANFIRST) {
- sv_free(pm->op_pmshort);
+ SvREFCNT_dec(pm->op_pmshort);
pm->op_pmshort = Nullsv;
}
else {
- sv_free(pm->op_pmregexp->regmust);
+ SvREFCNT_dec(pm->op_pmregexp->regmust);
pm->op_pmregexp->regmust = Nullsv;
return;
}
if (!pm->op_pmshort || /* promote the better string */
((pm->op_pmflags & PMf_SCANFIRST) &&
(SvCUR(pm->op_pmshort) < SvCUR(pm->op_pmregexp->regmust)) )){
- sv_free(pm->op_pmshort); /* ok if null */
+ SvREFCNT_dec(pm->op_pmshort); /* ok if null */
pm->op_pmshort = pm->op_pmregexp->regmust;
pm->op_pmregexp->regmust = Nullsv;
pm->op_pmflags |= PMf_SCANFIRST;
}
}
-char *
+static char *
scan_trans(start)
char *start;
{
s = scan_str(s);
if (!s) {
if (lex_stuff)
- sv_free(lex_stuff);
+ SvREFCNT_dec(lex_stuff);
lex_stuff = Nullsv;
croak("Translation pattern not terminated");
}
s = scan_str(s);
if (!s) {
if (lex_stuff)
- sv_free(lex_stuff);
+ SvREFCNT_dec(lex_stuff);
lex_stuff = Nullsv;
if (lex_repl)
- sv_free(lex_repl);
+ SvREFCNT_dec(lex_repl);
lex_repl = Nullsv;
croak("Translation replacement not terminated");
}
return s;
}
-char *
+static char *
scan_heredoc(s)
register char *s;
{
}
if (s >= bufend) {
curcop->cop_line = multi_start;
- croak("EOF in string");
+ missingterm(tokenbuf);
}
sv_setpvn(tmpstr,d+1,s-d);
s += len - 1;
if (!rsfp ||
!(oldoldbufptr = oldbufptr = s = sv_gets(linestr, rsfp, 0))) {
curcop->cop_line = multi_start;
- croak("EOF in string");
+ missingterm(tokenbuf);
}
curcop->cop_line++;
- if (perldb) {
+ if (perldb && curstash != debstash) {
SV *sv = NEWSV(88,0);
sv_upgrade(sv, SVt_PVMG);
SvLEN_set(tmpstr, SvCUR(tmpstr) + 1);
Renew(SvPVX(tmpstr), SvLEN(tmpstr), char);
}
- sv_free(herewas);
+ SvREFCNT_dec(herewas);
lex_stuff = tmpstr;
yylval.ival = op_type;
return s;
}
-char *
+static char *
scan_inputsymbol(start)
char *start;
{
io = GvIOn(gv);
if (strEQ(d,"ARGV")) {
GvAVn(gv);
- io->flags |= IOf_ARGV|IOf_START;
+ IoFLAGS(io) |= IOf_ARGV|IOf_START;
}
lex_op = (OP*)newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, gv));
yylval.ival = OP_NULL;
return s;
}
-char *
+static char *
scan_str(start)
char *start;
{
return Nullch;
}
curcop->cop_line++;
- if (perldb) {
+ if (perldb && curstash != debstash) {
SV *sv = NEWSV(88,0);
sv_upgrade(sv, SVt_PVMG);
while (isDIGIT(*s) || *s == '_') {
if (*s == '_') {
if (dowarn && lastub && s - lastub != 3)
- warn("Misplaced _");
+ warn("Misplaced _ in number");
lastub = ++s;
}
else
*d++ = *s++;
}
if (dowarn && lastub && s - lastub != 3)
- warn("Misplaced _");
+ warn("Misplaced _ in number");
if (*s == '.' && s[1] != '.') {
floatit = TRUE;
*d++ = *s++;
return s;
}
-char *
+static char *
scan_formline(s)
register char *s;
{
force_next(LSTOP);
}
else {
- sv_free(stuff);
+ SvREFCNT_dec(stuff);
in_format = 0;
bufptr = s;
}
}
int
+start_subparse()
+{
+ int oldsavestack_ix = savestack_ix;
+
+ save_I32(&subline);
+ save_item(subname);
+ SAVEINT(padix);
+ SAVESPTR(curpad);
+ SAVESPTR(comppad);
+ SAVESPTR(comppad_name);
+ SAVEINT(comppad_name_fill);
+ SAVEINT(min_intro_pending);
+ SAVEINT(max_intro_pending);
+ comppad = newAV();
+ comppad_name = newAV();
+ comppad_name_fill = 0;
+ min_intro_pending = 0;
+ av_push(comppad, Nullsv);
+ curpad = AvARRAY(comppad);
+ padix = 0;
+
+ subline = curcop->cop_line;
+ return oldsavestack_ix;
+}
+
+int
+yywarn(s)
+char *s;
+{
+ --error_count;
+ return yyerror(s);
+}
+
+int
yyerror(s)
char *s;
{
projects / p5sagit/p5-mst-13.2.git / blobdiff