toke.c

   1 /* $RCSfile: toke.c,v $$Revision: 4.0.1.6 $$Date: 92/06/08 16:03:49 $
   2  *
   3  *    Copyright (c) 1991, Larry Wall
   4  *
   5  *    You may distribute under the terms of either the GNU General Public
   6  *    License or the Artistic License, as specified in the README file.
   7  *
   8  * $Log:        toke.c,v $
   9  * Revision 4.0.1.6  92/06/08  16:03:49  lwall
  10  * patch20: an EXPR may now start with a bareword
  11  * patch20: print $fh EXPR can now expect term rather than operator in EXPR
  12  * patch20: added ... as variant on ..
  13  * patch20: new warning on spurious backslash
  14  * patch20: new warning on missing $ for foreach variable
  15  * patch20: "foo"x1024 now legal without space after x
  16  * patch20: new warning on print accidentally used as function
  17  * patch20: tr/stuff// wasn't working right
  18  * patch20: 2. now eats the dot
  19  * patch20: <@ARGV> now notices @ARGV
  20  * patch20: tr/// now lets you say \-
  21  *
  22  * Revision 4.0.1.5  91/11/11  16:45:51  lwall
  23  * patch19: default arg for shift was wrong after first subroutine definition
  24  *
  25  * Revision 4.0.1.4  91/11/05  19:02:48  lwall
  26  * patch11: \x and \c were subject to double interpretation in regexps
  27  * patch11: prepared for ctype implementations that don't define isascii()
  28  * patch11: nested list operators could miscount parens
  29  * patch11: once-thru blocks didn't display right in the debugger
  30  * patch11: sort eval "whatever" didn't work
  31  * patch11: underscore is now allowed within literal octal and hex numbers
  32  *
  33  * Revision 4.0.1.3  91/06/10  01:32:26  lwall
  34  * patch10: m'$foo' now treats string as single quoted
  35  * patch10: certain pattern optimizations were botched
  36  *
  37  * Revision 4.0.1.2  91/06/07  12:05:56  lwall
  38  * patch4: new copyright notice
  39  * patch4: debugger lost track of lines in eval
  40  * patch4: //o and s///o now optimize themselves fully at runtime
  41  * patch4: added global modifier for pattern matches
  42  *
  43  * Revision 4.0.1.1  91/04/12  09:18:18  lwall
  44  * patch1: perl -de "print" wouldn't stop at the first statement
  45  *
  46  * Revision 4.0  91/03/20  01:42:14  lwall
  47  * 4.0 baseline.
  48  *
  49  */
  50
  51 #include "EXTERN.h"
  52 #include "perl.h"
  53 #include "perly.h"
  54
  55 static void set_csh();
  56
  57 #ifdef I_FCNTL
  58 #include <fcntl.h>
  59 #endif
  60 #ifdef I_SYS_FILE
  61 #include <sys/file.h>
  62 #endif
  63
  64 #ifdef f_next
  65 #undef f_next
  66 #endif
  67
  68 /* which backslash sequences to keep in m// or s// */
  69
  70 static char *patleave = "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}";
  71
  72 char *reparse;          /* if non-null, scanident found ${foo[$bar]} */
  73
  74 void checkcomma();
  75
  76 #ifdef CLINE
  77 #undef CLINE
  78 #endif
  79 #define CLINE (cmdline = (curcmd->c_line < cmdline ? curcmd->c_line : cmdline))
  80
  81 #ifdef atarist
  82 #define PERL_META(c) ((c) | 128)
  83 #else
  84 #define META(c) ((c) | 128)
  85 #endif
  86
  87 #define RETURN(retval) return (bufptr = s,(int)retval)
  88 #define OPERATOR(retval) return (expectterm = TRUE,bufptr = s,(int)retval)
  89 #define TERM(retval) return (CLINE, expectterm = FALSE,bufptr = s,(int)retval)
  90 #define LOOPX(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)LOOPEX)
  91 #define FTST(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)FILETEST)
  92 #define FUN0(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC0)
  93 #define FUN1(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC1)
  94 #define FUN2(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2)
  95 #define FUN2x(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2x)
  96 #define FUN3(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC3)
  97 #define FUN4(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC4)
  98 #define FUN5(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC5)
  99 #define FL(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST)
 100 #define FL2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST2)
 101 #define HFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)HSHFUN)
 102 #define HFUN3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)HSHFUN3)
 103 #define LFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LVALFUN)
 104 #define AOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)ADDOP)
 105 #define MOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)MULOP)
 106 #define EOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)EQOP)
 107 #define ROP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)RELOP)
 108 #define FOP(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP)
 109 #define FOP2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP2)
 110 #define FOP3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP3)
 111 #define FOP4(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP4)
 112 #define FOP22(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP22)
 113 #define FOP25(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP25)
 114
 115 static char *last_uni;
 116
 117 /* This bit of chicanery makes a unary function followed by
 118  * a parenthesis into a function with one argument, highest precedence.
 119  */
 120 #define UNI(f) return(yylval.ival = f, \
 121         expectterm = TRUE, \
 122         bufptr = s, \
 123         last_uni = oldbufptr, \
 124         (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
 125
 126 /* This does similarly for list operators, merely by pretending that the
 127  * paren came before the listop rather than after.
 128  */
 129 #ifdef atarist
 130 #define LOP(f) return(CLINE, *s == '(' || (s = skipspace(s), *s == '(') ? \
 131         (*s = (char) PERL_META('('), bufptr = oldbufptr, '(') : \
 132         (yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
 133 #else
 134 #define LOP(f) return(CLINE, *s == '(' || (s = skipspace(s), *s == '(') ? \
 135         (*s = (char) META('('), bufptr = oldbufptr, '(') : \
 136         (yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
 137 #endif
 138 /* grandfather return to old style */
 139 #define OLDLOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP)
 140
 141 char *
 142 skipspace(s)
 143 register char *s;
 144 {
 145     while (s < bufend && isSPACE(*s))
 146         s++;
 147     return s;
 148 }
 149
 150 void
 151 check_uni() {
 152     char *s;
 153     char ch;
 154
 155     if (oldoldbufptr != last_uni)
 156         return;
 157     while (isSPACE(*last_uni))
 158         last_uni++;
 159     for (s = last_uni; isALNUM(*s); s++) ;
 160     ch = *s;
 161     *s = '\0';
 162     warn("Warning: Use of \"%s\" without parens is ambiguous", last_uni);
 163     *s = ch;
 164 }
 165
 166 #ifdef CRIPPLED_CC
 167
 168 #undef UNI
 169 #undef LOP
 170 #define UNI(f) return uni(f,s)
 171 #define LOP(f) return lop(f,s)
 172
 173 int
 174 uni(f,s)
 175 int f;
 176 char *s;
 177 {
 178     yylval.ival = f;
 179     expectterm = TRUE;
 180     bufptr = s;
 181     last_uni = oldbufptr;
 182     if (*s == '(')
 183         return FUNC1;
 184     s = skipspace(s);
 185     if (*s == '(')
 186         return FUNC1;
 187     else
 188         return UNIOP;
 189 }
 190
 191 int
 192 lop(f,s)
 193 int f;
 194 char *s;
 195 {
 196     CLINE;
 197     if (*s != '(')
 198         s = skipspace(s);
 199     if (*s == '(') {
 200 #ifdef atarist
 201         *s = PERL_META('(');
 202 #else
 203         *s = META('(');
 204 #endif
 205         bufptr = oldbufptr;
 206         return '(';
 207     }
 208     else {
 209         yylval.ival=f;
 210         expectterm = TRUE;
 211         bufptr = s;
 212         return LISTOP;
 213     }
 214 }
 215
 216 #endif /* CRIPPLED_CC */
 217
 218 int
 219 yylex()
 220 {
 221     register char *s = bufptr;
 222     register char *d;
 223     register int tmp;
 224     static bool in_format = FALSE;
 225     static bool firstline = TRUE;
 226     extern int yychar;          /* last token */
 227
 228     oldoldbufptr = oldbufptr;
 229     oldbufptr = s;
 230
 231   retry:
 232 #ifdef YYDEBUG
 233     if (debug & 1)
 234         if (index(s,'\n'))
 235             fprintf(stderr,"Tokener at %s",s);
 236         else
 237             fprintf(stderr,"Tokener at %s\n",s);
 238 #endif
 239 #ifdef BADSWITCH
 240     if (*s & 128) {
 241         if ((*s & 127) == '(') {
 242             *s++ = '(';
 243             oldbufptr = s;
 244         }
 245         else if ((*s & 127) == '}') {
 246             *s++ = '}';
 247             RETURN('}');
 248         }
 249         else
 250             warn("Unrecognized character \\%03o ignored", *s++ & 255);
 251         goto retry;
 252     }
 253 #endif
 254     switch (*s) {
 255     default:
 256         if ((*s & 127) == '(') {
 257             *s++ = '(';
 258             oldbufptr = s;
 259         }
 260         else if ((*s & 127) == '}') {
 261             *s++ = '}';
 262             RETURN('}');
 263         }
 264         else
 265             warn("Unrecognized character \\%03o ignored", *s++ & 255);
 266         goto retry;
 267     case 4:
 268     case 26:
 269         goto fake_eof;                  /* emulate EOF on ^D or ^Z */
 270     case 0:
 271         if (!rsfp)
 272             RETURN(0);
 273         if (s++ < bufend)
 274             goto retry;                 /* ignore stray nulls */
 275         last_uni = 0;
 276         if (firstline) {
 277             firstline = FALSE;
 278             if (minus_n || minus_p || perldb) {
 279                 str_set(linestr,"");
 280                 if (perldb) {
 281                     char *getenv();
 282                     char *pdb = getenv("PERLDB");
 283
 284                     str_cat(linestr, pdb ? pdb : "require 'perldb.pl'");
 285                     str_cat(linestr, ";");
 286                 }
 287                 if (minus_n || minus_p) {
 288                     str_cat(linestr,"line: while (<>) {");
 289                     if (minus_l)
 290                         str_cat(linestr,"chop;");
 291                     if (minus_a)
 292                         str_cat(linestr,"@F=split(' ');");
 293                 }
 294                 oldoldbufptr = oldbufptr = s = str_get(linestr);
 295                 bufend = linestr->str_ptr + linestr->str_cur;
 296                 goto retry;
 297             }
 298         }
 299         if (in_format) {
 300             bufptr = bufend;
 301             yylval.formval = load_format();
 302             in_format = FALSE;
 303             oldoldbufptr = oldbufptr = s = str_get(linestr) + 1;
 304             bufend = linestr->str_ptr + linestr->str_cur;
 305             OPERATOR(FORMLIST);
 306         }
 307         curcmd->c_line++;
 308 #ifdef CRYPTSCRIPT
 309         cryptswitch();
 310 #endif /* CRYPTSCRIPT */
 311         do {
 312             if ((s = str_gets(linestr, rsfp, 0)) == Nullch) {
 313               fake_eof:
 314                 if (rsfp) {
 315                     if (preprocess)
 316                         (void)mypclose(rsfp);
 317                     else if ((FILE*)rsfp == stdin)
 318                         clearerr(stdin);
 319                     else
 320                         (void)fclose(rsfp);
 321                     rsfp = Nullfp;
 322                 }
 323                 if (minus_n || minus_p) {
 324                     str_set(linestr,minus_p ? ";}continue{print" : "");
 325                     str_cat(linestr,";}");
 326                     oldoldbufptr = oldbufptr = s = str_get(linestr);
 327                     bufend = linestr->str_ptr + linestr->str_cur;
 328                     minus_n = minus_p = 0;
 329                     goto retry;
 330                 }
 331                 oldoldbufptr = oldbufptr = s = str_get(linestr);
 332                 str_set(linestr,"");
 333                 RETURN(';');    /* not infinite loop because rsfp is NULL now */
 334             }
 335             if (doextract && *linestr->str_ptr == '#')
 336                 doextract = FALSE;
 337         } while (doextract);
 338         oldoldbufptr = oldbufptr = bufptr = s;
 339         if (perldb) {
 340             STR *str = Str_new(85,0);
 341
 342             str_sset(str,linestr);
 343             astore(stab_xarray(curcmd->c_filestab),(int)curcmd->c_line,str);
 344         }
 345 #ifdef DEBUG
 346         if (firstline) {
 347             char *showinput();
 348             s = showinput();
 349         }
 350 #endif
 351         bufend = linestr->str_ptr + linestr->str_cur;
 352         if (curcmd->c_line == 1) {
 353             if (*s == '#' && s[1] == '!') {
 354                 if (!in_eval && !instr(s,"perl") && instr(origargv[0],"perl")) {
 355                     char **newargv;
 356                     char *cmd;
 357
 358                     s += 2;
 359                     if (*s == ' ')
 360                         s++;
 361                     cmd = s;
 362                     while (s < bufend && !isSPACE(*s))
 363                         s++;
 364                     *s++ = '\0';
 365                     while (s < bufend && isSPACE(*s))
 366                         s++;
 367                     if (s < bufend) {
 368                         Newz(899,newargv,origargc+3,char*);
 369                         newargv[1] = s;
 370                         while (s < bufend && !isSPACE(*s))
 371                             s++;
 372                         *s = '\0';
 373                         Copy(origargv+1, newargv+2, origargc+1, char*);
 374                     }
 375                     else
 376                         newargv = origargv;
 377                     newargv[0] = cmd;
 378                     execv(cmd,newargv);
 379                     fatal("Can't exec %s", cmd);
 380                 }
 381             }
 382             else {
 383                 while (s < bufend && isSPACE(*s))
 384                     s++;
 385                 if (*s == ':')  /* for csh's that have to exec sh scripts */
 386                     s++;
 387             }
 388         }
 389         goto retry;
 390     case ' ': case '\t': case '\f': case '\r': case 013:
 391         s++;
 392         goto retry;
 393     case '#':
 394         if (preprocess && s == str_get(linestr) &&
 395                s[1] == ' ' && (isDIGIT(s[2]) || strnEQ(s+2,"line ",5)) ) {
 396             while (*s && !isDIGIT(*s))
 397                 s++;
 398             curcmd->c_line = atoi(s)-1;
 399             while (isDIGIT(*s))
 400                 s++;
 401             d = bufend;
 402             while (s < d && isSPACE(*s)) s++;
 403             s[strlen(s)-1] = '\0';      /* wipe out newline */
 404             if (*s == '"') {
 405                 s++;
 406                 s[strlen(s)-1] = '\0';  /* wipe out trailing quote */
 407             }
 408             if (*s)
 409                 curcmd->c_filestab = fstab(s);
 410             else
 411                 curcmd->c_filestab = fstab(origfilename);
 412             oldoldbufptr = oldbufptr = s = str_get(linestr);
 413         }
 414         /* FALL THROUGH */
 415     case '\n':
 416         if (in_eval && !rsfp) {
 417             d = bufend;
 418             while (s < d && *s != '\n')
 419                 s++;
 420             if (s < d)
 421                 s++;
 422             if (in_format) {
 423                 bufptr = s;
 424                 yylval.formval = load_format();
 425                 in_format = FALSE;
 426                 oldoldbufptr = oldbufptr = s = bufptr + 1;
 427                 TERM(FORMLIST);
 428             }
 429             curcmd->c_line++;
 430         }
 431         else {
 432             *s = '\0';
 433             bufend = s;
 434         }
 435         goto retry;
 436     case '-':
 437         if (s[1] && isALPHA(s[1]) && !isALPHA(s[2])) {
 438             s++;
 439             switch (*s++) {
 440             case 'r': FTST(O_FTEREAD);
 441             case 'w': FTST(O_FTEWRITE);
 442             case 'x': FTST(O_FTEEXEC);
 443             case 'o': FTST(O_FTEOWNED);
 444             case 'R': FTST(O_FTRREAD);
 445             case 'W': FTST(O_FTRWRITE);
 446             case 'X': FTST(O_FTREXEC);
 447             case 'O': FTST(O_FTROWNED);
 448             case 'e': FTST(O_FTIS);
 449             case 'z': FTST(O_FTZERO);
 450             case 's': FTST(O_FTSIZE);
 451             case 'f': FTST(O_FTFILE);
 452             case 'd': FTST(O_FTDIR);
 453             case 'l': FTST(O_FTLINK);
 454             case 'p': FTST(O_FTPIPE);
 455             case 'S': FTST(O_FTSOCK);
 456             case 'u': FTST(O_FTSUID);
 457             case 'g': FTST(O_FTSGID);
 458             case 'k': FTST(O_FTSVTX);
 459             case 'b': FTST(O_FTBLK);
 460             case 'c': FTST(O_FTCHR);
 461             case 't': FTST(O_FTTTY);
 462             case 'T': FTST(O_FTTEXT);
 463             case 'B': FTST(O_FTBINARY);
 464             case 'M': stabent("\024",TRUE); FTST(O_FTMTIME);
 465             case 'A': stabent("\024",TRUE); FTST(O_FTATIME);
 466             case 'C': stabent("\024",TRUE); FTST(O_FTCTIME);
 467             default:
 468                 s -= 2;
 469                 break;
 470             }
 471         }
 472         tmp = *s++;
 473         if (*s == tmp) {
 474             s++;
 475             RETURN(DEC);
 476         }
 477         if (expectterm) {
 478             if (isSPACE(*s) || !isSPACE(*bufptr))
 479                 check_uni();
 480             OPERATOR('-');
 481         }
 482         else
 483             AOP(O_SUBTRACT);
 484     case '+':
 485         tmp = *s++;
 486         if (*s == tmp) {
 487             s++;
 488             RETURN(INC);
 489         }
 490         if (expectterm) {
 491             if (isSPACE(*s) || !isSPACE(*bufptr))
 492                 check_uni();
 493             OPERATOR('+');
 494         }
 495         else
 496             AOP(O_ADD);
 497
 498     case '*':
 499         if (expectterm) {
 500             check_uni();
 501             s = scanident(s,bufend,tokenbuf);
 502             yylval.stabval = stabent(tokenbuf,TRUE);
 503             TERM(STAR);
 504         }
 505         tmp = *s++;
 506         if (*s == tmp) {
 507             s++;
 508             OPERATOR(POW);
 509         }
 510         MOP(O_MULTIPLY);
 511     case '%':
 512         if (expectterm) {
 513             if (!isALPHA(s[1]))
 514                 check_uni();
 515             s = scanident(s,bufend,tokenbuf);
 516             yylval.stabval = hadd(stabent(tokenbuf,TRUE));
 517             TERM(HSH);
 518         }
 519         s++;
 520         MOP(O_MODULO);
 521
 522     case '^':
 523     case '~':
 524     case '(':
 525     case ',':
 526     case ':':
 527     case '[':
 528         tmp = *s++;
 529         OPERATOR(tmp);
 530     case '{':
 531         tmp = *s++;
 532         yylval.ival = curcmd->c_line;
 533         if (isSPACE(*s) || *s == '#')
 534             cmdline = NOLINE;   /* invalidate current command line number */
 535         OPERATOR(tmp);
 536     case ';':
 537         if (curcmd->c_line < cmdline)
 538             cmdline = curcmd->c_line;
 539         tmp = *s++;
 540         OPERATOR(tmp);
 541     case ')':
 542     case ']':
 543         tmp = *s++;
 544         TERM(tmp);
 545     case '}':
 546         *s |= 128;
 547         RETURN(';');
 548     case '&':
 549         s++;
 550         tmp = *s++;
 551         if (tmp == '&')
 552             OPERATOR(ANDAND);
 553         s--;
 554         if (expectterm) {
 555             d = bufend;
 556             while (s < d && isSPACE(*s))
 557                 s++;
 558             if (isALPHA(*s) || *s == '_' || *s == '\'')
 559                 *(--s) = '\\';  /* force next ident to WORD */
 560             else
 561                 check_uni();
 562             OPERATOR(AMPER);
 563         }
 564         OPERATOR('&');
 565     case '|':
 566         s++;
 567         tmp = *s++;
 568         if (tmp == '|')
 569             OPERATOR(OROR);
 570         s--;
 571         OPERATOR('|');
 572     case '=':
 573         s++;
 574         tmp = *s++;
 575         if (tmp == '=')
 576             EOP(O_EQ);
 577         if (tmp == '~')
 578             OPERATOR(MATCH);
 579         s--;
 580         OPERATOR('=');
 581     case '!':
 582         s++;
 583         tmp = *s++;
 584         if (tmp == '=')
 585             EOP(O_NE);
 586         if (tmp == '~')
 587             OPERATOR(NMATCH);
 588         s--;
 589         OPERATOR('!');
 590     case '<':
 591         if (expectterm) {
 592             if (s[1] != '<' && !index(s,'>'))
 593                 check_uni();
 594             s = scanstr(s, SCAN_DEF);
 595             TERM(RSTRING);
 596         }
 597         s++;
 598         tmp = *s++;
 599         if (tmp == '<')
 600             OPERATOR(LS);
 601         if (tmp == '=') {
 602             tmp = *s++;
 603             if (tmp == '>')
 604                 EOP(O_NCMP);
 605             s--;
 606             ROP(O_LE);
 607         }
 608         s--;
 609         ROP(O_LT);
 610     case '>':
 611         s++;
 612         tmp = *s++;
 613         if (tmp == '>')
 614             OPERATOR(RS);
 615         if (tmp == '=')
 616             ROP(O_GE);
 617         s--;
 618         ROP(O_GT);
 619
 620 #define SNARFWORD \
 621         d = tokenbuf; \
 622         while (isALNUM(*s) || *s == '\'') \
 623             *d++ = *s++; \
 624         while (d[-1] == '\'') \
 625             d--,s--; \
 626         *d = '\0'; \
 627         d = tokenbuf;
 628
 629     case '$':
 630         if (s[1] == '#' && (isALPHA(s[2]) || s[2] == '_')) {
 631             s++;
 632             s = scanident(s,bufend,tokenbuf);
 633             yylval.stabval = aadd(stabent(tokenbuf,TRUE));
 634             TERM(ARYLEN);
 635         }
 636         d = s;
 637         s = scanident(s,bufend,tokenbuf);
 638         if (reparse) {          /* turn ${foo[bar]} into ($foo[bar]) */
 639           do_reparse:
 640             s[-1] = ')';
 641             s = d;
 642             s[1] = s[0];
 643             s[0] = '(';
 644             goto retry;
 645         }
 646         yylval.stabval = stabent(tokenbuf,TRUE);
 647         expectterm = FALSE;
 648         if (isSPACE(*s) && oldoldbufptr && oldoldbufptr < bufptr) {
 649             s++;
 650             while (isSPACE(*oldoldbufptr))
 651                 oldoldbufptr++;
 652             if (*oldoldbufptr == 'p' && strnEQ(oldoldbufptr,"print",5)) {
 653                 if (index("&*<%", *s) && isALPHA(s[1]))
 654                     expectterm = TRUE;          /* e.g. print $fh &sub */
 655                 else if (*s == '.' && isDIGIT(s[1]))
 656                     expectterm = TRUE;          /* e.g. print $fh .3 */
 657                 else if (index("/?-+", *s) && !isSPACE(s[1]))
 658                     expectterm = TRUE;          /* e.g. print $fh -1 */
 659             }
 660         }
 661         RETURN(REG);
 662
 663     case '@':
 664         d = s;
 665         s = scanident(s,bufend,tokenbuf);
 666         if (reparse)
 667             goto do_reparse;
 668         yylval.stabval = aadd(stabent(tokenbuf,TRUE));
 669         TERM(ARY);
 670
 671     case '/':                   /* may either be division or pattern */
 672     case '?':                   /* may either be conditional or pattern */
 673         if (expectterm) {
 674             check_uni();
 675             s = scanpat(s);
 676             TERM(PATTERN);
 677         }
 678         tmp = *s++;
 679         if (tmp == '/')
 680             MOP(O_DIVIDE);
 681         OPERATOR(tmp);
 682
 683     case '.':
 684         if (!expectterm || !isDIGIT(s[1])) {
 685             tmp = *s++;
 686             if (*s == tmp) {
 687                 s++;
 688                 if (*s == tmp) {
 689                     s++;
 690                     yylval.ival = 0;
 691                 }
 692                 else
 693                     yylval.ival = AF_COMMON;
 694                 OPERATOR(DOTDOT);
 695             }
 696             if (expectterm)
 697                 check_uni();
 698             AOP(O_CONCAT);
 699         }
 700         /* FALL THROUGH */
 701     case '0': case '1': case '2': case '3': case '4':
 702     case '5': case '6': case '7': case '8': case '9':
 703     case '\'': case '"': case '`':
 704         s = scanstr(s, SCAN_DEF);
 705         TERM(RSTRING);
 706
 707     case '\\':  /* some magic to force next word to be a WORD */
 708         s++;    /* used by do and sub to force a separate namespace */
 709         if (!isALPHA(*s) && *s != '_' && *s != '\'') {
 710             warn("Spurious backslash ignored");
 711             goto retry;
 712         }
 713         /* FALL THROUGH */
 714     case '_':
 715         SNARFWORD;
 716         if (d[1] == '_') {
 717             if (strEQ(d,"__LINE__") || strEQ(d,"__FILE__")) {
 718                 ARG *arg = op_new(1);
 719
 720                 yylval.arg = arg;
 721                 arg->arg_type = O_ITEM;
 722                 if (d[2] == 'L')
 723                     (void)sprintf(tokenbuf,"%ld",(long)curcmd->c_line);
 724                 else
 725                     strcpy(tokenbuf, stab_val(curcmd->c_filestab)->str_ptr);
 726                 arg[1].arg_type = A_SINGLE;
 727                 arg[1].arg_ptr.arg_str = str_make(tokenbuf,strlen(tokenbuf));
 728                 TERM(RSTRING);
 729             }
 730             else if (strEQ(d,"__END__")) {
 731                 STAB *stab;
 732                 int fd;
 733
 734                 /*SUPPRESS 560*/
 735                 if (!in_eval && (stab = stabent("DATA",FALSE))) {
 736                     stab->str_pok |= SP_MULTI;
 737                     if (!stab_io(stab))
 738                         stab_io(stab) = stio_new();
 739                     stab_io(stab)->ifp = rsfp;
 740 #if defined(HAS_FCNTL) && defined(F_SETFD)
 741                     fd = fileno(rsfp);
 742                     fcntl(fd,F_SETFD,fd >= 3);
 743 #endif
 744                     if (preprocess)
 745                         stab_io(stab)->type = '|';
 746                     else if ((FILE*)rsfp == stdin)
 747                         stab_io(stab)->type = '-';
 748                     else
 749                         stab_io(stab)->type = '<';
 750                     rsfp = Nullfp;
 751                 }
 752                 goto fake_eof;
 753             }
 754         }
 755         break;
 756     case 'a': case 'A':
 757         SNARFWORD;
 758         if (strEQ(d,"alarm"))
 759             UNI(O_ALARM);
 760         if (strEQ(d,"accept"))
 761             FOP22(O_ACCEPT);
 762         if (strEQ(d,"atan2"))
 763             FUN2(O_ATAN2);
 764         break;
 765     case 'b': case 'B':
 766         SNARFWORD;
 767         if (strEQ(d,"bind"))
 768             FOP2(O_BIND);
 769         if (strEQ(d,"binmode"))
 770             FOP(O_BINMODE);
 771         break;
 772     case 'c': case 'C':
 773         SNARFWORD;
 774         if (strEQ(d,"chop"))
 775             LFUN(O_CHOP);
 776         if (strEQ(d,"continue"))
 777             OPERATOR(CONTINUE);
 778         if (strEQ(d,"chdir")) {
 779             (void)stabent("ENV",TRUE);  /* may use HOME */
 780             UNI(O_CHDIR);
 781         }
 782         if (strEQ(d,"close"))
 783             FOP(O_CLOSE);
 784         if (strEQ(d,"closedir"))
 785             FOP(O_CLOSEDIR);
 786         if (strEQ(d,"cmp"))
 787             EOP(O_SCMP);
 788         if (strEQ(d,"caller"))
 789             UNI(O_CALLER);
 790         if (strEQ(d,"crypt")) {
 791 #ifdef FCRYPT
 792             static int cryptseen = 0;
 793
 794             if (!cryptseen++)
 795                 init_des();
 796 #endif
 797             FUN2(O_CRYPT);
 798         }
 799         if (strEQ(d,"chmod"))
 800             LOP(O_CHMOD);
 801         if (strEQ(d,"chown"))
 802             LOP(O_CHOWN);
 803         if (strEQ(d,"connect"))
 804             FOP2(O_CONNECT);
 805         if (strEQ(d,"cos"))
 806             UNI(O_COS);
 807         if (strEQ(d,"chroot"))
 808             UNI(O_CHROOT);
 809         break;
 810     case 'd': case 'D':
 811         SNARFWORD;
 812         if (strEQ(d,"do")) {
 813             d = bufend;
 814             while (s < d && isSPACE(*s))
 815                 s++;
 816             if (isALPHA(*s) || *s == '_')
 817                 *(--s) = '\\';  /* force next ident to WORD */
 818             OPERATOR(DO);
 819         }
 820         if (strEQ(d,"die"))
 821             LOP(O_DIE);
 822         if (strEQ(d,"defined"))
 823             LFUN(O_DEFINED);
 824         if (strEQ(d,"delete"))
 825             OPERATOR(DELETE);
 826         if (strEQ(d,"dbmopen"))
 827             HFUN3(O_DBMOPEN);
 828         if (strEQ(d,"dbmclose"))
 829             HFUN(O_DBMCLOSE);
 830         if (strEQ(d,"dump"))
 831             LOOPX(O_DUMP);
 832         break;
 833     case 'e': case 'E':
 834         SNARFWORD;
 835         if (strEQ(d,"else"))
 836             OPERATOR(ELSE);
 837         if (strEQ(d,"elsif")) {
 838             yylval.ival = curcmd->c_line;
 839             OPERATOR(ELSIF);
 840         }
 841         if (strEQ(d,"eq") || strEQ(d,"EQ"))
 842             EOP(O_SEQ);
 843         if (strEQ(d,"exit"))
 844             UNI(O_EXIT);
 845         if (strEQ(d,"eval")) {
 846             allstabs = TRUE;            /* must initialize everything since */
 847             UNI(O_EVAL);                /* we don't know what will be used */
 848         }
 849         if (strEQ(d,"eof"))
 850             FOP(O_EOF);
 851         if (strEQ(d,"exp"))
 852             UNI(O_EXP);
 853         if (strEQ(d,"each"))
 854             HFUN(O_EACH);
 855         if (strEQ(d,"exec")) {
 856             set_csh();
 857             LOP(O_EXEC_OP);
 858         }
 859         if (strEQ(d,"endhostent"))
 860             FUN0(O_EHOSTENT);
 861         if (strEQ(d,"endnetent"))
 862             FUN0(O_ENETENT);
 863         if (strEQ(d,"endservent"))
 864             FUN0(O_ESERVENT);
 865         if (strEQ(d,"endprotoent"))
 866             FUN0(O_EPROTOENT);
 867         if (strEQ(d,"endpwent"))
 868             FUN0(O_EPWENT);
 869         if (strEQ(d,"endgrent"))
 870             FUN0(O_EGRENT);
 871         break;
 872     case 'f': case 'F':
 873         SNARFWORD;
 874         if (strEQ(d,"for") || strEQ(d,"foreach")) {
 875             yylval.ival = curcmd->c_line;
 876             while (s < bufend && isSPACE(*s))
 877                 s++;
 878             if (isALPHA(*s))
 879                 fatal("Missing $ on loop variable");
 880             OPERATOR(FOR);
 881         }
 882         if (strEQ(d,"format")) {
 883             d = bufend;
 884             while (s < d && isSPACE(*s))
 885                 s++;
 886             if (isALPHA(*s) || *s == '_')
 887                 *(--s) = '\\';  /* force next ident to WORD */
 888             in_format = TRUE;
 889             allstabs = TRUE;            /* must initialize everything since */
 890             OPERATOR(FORMAT);           /* we don't know what will be used */
 891         }
 892         if (strEQ(d,"fork"))
 893             FUN0(O_FORK);
 894         if (strEQ(d,"fcntl"))
 895             FOP3(O_FCNTL);
 896         if (strEQ(d,"fileno"))
 897             FOP(O_FILENO);
 898         if (strEQ(d,"flock"))
 899             FOP2(O_FLOCK);
 900         break;
 901     case 'g': case 'G':
 902         SNARFWORD;
 903         if (strEQ(d,"gt") || strEQ(d,"GT"))
 904             ROP(O_SGT);
 905         if (strEQ(d,"ge") || strEQ(d,"GE"))
 906             ROP(O_SGE);
 907         if (strEQ(d,"grep"))
 908             FL2(O_GREP);
 909         if (strEQ(d,"goto"))
 910             LOOPX(O_GOTO);
 911         if (strEQ(d,"gmtime"))
 912             UNI(O_GMTIME);
 913         if (strEQ(d,"getc"))
 914             FOP(O_GETC);
 915         if (strnEQ(d,"get",3)) {
 916             d += 3;
 917             if (*d == 'p') {
 918                 if (strEQ(d,"ppid"))
 919                     FUN0(O_GETPPID);
 920                 if (strEQ(d,"pgrp"))
 921                     UNI(O_GETPGRP);
 922                 if (strEQ(d,"priority"))
 923                     FUN2(O_GETPRIORITY);
 924                 if (strEQ(d,"protobyname"))
 925                     UNI(O_GPBYNAME);
 926                 if (strEQ(d,"protobynumber"))
 927                     FUN1(O_GPBYNUMBER);
 928                 if (strEQ(d,"protoent"))
 929                     FUN0(O_GPROTOENT);
 930                 if (strEQ(d,"pwent"))
 931                     FUN0(O_GPWENT);
 932                 if (strEQ(d,"pwnam"))
 933                     FUN1(O_GPWNAM);
 934                 if (strEQ(d,"pwuid"))
 935                     FUN1(O_GPWUID);
 936                 if (strEQ(d,"peername"))
 937                     FOP(O_GETPEERNAME);
 938             }
 939             else if (*d == 'h') {
 940                 if (strEQ(d,"hostbyname"))
 941                     UNI(O_GHBYNAME);
 942                 if (strEQ(d,"hostbyaddr"))
 943                     FUN2(O_GHBYADDR);
 944                 if (strEQ(d,"hostent"))
 945                     FUN0(O_GHOSTENT);
 946             }
 947             else if (*d == 'n') {
 948                 if (strEQ(d,"netbyname"))
 949                     UNI(O_GNBYNAME);
 950                 if (strEQ(d,"netbyaddr"))
 951                     FUN2(O_GNBYADDR);
 952                 if (strEQ(d,"netent"))
 953                     FUN0(O_GNETENT);
 954             }
 955             else if (*d == 's') {
 956                 if (strEQ(d,"servbyname"))
 957                     FUN2(O_GSBYNAME);
 958                 if (strEQ(d,"servbyport"))
 959                     FUN2(O_GSBYPORT);
 960                 if (strEQ(d,"servent"))
 961                     FUN0(O_GSERVENT);
 962                 if (strEQ(d,"sockname"))
 963                     FOP(O_GETSOCKNAME);
 964                 if (strEQ(d,"sockopt"))
 965                     FOP3(O_GSOCKOPT);
 966             }
 967             else if (*d == 'g') {
 968                 if (strEQ(d,"grent"))
 969                     FUN0(O_GGRENT);
 970                 if (strEQ(d,"grnam"))
 971                     FUN1(O_GGRNAM);
 972                 if (strEQ(d,"grgid"))
 973                     FUN1(O_GGRGID);
 974             }
 975             else if (*d == 'l') {
 976                 if (strEQ(d,"login"))
 977                     FUN0(O_GETLOGIN);
 978             }
 979             d -= 3;
 980         }
 981         break;
 982     case 'h': case 'H':
 983         SNARFWORD;
 984         if (strEQ(d,"hex"))
 985             UNI(O_HEX);
 986         break;
 987     case 'i': case 'I':
 988         SNARFWORD;
 989         if (strEQ(d,"if")) {
 990             yylval.ival = curcmd->c_line;
 991             OPERATOR(IF);
 992         }
 993         if (strEQ(d,"index"))
 994             FUN2x(O_INDEX);
 995         if (strEQ(d,"int"))
 996             UNI(O_INT);
 997         if (strEQ(d,"ioctl"))
 998             FOP3(O_IOCTL);
 999         break;
1000     case 'j': case 'J':
1001         SNARFWORD;
1002         if (strEQ(d,"join"))
1003             FL2(O_JOIN);
1004         break;
1005     case 'k': case 'K':
1006         SNARFWORD;
1007         if (strEQ(d,"keys"))
1008             HFUN(O_KEYS);
1009         if (strEQ(d,"kill"))
1010             LOP(O_KILL);
1011         break;
1012     case 'l': case 'L':
1013         SNARFWORD;
1014         if (strEQ(d,"last"))
1015             LOOPX(O_LAST);
1016         if (strEQ(d,"local"))
1017             OPERATOR(LOCAL);
1018         if (strEQ(d,"length"))
1019             UNI(O_LENGTH);
1020         if (strEQ(d,"lt") || strEQ(d,"LT"))
1021             ROP(O_SLT);
1022         if (strEQ(d,"le") || strEQ(d,"LE"))
1023             ROP(O_SLE);
1024         if (strEQ(d,"localtime"))
1025             UNI(O_LOCALTIME);
1026         if (strEQ(d,"log"))
1027             UNI(O_LOG);
1028         if (strEQ(d,"link"))
1029             FUN2(O_LINK);
1030         if (strEQ(d,"listen"))
1031             FOP2(O_LISTEN);
1032         if (strEQ(d,"lstat"))
1033             FOP(O_LSTAT);
1034         break;
1035     case 'm': case 'M':
1036         if (s[1] == '\'') {
1037             d = "m";
1038             s++;
1039         }
1040         else {
1041             SNARFWORD;
1042         }
1043         if (strEQ(d,"m")) {
1044             s = scanpat(s-1);
1045             if (yylval.arg)
1046                 TERM(PATTERN);
1047             else
1048                 RETURN(1);      /* force error */
1049         }
1050         switch (d[1]) {
1051         case 'k':
1052             if (strEQ(d,"mkdir"))
1053                 FUN2(O_MKDIR);
1054             break;
1055         case 's':
1056             if (strEQ(d,"msgctl"))
1057                 FUN3(O_MSGCTL);
1058             if (strEQ(d,"msgget"))
1059                 FUN2(O_MSGGET);
1060             if (strEQ(d,"msgrcv"))
1061                 FUN5(O_MSGRCV);
1062             if (strEQ(d,"msgsnd"))
1063                 FUN3(O_MSGSND);
1064             break;
1065         }
1066         break;
1067     case 'n': case 'N':
1068         SNARFWORD;
1069         if (strEQ(d,"next"))
1070             LOOPX(O_NEXT);
1071         if (strEQ(d,"ne") || strEQ(d,"NE"))
1072             EOP(O_SNE);
1073         break;
1074     case 'o': case 'O':
1075         SNARFWORD;
1076         if (strEQ(d,"open"))
1077             OPERATOR(OPEN);
1078         if (strEQ(d,"ord"))
1079             UNI(O_ORD);
1080         if (strEQ(d,"oct"))
1081             UNI(O_OCT);
1082         if (strEQ(d,"opendir"))
1083             FOP2(O_OPEN_DIR);
1084         break;
1085     case 'p': case 'P':
1086         SNARFWORD;
1087         if (strEQ(d,"print")) {
1088             checkcomma(s,d,"filehandle");
1089             LOP(O_PRINT);
1090         }
1091         if (strEQ(d,"printf")) {
1092             checkcomma(s,d,"filehandle");
1093             LOP(O_PRTF);
1094         }
1095         if (strEQ(d,"push")) {
1096             yylval.ival = O_PUSH;
1097             OPERATOR(PUSH);
1098         }
1099         if (strEQ(d,"pop"))
1100             OPERATOR(POP);
1101         if (strEQ(d,"pack"))
1102             FL2(O_PACK);
1103         if (strEQ(d,"package"))
1104             OPERATOR(PACKAGE);
1105         if (strEQ(d,"pipe"))
1106             FOP22(O_PIPE_OP);
1107         break;
1108     case 'q': case 'Q':
1109         SNARFWORD;
1110         if (strEQ(d,"q")) {
1111             s = scanstr(s-1, SCAN_DEF);
1112             TERM(RSTRING);
1113         }
1114         if (strEQ(d,"qq")) {
1115             s = scanstr(s-2, SCAN_DEF);
1116             TERM(RSTRING);
1117         }
1118         if (strEQ(d,"qx")) {
1119             s = scanstr(s-2, SCAN_DEF);
1120             TERM(RSTRING);
1121         }
1122         break;
1123     case 'r': case 'R':
1124         SNARFWORD;
1125         if (strEQ(d,"return"))
1126             OLDLOP(O_RETURN);
1127         if (strEQ(d,"require")) {
1128             allstabs = TRUE;            /* must initialize everything since */
1129             UNI(O_REQUIRE);             /* we don't know what will be used */
1130         }
1131         if (strEQ(d,"reset"))
1132             UNI(O_RESET);
1133         if (strEQ(d,"redo"))
1134             LOOPX(O_REDO);
1135         if (strEQ(d,"rename"))
1136             FUN2(O_RENAME);
1137         if (strEQ(d,"rand"))
1138             UNI(O_RAND);
1139         if (strEQ(d,"rmdir"))
1140             UNI(O_RMDIR);
1141         if (strEQ(d,"rindex"))
1142             FUN2x(O_RINDEX);
1143         if (strEQ(d,"read"))
1144             FOP3(O_READ);
1145         if (strEQ(d,"readdir"))
1146             FOP(O_READDIR);
1147         if (strEQ(d,"rewinddir"))
1148             FOP(O_REWINDDIR);
1149         if (strEQ(d,"recv"))
1150             FOP4(O_RECV);
1151         if (strEQ(d,"reverse"))
1152             LOP(O_REVERSE);
1153         if (strEQ(d,"readlink"))
1154             UNI(O_READLINK);
1155         break;
1156     case 's': case 'S':
1157         if (s[1] == '\'') {
1158             d = "s";
1159             s++;
1160         }
1161         else {
1162             SNARFWORD;
1163         }
1164         if (strEQ(d,"s")) {
1165             s = scansubst(s);
1166             if (yylval.arg)
1167                 TERM(SUBST);
1168             else
1169                 RETURN(1);      /* force error */
1170         }
1171         switch (d[1]) {
1172         case 'a':
1173         case 'b':
1174             break;
1175         case 'c':
1176             if (strEQ(d,"scalar"))
1177                 UNI(O_SCALAR);
1178             break;
1179         case 'd':
1180             break;
1181         case 'e':
1182             if (strEQ(d,"select"))
1183                 OPERATOR(SSELECT);
1184             if (strEQ(d,"seek"))
1185                 FOP3(O_SEEK);
1186             if (strEQ(d,"semctl"))
1187                 FUN4(O_SEMCTL);
1188             if (strEQ(d,"semget"))
1189                 FUN3(O_SEMGET);
1190             if (strEQ(d,"semop"))
1191                 FUN2(O_SEMOP);
1192             if (strEQ(d,"send"))
1193                 FOP3(O_SEND);
1194             if (strEQ(d,"setpgrp"))
1195                 FUN2(O_SETPGRP);
1196             if (strEQ(d,"setpriority"))
1197                 FUN3(O_SETPRIORITY);
1198             if (strEQ(d,"sethostent"))
1199                 FUN1(O_SHOSTENT);
1200             if (strEQ(d,"setnetent"))
1201                 FUN1(O_SNETENT);
1202             if (strEQ(d,"setservent"))
1203                 FUN1(O_SSERVENT);
1204             if (strEQ(d,"setprotoent"))
1205                 FUN1(O_SPROTOENT);
1206             if (strEQ(d,"setpwent"))
1207                 FUN0(O_SPWENT);
1208             if (strEQ(d,"setgrent"))
1209                 FUN0(O_SGRENT);
1210             if (strEQ(d,"seekdir"))
1211                 FOP2(O_SEEKDIR);
1212             if (strEQ(d,"setsockopt"))
1213                 FOP4(O_SSOCKOPT);
1214             break;
1215         case 'f':
1216         case 'g':
1217             break;
1218         case 'h':
1219             if (strEQ(d,"shift"))
1220                 TERM(SHIFT);
1221             if (strEQ(d,"shmctl"))
1222                 FUN3(O_SHMCTL);
1223             if (strEQ(d,"shmget"))
1224                 FUN3(O_SHMGET);
1225             if (strEQ(d,"shmread"))
1226                 FUN4(O_SHMREAD);
1227             if (strEQ(d,"shmwrite"))
1228                 FUN4(O_SHMWRITE);
1229             if (strEQ(d,"shutdown"))
1230                 FOP2(O_SHUTDOWN);
1231             break;
1232         case 'i':
1233             if (strEQ(d,"sin"))
1234                 UNI(O_SIN);
1235             break;
1236         case 'j':
1237         case 'k':
1238             break;
1239         case 'l':
1240             if (strEQ(d,"sleep"))
1241                 UNI(O_SLEEP);
1242             break;
1243         case 'm':
1244         case 'n':
1245             break;
1246         case 'o':
1247             if (strEQ(d,"socket"))
1248                 FOP4(O_SOCKET);
1249             if (strEQ(d,"socketpair"))
1250                 FOP25(O_SOCKPAIR);
1251             if (strEQ(d,"sort")) {
1252                 checkcomma(s,d,"subroutine name");
1253                 d = bufend;
1254                 while (s < d && isSPACE(*s)) s++;
1255                 if (*s == ';' || *s == ')')             /* probably a close */
1256                     fatal("sort is now a reserved word");
1257                 if (isALPHA(*s) || *s == '_') {
1258                     /*SUPPRESS 530*/
1259                     for (d = s; isALNUM(*d); d++) ;
1260                     strncpy(tokenbuf,s,d-s);
1261                     tokenbuf[d-s] = '\0';
1262                     if (strNE(tokenbuf,"keys") &&
1263                         strNE(tokenbuf,"values") &&
1264                         strNE(tokenbuf,"split") &&
1265                         strNE(tokenbuf,"grep") &&
1266                         strNE(tokenbuf,"readdir") &&
1267                         strNE(tokenbuf,"unpack") &&
1268                         strNE(tokenbuf,"do") &&
1269                         strNE(tokenbuf,"eval") &&
1270                         (d >= bufend || isSPACE(*d)) )
1271                         *(--s) = '\\';  /* force next ident to WORD */
1272                 }
1273                 LOP(O_SORT);
1274             }
1275             break;
1276         case 'p':
1277             if (strEQ(d,"split"))
1278                 TERM(SPLIT);
1279             if (strEQ(d,"sprintf"))
1280                 FL(O_SPRINTF);
1281             if (strEQ(d,"splice")) {
1282                 yylval.ival = O_SPLICE;
1283                 OPERATOR(PUSH);
1284             }
1285             break;
1286         case 'q':
1287             if (strEQ(d,"sqrt"))
1288                 UNI(O_SQRT);
1289             break;
1290         case 'r':
1291             if (strEQ(d,"srand"))
1292                 UNI(O_SRAND);
1293             break;
1294         case 's':
1295             break;
1296         case 't':
1297             if (strEQ(d,"stat"))
1298                 FOP(O_STAT);
1299             if (strEQ(d,"study")) {
1300                 sawstudy++;
1301                 LFUN(O_STUDY);
1302             }
1303             break;
1304         case 'u':
1305             if (strEQ(d,"substr"))
1306                 FUN2x(O_SUBSTR);
1307             if (strEQ(d,"sub")) {
1308                 yylval.ival = savestack->ary_fill; /* restore stuff on reduce */
1309                 savelong(&subline);
1310                 saveitem(subname);
1311
1312                 subline = curcmd->c_line;
1313                 d = bufend;
1314                 while (s < d && isSPACE(*s))
1315                     s++;
1316                 if (isALPHA(*s) || *s == '_' || *s == '\'') {
1317                     str_sset(subname,curstname);
1318                     str_ncat(subname,"'",1);
1319                     for (d = s+1; isALNUM(*d) || *d == '\''; d++)
1320                         /*SUPPRESS 530*/
1321                         ;
1322                     if (d[-1] == '\'')
1323                         d--;
1324                     str_ncat(subname,s,d-s);
1325                     *(--s) = '\\';      /* force next ident to WORD */
1326                 }
1327                 else
1328                     str_set(subname,"?");
1329                 OPERATOR(SUB);
1330             }
1331             break;
1332         case 'v':
1333         case 'w':
1334         case 'x':
1335             break;
1336         case 'y':
1337             if (strEQ(d,"system")) {
1338                 set_csh();
1339                 LOP(O_SYSTEM);
1340             }
1341             if (strEQ(d,"symlink"))
1342                 FUN2(O_SYMLINK);
1343             if (strEQ(d,"syscall"))
1344                 LOP(O_SYSCALL);
1345             if (strEQ(d,"sysread"))
1346                 FOP3(O_SYSREAD);
1347             if (strEQ(d,"syswrite"))
1348                 FOP3(O_SYSWRITE);
1349             break;
1350         case 'z':
1351             break;
1352         }
1353         break;
1354     case 't': case 'T':
1355         SNARFWORD;
1356         if (strEQ(d,"tr")) {
1357             s = scantrans(s);
1358             if (yylval.arg)
1359                 TERM(TRANS);
1360             else
1361                 RETURN(1);      /* force error */
1362         }
1363         if (strEQ(d,"tell"))
1364             FOP(O_TELL);
1365         if (strEQ(d,"telldir"))
1366             FOP(O_TELLDIR);
1367         if (strEQ(d,"time"))
1368             FUN0(O_TIME);
1369         if (strEQ(d,"times"))
1370             FUN0(O_TMS);
1371         if (strEQ(d,"truncate"))
1372             FOP2(O_TRUNCATE);
1373         break;
1374     case 'u': case 'U':
1375         SNARFWORD;
1376         if (strEQ(d,"using"))
1377             OPERATOR(USING);
1378         if (strEQ(d,"until")) {
1379             yylval.ival = curcmd->c_line;
1380             OPERATOR(UNTIL);
1381         }
1382         if (strEQ(d,"unless")) {
1383             yylval.ival = curcmd->c_line;
1384             OPERATOR(UNLESS);
1385         }
1386         if (strEQ(d,"unlink"))
1387             LOP(O_UNLINK);
1388         if (strEQ(d,"undef"))
1389             LFUN(O_UNDEF);
1390         if (strEQ(d,"unpack"))
1391             FUN2(O_UNPACK);
1392         if (strEQ(d,"utime"))
1393             LOP(O_UTIME);
1394         if (strEQ(d,"umask"))
1395             UNI(O_UMASK);
1396         if (strEQ(d,"unshift")) {
1397             yylval.ival = O_UNSHIFT;
1398             OPERATOR(PUSH);
1399         }
1400         break;
1401     case 'v': case 'V':
1402         SNARFWORD;
1403         if (strEQ(d,"values"))
1404             HFUN(O_VALUES);
1405         if (strEQ(d,"vec")) {
1406             sawvec = TRUE;
1407             FUN3(O_VEC);
1408         }
1409         break;
1410     case 'w': case 'W':
1411         SNARFWORD;
1412         if (strEQ(d,"while")) {
1413             yylval.ival = curcmd->c_line;
1414             OPERATOR(WHILE);
1415         }
1416         if (strEQ(d,"warn"))
1417             LOP(O_WARN);
1418         if (strEQ(d,"wait"))
1419             FUN0(O_WAIT);
1420         if (strEQ(d,"waitpid"))
1421             FUN2(O_WAITPID);
1422         if (strEQ(d,"wantarray")) {
1423             yylval.arg = op_new(1);
1424             yylval.arg->arg_type = O_ITEM;
1425             yylval.arg[1].arg_type = A_WANTARRAY;
1426             TERM(RSTRING);
1427         }
1428         if (strEQ(d,"write"))
1429             FOP(O_WRITE);
1430         break;
1431     case 'x': case 'X':
1432         if (*s == 'x' && isDIGIT(s[1]) && !expectterm) {
1433             s++;
1434             MOP(O_REPEAT);
1435         }
1436         SNARFWORD;
1437         if (strEQ(d,"x")) {
1438             if (!expectterm)
1439                 MOP(O_REPEAT);
1440             check_uni();
1441         }
1442         break;
1443     case 'y': case 'Y':
1444         if (s[1] == '\'') {
1445             d = "y";
1446             s++;
1447         }
1448         else {
1449             SNARFWORD;
1450         }
1451         if (strEQ(d,"y")) {
1452             s = scantrans(s);
1453             TERM(TRANS);
1454         }
1455         break;
1456     case 'z': case 'Z':
1457         SNARFWORD;
1458         break;
1459     }
1460     yylval.cval = savestr(d);
1461     if (expectterm == 2) {              /* special case: start of statement */
1462         while (isSPACE(*s)) s++;
1463         if (*s == ':') {
1464             s++;
1465             CLINE;
1466             OPERATOR(LABEL);
1467         }
1468         TERM(WORD);
1469     }
1470     expectterm = FALSE;
1471     if (oldoldbufptr && oldoldbufptr < bufptr) {
1472         while (isSPACE(*oldoldbufptr))
1473             oldoldbufptr++;
1474         if (*oldoldbufptr == 'p' && strnEQ(oldoldbufptr,"print",5))
1475             expectterm = TRUE;
1476         else if (*oldoldbufptr == 's' && strnEQ(oldoldbufptr,"sort",4))
1477             expectterm = TRUE;
1478     }
1479     return (CLINE, bufptr = s, (int)WORD);
1480 }
1481
1482 void
1483 checkcomma(s,name,what)
1484 register char *s;
1485 char *name;
1486 char *what;
1487 {
1488     char *w;
1489
1490     if (dowarn && *s == ' ' && s[1] == '(') {
1491         w = index(s,')');
1492         if (w)
1493             for (w++; *w && isSPACE(*w); w++) ;
1494         if (!w || !*w || !index(";|}", *w))     /* an advisory hack only... */
1495             warn("%s (...) interpreted as function",name);
1496     }
1497     while (s < bufend && isSPACE(*s))
1498         s++;
1499     if (*s == '(')
1500         s++;
1501     while (s < bufend && isSPACE(*s))
1502         s++;
1503     if (isALPHA(*s) || *s == '_') {
1504         w = s++;
1505         while (isALNUM(*s))
1506             s++;
1507         while (s < bufend && isSPACE(*s))
1508             s++;
1509         if (*s == ',') {
1510             *s = '\0';
1511             w = instr(
1512               "tell eof times getlogin wait length shift umask getppid \
1513               cos exp int log rand sin sqrt ord wantarray",
1514               w);
1515             *s = ',';
1516             if (w)
1517                 return;
1518             fatal("No comma allowed after %s", what);
1519         }
1520     }
1521 }
1522
1523 char *
1524 scanident(s,send,dest)
1525 register char *s;
1526 register char *send;
1527 char *dest;
1528 {
1529     register char *d;
1530     int brackets = 0;
1531
1532     reparse = Nullch;
1533     s++;
1534     d = dest;
1535     if (isDIGIT(*s)) {
1536         while (isDIGIT(*s))
1537             *d++ = *s++;
1538     }
1539     else {
1540         while (isALNUM(*s) || *s == '\'')
1541             *d++ = *s++;
1542     }
1543     while (d > dest+1 && d[-1] == '\'')
1544         d--,s--;
1545     *d = '\0';
1546     d = dest;
1547     if (!*d) {
1548         *d = *s++;
1549         if (*d == '{' /* } */ ) {
1550             d = dest;
1551             brackets++;
1552             while (s < send && brackets) {
1553                 if (!reparse && (d == dest || (*s && isALNUM(*s) ))) {
1554                     *d++ = *s++;
1555                     continue;
1556                 }
1557                 else if (!reparse)
1558                     reparse = s;
1559                 switch (*s++) {
1560                 /* { */
1561                 case '}':
1562                     brackets--;
1563                     if (reparse && reparse == s - 1)
1564                         reparse = Nullch;
1565                     break;
1566                 case '{':   /* } */
1567                     brackets++;
1568                     break;
1569                 }
1570             }
1571             *d = '\0';
1572             d = dest;
1573         }
1574         else
1575             d[1] = '\0';
1576     }
1577     if (*d == '^' && (isUPPER(*s) || index("[\\]^_?", *s))) {
1578 #ifdef DEBUGGING
1579         if (*s == 'D')
1580             debug |= 32768;
1581 #endif
1582         *d = *s++ ^ 64;
1583     }
1584     return s;
1585 }
1586
1587 void
1588 scanconst(spat,string,len)
1589 SPAT *spat;
1590 char *string;
1591 int len;
1592 {
1593     register STR *tmpstr;
1594     register char *t;
1595     register char *d;
1596     register char *e;
1597     char *origstring = string;
1598     static char *vert = "|";
1599
1600     if (ninstr(string, string+len, vert, vert+1))
1601         return;
1602     if (*string == '^')
1603         string++, len--;
1604     tmpstr = Str_new(86,len);
1605     str_nset(tmpstr,string,len);
1606     t = str_get(tmpstr);
1607     e = t + len;
1608     tmpstr->str_u.str_useful = 100;
1609     for (d=t; d < e; ) {
1610         switch (*d) {
1611         case '{':
1612             if (isDIGIT(d[1]))
1613                 e = d;
1614             else
1615                 goto defchar;
1616             break;
1617         case '.': case '[': case '$': case '(': case ')': case '|': case '+':
1618         case '^':
1619             e = d;
1620             break;
1621         case '\\':
1622             if (d[1] && index("wWbB0123456789sSdDlLuUExc",d[1])) {
1623                 e = d;
1624                 break;
1625             }
1626             Move(d+1,d,e-d,char);
1627             e--;
1628             switch(*d) {
1629             case 'n':
1630                 *d = '\n';
1631                 break;
1632             case 't':
1633                 *d = '\t';
1634                 break;
1635             case 'f':
1636                 *d = '\f';
1637                 break;
1638             case 'r':
1639                 *d = '\r';
1640                 break;
1641             case 'e':
1642                 *d = '\033';
1643                 break;
1644             case 'a':
1645                 *d = '\007';
1646                 break;
1647             }
1648             /* FALL THROUGH */
1649         default:
1650           defchar:
1651             if (d[1] == '*' || (d[1] == '{' && d[2] == '0') || d[1] == '?') {
1652                 e = d;
1653                 break;
1654             }
1655             d++;
1656         }
1657     }
1658     if (d == t) {
1659         str_free(tmpstr);
1660         return;
1661     }
1662     *d = '\0';
1663     tmpstr->str_cur = d - t;
1664     if (d == t+len)
1665         spat->spat_flags |= SPAT_ALL;
1666     if (*origstring != '^')
1667         spat->spat_flags |= SPAT_SCANFIRST;
1668     spat->spat_short = tmpstr;
1669     spat->spat_slen = d - t;
1670 }
1671
1672 char *
1673 scanpat(s)
1674 register char *s;
1675 {
1676     register SPAT *spat;
1677     register char *d;
1678     register char *e;
1679     int len;
1680     SPAT savespat;
1681     STR *str = Str_new(93,0);
1682     char delim;
1683
1684     Newz(801,spat,1,SPAT);
1685     spat->spat_next = curstash->tbl_spatroot;   /* link into spat list */
1686     curstash->tbl_spatroot = spat;
1687
1688     switch (*s++) {
1689     case 'm':
1690         s++;
1691         break;
1692     case '/':
1693         break;
1694     case '?':
1695         spat->spat_flags |= SPAT_ONCE;
1696         break;
1697     default:
1698         fatal("panic: scanpat");
1699     }
1700     s = str_append_till(str,s,bufend,s[-1],patleave);
1701     if (s >= bufend) {
1702         str_free(str);
1703         yyerror("Search pattern not terminated");
1704         yylval.arg = Nullarg;
1705         return s;
1706     }
1707     delim = *s++;
1708     while (*s == 'i' || *s == 'o' || *s == 'g') {
1709         if (*s == 'i') {
1710             s++;
1711             sawi = TRUE;
1712             spat->spat_flags |= SPAT_FOLD;
1713         }
1714         if (*s == 'o') {
1715             s++;
1716             spat->spat_flags |= SPAT_KEEP;
1717         }
1718         if (*s == 'g') {
1719             s++;
1720             spat->spat_flags |= SPAT_GLOBAL;
1721         }
1722     }
1723     len = str->str_cur;
1724     e = str->str_ptr + len;
1725     if (delim == '\'')
1726         d = e;
1727     else
1728         d = str->str_ptr;
1729     for (; d < e; d++) {
1730         if (*d == '\\')
1731             d++;
1732         else if ((*d == '$' && d[1] && d[1] != '|' && d[1] != ')') ||
1733                  (*d == '@')) {
1734             register ARG *arg;
1735
1736             spat->spat_runtime = arg = op_new(1);
1737             arg->arg_type = O_ITEM;
1738             arg[1].arg_type = A_DOUBLE;
1739             arg[1].arg_ptr.arg_str = str_smake(str);
1740             d = scanident(d,bufend,buf);
1741             (void)stabent(buf,TRUE);            /* make sure it's created */
1742             for (; d < e; d++) {
1743                 if (*d == '\\')
1744                     d++;
1745                 else if (*d == '$' && d[1] && d[1] != '|' && d[1] != ')') {
1746                     d = scanident(d,bufend,buf);
1747                     (void)stabent(buf,TRUE);
1748                 }
1749                 else if (*d == '@') {
1750                     d = scanident(d,bufend,buf);
1751                     if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
1752                       strEQ(buf,"SIG") || strEQ(buf,"INC"))
1753                         (void)stabent(buf,TRUE);
1754                 }
1755             }
1756             goto got_pat;               /* skip compiling for now */
1757         }
1758     }
1759     if (spat->spat_flags & SPAT_FOLD)
1760         StructCopy(spat, &savespat, SPAT);
1761     scanconst(spat,str->str_ptr,len);
1762     if ((spat->spat_flags & SPAT_ALL) && (spat->spat_flags & SPAT_SCANFIRST)) {
1763         fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
1764         spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
1765             spat->spat_flags & SPAT_FOLD);
1766                 /* Note that this regexp can still be used if someone says
1767                  * something like /a/ && s//b/;  so we can't delete it.
1768                  */
1769     }
1770     else {
1771         if (spat->spat_flags & SPAT_FOLD)
1772         StructCopy(&savespat, spat, SPAT);
1773         if (spat->spat_short)
1774             fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
1775         spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
1776             spat->spat_flags & SPAT_FOLD);
1777         hoistmust(spat);
1778     }
1779   got_pat:
1780     str_free(str);
1781     yylval.arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat);
1782     return s;
1783 }
1784
1785 char *
1786 scansubst(start)
1787 char *start;
1788 {
1789     register char *s = start;
1790     register SPAT *spat;
1791     register char *d;
1792     register char *e;
1793     int len;
1794     STR *str = Str_new(93,0);
1795     char term = *s;
1796
1797     if (term && (d = index("([{< )]}> )]}>",term)))
1798         term = d[5];
1799
1800     Newz(802,spat,1,SPAT);
1801     spat->spat_next = curstash->tbl_spatroot;   /* link into spat list */
1802     curstash->tbl_spatroot = spat;
1803
1804     s = str_append_till(str,s+1,bufend,term,patleave);
1805     if (s >= bufend) {
1806         str_free(str);
1807         yyerror("Substitution pattern not terminated");
1808         yylval.arg = Nullarg;
1809         return s;
1810     }
1811     len = str->str_cur;
1812     e = str->str_ptr + len;
1813     for (d = str->str_ptr; d < e; d++) {
1814         if (*d == '\\')
1815             d++;
1816         else if ((*d == '$' && d[1] && d[1] != '|' && /*(*/ d[1] != ')') ||
1817             *d == '@' ) {
1818             register ARG *arg;
1819
1820             spat->spat_runtime = arg = op_new(1);
1821             arg->arg_type = O_ITEM;
1822             arg[1].arg_type = A_DOUBLE;
1823             arg[1].arg_ptr.arg_str = str_smake(str);
1824             d = scanident(d,e,buf);
1825             (void)stabent(buf,TRUE);            /* make sure it's created */
1826             for (; *d; d++) {
1827                 if (*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') {
1828                     d = scanident(d,e,buf);
1829                     (void)stabent(buf,TRUE);
1830                 }
1831                 else if (*d == '@' && d[-1] != '\\') {
1832                     d = scanident(d,e,buf);
1833                     if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
1834                       strEQ(buf,"SIG") || strEQ(buf,"INC"))
1835                         (void)stabent(buf,TRUE);
1836                 }
1837             }
1838             goto get_repl;              /* skip compiling for now */
1839         }
1840     }
1841     scanconst(spat,str->str_ptr,len);
1842 get_repl:
1843     if (term != *start)
1844         s++;
1845     s = scanstr(s, SCAN_REPL);
1846     if (s >= bufend) {
1847         str_free(str);
1848         yyerror("Substitution replacement not terminated");
1849         yylval.arg = Nullarg;
1850         return s;
1851     }
1852     spat->spat_repl = yylval.arg;
1853     if ((spat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
1854         spat->spat_flags |= SPAT_CONST;
1855     else if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE) {
1856         STR *tmpstr;
1857         register char *t;
1858
1859         spat->spat_flags |= SPAT_CONST;
1860         tmpstr = spat->spat_repl[1].arg_ptr.arg_str;
1861         e = tmpstr->str_ptr + tmpstr->str_cur;
1862         for (t = tmpstr->str_ptr; t < e; t++) {
1863             if (*t == '$' && t[1] && (index("`'&+0123456789",t[1]) ||
1864               (t[1] == '{' /*}*/ && isDIGIT(t[2])) ))
1865                 spat->spat_flags &= ~SPAT_CONST;
1866         }
1867     }
1868     while (*s == 'g' || *s == 'i' || *s == 'e' || *s == 'o') {
1869         int es = 0;
1870
1871         if (*s == 'e') {
1872             s++;
1873             es++;
1874             if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE)
1875                 spat->spat_repl[1].arg_type = A_SINGLE;
1876             spat->spat_repl = make_op(
1877                 (!es && spat->spat_repl[1].arg_type == A_SINGLE
1878                         ? O_EVALONCE
1879                         : O_EVAL),
1880                 2,
1881                 spat->spat_repl,
1882                 Nullarg,
1883                 Nullarg);
1884             spat->spat_flags &= ~SPAT_CONST;
1885         }
1886         if (*s == 'g') {
1887             s++;
1888             spat->spat_flags |= SPAT_GLOBAL;
1889         }
1890         if (*s == 'i') {
1891             s++;
1892             sawi = TRUE;
1893             spat->spat_flags |= SPAT_FOLD;
1894             if (!(spat->spat_flags & SPAT_SCANFIRST)) {
1895                 str_free(spat->spat_short);     /* anchored opt doesn't do */
1896                 spat->spat_short = Nullstr;     /* case insensitive match */
1897                 spat->spat_slen = 0;
1898             }
1899         }
1900         if (*s == 'o') {
1901             s++;
1902             spat->spat_flags |= SPAT_KEEP;
1903         }
1904     }
1905     if (spat->spat_short && (spat->spat_flags & SPAT_SCANFIRST))
1906         fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
1907     if (!spat->spat_runtime) {
1908         spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
1909           spat->spat_flags & SPAT_FOLD);
1910         hoistmust(spat);
1911     }
1912     yylval.arg = make_match(O_SUBST,stab2arg(A_STAB,defstab),spat);
1913     str_free(str);
1914     return s;
1915 }
1916
1917 void
1918 hoistmust(spat)
1919 register SPAT *spat;
1920 {
1921     if (!spat->spat_short && spat->spat_regexp->regstart &&
1922         (!spat->spat_regexp->regmust || spat->spat_regexp->reganch & ROPT_ANCH)
1923        ) {
1924         if (!(spat->spat_regexp->reganch & ROPT_ANCH))
1925             spat->spat_flags |= SPAT_SCANFIRST;
1926         else if (spat->spat_flags & SPAT_FOLD)
1927             return;
1928         spat->spat_short = str_smake(spat->spat_regexp->regstart);
1929     }
1930     else if (spat->spat_regexp->regmust) {/* is there a better short-circuit? */
1931         if (spat->spat_short &&
1932           str_eq(spat->spat_short,spat->spat_regexp->regmust))
1933         {
1934             if (spat->spat_flags & SPAT_SCANFIRST) {
1935                 str_free(spat->spat_short);
1936                 spat->spat_short = Nullstr;
1937             }
1938             else {
1939                 str_free(spat->spat_regexp->regmust);
1940                 spat->spat_regexp->regmust = Nullstr;
1941                 return;
1942             }
1943         }
1944         if (!spat->spat_short ||        /* promote the better string */
1945           ((spat->spat_flags & SPAT_SCANFIRST) &&
1946            (spat->spat_short->str_cur < spat->spat_regexp->regmust->str_cur) )){
1947             str_free(spat->spat_short);         /* ok if null */
1948             spat->spat_short = spat->spat_regexp->regmust;
1949             spat->spat_regexp->regmust = Nullstr;
1950             spat->spat_flags |= SPAT_SCANFIRST;
1951         }
1952     }
1953 }
1954
1955 char *
1956 scantrans(start)
1957 char *start;
1958 {
1959     register char *s = start;
1960     ARG *arg =
1961         l(make_op(O_TRANS,2,stab2arg(A_STAB,defstab),Nullarg,Nullarg));
1962     STR *tstr;
1963     STR *rstr;
1964     register char *t;
1965     register char *r;
1966     register short *tbl;
1967     register int i;
1968     register int j;
1969     int tlen, rlen;
1970     int squash;
1971     int delete;
1972     int complement;
1973
1974     New(803,tbl,256,short);
1975     arg[2].arg_type = A_NULL;
1976     arg[2].arg_ptr.arg_cval = (char*) tbl;
1977
1978     s = scanstr(s, SCAN_TR);
1979     if (s >= bufend) {
1980         yyerror("Translation pattern not terminated");
1981         yylval.arg = Nullarg;
1982         return s;
1983     }
1984     tstr = yylval.arg[1].arg_ptr.arg_str;
1985     yylval.arg[1].arg_ptr.arg_str = Nullstr;
1986     arg_free(yylval.arg);
1987     t = tstr->str_ptr;
1988     tlen = tstr->str_cur;
1989
1990     if (s[-1] == *start)
1991         s--;
1992
1993     s = scanstr(s, SCAN_TR|SCAN_REPL);
1994     if (s >= bufend) {
1995         yyerror("Translation replacement not terminated");
1996         yylval.arg = Nullarg;
1997         return s;
1998     }
1999     rstr = yylval.arg[1].arg_ptr.arg_str;
2000     yylval.arg[1].arg_ptr.arg_str = Nullstr;
2001     arg_free(yylval.arg);
2002     r = rstr->str_ptr;
2003     rlen = rstr->str_cur;
2004
2005     complement = delete = squash = 0;
2006     while (*s == 'c' || *s == 'd' || *s == 's') {
2007         if (*s == 'c')
2008             complement = 1;
2009         else if (*s == 'd')
2010             delete = 2;
2011         else
2012             squash = 1;
2013         s++;
2014     }
2015     arg[2].arg_len = delete|squash;
2016     yylval.arg = arg;
2017     if (complement) {
2018         Zero(tbl, 256, short);
2019         for (i = 0; i < tlen; i++)
2020             tbl[t[i] & 0377] = -1;
2021         for (i = 0, j = 0; i < 256; i++) {
2022             if (!tbl[i]) {
2023                 if (j >= rlen) {
2024                     if (delete)
2025                         tbl[i] = -2;
2026                     else if (rlen)
2027                         tbl[i] = r[j-1] & 0377;
2028                     else
2029                         tbl[i] = i;
2030                 }
2031                 else
2032                     tbl[i] = r[j++] & 0377;
2033             }
2034         }
2035     }
2036     else {
2037         if (!rlen && !delete) {
2038             r = t; rlen = tlen;
2039         }
2040         for (i = 0; i < 256; i++)
2041             tbl[i] = -1;
2042         for (i = 0, j = 0; i < tlen; i++,j++) {
2043             if (j >= rlen) {
2044                 if (delete) {
2045                     if (tbl[t[i] & 0377] == -1)
2046                         tbl[t[i] & 0377] = -2;
2047                     continue;
2048                 }
2049                 --j;
2050             }
2051             if (tbl[t[i] & 0377] == -1)
2052                 tbl[t[i] & 0377] = r[j] & 0377;
2053         }
2054     }
2055     str_free(tstr);
2056     str_free(rstr);
2057     return s;
2058 }
2059
2060 char *
2061 scanstr(start, in_what)
2062 char *start;
2063 int in_what;
2064 {
2065     register char *s = start;
2066     register char term;
2067     register char *d;
2068     register ARG *arg;
2069     register char *send;
2070     register bool makesingle = FALSE;
2071     register STAB *stab;
2072     bool alwaysdollar = FALSE;
2073     bool hereis = FALSE;
2074     STR *herewas;
2075     STR *str;
2076     /* which backslash sequences to keep */
2077     char *leave = (in_what & SCAN_TR)
2078         ? "\\$@nrtfbeacx0123456789-"
2079         : "\\$@nrtfbeacx0123456789[{]}lLuUE";
2080     int len;
2081
2082     arg = op_new(1);
2083     yylval.arg = arg;
2084     arg->arg_type = O_ITEM;
2085
2086     switch (*s) {
2087     default:                    /* a substitution replacement */
2088         arg[1].arg_type = A_DOUBLE;
2089         makesingle = TRUE;      /* maybe disable runtime scanning */
2090         term = *s;
2091         if (term == '\'')
2092             leave = Nullch;
2093         goto snarf_it;
2094     case '0':
2095         {
2096             unsigned long i;
2097             int shift;
2098
2099             arg[1].arg_type = A_SINGLE;
2100             if (s[1] == 'x') {
2101                 shift = 4;
2102                 s += 2;
2103             }
2104             else if (s[1] == '.')
2105                 goto decimal;
2106             else
2107                 shift = 3;
2108             i = 0;
2109             for (;;) {
2110                 switch (*s) {
2111                 default:
2112                     goto out;
2113                 case '_':
2114                     s++;
2115                     break;
2116                 case '8': case '9':
2117                     if (shift != 4)
2118                         yyerror("Illegal octal digit");
2119                     /* FALL THROUGH */
2120                 case '0': case '1': case '2': case '3': case '4':
2121                 case '5': case '6': case '7':
2122                     i <<= shift;
2123                     i += *s++ & 15;
2124                     break;
2125                 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
2126                 case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
2127                     if (shift != 4)
2128                         goto out;
2129                     i <<= 4;
2130                     i += (*s++ & 7) + 9;
2131                     break;
2132                 }
2133             }
2134           out:
2135             str = Str_new(92,0);
2136             str_numset(str,(double)i);
2137             if (str->str_ptr) {
2138                 Safefree(str->str_ptr);
2139                 str->str_ptr = Nullch;
2140                 str->str_len = str->str_cur = 0;
2141             }
2142             arg[1].arg_ptr.arg_str = str;
2143         }
2144         break;
2145     case '1': case '2': case '3': case '4': case '5':
2146     case '6': case '7': case '8': case '9': case '.':
2147       decimal:
2148         arg[1].arg_type = A_SINGLE;
2149         d = tokenbuf;
2150         while (isDIGIT(*s) || *s == '_') {
2151             if (*s == '_')
2152                 s++;
2153             else
2154                 *d++ = *s++;
2155         }
2156         if (*s == '.' && s[1] != '.') {
2157             *d++ = *s++;
2158             while (isDIGIT(*s) || *s == '_') {
2159                 if (*s == '_')
2160                     s++;
2161                 else
2162                     *d++ = *s++;
2163             }
2164         }
2165         if (*s && index("eE",*s) && index("+-0123456789",s[1])) {
2166             *d++ = *s++;
2167             if (*s == '+' || *s == '-')
2168                 *d++ = *s++;
2169             while (isDIGIT(*s))
2170                 *d++ = *s++;
2171         }
2172         *d = '\0';
2173         str = Str_new(92,0);
2174         str_numset(str,atof(tokenbuf));
2175         if (str->str_ptr) {
2176             Safefree(str->str_ptr);
2177             str->str_ptr = Nullch;
2178             str->str_len = str->str_cur = 0;
2179         }
2180         arg[1].arg_ptr.arg_str = str;
2181         break;
2182     case '<':
2183         if (in_what & (SCAN_REPL|SCAN_TR))
2184             goto do_double;
2185         if (*++s == '<') {
2186             hereis = TRUE;
2187             d = tokenbuf;
2188             if (!rsfp)
2189                 *d++ = '\n';
2190             if (*++s && index("`'\"",*s)) {
2191                 term = *s++;
2192                 s = cpytill(d,s,bufend,term,&len);
2193                 if (s < bufend)
2194                     s++;
2195                 d += len;
2196             }
2197             else {
2198                 if (*s == '\\')
2199                     s++, term = '\'';
2200                 else
2201                     term = '"';
2202                 while (isALNUM(*s))
2203                     *d++ = *s++;
2204             }                           /* assuming tokenbuf won't clobber */
2205             *d++ = '\n';
2206             *d = '\0';
2207             len = d - tokenbuf;
2208             d = "\n";
2209             if (rsfp || !(d=ninstr(s,bufend,d,d+1)))
2210                 herewas = str_make(s,bufend-s);
2211             else
2212                 s--, herewas = str_make(s,d-s);
2213             s += herewas->str_cur;
2214             if (term == '\'')
2215                 goto do_single;
2216             if (term == '`')
2217                 goto do_back;
2218             goto do_double;
2219         }
2220         d = tokenbuf;
2221         s = cpytill(d,s,bufend,'>',&len);
2222         if (s < bufend)
2223             s++;
2224         else
2225             fatal("Unterminated <> operator");
2226
2227         if (*d == '$') d++;
2228         while (*d && (isALNUM(*d) || *d == '\''))
2229             d++;
2230         if (d - tokenbuf != len) {
2231             s = start;
2232             term = *s;
2233             arg[1].arg_type = A_GLOB;
2234             set_csh();
2235             alwaysdollar = TRUE;        /* treat $) and $| as variables */
2236             goto snarf_it;
2237         }
2238         else {
2239             d = tokenbuf;
2240             if (!len)
2241                 (void)strcpy(d,"ARGV");
2242             if (*d == '$') {
2243                 arg[1].arg_type = A_INDREAD;
2244                 arg[1].arg_ptr.arg_stab = stabent(d+1,TRUE);
2245             }
2246             else {
2247                 arg[1].arg_type = A_READ;
2248                 arg[1].arg_ptr.arg_stab = stabent(d,TRUE);
2249                 if (!stab_io(arg[1].arg_ptr.arg_stab))
2250                     stab_io(arg[1].arg_ptr.arg_stab) = stio_new();
2251                 if (strEQ(d,"ARGV")) {
2252                     (void)aadd(arg[1].arg_ptr.arg_stab);
2253                     stab_io(arg[1].arg_ptr.arg_stab)->flags |=
2254                       IOF_ARGV|IOF_START;
2255                 }
2256             }
2257         }
2258         break;
2259
2260     case 'q':
2261         s++;
2262         if (*s == 'q') {
2263             s++;
2264             goto do_double;
2265         }
2266         if (*s == 'x') {
2267             s++;
2268             goto do_back;
2269         }
2270         /* FALL THROUGH */
2271     case '\'':
2272       do_single:
2273         term = *s;
2274         arg[1].arg_type = A_SINGLE;
2275         leave = Nullch;
2276         goto snarf_it;
2277
2278     case '"':
2279       do_double:
2280         term = *s;
2281         arg[1].arg_type = A_DOUBLE;
2282         makesingle = TRUE;      /* maybe disable runtime scanning */
2283         alwaysdollar = TRUE;    /* treat $) and $| as variables */
2284         goto snarf_it;
2285     case '`':
2286       do_back:
2287         term = *s;
2288         arg[1].arg_type = A_BACKTICK;
2289         set_csh();
2290         alwaysdollar = TRUE;    /* treat $) and $| as variables */
2291       snarf_it:
2292         {
2293             STR *tmpstr;
2294             STR *tmpstr2 = Nullstr;
2295             char *tmps;
2296
2297             CLINE;
2298             multi_start = curcmd->c_line;
2299             if (hereis)
2300                 multi_open = multi_close = '<';
2301             else {
2302                 multi_open = term;
2303                 if (term && (tmps = index("([{< )]}> )]}>",term)))
2304                     term = tmps[5];
2305                 multi_close = term;
2306             }
2307             tmpstr = Str_new(87,80);
2308             if (hereis) {
2309                 term = *tokenbuf;
2310                 if (!rsfp) {
2311                     d = s;
2312                     while (s < bufend &&
2313                       (*s != term || bcmp(s,tokenbuf,len) != 0) ) {
2314                         if (*s++ == '\n')
2315                             curcmd->c_line++;
2316                     }
2317                     if (s >= bufend) {
2318                         curcmd->c_line = multi_start;
2319                         fatal("EOF in string");
2320                     }
2321                     str_nset(tmpstr,d+1,s-d);
2322                     s += len - 1;
2323                     str_ncat(herewas,s,bufend-s);
2324                     str_replace(linestr,herewas);
2325                     oldoldbufptr = oldbufptr = bufptr = s = str_get(linestr);
2326                     bufend = linestr->str_ptr + linestr->str_cur;
2327                     hereis = FALSE;
2328                 }
2329                 else
2330                     str_nset(tmpstr,"",0);   /* avoid "uninitialized" warning */
2331             }
2332             else
2333                 s = str_append_till(tmpstr,s+1,bufend,term,leave);
2334             while (s >= bufend) {       /* multiple line string? */
2335                 if (!rsfp ||
2336                  !(oldoldbufptr = oldbufptr = s = str_gets(linestr, rsfp, 0))) {
2337                     curcmd->c_line = multi_start;
2338                     fatal("EOF in string");
2339                 }
2340                 curcmd->c_line++;
2341                 if (perldb) {
2342                     STR *str = Str_new(88,0);
2343
2344                     str_sset(str,linestr);
2345                     astore(stab_xarray(curcmd->c_filestab),
2346                       (int)curcmd->c_line,str);
2347                 }
2348                 bufend = linestr->str_ptr + linestr->str_cur;
2349                 if (hereis) {
2350                     if (*s == term && bcmp(s,tokenbuf,len) == 0) {
2351                         s = bufend - 1;
2352                         *s = ' ';
2353                         str_scat(linestr,herewas);
2354                         bufend = linestr->str_ptr + linestr->str_cur;
2355                     }
2356                     else {
2357                         s = bufend;
2358                         str_scat(tmpstr,linestr);
2359                     }
2360                 }
2361                 else
2362                     s = str_append_till(tmpstr,s,bufend,term,leave);
2363             }
2364             multi_end = curcmd->c_line;
2365             s++;
2366             if (tmpstr->str_cur + 5 < tmpstr->str_len) {
2367                 tmpstr->str_len = tmpstr->str_cur + 1;
2368                 Renew(tmpstr->str_ptr, tmpstr->str_len, char);
2369             }
2370             if (arg[1].arg_type == A_SINGLE) {
2371                 arg[1].arg_ptr.arg_str = tmpstr;
2372                 break;
2373             }
2374             tmps = s;
2375             s = tmpstr->str_ptr;
2376             send = s + tmpstr->str_cur;
2377             while (s < send) {          /* see if we can make SINGLE */
2378                 if (*s == '\\' && s[1] && isDIGIT(s[1]) && !isDIGIT(s[2]) &&
2379                   !alwaysdollar && s[1] != '0')
2380                     *s = '$';           /* grandfather \digit in subst */
2381                 if ((*s == '$' || *s == '@') && s+1 < send &&
2382                   (alwaysdollar || (s[1] != ')' && s[1] != '|'))) {
2383                     makesingle = FALSE; /* force interpretation */
2384                 }
2385                 else if (*s == '\\' && s+1 < send) {
2386                     if (index("lLuUE",s[1]))
2387                         makesingle = FALSE;
2388                     s++;
2389                 }
2390                 s++;
2391             }
2392             s = d = tmpstr->str_ptr;    /* assuming shrinkage only */
2393             while (s < send) {
2394                 if (in_what & SCAN_TR) {
2395                     if (*s != '\\' && s[1] == '-' && s+2 < send) {
2396                         int i;
2397                         if (!tmpstr2) { /* oops, have to grow */
2398                             tmpstr2 = str_smake(tmpstr);
2399                             s = tmpstr2->str_ptr + (s - tmpstr->str_ptr);
2400                             send = tmpstr2->str_ptr + (send - tmpstr->str_ptr);
2401                         }
2402                         i = d - tmpstr->str_ptr;
2403                         STR_GROW(tmpstr, tmpstr->str_len + 256);
2404                         d = tmpstr->str_ptr + i;
2405                         for (i = (s[0] & 0377); i <= (s[2] & 0377); i++)
2406                             *d++ = i;
2407                         s += 3;
2408                         continue;
2409                     }
2410                 }
2411                 else {
2412                     if ((*s == '$' && s+1 < send &&
2413                         (alwaysdollar || /*(*/(s[1] != ')' && s[1] != '|')) ) ||
2414                         (*s == '@' && s+1 < send) ) {
2415                         if (s[1] == '#' && (isALPHA(s[2]) || s[2] == '_'))
2416                             *d++ = *s++;
2417                         len = scanident(s,send,tokenbuf) - s;
2418                         if (*s == '$' || strEQ(tokenbuf,"ARGV")
2419                           || strEQ(tokenbuf,"ENV")
2420                           || strEQ(tokenbuf,"SIG")
2421                           || strEQ(tokenbuf,"INC") )
2422                             (void)stabent(tokenbuf,TRUE); /* add symbol */
2423                         while (len--)
2424                             *d++ = *s++;
2425                         continue;
2426                     }
2427                 }
2428                 if (*s == '\\' && s+1 < send) {
2429                     s++;
2430                     switch (*s) {
2431                     default:
2432                         if (!makesingle && (!leave || (*s && index(leave,*s))))
2433                             *d++ = '\\';
2434                         *d++ = *s++;
2435                         continue;
2436                     case '0': case '1': case '2': case '3':
2437                     case '4': case '5': case '6': case '7':
2438                         *d++ = scanoct(s, 3, &len);
2439                         s += len;
2440                         continue;
2441                     case 'x':
2442                         *d++ = scanhex(++s, 2, &len);
2443                         s += len;
2444                         continue;
2445                     case 'c':
2446                         s++;
2447                         *d = *s++;
2448                         if (isLOWER(*d))
2449                             *d = toupper(*d);
2450                         *d++ ^= 64;
2451                         continue;
2452                     case 'b':
2453                         *d++ = '\b';
2454                         break;
2455                     case 'n':
2456                         *d++ = '\n';
2457                         break;
2458                     case 'r':
2459                         *d++ = '\r';
2460                         break;
2461                     case 'f':
2462                         *d++ = '\f';
2463                         break;
2464                     case 't':
2465                         *d++ = '\t';
2466                         break;
2467                     case 'e':
2468                         *d++ = '\033';
2469                         break;
2470                     case 'a':
2471                         *d++ = '\007';
2472                         break;
2473                     }
2474                     s++;
2475                     continue;
2476                 }
2477                 *d++ = *s++;
2478             }
2479             *d = '\0';
2480
2481             if (arg[1].arg_type == A_DOUBLE && makesingle)
2482                 arg[1].arg_type = A_SINGLE;     /* now we can optimize on it */
2483
2484             tmpstr->str_cur = d - tmpstr->str_ptr;
2485             if (arg[1].arg_type == A_GLOB) {
2486                 arg[1].arg_ptr.arg_stab = stab = genstab();
2487                 stab_io(stab) = stio_new();
2488                 str_sset(stab_val(stab), tmpstr);
2489             }
2490             else
2491                 arg[1].arg_ptr.arg_str = tmpstr;
2492             s = tmps;
2493             if (tmpstr2)
2494                 str_free(tmpstr2);
2495             break;
2496         }
2497     }
2498     if (hereis)
2499         str_free(herewas);
2500     return s;
2501 }
2502
2503 FCMD *
2504 load_format()
2505 {
2506     FCMD froot;
2507     FCMD *flinebeg;
2508     char *eol;
2509     register FCMD *fprev = &froot;
2510     register FCMD *fcmd;
2511     register char *s;
2512     register char *t;
2513     register STR *str;
2514     bool noblank;
2515     bool repeater;
2516
2517     Zero(&froot, 1, FCMD);
2518     s = bufptr;
2519     while (s < bufend || (rsfp && (s = str_gets(linestr,rsfp, 0)) != Nullch)) {
2520         curcmd->c_line++;
2521         if (in_eval && !rsfp) {
2522             eol = index(s,'\n');
2523             if (!eol++)
2524                 eol = bufend;
2525         }
2526         else
2527             eol = bufend = linestr->str_ptr + linestr->str_cur;
2528         if (perldb) {
2529             STR *tmpstr = Str_new(89,0);
2530
2531             str_nset(tmpstr, s, eol-s);
2532             astore(stab_xarray(curcmd->c_filestab), (int)curcmd->c_line,tmpstr);
2533         }
2534         if (*s == '.') {
2535             /*SUPPRESS 530*/
2536             for (t = s+1; *t == ' ' || *t == '\t'; t++) ;
2537             if (*t == '\n') {
2538                 bufptr = s;
2539                 return froot.f_next;
2540             }
2541         }
2542         if (*s == '#') {
2543             s = eol;
2544             continue;
2545         }
2546         flinebeg = Nullfcmd;
2547         noblank = FALSE;
2548         repeater = FALSE;
2549         while (s < eol) {
2550             Newz(804,fcmd,1,FCMD);
2551             fprev->f_next = fcmd;
2552             fprev = fcmd;
2553             for (t=s; t < eol && *t != '@' && *t != '^'; t++) {
2554                 if (*t == '~') {
2555                     noblank = TRUE;
2556                     *t = ' ';
2557                     if (t[1] == '~') {
2558                         repeater = TRUE;
2559                         t[1] = ' ';
2560                     }
2561                 }
2562             }
2563             fcmd->f_pre = nsavestr(s, t-s);
2564             fcmd->f_presize = t-s;
2565             s = t;
2566             if (s >= eol) {
2567                 if (noblank)
2568                     fcmd->f_flags |= FC_NOBLANK;
2569                 if (repeater)
2570                     fcmd->f_flags |= FC_REPEAT;
2571                 break;
2572             }
2573             if (!flinebeg)
2574                 flinebeg = fcmd;                /* start values here */
2575             if (*s++ == '^')
2576                 fcmd->f_flags |= FC_CHOP;       /* for doing text filling */
2577             switch (*s) {
2578             case '*':
2579                 fcmd->f_type = F_LINES;
2580                 *s = '\0';
2581                 break;
2582             case '<':
2583                 fcmd->f_type = F_LEFT;
2584                 while (*s == '<')
2585                     s++;
2586                 break;
2587             case '>':
2588                 fcmd->f_type = F_RIGHT;
2589                 while (*s == '>')
2590                     s++;
2591                 break;
2592             case '|':
2593                 fcmd->f_type = F_CENTER;
2594                 while (*s == '|')
2595                     s++;
2596                 break;
2597             case '#':
2598             case '.':
2599                 /* Catch the special case @... and handle it as a string
2600                    field. */
2601                 if (*s == '.' && s[1] == '.') {
2602                     goto default_format;
2603                 }
2604                 fcmd->f_type = F_DECIMAL;
2605                 {
2606                     char *p;
2607
2608                     /* Read a format in the form @####.####, where either group
2609                        of ### may be empty, or the final .### may be missing. */
2610                     while (*s == '#')
2611                         s++;
2612                     if (*s == '.') {
2613                         s++;
2614                         p = s;
2615                         while (*s == '#')
2616                             s++;
2617                         fcmd->f_decimals = s-p;
2618                         fcmd->f_flags |= FC_DP;
2619                     } else {
2620                         fcmd->f_decimals = 0;
2621                     }
2622                 }
2623                 break;
2624             default:
2625             default_format:
2626                 fcmd->f_type = F_LEFT;
2627                 break;
2628             }
2629             if (fcmd->f_flags & FC_CHOP && *s == '.') {
2630                 fcmd->f_flags |= FC_MORE;
2631                 while (*s == '.')
2632                     s++;
2633             }
2634             fcmd->f_size = s-t;
2635         }
2636         if (flinebeg) {
2637           again:
2638             if (s >= bufend &&
2639               (!rsfp || (s = str_gets(linestr, rsfp, 0)) == Nullch) )
2640                 goto badform;
2641             curcmd->c_line++;
2642             if (in_eval && !rsfp) {
2643                 eol = index(s,'\n');
2644                 if (!eol++)
2645                     eol = bufend;
2646             }
2647             else
2648                 eol = bufend = linestr->str_ptr + linestr->str_cur;
2649             if (perldb) {
2650                 STR *tmpstr = Str_new(90,0);
2651
2652                 str_nset(tmpstr, s, eol-s);
2653                 astore(stab_xarray(curcmd->c_filestab),
2654                     (int)curcmd->c_line,tmpstr);
2655             }
2656             if (strnEQ(s,".\n",2)) {
2657                 bufptr = s;
2658                 yyerror("Missing values line");
2659                 return froot.f_next;
2660             }
2661             if (*s == '#') {
2662                 s = eol;
2663                 goto again;
2664             }
2665             str = flinebeg->f_unparsed = Str_new(91,eol - s);
2666             str->str_u.str_hash = curstash;
2667             str_nset(str,"(",1);
2668             flinebeg->f_line = curcmd->c_line;
2669             eol[-1] = '\0';
2670             if (!flinebeg->f_next->f_type || index(s, ',')) {
2671                 eol[-1] = '\n';
2672                 str_ncat(str, s, eol - s - 1);
2673                 str_ncat(str,",$$);",5);
2674                 s = eol;
2675             }
2676             else {
2677                 eol[-1] = '\n';
2678                 while (s < eol && isSPACE(*s))
2679                     s++;
2680                 t = s;
2681                 while (s < eol) {
2682                     switch (*s) {
2683                     case ' ': case '\t': case '\n': case ';':
2684                         str_ncat(str, t, s - t);
2685                         str_ncat(str, "," ,1);
2686                         while (s < eol && (isSPACE(*s) || *s == ';'))
2687                             s++;
2688                         t = s;
2689                         break;
2690                     case '$':
2691                         str_ncat(str, t, s - t);
2692                         t = s;
2693                         s = scanident(s,eol,tokenbuf);
2694                         str_ncat(str, t, s - t);
2695                         t = s;
2696                         if (s < eol && *s && index("$'\"",*s))
2697                             str_ncat(str, ",", 1);
2698                         break;
2699                     case '"': case '\'':
2700                         str_ncat(str, t, s - t);
2701                         t = s;
2702                         s++;
2703                         while (s < eol && (*s != *t || s[-1] == '\\'))
2704                             s++;
2705                         if (s < eol)
2706                             s++;
2707                         str_ncat(str, t, s - t);
2708                         t = s;
2709                         if (s < eol && *s && index("$'\"",*s))
2710                             str_ncat(str, ",", 1);
2711                         break;
2712                     default:
2713                         yyerror("Please use commas to separate fields");
2714                     }
2715                 }
2716                 str_ncat(str,"$$);",4);
2717             }
2718         }
2719     }
2720   badform:
2721     bufptr = str_get(linestr);
2722     yyerror("Format not terminated");
2723     return froot.f_next;
2724 }
2725
2726 static void
2727 set_csh()
2728 {
2729 #ifdef CSH
2730     if (!cshlen)
2731         cshlen = strlen(cshname);
2732 #endif
2733 }