-/* $Header: toke.c,v 3.0.1.2 89/11/11 05:04:42 lwall Locked $
+/* $Header: toke.c,v 3.0.1.7 90/03/27 16:32:37 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: toke.c,v $
+ * Revision 3.0.1.7 90/03/27 16:32:37 lwall
+ * patch16: MSDOS support
+ * patch16: formats didn't work inside eval
+ * patch16: final semicolon in program wasn't optional with -p or -n
+ *
+ * Revision 3.0.1.6 90/03/12 17:06:36 lwall
+ * patch13: last semicolon of program is now optional, just for Randal
+ * patch13: added splice operator: @oldelems = splice(@array,$offset,$len,LIST)
+ *
+ * Revision 3.0.1.5 90/02/28 18:47:06 lwall
+ * patch9: return grandfathered to never be function call
+ * patch9: non-existent perldb.pl now gives reasonable error message
+ * patch9: perl can now start up other interpreters scripts
+ * patch9: line numbers were bogus during certain portions of foreach evaluation
+ * patch9: null hereis core dumped
+ *
+ * Revision 3.0.1.4 89/12/21 20:26:56 lwall
+ * patch7: -d switch incompatible with -p or -n
+ * patch7: " ''$foo'' " didn't parse right
+ * patch7: grandfathered m'pat' and s'pat'repl' to not be package qualifiers
+ *
+ * Revision 3.0.1.3 89/11/17 15:43:15 lwall
+ * patch5: IBM PC/RT compiler can't deal with UNI() and LOP() macros
+ * patch5: } misadjusted expection of subsequent term or operator
+ * patch5: y/abcde// didn't work
+ *
* Revision 3.0.1.2 89/11/11 05:04:42 lwall
* patch2: fixed a CLINE macro conflict
*
#define LOP(f) return(*s == '(' || (s = skipspace(s), *s == '(') ? \
(*s = META('('), bufptr = oldbufptr, '(') : \
(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
+/* grandfather return to old style */
+#define OLDLOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP)
char *
skipspace(s)
return s;
}
+#ifdef CRIPPLED_CC
+
+#undef UNI
+#undef LOP
+#define UNI(f) return uni(f,s)
+#define LOP(f) return lop(f,s)
+
+int
+uni(f,s)
+int f;
+char *s;
+{
+ yylval.ival = f;
+ expectterm = TRUE;
+ bufptr = s;
+ if (*s == '(')
+ return FUNC1;
+ s = skipspace(s);
+ if (*s == '(')
+ return FUNC1;
+ else
+ return UNIOP;
+}
+
+int
+lop(f,s)
+int f;
+char *s;
+{
+ if (*s != '(')
+ s = skipspace(s);
+ if (*s == '(') {
+ *s = META('(');
+ bufptr = oldbufptr;
+ return '(';
+ }
+ else {
+ yylval.ival=f;
+ expectterm = TRUE;
+ bufptr = s;
+ return LISTOP;
+ }
+}
+
+#endif /* CRIPPLED_CC */
+
yylex()
{
register char *s = bufptr;
if (minus_n || minus_p || perldb) {
str_set(linestr,"");
if (perldb)
- str_cat(linestr,"do 'perldb.pl'; print $@;");
+ str_cat(linestr,
+"do 'perldb.pl' || die \"Can't find perldb.pl in @INC\"; print $@;");
if (minus_n || minus_p) {
str_cat(linestr,"line: while (<>) {");
if (minus_a)
}
}
if (in_format) {
+ bufptr = bufend;
yylval.formval = load_format();
in_format = FALSE;
oldoldbufptr = oldbufptr = s = str_get(linestr) + 1;
(void)fclose(rsfp);
rsfp = Nullfp;
if (minus_n || minus_p) {
- str_set(linestr,minus_p ? "}continue{print;" : "");
- str_cat(linestr,"}");
+ str_set(linestr,minus_p ? ";}continue{print" : "");
+ str_cat(linestr,";}");
oldoldbufptr = oldbufptr = s = str_get(linestr);
bufend = linestr->str_ptr + linestr->str_cur;
+ minus_n = minus_p = 0;
goto retry;
}
oldoldbufptr = oldbufptr = s = str_get(linestr);
str_set(linestr,"");
- RETURN(0);
+ RETURN(';'); /* not infinite loop because rsfp is NULL now */
}
oldoldbufptr = oldbufptr = bufptr = s;
if (perldb) {
}
#endif
bufend = linestr->str_ptr + linestr->str_cur;
- if (firstline) {
- while (s < bufend && isspace(*s))
- s++;
- if (*s == ':') /* for csh's that have to exec sh scripts */
- s++;
- firstline = FALSE;
+ if (line == 1) {
+ if (*s == '#' && s[1] == '!') {
+ if (!in_eval && !instr(s,"perl") && instr(origargv[0],"perl")) {
+ char **newargv;
+ char *cmd;
+
+ s += 2;
+ if (*s == ' ')
+ s++;
+ cmd = s;
+ while (s < bufend && !isspace(*s))
+ s++;
+ *s++ = '\0';
+ while (s < bufend && isspace(*s))
+ s++;
+ if (s < bufend) {
+ Newz(899,newargv,origargc+3,char*);
+ newargv[1] = s;
+ while (s < bufend && !isspace(*s))
+ s++;
+ *s = '\0';
+ Copy(origargv+1, newargv+2, origargc+1, char*);
+ }
+ else
+ newargv = origargv;
+ newargv[0] = cmd;
+ execv(cmd,newargv);
+ fatal("Can't exec %s", cmd);
+ }
+ }
+ else {
+ while (s < bufend && isspace(*s))
+ s++;
+ if (*s == ':') /* for csh's that have to exec sh scripts */
+ s++;
+ }
}
goto retry;
case ' ': case '\t': case '\f':
d = bufend;
while (s < d && *s != '\n')
s++;
- if (s < d) {
+ if (s < d)
s++;
- line++;
+ if (in_format) {
+ bufptr = s;
+ yylval.formval = load_format();
+ in_format = FALSE;
+ oldoldbufptr = oldbufptr = s = bufptr + 1;
+ TERM(FORMLIST);
}
+ line++;
}
else {
*s = '\0';
TERM(tmp);
case '}':
tmp = *s++;
- for (d = s; *d == ' ' || *d == '\t'; d++) ;
- if (*d == '\n' || *d == '#')
- OPERATOR(tmp); /* block end */
- else
- TERM(tmp); /* associative array end */
+ RETURN(tmp);
case '&':
s++;
tmp = *s++;
while (isascii(*s) && \
(isalpha(*s) || isdigit(*s) || *s == '_' || *s == '\'')) \
*d++ = *s++; \
- if (d[-1] == '\'') \
+ while (d[-1] == '\'') \
d--,s--; \
*d = '\0'; \
d = tokenbuf;
SNARFWORD;
if (strEQ(d,"bind"))
FOP2(O_BIND);
+ if (strEQ(d,"binmode"))
+ FOP(O_BINMODE);
break;
case 'c': case 'C':
SNARFWORD;
LFUN(O_CHOP);
if (strEQ(d,"continue"))
OPERATOR(CONTINUE);
- if (strEQ(d,"chdir"))
+ if (strEQ(d,"chdir")) {
+ (void)stabent("ENV",TRUE); /* may use HOME */
UNI(O_CHDIR);
+ }
if (strEQ(d,"close"))
FOP(O_CLOSE);
if (strEQ(d,"closedir"))
break;
case 'f': case 'F':
SNARFWORD;
- if (strEQ(d,"for"))
- OPERATOR(FOR);
- if (strEQ(d,"foreach"))
+ if (strEQ(d,"for") || strEQ(d,"foreach")) {
+ yylval.ival = line;
OPERATOR(FOR);
+ }
if (strEQ(d,"format")) {
d = bufend;
while (s < d && isspace(*s))
FOP(O_LSTAT);
break;
case 'm': case 'M':
- SNARFWORD;
+ if (s[1] == '\'') {
+ d = "m";
+ s++;
+ }
+ else {
+ SNARFWORD;
+ }
if (strEQ(d,"m")) {
s = scanpat(s-1);
if (yylval.arg)
FL2(O_PACK);
if (strEQ(d,"package"))
OPERATOR(PACKAGE);
+ if (strEQ(d,"pipe"))
+ FOP22(O_PIPE);
break;
case 'q': case 'Q':
SNARFWORD;
case 'r': case 'R':
SNARFWORD;
if (strEQ(d,"return"))
- LOP(O_RETURN);
+ OLDLOP(O_RETURN);
if (strEQ(d,"reset"))
UNI(O_RESET);
if (strEQ(d,"redo"))
UNI(O_READLINK);
break;
case 's': case 'S':
- SNARFWORD;
+ if (s[1] == '\'') {
+ d = "s";
+ s++;
+ }
+ else {
+ SNARFWORD;
+ }
if (strEQ(d,"s")) {
s = scansubst(s);
if (yylval.arg)
TERM(SPLIT);
if (strEQ(d,"sprintf"))
FL(O_SPRINTF);
+ if (strEQ(d,"splice")) {
+ yylval.ival = O_SPLICE;
+ OPERATOR(PUSH);
+ }
break;
case 'q':
if (strEQ(d,"sqrt"))
MOP(O_REPEAT);
break;
case 'y': case 'Y':
- SNARFWORD;
+ if (s[1] == '\'') {
+ d = "y";
+ s++;
+ }
+ else {
+ SNARFWORD;
+ }
if (strEQ(d,"y")) {
s = scantrans(s);
TERM(TRANS);
while (isalpha(*s) || isdigit(*s) || *s == '_' || *s == '\'')
*d++ = *s++;
}
- if (d > dest+1 && d[-1] == '\'')
+ while (d > dest+1 && d[-1] == '\'')
d--,s--;
*d = '\0';
d = dest;
tmpstr = spat->spat_repl[1].arg_ptr.arg_str;
e = tmpstr->str_ptr + tmpstr->str_cur;
for (t = tmpstr->str_ptr; t < e; t++) {
- if (*t == '$' && t[1] && index("`'&+0123456789",t[1]))
+ if (*t == '$' && t[1] && (index("`'&+0123456789",t[1]) ||
+ (t[1] == '{' /*}*/ && isdigit(t[2])) ))
spat->spat_flags &= ~SPAT_CONST;
}
}
yylval.arg = arg;
if (!*r) {
Safefree(r);
- r = t;
+ r = t; rlen = tlen;
}
for (i = 0, j = 0; i < tlen; i++,j++) {
if (j >= rlen)
out:
(void)sprintf(tokenbuf,"%ld",i);
arg[1].arg_ptr.arg_str = str_make(tokenbuf,strlen(tokenbuf));
+#ifdef MICROPORT /* Microport 2.4 hack */
+ { double zz = str_2num(arg[1].arg_ptr.arg_str); }
+#else
(void)str_2num(arg[1].arg_ptr.arg_str);
+#endif /* Microport 2.4 hack */
}
break;
case '1': case '2': case '3': case '4': case '5':
}
*d = '\0';
arg[1].arg_ptr.arg_str = str_make(tokenbuf, d - tokenbuf);
+#ifdef MICROPORT /* Microport 2.4 hack */
+ { double zz = str_2num(arg[1].arg_ptr.arg_str); }
+#else
(void)str_2num(arg[1].arg_ptr.arg_str);
+#endif /* Microport 2.4 hack */
break;
case '<':
if (*++s == '<') {
term = tmps[5];
multi_close = term;
}
- tmpstr = Str_new(87,0);
+ tmpstr = Str_new(87,80);
if (hereis) {
term = *tokenbuf;
if (!rsfp) {
if ((*s == '$' && s+1 < send &&
(alwaysdollar || /*(*/ (s[1] != ')' && s[1] != '|')) ) ||
(*s == '@' && s+1 < send) ) {
- len = scanreg(s,bufend,tokenbuf) - s;
+ len = scanreg(s,send,tokenbuf) - s;
if (*s == '$' || strEQ(tokenbuf,"ARGV")
|| strEQ(tokenbuf,"ENV")
|| strEQ(tokenbuf,"SIG")
{
FCMD froot;
FCMD *flinebeg;
+ char *eol;
register FCMD *fprev = &froot;
register FCMD *fcmd;
register char *s;
bool repeater;
Zero(&froot, 1, FCMD);
- while ((s = str_gets(linestr,rsfp, 0)) != Nullch) {
+ s = bufptr;
+ while (s < bufend || (s = str_gets(linestr,rsfp, 0)) != Nullch) {
line++;
if (perldb) {
STR *tmpstr = Str_new(89,0);
str_sset(tmpstr,linestr);
astore(lineary,(int)line,tmpstr);
}
- bufend = linestr->str_ptr + linestr->str_cur;
- if (strEQ(s,".\n")) {
+ if (in_eval && !rsfp) {
+ eol = index(s,'\n');
+ if (!eol++)
+ eol = bufend;
+ }
+ else
+ eol = bufend = linestr->str_ptr + linestr->str_cur;
+ if (strnEQ(s,".\n",2)) {
bufptr = s;
return froot.f_next;
}
- if (*s == '#')
+ if (*s == '#') {
+ s = eol;
continue;
+ }
flinebeg = Nullfcmd;
noblank = FALSE;
repeater = FALSE;
- while (s < bufend) {
+ while (s < eol) {
Newz(804,fcmd,1,FCMD);
fprev->f_next = fcmd;
fprev = fcmd;
- for (t=s; t < bufend && *t != '@' && *t != '^'; t++) {
+ for (t=s; t < eol && *t != '@' && *t != '^'; t++) {
if (*t == '~') {
noblank = TRUE;
*t = ' ';
fcmd->f_pre = nsavestr(s, t-s);
fcmd->f_presize = t-s;
s = t;
- if (s >= bufend) {
+ if (s >= eol) {
if (noblank)
fcmd->f_flags |= FC_NOBLANK;
if (repeater)
}
if (flinebeg) {
again:
- if ((s = str_gets(linestr, rsfp, 0)) == Nullch)
+ if (s >= bufend && (s = str_gets(linestr, rsfp, 0)) == Nullch)
goto badform;
line++;
if (perldb) {
str_sset(tmpstr,linestr);
astore(lineary,(int)line,tmpstr);
}
- if (strEQ(s,".\n")) {
+ if (in_eval && !rsfp) {
+ eol = index(s,'\n');
+ if (!eol++)
+ eol = bufend;
+ }
+ else
+ eol = bufend = linestr->str_ptr + linestr->str_cur;
+ if (strnEQ(s,".\n",2)) {
bufptr = s;
yyerror("Missing values line");
return froot.f_next;
}
- if (*s == '#')
+ if (*s == '#') {
+ s = eol;
goto again;
- bufend = linestr->str_ptr + linestr->str_cur;
- str = flinebeg->f_unparsed = Str_new(91,bufend - bufptr);
+ }
+ str = flinebeg->f_unparsed = Str_new(91,eol - s);
str->str_u.str_hash = curstash;
str_nset(str,"(",1);
flinebeg->f_line = line;
- if (!flinebeg->f_next->f_type || index(linestr->str_ptr, ',')) {
- str_scat(str,linestr);
+ eol[-1] = '\0';
+ if (!flinebeg->f_next->f_type || index(s, ',')) {
+ eol[-1] = '\n';
+ str_ncat(str, s, eol - s - 1);
str_ncat(str,",$$);",5);
+ s = eol;
}
else {
- while (s < bufend && isspace(*s))
+ eol[-1] = '\n';
+ while (s < eol && isspace(*s))
s++;
t = s;
- while (s < bufend) {
+ while (s < eol) {
switch (*s) {
case ' ': case '\t': case '\n': case ';':
str_ncat(str, t, s - t);
str_ncat(str, "," ,1);
- while (s < bufend && (isspace(*s) || *s == ';'))
+ while (s < eol && (isspace(*s) || *s == ';'))
s++;
t = s;
break;
case '$':
str_ncat(str, t, s - t);
t = s;
- s = scanreg(s,bufend,tokenbuf);
+ s = scanreg(s,eol,tokenbuf);
str_ncat(str, t, s - t);
t = s;
- if (s < bufend && *s && index("$'\"",*s))
+ if (s < eol && *s && index("$'\"",*s))
str_ncat(str, ",", 1);
break;
case '"': case '\'':
str_ncat(str, t, s - t);
t = s;
s++;
- while (s < bufend && (*s != *t || s[-1] == '\\'))
+ while (s < eol && (*s != *t || s[-1] == '\\'))
s++;
- if (s < bufend)
+ if (s < eol)
s++;
str_ncat(str, t, s - t);
t = s;
- if (s < bufend && *s && index("$'\"",*s))
+ if (s < eol && *s && index("$'\"",*s))
str_ncat(str, ",", 1);
break;
default:
projects / p5sagit/p5-mst-13.2.git / blobdiff