toke.c

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