toke.c

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