toke.c

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