toke.c

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