1 /* $RCSfile: toke.c,v $$Revision: 4.0.1.8 $$Date: 92/06/23 12:33:45 $
3 * Copyright (c) 1991, Larry Wall
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
9 * Revision 4.0.1.8 92/06/23 12:33:45 lwall
10 * patch35: bad interaction between backslash and hyphen in tr///
12 * Revision 4.0.1.7 92/06/11 21:16:30 lwall
13 * patch34: expectterm incorrectly set to indicate start of program or block
15 * Revision 4.0.1.6 92/06/08 16:03:49 lwall
16 * patch20: an EXPR may now start with a bareword
17 * patch20: print $fh EXPR can now expect term rather than operator in EXPR
18 * patch20: added ... as variant on ..
19 * patch20: new warning on spurious backslash
20 * patch20: new warning on missing $ for foreach variable
21 * patch20: "foo"x1024 now legal without space after x
22 * patch20: new warning on print accidentally used as function
23 * patch20: tr/stuff// wasn't working right
24 * patch20: 2. now eats the dot
25 * patch20: <@ARGV> now notices @ARGV
26 * patch20: tr/// now lets you say \-
28 * Revision 4.0.1.5 91/11/11 16:45:51 lwall
29 * patch19: default arg for shift was wrong after first subroutine definition
31 * Revision 4.0.1.4 91/11/05 19:02:48 lwall
32 * patch11: \x and \c were subject to double interpretation in regexps
33 * patch11: prepared for ctype implementations that don't define isascii()
34 * patch11: nested list operators could miscount parens
35 * patch11: once-thru blocks didn't display right in the debugger
36 * patch11: sort eval "whatever" didn't work
37 * patch11: underscore is now allowed within literal octal and hex numbers
39 * Revision 4.0.1.3 91/06/10 01:32:26 lwall
40 * patch10: m'$foo' now treats string as single quoted
41 * patch10: certain pattern optimizations were botched
43 * Revision 4.0.1.2 91/06/07 12:05:56 lwall
44 * patch4: new copyright notice
45 * patch4: debugger lost track of lines in eval
46 * patch4: //o and s///o now optimize themselves fully at runtime
47 * patch4: added global modifier for pattern matches
49 * Revision 4.0.1.1 91/04/12 09:18:18 lwall
50 * patch1: perl -de "print" wouldn't stop at the first statement
52 * Revision 4.0 91/03/20 01:42:14 lwall
61 static void set_csh();
74 /* which backslash sequences to keep in m// or s// */
76 static char *patleave = "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}";
78 char *reparse; /* if non-null, scanident found ${foo[$bar]} */
85 #define CLINE (cmdline = (curcmd->c_line < cmdline ? curcmd->c_line : cmdline))
88 #define PERL_META(c) ((c) | 128)
90 #define META(c) ((c) | 128)
93 #define RETURN(retval) return (bufptr = s,(int)retval)
94 #define OPERATOR(retval) return (expectterm = TRUE,bufptr = s,(int)retval)
95 #define TERM(retval) return (CLINE, expectterm = FALSE,bufptr = s,(int)retval)
96 #define LOOPX(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)LOOPEX)
97 #define FTST(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)FILETEST)
98 #define FUN0(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC0)
99 #define FUN1(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC1)
100 #define FUN2(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2)
101 #define FUN2x(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2x)
102 #define FUN3(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC3)
103 #define FUN4(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC4)
104 #define FUN5(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC5)
105 #define FL(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST)
106 #define FL2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST2)
107 #define HFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)HSHFUN)
108 #define HFUN3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)HSHFUN3)
109 #define LFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LVALFUN)
110 #define AOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)ADDOP)
111 #define MOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)MULOP)
112 #define EOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)EQOP)
113 #define ROP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)RELOP)
114 #define FOP(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP)
115 #define FOP2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP2)
116 #define FOP3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP3)
117 #define FOP4(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP4)
118 #define FOP22(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP22)
119 #define FOP25(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP25)
121 static char *last_uni;
123 /* This bit of chicanery makes a unary function followed by
124 * a parenthesis into a function with one argument, highest precedence.
126 #define UNI(f) return(yylval.ival = f, \
129 last_uni = oldbufptr, \
130 (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
132 /* This does similarly for list operators, merely by pretending that the
133 * paren came before the listop rather than after.
136 #define LOP(f) return(CLINE, *s == '(' || (s = skipspace(s), *s == '(') ? \
137 (*s = (char) PERL_META('('), bufptr = oldbufptr, '(') : \
138 (yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
140 #define LOP(f) return(CLINE, *s == '(' || (s = skipspace(s), *s == '(') ? \
141 (*s = (char) META('('), bufptr = oldbufptr, '(') : \
142 (yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
144 /* grandfather return to old style */
145 #define OLDLOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP)
151 while (s < bufend && isSPACE(*s))
161 if (oldoldbufptr != last_uni)
163 while (isSPACE(*last_uni))
165 for (s = last_uni; isALNUM(*s); s++) ;
168 warn("Warning: Use of \"%s\" without parens is ambiguous", last_uni);
176 #define UNI(f) return uni(f,s)
177 #define LOP(f) return lop(f,s)
187 last_uni = oldbufptr;
222 #endif /* CRIPPLED_CC */
227 register char *s = bufptr;
230 static bool in_format = FALSE;
231 static bool firstline = TRUE;
232 extern int yychar; /* last token */
234 oldoldbufptr = oldbufptr;
241 fprintf(stderr,"Tokener at %s",s);
243 fprintf(stderr,"Tokener at %s\n",s);
247 if ((*s & 127) == '(') {
251 else if ((*s & 127) == '}') {
256 warn("Unrecognized character \\%03o ignored", *s++ & 255);
262 if ((*s & 127) == '(') {
266 else if ((*s & 127) == '}') {
271 warn("Unrecognized character \\%03o ignored", *s++ & 255);
275 goto fake_eof; /* emulate EOF on ^D or ^Z */
280 goto retry; /* ignore stray nulls */
284 if (minus_n || minus_p || perldb) {
288 char *pdb = getenv("PERLDB");
290 str_cat(linestr, pdb ? pdb : "require 'perldb.pl'");
291 str_cat(linestr, ";");
293 if (minus_n || minus_p) {
294 str_cat(linestr,"line: while (<>) {");
296 str_cat(linestr,"chop;");
298 str_cat(linestr,"@F=split(' ');");
300 oldoldbufptr = oldbufptr = s = str_get(linestr);
301 bufend = linestr->str_ptr + linestr->str_cur;
307 yylval.formval = load_format();
309 oldoldbufptr = oldbufptr = s = str_get(linestr) + 1;
310 bufend = linestr->str_ptr + linestr->str_cur;
316 #endif /* CRYPTSCRIPT */
318 if ((s = str_gets(linestr, rsfp, 0)) == Nullch) {
322 (void)mypclose(rsfp);
323 else if ((FILE*)rsfp == stdin)
329 if (minus_n || minus_p) {
330 str_set(linestr,minus_p ? ";}continue{print" : "");
331 str_cat(linestr,";}");
332 oldoldbufptr = oldbufptr = s = str_get(linestr);
333 bufend = linestr->str_ptr + linestr->str_cur;
334 minus_n = minus_p = 0;
337 oldoldbufptr = oldbufptr = s = str_get(linestr);
339 RETURN(';'); /* not infinite loop because rsfp is NULL now */
341 if (doextract && *linestr->str_ptr == '#')
344 oldoldbufptr = oldbufptr = bufptr = s;
346 STR *str = Str_new(85,0);
348 str_sset(str,linestr);
349 astore(stab_xarray(curcmd->c_filestab),(int)curcmd->c_line,str);
357 bufend = linestr->str_ptr + linestr->str_cur;
358 if (curcmd->c_line == 1) {
359 if (*s == '#' && s[1] == '!') {
360 if (!in_eval && !instr(s,"perl") && instr(origargv[0],"perl")) {
368 while (s < bufend && !isSPACE(*s))
371 while (s < bufend && isSPACE(*s))
374 Newz(899,newargv,origargc+3,char*);
376 while (s < bufend && !isSPACE(*s))
379 Copy(origargv+1, newargv+2, origargc+1, char*);
385 fatal("Can't exec %s", cmd);
389 while (s < bufend && isSPACE(*s))
391 if (*s == ':') /* for csh's that have to exec sh scripts */
396 case ' ': case '\t': case '\f': case '\r': case 013:
400 if (preprocess && s == str_get(linestr) &&
401 s[1] == ' ' && (isDIGIT(s[2]) || strnEQ(s+2,"line ",5)) ) {
402 while (*s && !isDIGIT(*s))
404 curcmd->c_line = atoi(s)-1;
408 while (s < d && isSPACE(*s)) s++;
409 s[strlen(s)-1] = '\0'; /* wipe out newline */
412 s[strlen(s)-1] = '\0'; /* wipe out trailing quote */
415 curcmd->c_filestab = fstab(s);
417 curcmd->c_filestab = fstab(origfilename);
418 oldoldbufptr = oldbufptr = s = str_get(linestr);
422 if (in_eval && !rsfp) {
424 while (s < d && *s != '\n')
430 yylval.formval = load_format();
432 oldoldbufptr = oldbufptr = s = bufptr + 1;
443 if (s[1] && isALPHA(s[1]) && !isALPHA(s[2])) {
446 case 'r': FTST(O_FTEREAD);
447 case 'w': FTST(O_FTEWRITE);
448 case 'x': FTST(O_FTEEXEC);
449 case 'o': FTST(O_FTEOWNED);
450 case 'R': FTST(O_FTRREAD);
451 case 'W': FTST(O_FTRWRITE);
452 case 'X': FTST(O_FTREXEC);
453 case 'O': FTST(O_FTROWNED);
454 case 'e': FTST(O_FTIS);
455 case 'z': FTST(O_FTZERO);
456 case 's': FTST(O_FTSIZE);
457 case 'f': FTST(O_FTFILE);
458 case 'd': FTST(O_FTDIR);
459 case 'l': FTST(O_FTLINK);
460 case 'p': FTST(O_FTPIPE);
461 case 'S': FTST(O_FTSOCK);
462 case 'u': FTST(O_FTSUID);
463 case 'g': FTST(O_FTSGID);
464 case 'k': FTST(O_FTSVTX);
465 case 'b': FTST(O_FTBLK);
466 case 'c': FTST(O_FTCHR);
467 case 't': FTST(O_FTTTY);
468 case 'T': FTST(O_FTTEXT);
469 case 'B': FTST(O_FTBINARY);
470 case 'M': stabent("\024",TRUE); FTST(O_FTMTIME);
471 case 'A': stabent("\024",TRUE); FTST(O_FTATIME);
472 case 'C': stabent("\024",TRUE); FTST(O_FTCTIME);
484 if (isSPACE(*s) || !isSPACE(*bufptr))
497 if (isSPACE(*s) || !isSPACE(*bufptr))
507 s = scanident(s,bufend,tokenbuf);
508 yylval.stabval = stabent(tokenbuf,TRUE);
521 s = scanident(s,bufend,tokenbuf);
522 yylval.stabval = hadd(stabent(tokenbuf,TRUE));
538 yylval.ival = curcmd->c_line;
539 if (isSPACE(*s) || *s == '#')
540 cmdline = NOLINE; /* invalidate current command line number */
544 if (curcmd->c_line < cmdline)
545 cmdline = curcmd->c_line;
563 while (s < d && isSPACE(*s))
565 if (isALPHA(*s) || *s == '_' || *s == '\'')
566 *(--s) = '\\'; /* force next ident to WORD */
599 if (s[1] != '<' && !index(s,'>'))
601 s = scanstr(s, SCAN_DEF);
629 while (isALNUM(*s) || *s == '\'') \
631 while (d[-1] == '\'') \
637 if (s[1] == '#' && (isALPHA(s[2]) || s[2] == '_')) {
639 s = scanident(s,bufend,tokenbuf);
640 yylval.stabval = aadd(stabent(tokenbuf,TRUE));
644 s = scanident(s,bufend,tokenbuf);
645 if (reparse) { /* turn ${foo[bar]} into ($foo[bar]) */
653 yylval.stabval = stabent(tokenbuf,TRUE);
655 if (isSPACE(*s) && oldoldbufptr && oldoldbufptr < bufptr) {
657 while (isSPACE(*oldoldbufptr))
659 if (*oldoldbufptr == 'p' && strnEQ(oldoldbufptr,"print",5)) {
660 if (index("&*<%", *s) && isALPHA(s[1]))
661 expectterm = TRUE; /* e.g. print $fh &sub */
662 else if (*s == '.' && isDIGIT(s[1]))
663 expectterm = TRUE; /* e.g. print $fh .3 */
664 else if (index("/?-+", *s) && !isSPACE(s[1]))
665 expectterm = TRUE; /* e.g. print $fh -1 */
672 s = scanident(s,bufend,tokenbuf);
675 yylval.stabval = aadd(stabent(tokenbuf,TRUE));
678 case '/': /* may either be division or pattern */
679 case '?': /* may either be conditional or pattern */
691 if (!expectterm || !isDIGIT(s[1])) {
700 yylval.ival = AF_COMMON;
708 case '0': case '1': case '2': case '3': case '4':
709 case '5': case '6': case '7': case '8': case '9':
710 case '\'': case '"': case '`':
711 s = scanstr(s, SCAN_DEF);
714 case '\\': /* some magic to force next word to be a WORD */
715 s++; /* used by do and sub to force a separate namespace */
716 if (!isALPHA(*s) && *s != '_' && *s != '\'') {
717 warn("Spurious backslash ignored");
724 if (strEQ(d,"__LINE__") || strEQ(d,"__FILE__")) {
725 ARG *arg = op_new(1);
728 arg->arg_type = O_ITEM;
730 (void)sprintf(tokenbuf,"%ld",(long)curcmd->c_line);
732 strcpy(tokenbuf, stab_val(curcmd->c_filestab)->str_ptr);
733 arg[1].arg_type = A_SINGLE;
734 arg[1].arg_ptr.arg_str = str_make(tokenbuf,strlen(tokenbuf));
737 else if (strEQ(d,"__END__")) {
742 if (!in_eval && (stab = stabent("DATA",FALSE))) {
743 stab->str_pok |= SP_MULTI;
745 stab_io(stab) = stio_new();
746 stab_io(stab)->ifp = rsfp;
747 #if defined(HAS_FCNTL) && defined(F_SETFD)
749 fcntl(fd,F_SETFD,fd >= 3);
752 stab_io(stab)->type = '|';
753 else if ((FILE*)rsfp == stdin)
754 stab_io(stab)->type = '-';
756 stab_io(stab)->type = '<';
765 if (strEQ(d,"alarm"))
767 if (strEQ(d,"accept"))
769 if (strEQ(d,"atan2"))
776 if (strEQ(d,"binmode"))
783 if (strEQ(d,"continue"))
785 if (strEQ(d,"chdir")) {
786 (void)stabent("ENV",TRUE); /* may use HOME */
789 if (strEQ(d,"close"))
791 if (strEQ(d,"closedir"))
795 if (strEQ(d,"caller"))
797 if (strEQ(d,"crypt")) {
799 static int cryptseen = 0;
806 if (strEQ(d,"chmod"))
808 if (strEQ(d,"chown"))
810 if (strEQ(d,"connect"))
814 if (strEQ(d,"chroot"))
821 while (s < d && isSPACE(*s))
823 if (isALPHA(*s) || *s == '_')
824 *(--s) = '\\'; /* force next ident to WORD */
829 if (strEQ(d,"defined"))
831 if (strEQ(d,"delete"))
833 if (strEQ(d,"dbmopen"))
835 if (strEQ(d,"dbmclose"))
844 if (strEQ(d,"elsif")) {
845 yylval.ival = curcmd->c_line;
848 if (strEQ(d,"eq") || strEQ(d,"EQ"))
852 if (strEQ(d,"eval")) {
853 allstabs = TRUE; /* must initialize everything since */
854 UNI(O_EVAL); /* we don't know what will be used */
862 if (strEQ(d,"exec")) {
866 if (strEQ(d,"endhostent"))
868 if (strEQ(d,"endnetent"))
870 if (strEQ(d,"endservent"))
872 if (strEQ(d,"endprotoent"))
874 if (strEQ(d,"endpwent"))
876 if (strEQ(d,"endgrent"))
881 if (strEQ(d,"for") || strEQ(d,"foreach")) {
882 yylval.ival = curcmd->c_line;
883 while (s < bufend && isSPACE(*s))
886 fatal("Missing $ on loop variable");
889 if (strEQ(d,"format")) {
891 while (s < d && isSPACE(*s))
893 if (isALPHA(*s) || *s == '_')
894 *(--s) = '\\'; /* force next ident to WORD */
896 allstabs = TRUE; /* must initialize everything since */
897 OPERATOR(FORMAT); /* we don't know what will be used */
901 if (strEQ(d,"fcntl"))
903 if (strEQ(d,"fileno"))
905 if (strEQ(d,"flock"))
910 if (strEQ(d,"gt") || strEQ(d,"GT"))
912 if (strEQ(d,"ge") || strEQ(d,"GE"))
918 if (strEQ(d,"gmtime"))
922 if (strnEQ(d,"get",3)) {
929 if (strEQ(d,"priority"))
931 if (strEQ(d,"protobyname"))
933 if (strEQ(d,"protobynumber"))
935 if (strEQ(d,"protoent"))
937 if (strEQ(d,"pwent"))
939 if (strEQ(d,"pwnam"))
941 if (strEQ(d,"pwuid"))
943 if (strEQ(d,"peername"))
946 else if (*d == 'h') {
947 if (strEQ(d,"hostbyname"))
949 if (strEQ(d,"hostbyaddr"))
951 if (strEQ(d,"hostent"))
954 else if (*d == 'n') {
955 if (strEQ(d,"netbyname"))
957 if (strEQ(d,"netbyaddr"))
959 if (strEQ(d,"netent"))
962 else if (*d == 's') {
963 if (strEQ(d,"servbyname"))
965 if (strEQ(d,"servbyport"))
967 if (strEQ(d,"servent"))
969 if (strEQ(d,"sockname"))
971 if (strEQ(d,"sockopt"))
974 else if (*d == 'g') {
975 if (strEQ(d,"grent"))
977 if (strEQ(d,"grnam"))
979 if (strEQ(d,"grgid"))
982 else if (*d == 'l') {
983 if (strEQ(d,"login"))
997 yylval.ival = curcmd->c_line;
1000 if (strEQ(d,"index"))
1004 if (strEQ(d,"ioctl"))
1009 if (strEQ(d,"join"))
1014 if (strEQ(d,"keys"))
1016 if (strEQ(d,"kill"))
1021 if (strEQ(d,"last"))
1023 if (strEQ(d,"local"))
1025 if (strEQ(d,"length"))
1027 if (strEQ(d,"lt") || strEQ(d,"LT"))
1029 if (strEQ(d,"le") || strEQ(d,"LE"))
1031 if (strEQ(d,"localtime"))
1035 if (strEQ(d,"link"))
1037 if (strEQ(d,"listen"))
1039 if (strEQ(d,"lstat"))
1055 RETURN(1); /* force error */
1059 if (strEQ(d,"mkdir"))
1063 if (strEQ(d,"msgctl"))
1065 if (strEQ(d,"msgget"))
1067 if (strEQ(d,"msgrcv"))
1069 if (strEQ(d,"msgsnd"))
1076 if (strEQ(d,"next"))
1078 if (strEQ(d,"ne") || strEQ(d,"NE"))
1083 if (strEQ(d,"open"))
1089 if (strEQ(d,"opendir"))
1094 if (strEQ(d,"print")) {
1095 checkcomma(s,d,"filehandle");
1098 if (strEQ(d,"printf")) {
1099 checkcomma(s,d,"filehandle");
1102 if (strEQ(d,"push")) {
1103 yylval.ival = O_PUSH;
1108 if (strEQ(d,"pack"))
1110 if (strEQ(d,"package"))
1112 if (strEQ(d,"pipe"))
1118 s = scanstr(s-1, SCAN_DEF);
1121 if (strEQ(d,"qq")) {
1122 s = scanstr(s-2, SCAN_DEF);
1125 if (strEQ(d,"qx")) {
1126 s = scanstr(s-2, SCAN_DEF);
1132 if (strEQ(d,"return"))
1134 if (strEQ(d,"require")) {
1135 allstabs = TRUE; /* must initialize everything since */
1136 UNI(O_REQUIRE); /* we don't know what will be used */
1138 if (strEQ(d,"reset"))
1140 if (strEQ(d,"redo"))
1142 if (strEQ(d,"rename"))
1144 if (strEQ(d,"rand"))
1146 if (strEQ(d,"rmdir"))
1148 if (strEQ(d,"rindex"))
1150 if (strEQ(d,"read"))
1152 if (strEQ(d,"readdir"))
1154 if (strEQ(d,"rewinddir"))
1156 if (strEQ(d,"recv"))
1158 if (strEQ(d,"reverse"))
1160 if (strEQ(d,"readlink"))
1176 RETURN(1); /* force error */
1183 if (strEQ(d,"scalar"))
1189 if (strEQ(d,"select"))
1191 if (strEQ(d,"seek"))
1193 if (strEQ(d,"semctl"))
1195 if (strEQ(d,"semget"))
1197 if (strEQ(d,"semop"))
1199 if (strEQ(d,"send"))
1201 if (strEQ(d,"setpgrp"))
1203 if (strEQ(d,"setpriority"))
1204 FUN3(O_SETPRIORITY);
1205 if (strEQ(d,"sethostent"))
1207 if (strEQ(d,"setnetent"))
1209 if (strEQ(d,"setservent"))
1211 if (strEQ(d,"setprotoent"))
1213 if (strEQ(d,"setpwent"))
1215 if (strEQ(d,"setgrent"))
1217 if (strEQ(d,"seekdir"))
1219 if (strEQ(d,"setsockopt"))
1226 if (strEQ(d,"shift"))
1228 if (strEQ(d,"shmctl"))
1230 if (strEQ(d,"shmget"))
1232 if (strEQ(d,"shmread"))
1234 if (strEQ(d,"shmwrite"))
1236 if (strEQ(d,"shutdown"))
1247 if (strEQ(d,"sleep"))
1254 if (strEQ(d,"socket"))
1256 if (strEQ(d,"socketpair"))
1258 if (strEQ(d,"sort")) {
1259 checkcomma(s,d,"subroutine name");
1261 while (s < d && isSPACE(*s)) s++;
1262 if (*s == ';' || *s == ')') /* probably a close */
1263 fatal("sort is now a reserved word");
1264 if (isALPHA(*s) || *s == '_') {
1266 for (d = s; isALNUM(*d); d++) ;
1267 strncpy(tokenbuf,s,d-s);
1268 tokenbuf[d-s] = '\0';
1269 if (strNE(tokenbuf,"keys") &&
1270 strNE(tokenbuf,"values") &&
1271 strNE(tokenbuf,"split") &&
1272 strNE(tokenbuf,"grep") &&
1273 strNE(tokenbuf,"readdir") &&
1274 strNE(tokenbuf,"unpack") &&
1275 strNE(tokenbuf,"do") &&
1276 strNE(tokenbuf,"eval") &&
1277 (d >= bufend || isSPACE(*d)) )
1278 *(--s) = '\\'; /* force next ident to WORD */
1284 if (strEQ(d,"split"))
1286 if (strEQ(d,"sprintf"))
1288 if (strEQ(d,"splice")) {
1289 yylval.ival = O_SPLICE;
1294 if (strEQ(d,"sqrt"))
1298 if (strEQ(d,"srand"))
1304 if (strEQ(d,"stat"))
1306 if (strEQ(d,"study")) {
1312 if (strEQ(d,"substr"))
1314 if (strEQ(d,"sub")) {
1315 yylval.ival = savestack->ary_fill; /* restore stuff on reduce */
1319 subline = curcmd->c_line;
1321 while (s < d && isSPACE(*s))
1323 if (isALPHA(*s) || *s == '_' || *s == '\'') {
1324 str_sset(subname,curstname);
1325 str_ncat(subname,"'",1);
1326 for (d = s+1; isALNUM(*d) || *d == '\''; d++)
1331 str_ncat(subname,s,d-s);
1332 *(--s) = '\\'; /* force next ident to WORD */
1335 str_set(subname,"?");
1344 if (strEQ(d,"system")) {
1348 if (strEQ(d,"symlink"))
1350 if (strEQ(d,"syscall"))
1352 if (strEQ(d,"sysread"))
1354 if (strEQ(d,"syswrite"))
1363 if (strEQ(d,"tr")) {
1368 RETURN(1); /* force error */
1370 if (strEQ(d,"tell"))
1372 if (strEQ(d,"telldir"))
1374 if (strEQ(d,"time"))
1376 if (strEQ(d,"times"))
1378 if (strEQ(d,"truncate"))
1383 if (strEQ(d,"using"))
1385 if (strEQ(d,"until")) {
1386 yylval.ival = curcmd->c_line;
1389 if (strEQ(d,"unless")) {
1390 yylval.ival = curcmd->c_line;
1393 if (strEQ(d,"unlink"))
1395 if (strEQ(d,"undef"))
1397 if (strEQ(d,"unpack"))
1399 if (strEQ(d,"utime"))
1401 if (strEQ(d,"umask"))
1403 if (strEQ(d,"unshift")) {
1404 yylval.ival = O_UNSHIFT;
1410 if (strEQ(d,"values"))
1412 if (strEQ(d,"vec")) {
1419 if (strEQ(d,"while")) {
1420 yylval.ival = curcmd->c_line;
1423 if (strEQ(d,"warn"))
1425 if (strEQ(d,"wait"))
1427 if (strEQ(d,"waitpid"))
1429 if (strEQ(d,"wantarray")) {
1430 yylval.arg = op_new(1);
1431 yylval.arg->arg_type = O_ITEM;
1432 yylval.arg[1].arg_type = A_WANTARRAY;
1435 if (strEQ(d,"write"))
1439 if (*s == 'x' && isDIGIT(s[1]) && !expectterm) {
1467 yylval.cval = savestr(d);
1468 if (expectterm == 2) { /* special case: start of statement */
1469 while (isSPACE(*s)) s++;
1478 if (oldoldbufptr && oldoldbufptr < bufptr) {
1479 while (isSPACE(*oldoldbufptr))
1481 if (*oldoldbufptr == 'p' && strnEQ(oldoldbufptr,"print",5))
1483 else if (*oldoldbufptr == 's' && strnEQ(oldoldbufptr,"sort",4))
1486 return (CLINE, bufptr = s, (int)WORD);
1490 checkcomma(s,name,what)
1497 if (dowarn && *s == ' ' && s[1] == '(') {
1500 for (w++; *w && isSPACE(*w); w++) ;
1501 if (!w || !*w || !index(";|}", *w)) /* an advisory hack only... */
1502 warn("%s (...) interpreted as function",name);
1504 while (s < bufend && isSPACE(*s))
1508 while (s < bufend && isSPACE(*s))
1510 if (isALPHA(*s) || *s == '_') {
1514 while (s < bufend && isSPACE(*s))
1519 "tell eof times getlogin wait length shift umask getppid \
1520 cos exp int log rand sin sqrt ord wantarray",
1525 fatal("No comma allowed after %s", what);
1531 scanident(s,send,dest)
1533 register char *send;
1547 while (isALNUM(*s) || *s == '\'')
1550 while (d > dest+1 && d[-1] == '\'')
1556 if (*d == '{' /* } */ ) {
1559 while (s < send && brackets) {
1560 if (!reparse && (d == dest || (*s && isALNUM(*s) ))) {
1570 if (reparse && reparse == s - 1)
1584 if (*d == '^' && (isUPPER(*s) || index("[\\]^_?", *s))) {
1595 scanconst(spat,string,len)
1600 register STR *tmpstr;
1604 char *origstring = string;
1605 static char *vert = "|";
1607 if (ninstr(string, string+len, vert, vert+1))
1611 tmpstr = Str_new(86,len);
1612 str_nset(tmpstr,string,len);
1613 t = str_get(tmpstr);
1615 tmpstr->str_u.str_useful = 100;
1616 for (d=t; d < e; ) {
1624 case '.': case '[': case '$': case '(': case ')': case '|': case '+':
1629 if (d[1] && index("wWbB0123456789sSdDlLuUExc",d[1])) {
1633 Move(d+1,d,e-d,char);
1658 if (d[1] == '*' || (d[1] == '{' && d[2] == '0') || d[1] == '?') {
1670 tmpstr->str_cur = d - t;
1672 spat->spat_flags |= SPAT_ALL;
1673 if (*origstring != '^')
1674 spat->spat_flags |= SPAT_SCANFIRST;
1675 spat->spat_short = tmpstr;
1676 spat->spat_slen = d - t;
1683 register SPAT *spat;
1688 STR *str = Str_new(93,0);
1691 Newz(801,spat,1,SPAT);
1692 spat->spat_next = curstash->tbl_spatroot; /* link into spat list */
1693 curstash->tbl_spatroot = spat;
1702 spat->spat_flags |= SPAT_ONCE;
1705 fatal("panic: scanpat");
1707 s = str_append_till(str,s,bufend,s[-1],patleave);
1710 yyerror("Search pattern not terminated");
1711 yylval.arg = Nullarg;
1715 while (*s == 'i' || *s == 'o' || *s == 'g') {
1719 spat->spat_flags |= SPAT_FOLD;
1723 spat->spat_flags |= SPAT_KEEP;
1727 spat->spat_flags |= SPAT_GLOBAL;
1731 e = str->str_ptr + len;
1736 for (; d < e; d++) {
1739 else if ((*d == '$' && d[1] && d[1] != '|' && d[1] != ')') ||
1743 spat->spat_runtime = arg = op_new(1);
1744 arg->arg_type = O_ITEM;
1745 arg[1].arg_type = A_DOUBLE;
1746 arg[1].arg_ptr.arg_str = str_smake(str);
1747 d = scanident(d,bufend,buf);
1748 (void)stabent(buf,TRUE); /* make sure it's created */
1749 for (; d < e; d++) {
1752 else if (*d == '$' && d[1] && d[1] != '|' && d[1] != ')') {
1753 d = scanident(d,bufend,buf);
1754 (void)stabent(buf,TRUE);
1756 else if (*d == '@') {
1757 d = scanident(d,bufend,buf);
1758 if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
1759 strEQ(buf,"SIG") || strEQ(buf,"INC"))
1760 (void)stabent(buf,TRUE);
1763 goto got_pat; /* skip compiling for now */
1766 if (spat->spat_flags & SPAT_FOLD)
1767 StructCopy(spat, &savespat, SPAT);
1768 scanconst(spat,str->str_ptr,len);
1769 if ((spat->spat_flags & SPAT_ALL) && (spat->spat_flags & SPAT_SCANFIRST)) {
1770 fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
1771 spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
1772 spat->spat_flags & SPAT_FOLD);
1773 /* Note that this regexp can still be used if someone says
1774 * something like /a/ && s//b/; so we can't delete it.
1778 if (spat->spat_flags & SPAT_FOLD)
1779 StructCopy(&savespat, spat, SPAT);
1780 if (spat->spat_short)
1781 fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
1782 spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
1783 spat->spat_flags & SPAT_FOLD);
1788 yylval.arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat);
1796 register char *s = start;
1797 register SPAT *spat;
1801 STR *str = Str_new(93,0);
1804 if (term && (d = index("([{< )]}> )]}>",term)))
1807 Newz(802,spat,1,SPAT);
1808 spat->spat_next = curstash->tbl_spatroot; /* link into spat list */
1809 curstash->tbl_spatroot = spat;
1811 s = str_append_till(str,s+1,bufend,term,patleave);
1814 yyerror("Substitution pattern not terminated");
1815 yylval.arg = Nullarg;
1819 e = str->str_ptr + len;
1820 for (d = str->str_ptr; d < e; d++) {
1823 else if ((*d == '$' && d[1] && d[1] != '|' && /*(*/ d[1] != ')') ||
1827 spat->spat_runtime = arg = op_new(1);
1828 arg->arg_type = O_ITEM;
1829 arg[1].arg_type = A_DOUBLE;
1830 arg[1].arg_ptr.arg_str = str_smake(str);
1831 d = scanident(d,e,buf);
1832 (void)stabent(buf,TRUE); /* make sure it's created */
1834 if (*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') {
1835 d = scanident(d,e,buf);
1836 (void)stabent(buf,TRUE);
1838 else if (*d == '@' && d[-1] != '\\') {
1839 d = scanident(d,e,buf);
1840 if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
1841 strEQ(buf,"SIG") || strEQ(buf,"INC"))
1842 (void)stabent(buf,TRUE);
1845 goto get_repl; /* skip compiling for now */
1848 scanconst(spat,str->str_ptr,len);
1852 s = scanstr(s, SCAN_REPL);
1855 yyerror("Substitution replacement not terminated");
1856 yylval.arg = Nullarg;
1859 spat->spat_repl = yylval.arg;
1860 if ((spat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
1861 spat->spat_flags |= SPAT_CONST;
1862 else if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE) {
1866 spat->spat_flags |= SPAT_CONST;
1867 tmpstr = spat->spat_repl[1].arg_ptr.arg_str;
1868 e = tmpstr->str_ptr + tmpstr->str_cur;
1869 for (t = tmpstr->str_ptr; t < e; t++) {
1870 if (*t == '$' && t[1] && (index("`'&+0123456789",t[1]) ||
1871 (t[1] == '{' /*}*/ && isDIGIT(t[2])) ))
1872 spat->spat_flags &= ~SPAT_CONST;
1875 while (*s == 'g' || *s == 'i' || *s == 'e' || *s == 'o') {
1881 if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE)
1882 spat->spat_repl[1].arg_type = A_SINGLE;
1883 spat->spat_repl = make_op(
1884 (!es && spat->spat_repl[1].arg_type == A_SINGLE
1891 spat->spat_flags &= ~SPAT_CONST;
1895 spat->spat_flags |= SPAT_GLOBAL;
1900 spat->spat_flags |= SPAT_FOLD;
1901 if (!(spat->spat_flags & SPAT_SCANFIRST)) {
1902 str_free(spat->spat_short); /* anchored opt doesn't do */
1903 spat->spat_short = Nullstr; /* case insensitive match */
1904 spat->spat_slen = 0;
1909 spat->spat_flags |= SPAT_KEEP;
1912 if (spat->spat_short && (spat->spat_flags & SPAT_SCANFIRST))
1913 fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
1914 if (!spat->spat_runtime) {
1915 spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
1916 spat->spat_flags & SPAT_FOLD);
1919 yylval.arg = make_match(O_SUBST,stab2arg(A_STAB,defstab),spat);
1926 register SPAT *spat;
1928 if (!spat->spat_short && spat->spat_regexp->regstart &&
1929 (!spat->spat_regexp->regmust || spat->spat_regexp->reganch & ROPT_ANCH)
1931 if (!(spat->spat_regexp->reganch & ROPT_ANCH))
1932 spat->spat_flags |= SPAT_SCANFIRST;
1933 else if (spat->spat_flags & SPAT_FOLD)
1935 spat->spat_short = str_smake(spat->spat_regexp->regstart);
1937 else if (spat->spat_regexp->regmust) {/* is there a better short-circuit? */
1938 if (spat->spat_short &&
1939 str_eq(spat->spat_short,spat->spat_regexp->regmust))
1941 if (spat->spat_flags & SPAT_SCANFIRST) {
1942 str_free(spat->spat_short);
1943 spat->spat_short = Nullstr;
1946 str_free(spat->spat_regexp->regmust);
1947 spat->spat_regexp->regmust = Nullstr;
1951 if (!spat->spat_short || /* promote the better string */
1952 ((spat->spat_flags & SPAT_SCANFIRST) &&
1953 (spat->spat_short->str_cur < spat->spat_regexp->regmust->str_cur) )){
1954 str_free(spat->spat_short); /* ok if null */
1955 spat->spat_short = spat->spat_regexp->regmust;
1956 spat->spat_regexp->regmust = Nullstr;
1957 spat->spat_flags |= SPAT_SCANFIRST;
1966 register char *s = start;
1968 l(make_op(O_TRANS,2,stab2arg(A_STAB,defstab),Nullarg,Nullarg));
1973 register short *tbl;
1981 New(803,tbl,256,short);
1982 arg[2].arg_type = A_NULL;
1983 arg[2].arg_ptr.arg_cval = (char*) tbl;
1985 s = scanstr(s, SCAN_TR);
1987 yyerror("Translation pattern not terminated");
1988 yylval.arg = Nullarg;
1991 tstr = yylval.arg[1].arg_ptr.arg_str;
1992 yylval.arg[1].arg_ptr.arg_str = Nullstr;
1993 arg_free(yylval.arg);
1995 tlen = tstr->str_cur;
1997 if (s[-1] == *start)
2000 s = scanstr(s, SCAN_TR|SCAN_REPL);
2002 yyerror("Translation replacement not terminated");
2003 yylval.arg = Nullarg;
2006 rstr = yylval.arg[1].arg_ptr.arg_str;
2007 yylval.arg[1].arg_ptr.arg_str = Nullstr;
2008 arg_free(yylval.arg);
2010 rlen = rstr->str_cur;
2012 complement = delete = squash = 0;
2013 while (*s == 'c' || *s == 'd' || *s == 's') {
2022 arg[2].arg_len = delete|squash;
2025 Zero(tbl, 256, short);
2026 for (i = 0; i < tlen; i++)
2027 tbl[t[i] & 0377] = -1;
2028 for (i = 0, j = 0; i < 256; i++) {
2034 tbl[i] = r[j-1] & 0377;
2039 tbl[i] = r[j++] & 0377;
2044 if (!rlen && !delete) {
2047 for (i = 0; i < 256; i++)
2049 for (i = 0, j = 0; i < tlen; i++,j++) {
2052 if (tbl[t[i] & 0377] == -1)
2053 tbl[t[i] & 0377] = -2;
2058 if (tbl[t[i] & 0377] == -1)
2059 tbl[t[i] & 0377] = r[j] & 0377;
2068 scanstr(start, in_what)
2072 register char *s = start;
2076 register char *send;
2077 register bool makesingle = FALSE;
2078 register STAB *stab;
2079 bool alwaysdollar = FALSE;
2080 bool hereis = FALSE;
2083 /* which backslash sequences to keep */
2084 char *leave = (in_what & SCAN_TR)
2085 ? "\\$@nrtfbeacx0123456789-"
2086 : "\\$@nrtfbeacx0123456789[{]}lLuUE";
2091 arg->arg_type = O_ITEM;
2094 default: /* a substitution replacement */
2095 arg[1].arg_type = A_DOUBLE;
2096 makesingle = TRUE; /* maybe disable runtime scanning */
2106 arg[1].arg_type = A_SINGLE;
2111 else if (s[1] == '.')
2125 yyerror("Illegal octal digit");
2127 case '0': case '1': case '2': case '3': case '4':
2128 case '5': case '6': case '7':
2132 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
2133 case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
2137 i += (*s++ & 7) + 9;
2142 str = Str_new(92,0);
2143 str_numset(str,(double)i);
2145 Safefree(str->str_ptr);
2146 str->str_ptr = Nullch;
2147 str->str_len = str->str_cur = 0;
2149 arg[1].arg_ptr.arg_str = str;
2152 case '1': case '2': case '3': case '4': case '5':
2153 case '6': case '7': case '8': case '9': case '.':
2155 arg[1].arg_type = A_SINGLE;
2157 while (isDIGIT(*s) || *s == '_') {
2163 if (*s == '.' && s[1] != '.') {
2165 while (isDIGIT(*s) || *s == '_') {
2172 if (*s && index("eE",*s) && index("+-0123456789",s[1])) {
2174 if (*s == '+' || *s == '-')
2180 str = Str_new(92,0);
2181 str_numset(str,atof(tokenbuf));
2183 Safefree(str->str_ptr);
2184 str->str_ptr = Nullch;
2185 str->str_len = str->str_cur = 0;
2187 arg[1].arg_ptr.arg_str = str;
2190 if (in_what & (SCAN_REPL|SCAN_TR))
2197 if (*++s && index("`'\"",*s)) {
2199 s = cpytill(d,s,bufend,term,&len);
2211 } /* assuming tokenbuf won't clobber */
2216 if (rsfp || !(d=ninstr(s,bufend,d,d+1)))
2217 herewas = str_make(s,bufend-s);
2219 s--, herewas = str_make(s,d-s);
2220 s += herewas->str_cur;
2228 s = cpytill(d,s,bufend,'>',&len);
2232 fatal("Unterminated <> operator");
2235 while (*d && (isALNUM(*d) || *d == '\''))
2237 if (d - tokenbuf != len) {
2240 arg[1].arg_type = A_GLOB;
2242 alwaysdollar = TRUE; /* treat $) and $| as variables */
2248 (void)strcpy(d,"ARGV");
2250 arg[1].arg_type = A_INDREAD;
2251 arg[1].arg_ptr.arg_stab = stabent(d+1,TRUE);
2254 arg[1].arg_type = A_READ;
2255 arg[1].arg_ptr.arg_stab = stabent(d,TRUE);
2256 if (!stab_io(arg[1].arg_ptr.arg_stab))
2257 stab_io(arg[1].arg_ptr.arg_stab) = stio_new();
2258 if (strEQ(d,"ARGV")) {
2259 (void)aadd(arg[1].arg_ptr.arg_stab);
2260 stab_io(arg[1].arg_ptr.arg_stab)->flags |=
2281 arg[1].arg_type = A_SINGLE;
2288 arg[1].arg_type = A_DOUBLE;
2289 makesingle = TRUE; /* maybe disable runtime scanning */
2290 alwaysdollar = TRUE; /* treat $) and $| as variables */
2295 arg[1].arg_type = A_BACKTICK;
2297 alwaysdollar = TRUE; /* treat $) and $| as variables */
2301 STR *tmpstr2 = Nullstr;
2303 bool dorange = FALSE;
2306 multi_start = curcmd->c_line;
2308 multi_open = multi_close = '<';
2311 if (term && (tmps = index("([{< )]}> )]}>",term)))
2315 tmpstr = Str_new(87,80);
2320 while (s < bufend &&
2321 (*s != term || bcmp(s,tokenbuf,len) != 0) ) {
2326 curcmd->c_line = multi_start;
2327 fatal("EOF in string");
2329 str_nset(tmpstr,d+1,s-d);
2331 str_ncat(herewas,s,bufend-s);
2332 str_replace(linestr,herewas);
2333 oldoldbufptr = oldbufptr = bufptr = s = str_get(linestr);
2334 bufend = linestr->str_ptr + linestr->str_cur;
2338 str_nset(tmpstr,"",0); /* avoid "uninitialized" warning */
2341 s = str_append_till(tmpstr,s+1,bufend,term,leave);
2342 while (s >= bufend) { /* multiple line string? */
2344 !(oldoldbufptr = oldbufptr = s = str_gets(linestr, rsfp, 0))) {
2345 curcmd->c_line = multi_start;
2346 fatal("EOF in string");
2350 STR *str = Str_new(88,0);
2352 str_sset(str,linestr);
2353 astore(stab_xarray(curcmd->c_filestab),
2354 (int)curcmd->c_line,str);
2356 bufend = linestr->str_ptr + linestr->str_cur;
2358 if (*s == term && bcmp(s,tokenbuf,len) == 0) {
2361 str_scat(linestr,herewas);
2362 bufend = linestr->str_ptr + linestr->str_cur;
2366 str_scat(tmpstr,linestr);
2370 s = str_append_till(tmpstr,s,bufend,term,leave);
2372 multi_end = curcmd->c_line;
2374 if (tmpstr->str_cur + 5 < tmpstr->str_len) {
2375 tmpstr->str_len = tmpstr->str_cur + 1;
2376 Renew(tmpstr->str_ptr, tmpstr->str_len, char);
2378 if (arg[1].arg_type == A_SINGLE) {
2379 arg[1].arg_ptr.arg_str = tmpstr;
2383 s = tmpstr->str_ptr;
2384 send = s + tmpstr->str_cur;
2385 while (s < send) { /* see if we can make SINGLE */
2386 if (*s == '\\' && s[1] && isDIGIT(s[1]) && !isDIGIT(s[2]) &&
2387 !alwaysdollar && s[1] != '0')
2388 *s = '$'; /* grandfather \digit in subst */
2389 if ((*s == '$' || *s == '@') && s+1 < send &&
2390 (alwaysdollar || (s[1] != ')' && s[1] != '|'))) {
2391 makesingle = FALSE; /* force interpretation */
2393 else if (*s == '\\' && s+1 < send) {
2394 if (index("lLuUE",s[1]))
2400 s = d = tmpstr->str_ptr; /* assuming shrinkage only */
2401 while (s < send || dorange) {
2402 if (in_what & SCAN_TR) {
2406 if (!tmpstr2) { /* oops, have to grow */
2407 tmpstr2 = str_smake(tmpstr);
2408 s = tmpstr2->str_ptr + (s - tmpstr->str_ptr);
2409 send = tmpstr2->str_ptr + (send - tmpstr->str_ptr);
2411 i = d - tmpstr->str_ptr;
2412 STR_GROW(tmpstr, tmpstr->str_len + 256);
2413 d = tmpstr->str_ptr + i;
2416 for (i = (*d & 0377); i <= max; i++)
2421 else if (*s == '-' && s+1 < send && d != tmpstr->str_ptr) {
2427 if ((*s == '$' && s+1 < send &&
2428 (alwaysdollar || /*(*/(s[1] != ')' && s[1] != '|')) ) ||
2429 (*s == '@' && s+1 < send) ) {
2430 if (s[1] == '#' && (isALPHA(s[2]) || s[2] == '_'))
2432 len = scanident(s,send,tokenbuf) - s;
2433 if (*s == '$' || strEQ(tokenbuf,"ARGV")
2434 || strEQ(tokenbuf,"ENV")
2435 || strEQ(tokenbuf,"SIG")
2436 || strEQ(tokenbuf,"INC") )
2437 (void)stabent(tokenbuf,TRUE); /* add symbol */
2443 if (*s == '\\' && s+1 < send) {
2447 if (in_what & SCAN_TR) {
2453 if (!makesingle && (!leave || (*s && index(leave,*s))))
2457 case '0': case '1': case '2': case '3':
2458 case '4': case '5': case '6': case '7':
2459 *d++ = scanoct(s, 3, &len);
2463 *d++ = scanhex(++s, 2, &len);
2502 if (arg[1].arg_type == A_DOUBLE && makesingle)
2503 arg[1].arg_type = A_SINGLE; /* now we can optimize on it */
2505 tmpstr->str_cur = d - tmpstr->str_ptr;
2506 if (arg[1].arg_type == A_GLOB) {
2507 arg[1].arg_ptr.arg_stab = stab = genstab();
2508 stab_io(stab) = stio_new();
2509 str_sset(stab_val(stab), tmpstr);
2512 arg[1].arg_ptr.arg_str = tmpstr;
2530 register FCMD *fprev = &froot;
2531 register FCMD *fcmd;
2538 Zero(&froot, 1, FCMD);
2540 while (s < bufend || (rsfp && (s = str_gets(linestr,rsfp, 0)) != Nullch)) {
2542 if (in_eval && !rsfp) {
2543 eol = index(s,'\n');
2548 eol = bufend = linestr->str_ptr + linestr->str_cur;
2550 STR *tmpstr = Str_new(89,0);
2552 str_nset(tmpstr, s, eol-s);
2553 astore(stab_xarray(curcmd->c_filestab), (int)curcmd->c_line,tmpstr);
2557 for (t = s+1; *t == ' ' || *t == '\t'; t++) ;
2560 return froot.f_next;
2567 flinebeg = Nullfcmd;
2571 Newz(804,fcmd,1,FCMD);
2572 fprev->f_next = fcmd;
2574 for (t=s; t < eol && *t != '@' && *t != '^'; t++) {
2584 fcmd->f_pre = nsavestr(s, t-s);
2585 fcmd->f_presize = t-s;
2589 fcmd->f_flags |= FC_NOBLANK;
2591 fcmd->f_flags |= FC_REPEAT;
2595 flinebeg = fcmd; /* start values here */
2597 fcmd->f_flags |= FC_CHOP; /* for doing text filling */
2600 fcmd->f_type = F_LINES;
2604 fcmd->f_type = F_LEFT;
2609 fcmd->f_type = F_RIGHT;
2614 fcmd->f_type = F_CENTER;
2620 /* Catch the special case @... and handle it as a string
2622 if (*s == '.' && s[1] == '.') {
2623 goto default_format;
2625 fcmd->f_type = F_DECIMAL;
2629 /* Read a format in the form @####.####, where either group
2630 of ### may be empty, or the final .### may be missing. */
2638 fcmd->f_decimals = s-p;
2639 fcmd->f_flags |= FC_DP;
2641 fcmd->f_decimals = 0;
2647 fcmd->f_type = F_LEFT;
2650 if (fcmd->f_flags & FC_CHOP && *s == '.') {
2651 fcmd->f_flags |= FC_MORE;
2660 (!rsfp || (s = str_gets(linestr, rsfp, 0)) == Nullch) )
2663 if (in_eval && !rsfp) {
2664 eol = index(s,'\n');
2669 eol = bufend = linestr->str_ptr + linestr->str_cur;
2671 STR *tmpstr = Str_new(90,0);
2673 str_nset(tmpstr, s, eol-s);
2674 astore(stab_xarray(curcmd->c_filestab),
2675 (int)curcmd->c_line,tmpstr);
2677 if (strnEQ(s,".\n",2)) {
2679 yyerror("Missing values line");
2680 return froot.f_next;
2686 str = flinebeg->f_unparsed = Str_new(91,eol - s);
2687 str->str_u.str_hash = curstash;
2688 str_nset(str,"(",1);
2689 flinebeg->f_line = curcmd->c_line;
2691 if (!flinebeg->f_next->f_type || index(s, ',')) {
2693 str_ncat(str, s, eol - s - 1);
2694 str_ncat(str,",$$);",5);
2699 while (s < eol && isSPACE(*s))
2704 case ' ': case '\t': case '\n': case ';':
2705 str_ncat(str, t, s - t);
2706 str_ncat(str, "," ,1);
2707 while (s < eol && (isSPACE(*s) || *s == ';'))
2712 str_ncat(str, t, s - t);
2714 s = scanident(s,eol,tokenbuf);
2715 str_ncat(str, t, s - t);
2717 if (s < eol && *s && index("$'\"",*s))
2718 str_ncat(str, ",", 1);
2720 case '"': case '\'':
2721 str_ncat(str, t, s - t);
2724 while (s < eol && (*s != *t || s[-1] == '\\'))
2728 str_ncat(str, t, s - t);
2730 if (s < eol && *s && index("$'\"",*s))
2731 str_ncat(str, ",", 1);
2734 yyerror("Please use commas to separate fields");
2737 str_ncat(str,"$$);",4);
2742 bufptr = str_get(linestr);
2743 yyerror("Format not terminated");
2744 return froot.f_next;
2752 cshlen = strlen(cshname);