toke.c

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