toke.c

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