toke.c

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