toke.c

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