toke.c

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