toke.c

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