Commit | Line | Data |
---|---|---|
13281fa4 | 1 | char rcsid[] = "$Header: perly.c,v 2.0.1.1 88/06/28 16:36:49 root Exp $"; |
8d063cd8 LW |
2 | /* |
3 | * $Log: perly.c,v $ | |
13281fa4 LW |
4 | * Revision 2.0.1.1 88/06/28 16:36:49 root |
5 | * patch1: added DOSUID code | |
6 | * | |
378cc40b LW |
7 | * Revision 2.0 88/06/05 00:09:56 root |
8 | * Baseline version 2.0. | |
8d063cd8 LW |
9 | * |
10 | */ | |
11 | ||
378cc40b LW |
12 | #include "EXTERN.h" |
13 | #include "perl.h" | |
14 | #include "perly.h" | |
15 | ||
16 | extern char *tokename[]; | |
17 | extern int yychar; | |
18 | ||
19 | static int cmd_tosave(); | |
20 | static int arg_tosave(); | |
21 | static int spat_tosave(); | |
8d063cd8 LW |
22 | |
23 | main(argc,argv,env) | |
24 | register int argc; | |
25 | register char **argv; | |
26 | register char **env; | |
27 | { | |
28 | register STR *str; | |
29 | register char *s; | |
378cc40b LW |
30 | char *index(), *strcpy(), *getenv(); |
31 | bool dosearch = FALSE; | |
13281fa4 LW |
32 | #ifdef DOSUID |
33 | char **origargv = argv; | |
34 | char *validarg = ""; | |
35 | #endif | |
8d063cd8 | 36 | |
378cc40b LW |
37 | uid = (int)getuid(); |
38 | euid = (int)geteuid(); | |
8d063cd8 | 39 | linestr = str_new(80); |
378cc40b LW |
40 | str_nset(linestr,"",0); |
41 | str = str_make(""); /* first used for -I flags */ | |
42 | incstab = aadd(stabent("INC",TRUE)); | |
8d063cd8 LW |
43 | for (argc--,argv++; argc; argc--,argv++) { |
44 | if (argv[0][0] != '-' || !argv[0][1]) | |
45 | break; | |
13281fa4 LW |
46 | #ifdef DOSUID |
47 | if (*validarg) | |
48 | validarg = " PHOOEY "; | |
49 | else | |
50 | validarg = argv[0]; | |
51 | #endif | |
52 | s = argv[0]+1; | |
8d063cd8 | 53 | reswitch: |
13281fa4 | 54 | switch (*s) { |
378cc40b LW |
55 | case 'a': |
56 | minus_a = TRUE; | |
13281fa4 | 57 | s++; |
378cc40b | 58 | goto reswitch; |
8d063cd8 LW |
59 | #ifdef DEBUGGING |
60 | case 'D': | |
13281fa4 | 61 | debug = atoi(s+1); |
8d063cd8 LW |
62 | #ifdef YYDEBUG |
63 | yydebug = (debug & 1); | |
64 | #endif | |
65 | break; | |
66 | #endif | |
67 | case 'e': | |
68 | if (!e_fp) { | |
378cc40b | 69 | e_tmpname = strcpy(safemalloc(sizeof(TMPPATH)),TMPPATH); |
8d063cd8 LW |
70 | mktemp(e_tmpname); |
71 | e_fp = fopen(e_tmpname,"w"); | |
72 | } | |
73 | if (argv[1]) | |
74 | fputs(argv[1],e_fp); | |
75 | putc('\n', e_fp); | |
76 | argc--,argv++; | |
77 | break; | |
78 | case 'i': | |
13281fa4 | 79 | inplace = savestr(s+1); |
8d063cd8 LW |
80 | argvoutstab = stabent("ARGVOUT",TRUE); |
81 | break; | |
82 | case 'I': | |
13281fa4 LW |
83 | str_cat(str,"-"); |
84 | str_cat(str,s); | |
8d063cd8 | 85 | str_cat(str," "); |
13281fa4 LW |
86 | if (s[1]) { |
87 | apush(incstab->stab_array,str_make(s+1)); | |
378cc40b LW |
88 | } |
89 | else { | |
90 | apush(incstab->stab_array,str_make(argv[1])); | |
8d063cd8 LW |
91 | str_cat(str,argv[1]); |
92 | argc--,argv++; | |
93 | str_cat(str," "); | |
94 | } | |
95 | break; | |
96 | case 'n': | |
378cc40b | 97 | minus_n = TRUE; |
13281fa4 | 98 | s++; |
8d063cd8 LW |
99 | goto reswitch; |
100 | case 'p': | |
378cc40b | 101 | minus_p = TRUE; |
13281fa4 | 102 | s++; |
8d063cd8 LW |
103 | goto reswitch; |
104 | case 'P': | |
105 | preprocess = TRUE; | |
13281fa4 | 106 | s++; |
8d063cd8 LW |
107 | goto reswitch; |
108 | case 's': | |
109 | doswitches = TRUE; | |
13281fa4 | 110 | s++; |
8d063cd8 | 111 | goto reswitch; |
378cc40b LW |
112 | case 'S': |
113 | dosearch = TRUE; | |
13281fa4 | 114 | s++; |
378cc40b LW |
115 | goto reswitch; |
116 | case 'U': | |
117 | unsafe = TRUE; | |
13281fa4 | 118 | s++; |
378cc40b | 119 | goto reswitch; |
8d063cd8 LW |
120 | case 'v': |
121 | version(); | |
122 | exit(0); | |
378cc40b LW |
123 | case 'w': |
124 | dowarn = TRUE; | |
13281fa4 | 125 | s++; |
378cc40b | 126 | goto reswitch; |
8d063cd8 LW |
127 | case '-': |
128 | argc--,argv++; | |
129 | goto switch_end; | |
130 | case 0: | |
131 | break; | |
132 | default: | |
13281fa4 | 133 | fatal("Unrecognized switch: -%s",s); |
8d063cd8 LW |
134 | } |
135 | } | |
136 | switch_end: | |
137 | if (e_fp) { | |
138 | fclose(e_fp); | |
139 | argc++,argv--; | |
140 | argv[0] = e_tmpname; | |
141 | } | |
378cc40b LW |
142 | #ifndef PRIVLIB |
143 | #define PRIVLIB "/usr/local/lib/perl" | |
144 | #endif | |
145 | apush(incstab->stab_array,str_make(PRIVLIB)); | |
8d063cd8 LW |
146 | |
147 | str_set(&str_no,No); | |
148 | str_set(&str_yes,Yes); | |
149 | init_eval(); | |
150 | ||
151 | /* open script */ | |
152 | ||
153 | if (argv[0] == Nullch) | |
154 | argv[0] = "-"; | |
378cc40b LW |
155 | if (dosearch && argv[0][0] != '/' && (s = getenv("PATH"))) { |
156 | char *xfound = Nullch, *xfailed = Nullch; | |
157 | ||
158 | while (*s) { | |
159 | s = cpytill(tokenbuf,s,':'); | |
160 | if (*s) | |
161 | s++; | |
162 | if (tokenbuf[0]) | |
163 | strcat(tokenbuf,"/"); | |
164 | strcat(tokenbuf,argv[0]); | |
165 | #ifdef DEBUGGING | |
166 | if (debug & 1) | |
167 | fprintf(stderr,"Looking for %s\n",tokenbuf); | |
168 | #endif | |
169 | if (stat(tokenbuf,&statbuf) < 0) /* not there? */ | |
170 | continue; | |
171 | if ((statbuf.st_mode & S_IFMT) == S_IFREG | |
172 | && cando(S_IREAD,TRUE) && cando(S_IEXEC,TRUE)) { | |
173 | xfound = tokenbuf; /* bingo! */ | |
174 | break; | |
175 | } | |
176 | if (!xfailed) | |
177 | xfailed = savestr(tokenbuf); | |
178 | } | |
179 | if (!xfound) | |
180 | fatal("Can't execute %s", xfailed); | |
181 | if (xfailed) | |
182 | safefree(xfailed); | |
183 | argv[0] = savestr(xfound); | |
184 | } | |
8d063cd8 | 185 | filename = savestr(argv[0]); |
378cc40b | 186 | origfilename = savestr(filename); |
8d063cd8 LW |
187 | if (strEQ(filename,"-")) |
188 | argv[0] = ""; | |
189 | if (preprocess) { | |
378cc40b LW |
190 | str_cat(str,"-I"); |
191 | str_cat(str,PRIVLIB); | |
8d063cd8 LW |
192 | sprintf(buf, "\ |
193 | /bin/sed -e '/^[^#]/b' \ | |
194 | -e '/^#[ ]*include[ ]/b' \ | |
195 | -e '/^#[ ]*define[ ]/b' \ | |
196 | -e '/^#[ ]*if[ ]/b' \ | |
197 | -e '/^#[ ]*ifdef[ ]/b' \ | |
378cc40b | 198 | -e '/^#[ ]*ifndef[ ]/b' \ |
8d063cd8 LW |
199 | -e '/^#[ ]*else/b' \ |
200 | -e '/^#[ ]*endif/b' \ | |
201 | -e 's/^#.*//' \ | |
378cc40b LW |
202 | %s | %s -C %s %s", |
203 | argv[0], CPPSTDIN, str_get(str), CPPMINUS); | |
13281fa4 LW |
204 | #ifdef IAMSUID |
205 | if (euid != uid && !euid) /* if running suidperl */ | |
206 | seteuid(uid); /* musn't stay setuid root */ | |
207 | #endif | |
8d063cd8 LW |
208 | rsfp = popen(buf,"r"); |
209 | } | |
210 | else if (!*argv[0]) | |
211 | rsfp = stdin; | |
212 | else | |
213 | rsfp = fopen(argv[0],"r"); | |
13281fa4 LW |
214 | if (rsfp == Nullfp) { |
215 | #ifdef DOSUID | |
216 | #ifndef IAMSUID | |
217 | if (euid && stat(filename,&statbuf) >= 0 && | |
218 | statbuf.st_mode & (S_ISUID|S_ISGID)) { | |
219 | execvp("suidperl", origargv); /* try again */ | |
220 | fatal("Can't do setuid\n"); | |
221 | } | |
222 | #endif | |
223 | #endif | |
378cc40b | 224 | fatal("Perl script \"%s\" doesn't seem to exist",filename); |
13281fa4 | 225 | } |
8d063cd8 LW |
226 | str_free(str); /* free -I directories */ |
227 | ||
13281fa4 LW |
228 | /* do we need to emulate setuid on scripts? */ |
229 | ||
230 | /* This code is for those BSD systems that have setuid #! scripts disabled | |
231 | * in the kernel because of a security problem. Merely defining DOSUID | |
232 | * in perl will not fix that problem, but if you have disabled setuid | |
233 | * scripts in the kernel, this will attempt to emulate setuid and setgid | |
234 | * on scripts that have those now-otherwise-useless bits set. The setuid | |
235 | * root version must be called suidperl. If regular perl discovers that | |
236 | * it has opened a setuid script, it calls suidperl with the same argv | |
237 | * that it had. If suidperl finds that the script it has just opened | |
238 | * is NOT setuid root, it sets the effective uid back to the uid. We | |
239 | * don't just make perl setuid root because that loses the effective | |
240 | * uid we had before invoking perl, if it was different from the uid. | |
241 | * | |
242 | * DOSUID must be defined in both perl and suidperl, and IAMSUID must | |
243 | * be defined in suidperl only. suidperl must be setuid root. The | |
244 | * Configure script will set this up for you if you want it. | |
245 | */ | |
246 | #ifdef DOSUID | |
247 | if (fstat(fileno(rsfp),&statbuf) < 0) /* normal stat is insecure */ | |
248 | fatal("Can't stat script \"%s\"",filename); | |
249 | if (statbuf.st_mode & (S_ISUID|S_ISGID)) { | |
250 | int len; | |
251 | ||
252 | if (access(filename,1)) /* as a double check */ | |
253 | fatal("Permission denied"); | |
254 | if ((statbuf.st_mode & S_IFMT) != S_IFREG) | |
255 | fatal("Permission denied"); | |
256 | doswitches = FALSE; /* -s is insecure in suid */ | |
257 | line++; | |
258 | if (fgets(tokenbuf,sizeof tokenbuf, rsfp) == Nullch || | |
259 | strnNE(tokenbuf,"#!",2) ) /* required even on Sys V */ | |
260 | fatal("No #! line"); | |
261 | for (s = tokenbuf+2; !isspace(*s); s++) ; | |
262 | if (strnNE(s-4,"perl",4)) /* sanity check */ | |
263 | fatal("Not a perl script"); | |
264 | while (*s && isspace(*s)) s++; | |
265 | /* | |
266 | * #! arg must be what we saw above. They can invoke it by | |
267 | * mentioning suidperl explicitly, but they may not add any strange | |
268 | * arguments beyond what #! says if they do invoke suidperl that way. | |
269 | */ | |
270 | len = strlen(validarg); | |
271 | if (strEQ(validarg," PHOOEY ") || | |
272 | strnNE(s,validarg,len) || !isspace(s[len])) | |
273 | fatal("Arg must be \"%s\"\n",s); | |
274 | ||
275 | if (euid) { /* oops, we're not the setuid root perl */ | |
276 | fclose(rsfp); | |
277 | #ifndef IAMSUID | |
278 | execvp("suidperl", origargv); /* try again */ | |
279 | #endif | |
280 | fatal("Can't do setuid\n"); | |
281 | } | |
282 | ||
283 | if (statbuf.st_mode & S_ISUID && statbuf.st_uid != euid) | |
284 | seteuid(statbuf.st_uid); /* all that for this */ | |
285 | else if (uid) /* oops, mustn't run as root */ | |
286 | seteuid(uid); | |
287 | if (statbuf.st_mode & S_ISGID && statbuf.st_gid != getegid()) | |
288 | setegid(statbuf.st_gid); | |
289 | euid = (int)geteuid(); | |
290 | if (!cando(S_IEXEC,TRUE)) | |
291 | fatal("Permission denied\n"); /* they can't do this */ | |
292 | } | |
293 | #ifdef IAMSUID | |
294 | else if (preprocess) | |
295 | fatal("-P not allowed for setuid/setgid script\n"); | |
296 | else | |
297 | fatal("Script is not setuid/setgid in suidperl\n"); | |
298 | #endif /* IAMSUID */ | |
299 | #endif /* DOSUID */ | |
300 | ||
8d063cd8 LW |
301 | defstab = stabent("_",TRUE); |
302 | ||
303 | /* init tokener */ | |
304 | ||
305 | bufptr = str_get(linestr); | |
306 | ||
307 | /* now parse the report spec */ | |
308 | ||
309 | if (yyparse()) | |
310 | fatal("Execution aborted due to compilation errors.\n"); | |
311 | ||
378cc40b LW |
312 | if (dowarn) { |
313 | stab_check('A','Z'); | |
314 | stab_check('a','z'); | |
315 | } | |
316 | ||
317 | preprocess = FALSE; | |
8d063cd8 LW |
318 | if (e_fp) { |
319 | e_fp = Nullfp; | |
320 | UNLINK(e_tmpname); | |
321 | } | |
322 | argc--,argv++; /* skip name of script */ | |
323 | if (doswitches) { | |
324 | for (; argc > 0 && **argv == '-'; argc--,argv++) { | |
325 | if (argv[0][1] == '-') { | |
326 | argc--,argv++; | |
327 | break; | |
328 | } | |
329 | str_numset(stabent(argv[0]+1,TRUE)->stab_val,(double)1.0); | |
330 | } | |
331 | } | |
a559c259 | 332 | if (argvstab = stabent("ARGV",allstabs)) { |
378cc40b | 333 | aadd(argvstab); |
8d063cd8 LW |
334 | for (; argc > 0; argc--,argv++) { |
335 | apush(argvstab->stab_array,str_make(argv[0])); | |
336 | } | |
337 | } | |
a559c259 | 338 | if (envstab = stabent("ENV",allstabs)) { |
378cc40b | 339 | hadd(envstab); |
8d063cd8 LW |
340 | for (; *env; env++) { |
341 | if (!(s = index(*env,'='))) | |
342 | continue; | |
343 | *s++ = '\0'; | |
344 | str = str_make(s); | |
345 | str->str_link.str_magic = envstab; | |
346 | hstore(envstab->stab_hash,*env,str); | |
347 | *--s = '='; | |
348 | } | |
349 | } | |
378cc40b LW |
350 | if (sigstab = stabent("SIG",allstabs)) |
351 | hadd(sigstab); | |
8d063cd8 | 352 | |
378cc40b | 353 | magicalize("!#?^~=-%0123456789.+&*()<>,\\/[|"); |
8d063cd8 | 354 | |
378cc40b LW |
355 | sawampersand = (stabent("&",FALSE) != Nullstab); |
356 | if (tmpstab = stabent("0",allstabs)) | |
357 | str_set(STAB_STR(tmpstab),origfilename); | |
358 | if (tmpstab = stabent("$",allstabs)) | |
8d063cd8 LW |
359 | str_numset(STAB_STR(tmpstab),(double)getpid()); |
360 | ||
361 | tmpstab = stabent("stdin",TRUE); | |
362 | tmpstab->stab_io = stio_new(); | |
363 | tmpstab->stab_io->fp = stdin; | |
364 | ||
365 | tmpstab = stabent("stdout",TRUE); | |
366 | tmpstab->stab_io = stio_new(); | |
367 | tmpstab->stab_io->fp = stdout; | |
368 | defoutstab = tmpstab; | |
369 | curoutstab = tmpstab; | |
370 | ||
371 | tmpstab = stabent("stderr",TRUE); | |
372 | tmpstab->stab_io = stio_new(); | |
373 | tmpstab->stab_io->fp = stderr; | |
378cc40b LW |
374 | |
375 | savestack = anew(Nullstab); /* for saving non-local values */ | |
8d063cd8 LW |
376 | |
377 | setjmp(top_env); /* sets goto_targ on longjump */ | |
378 | ||
379 | #ifdef DEBUGGING | |
380 | if (debug & 1024) | |
381 | dump_cmd(main_root,Nullcmd); | |
382 | if (debug) | |
383 | fprintf(stderr,"\nEXECUTING...\n\n"); | |
384 | #endif | |
385 | ||
386 | /* do it */ | |
387 | ||
388 | (void) cmd_exec(main_root); | |
389 | ||
390 | if (goto_targ) | |
378cc40b | 391 | fatal("Can't find label \"%s\"--aborting",goto_targ); |
8d063cd8 | 392 | exit(0); |
378cc40b | 393 | /* NOTREACHED */ |
8d063cd8 LW |
394 | } |
395 | ||
396 | magicalize(list) | |
397 | register char *list; | |
398 | { | |
399 | register STAB *stab; | |
400 | char sym[2]; | |
401 | ||
402 | sym[1] = '\0'; | |
403 | while (*sym = *list++) { | |
a559c259 | 404 | if (stab = stabent(sym,allstabs)) { |
8d063cd8 LW |
405 | stab->stab_flags = SF_VMAGIC; |
406 | stab->stab_val->str_link.str_magic = stab; | |
407 | } | |
408 | } | |
409 | } | |
410 | ||
8d063cd8 LW |
411 | ARG * |
412 | make_split(stab,arg) | |
413 | register STAB *stab; | |
414 | register ARG *arg; | |
415 | { | |
378cc40b | 416 | register SPAT *spat = (SPAT *) safemalloc(sizeof (SPAT)); |
8d063cd8 | 417 | |
378cc40b LW |
418 | if (arg->arg_type != O_MATCH) { |
419 | spat = (SPAT *) safemalloc(sizeof (SPAT)); | |
8d063cd8 LW |
420 | bzero((char *)spat, sizeof(SPAT)); |
421 | spat->spat_next = spat_root; /* link into spat list */ | |
422 | spat_root = spat; | |
8d063cd8 LW |
423 | |
424 | spat->spat_runtime = arg; | |
378cc40b | 425 | arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat); |
8d063cd8 LW |
426 | } |
427 | arg->arg_type = O_SPLIT; | |
378cc40b LW |
428 | spat = arg[2].arg_ptr.arg_spat; |
429 | spat->spat_repl = stab2arg(A_STAB,aadd(stab)); | |
430 | if (spat->spat_short) { /* exact match can bypass regexec() */ | |
431 | if (!((spat->spat_flags & SPAT_SCANFIRST) && | |
432 | (spat->spat_flags & SPAT_ALL) )) { | |
433 | str_free(spat->spat_short); | |
434 | spat->spat_short = Nullstr; | |
8d063cd8 | 435 | } |
8d063cd8 | 436 | } |
378cc40b | 437 | return arg; |
8d063cd8 LW |
438 | } |
439 | ||
378cc40b LW |
440 | SUBR * |
441 | make_sub(name,cmd) | |
442 | char *name; | |
443 | CMD *cmd; | |
8d063cd8 | 444 | { |
378cc40b LW |
445 | register SUBR *sub = (SUBR *) safemalloc(sizeof (SUBR)); |
446 | STAB *stab = stabent(name,TRUE); | |
447 | ||
448 | if (stab->stab_sub) { | |
449 | if (dowarn) { | |
450 | line_t oldline = line; | |
451 | ||
452 | if (cmd) | |
453 | line = cmd->c_line; | |
454 | warn("Subroutine %s redefined",name); | |
455 | line = oldline; | |
456 | } | |
457 | cmd_free(stab->stab_sub->cmd); | |
458 | afree(stab->stab_sub->tosave); | |
459 | safefree((char*)stab->stab_sub); | |
460 | } | |
461 | bzero((char *)sub, sizeof(SUBR)); | |
462 | sub->cmd = cmd; | |
463 | sub->filename = filename; | |
464 | tosave = anew(Nullstab); | |
465 | tosave->ary_fill = 0; /* make 1 based */ | |
466 | cmd_tosave(cmd); /* this builds the tosave array */ | |
467 | sub->tosave = tosave; | |
468 | stab->stab_sub = sub; | |
8d063cd8 LW |
469 | } |
470 | ||
471 | CMD * | |
472 | block_head(tail) | |
473 | register CMD *tail; | |
474 | { | |
475 | if (tail == Nullcmd) { | |
476 | return tail; | |
477 | } | |
478 | return tail->c_head; | |
479 | } | |
480 | ||
481 | CMD * | |
482 | append_line(head,tail) | |
483 | register CMD *head; | |
484 | register CMD *tail; | |
485 | { | |
486 | if (tail == Nullcmd) | |
487 | return head; | |
488 | if (!tail->c_head) /* make sure tail is well formed */ | |
489 | tail->c_head = tail; | |
490 | if (head != Nullcmd) { | |
491 | tail = tail->c_head; /* get to start of tail list */ | |
492 | if (!head->c_head) | |
493 | head->c_head = head; /* start a new head list */ | |
494 | while (head->c_next) { | |
495 | head->c_next->c_head = head->c_head; | |
496 | head = head->c_next; /* get to end of head list */ | |
497 | } | |
498 | head->c_next = tail; /* link to end of old list */ | |
499 | tail->c_head = head->c_head; /* propagate head pointer */ | |
500 | } | |
501 | while (tail->c_next) { | |
502 | tail->c_next->c_head = tail->c_head; | |
503 | tail = tail->c_next; | |
504 | } | |
505 | return tail; | |
506 | } | |
507 | ||
508 | CMD * | |
509 | make_acmd(type,stab,cond,arg) | |
510 | int type; | |
511 | STAB *stab; | |
512 | ARG *cond; | |
513 | ARG *arg; | |
514 | { | |
515 | register CMD *cmd = (CMD *) safemalloc(sizeof (CMD)); | |
516 | ||
517 | bzero((char *)cmd, sizeof(CMD)); | |
518 | cmd->c_type = type; | |
519 | cmd->ucmd.acmd.ac_stab = stab; | |
520 | cmd->ucmd.acmd.ac_expr = arg; | |
521 | cmd->c_expr = cond; | |
522 | if (cond) { | |
378cc40b | 523 | opt_arg(cmd,1,1); |
8d063cd8 LW |
524 | cmd->c_flags |= CF_COND; |
525 | } | |
378cc40b LW |
526 | if (cmdline != NOLINE) { |
527 | cmd->c_line = cmdline; | |
528 | cmdline = NOLINE; | |
529 | } | |
530 | cmd->c_file = filename; | |
8d063cd8 LW |
531 | return cmd; |
532 | } | |
533 | ||
534 | CMD * | |
535 | make_ccmd(type,arg,cblock) | |
536 | int type; | |
537 | register ARG *arg; | |
538 | struct compcmd cblock; | |
539 | { | |
540 | register CMD *cmd = (CMD *) safemalloc(sizeof (CMD)); | |
541 | ||
542 | bzero((char *)cmd, sizeof(CMD)); | |
543 | cmd->c_type = type; | |
544 | cmd->c_expr = arg; | |
545 | cmd->ucmd.ccmd.cc_true = cblock.comp_true; | |
546 | cmd->ucmd.ccmd.cc_alt = cblock.comp_alt; | |
547 | if (arg) { | |
378cc40b | 548 | opt_arg(cmd,1,0); |
8d063cd8 LW |
549 | cmd->c_flags |= CF_COND; |
550 | } | |
378cc40b LW |
551 | if (cmdline != NOLINE) { |
552 | cmd->c_line = cmdline; | |
553 | cmdline = NOLINE; | |
554 | } | |
8d063cd8 LW |
555 | return cmd; |
556 | } | |
557 | ||
558 | void | |
378cc40b | 559 | opt_arg(cmd,fliporflop,acmd) |
8d063cd8 LW |
560 | register CMD *cmd; |
561 | int fliporflop; | |
378cc40b | 562 | int acmd; |
8d063cd8 LW |
563 | { |
564 | register ARG *arg; | |
565 | int opt = CFT_EVAL; | |
566 | int sure = 0; | |
567 | ARG *arg2; | |
568 | char *tmps; /* for True macro */ | |
569 | int context = 0; /* 0 = normal, 1 = before &&, 2 = before || */ | |
570 | int flp = fliporflop; | |
571 | ||
572 | if (!cmd) | |
573 | return; | |
574 | arg = cmd->c_expr; | |
575 | ||
378cc40b LW |
576 | /* Can we turn && and || into if and unless? */ |
577 | ||
578 | if (acmd && !cmd->ucmd.acmd.ac_expr && | |
579 | (arg->arg_type == O_AND || arg->arg_type == O_OR) ) { | |
580 | dehoist(arg,1); | |
581 | dehoist(arg,2); | |
582 | cmd->ucmd.acmd.ac_expr = arg[2].arg_ptr.arg_arg; | |
583 | cmd->c_expr = arg[1].arg_ptr.arg_arg; | |
584 | if (arg->arg_type == O_OR) | |
585 | cmd->c_flags ^= CF_INVERT; /* || is like unless */ | |
586 | arg->arg_len = 0; | |
587 | arg_free(arg); | |
588 | arg = cmd->c_expr; | |
589 | } | |
590 | ||
8d063cd8 LW |
591 | /* Turn "if (!expr)" into "unless (expr)" */ |
592 | ||
378cc40b LW |
593 | while (arg->arg_type == O_NOT) { |
594 | dehoist(arg,1); | |
8d063cd8 LW |
595 | cmd->c_flags ^= CF_INVERT; /* flip sense of cmd */ |
596 | cmd->c_expr = arg[1].arg_ptr.arg_arg; /* hoist the rest of expr */ | |
597 | free_arg(arg); | |
598 | arg = cmd->c_expr; /* here we go again */ | |
599 | } | |
600 | ||
601 | if (!arg->arg_len) { /* sanity check */ | |
602 | cmd->c_flags |= opt; | |
603 | return; | |
604 | } | |
605 | ||
606 | /* for "cond .. cond" we set up for the initial check */ | |
607 | ||
608 | if (arg->arg_type == O_FLIP) | |
609 | context |= 4; | |
610 | ||
611 | /* for "cond && expr" and "cond || expr" we can ignore expr, sort of */ | |
612 | ||
613 | if (arg->arg_type == O_AND) | |
614 | context |= 1; | |
615 | else if (arg->arg_type == O_OR) | |
616 | context |= 2; | |
617 | if (context && arg[flp].arg_type == A_EXPR) { | |
618 | arg = arg[flp].arg_ptr.arg_arg; | |
619 | flp = 1; | |
620 | } | |
621 | ||
622 | if (arg[flp].arg_flags & (AF_PRE|AF_POST)) { | |
623 | cmd->c_flags |= opt; | |
624 | return; /* side effect, can't optimize */ | |
625 | } | |
626 | ||
627 | if (arg->arg_type == O_ITEM || arg->arg_type == O_FLIP || | |
628 | arg->arg_type == O_AND || arg->arg_type == O_OR) { | |
629 | if (arg[flp].arg_type == A_SINGLE) { | |
630 | opt = (str_true(arg[flp].arg_ptr.arg_str) ? CFT_TRUE : CFT_FALSE); | |
378cc40b | 631 | cmd->c_short = arg[flp].arg_ptr.arg_str; |
8d063cd8 LW |
632 | goto literal; |
633 | } | |
634 | else if (arg[flp].arg_type == A_STAB || arg[flp].arg_type == A_LVAL) { | |
635 | cmd->c_stab = arg[flp].arg_ptr.arg_stab; | |
636 | opt = CFT_REG; | |
637 | literal: | |
638 | if (!context) { /* no && or ||? */ | |
639 | free_arg(arg); | |
640 | cmd->c_expr = Nullarg; | |
641 | } | |
642 | if (!(context & 1)) | |
643 | cmd->c_flags |= CF_EQSURE; | |
644 | if (!(context & 2)) | |
645 | cmd->c_flags |= CF_NESURE; | |
646 | } | |
647 | } | |
648 | else if (arg->arg_type == O_MATCH || arg->arg_type == O_SUBST || | |
378cc40b | 649 | arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST) { |
8d063cd8 LW |
650 | if ((arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) && |
651 | arg[2].arg_type == A_SPAT && | |
378cc40b | 652 | arg[2].arg_ptr.arg_spat->spat_short ) { |
8d063cd8 | 653 | cmd->c_stab = arg[1].arg_ptr.arg_stab; |
378cc40b LW |
654 | cmd->c_short = arg[2].arg_ptr.arg_spat->spat_short; |
655 | cmd->c_slen = arg[2].arg_ptr.arg_spat->spat_slen; | |
656 | if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_ALL && | |
657 | !(arg[2].arg_ptr.arg_spat->spat_flags & SPAT_ONCE) && | |
8d063cd8 LW |
658 | (arg->arg_type == O_MATCH || arg->arg_type == O_NMATCH) ) |
659 | sure |= CF_EQSURE; /* (SUBST must be forced even */ | |
660 | /* if we know it will work.) */ | |
378cc40b LW |
661 | arg[2].arg_ptr.arg_spat->spat_short = Nullstr; |
662 | arg[2].arg_ptr.arg_spat->spat_slen = 0; /* only one chk */ | |
8d063cd8 LW |
663 | sure |= CF_NESURE; /* normally only sure if it fails */ |
664 | if (arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST) | |
665 | cmd->c_flags |= CF_FIRSTNEG; | |
666 | if (context & 1) { /* only sure if thing is false */ | |
667 | if (cmd->c_flags & CF_FIRSTNEG) | |
668 | sure &= ~CF_NESURE; | |
669 | else | |
670 | sure &= ~CF_EQSURE; | |
671 | } | |
672 | else if (context & 2) { /* only sure if thing is true */ | |
673 | if (cmd->c_flags & CF_FIRSTNEG) | |
674 | sure &= ~CF_EQSURE; | |
675 | else | |
676 | sure &= ~CF_NESURE; | |
677 | } | |
678 | if (sure & (CF_EQSURE|CF_NESURE)) { /* if we know anything*/ | |
679 | if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_SCANFIRST) | |
680 | opt = CFT_SCAN; | |
681 | else | |
682 | opt = CFT_ANCHOR; | |
683 | if (sure == (CF_EQSURE|CF_NESURE) /* really sure? */ | |
684 | && arg->arg_type == O_MATCH | |
685 | && context & 4 | |
686 | && fliporflop == 1) { | |
378cc40b LW |
687 | spat_free(arg[2].arg_ptr.arg_spat); |
688 | arg[2].arg_ptr.arg_spat = Nullspat; /* don't do twice */ | |
8d063cd8 LW |
689 | } |
690 | cmd->c_flags |= sure; | |
691 | } | |
692 | } | |
693 | } | |
694 | else if (arg->arg_type == O_SEQ || arg->arg_type == O_SNE || | |
695 | arg->arg_type == O_SLT || arg->arg_type == O_SGT) { | |
696 | if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) { | |
697 | if (arg[2].arg_type == A_SINGLE) { | |
698 | cmd->c_stab = arg[1].arg_ptr.arg_stab; | |
378cc40b LW |
699 | cmd->c_short = arg[2].arg_ptr.arg_str; |
700 | cmd->c_slen = 30000; | |
8d063cd8 LW |
701 | switch (arg->arg_type) { |
702 | case O_SLT: case O_SGT: | |
703 | sure |= CF_EQSURE; | |
704 | cmd->c_flags |= CF_FIRSTNEG; | |
705 | break; | |
706 | case O_SNE: | |
707 | cmd->c_flags |= CF_FIRSTNEG; | |
708 | /* FALL THROUGH */ | |
709 | case O_SEQ: | |
710 | sure |= CF_NESURE|CF_EQSURE; | |
711 | break; | |
712 | } | |
713 | if (context & 1) { /* only sure if thing is false */ | |
714 | if (cmd->c_flags & CF_FIRSTNEG) | |
715 | sure &= ~CF_NESURE; | |
716 | else | |
717 | sure &= ~CF_EQSURE; | |
718 | } | |
719 | else if (context & 2) { /* only sure if thing is true */ | |
720 | if (cmd->c_flags & CF_FIRSTNEG) | |
721 | sure &= ~CF_EQSURE; | |
722 | else | |
723 | sure &= ~CF_NESURE; | |
724 | } | |
725 | if (sure & (CF_EQSURE|CF_NESURE)) { | |
726 | opt = CFT_STROP; | |
727 | cmd->c_flags |= sure; | |
728 | } | |
729 | } | |
730 | } | |
731 | } | |
378cc40b LW |
732 | else if (arg->arg_type == O_EQ || arg->arg_type == O_NE || |
733 | arg->arg_type == O_LE || arg->arg_type == O_GE || | |
734 | arg->arg_type == O_LT || arg->arg_type == O_GT) { | |
735 | if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) { | |
736 | if (arg[2].arg_type == A_SINGLE) { | |
737 | cmd->c_stab = arg[1].arg_ptr.arg_stab; | |
738 | cmd->c_short = str_nmake(str_gnum(arg[2].arg_ptr.arg_str)); | |
739 | cmd->c_slen = arg->arg_type; | |
740 | sure |= CF_NESURE|CF_EQSURE; | |
741 | if (context & 1) { /* only sure if thing is false */ | |
742 | sure &= ~CF_EQSURE; | |
743 | } | |
744 | else if (context & 2) { /* only sure if thing is true */ | |
745 | sure &= ~CF_NESURE; | |
746 | } | |
747 | if (sure & (CF_EQSURE|CF_NESURE)) { | |
748 | opt = CFT_NUMOP; | |
749 | cmd->c_flags |= sure; | |
750 | } | |
751 | } | |
752 | } | |
753 | } | |
8d063cd8 LW |
754 | else if (arg->arg_type == O_ASSIGN && |
755 | (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) && | |
756 | arg[1].arg_ptr.arg_stab == defstab && | |
757 | arg[2].arg_type == A_EXPR ) { | |
758 | arg2 = arg[2].arg_ptr.arg_arg; | |
759 | if (arg2->arg_type == O_ITEM && arg2[1].arg_type == A_READ) { | |
760 | opt = CFT_GETS; | |
761 | cmd->c_stab = arg2[1].arg_ptr.arg_stab; | |
762 | if (!(arg2[1].arg_ptr.arg_stab->stab_io->flags & IOF_ARGV)) { | |
763 | free_arg(arg2); | |
764 | free_arg(arg); | |
765 | cmd->c_expr = Nullarg; | |
766 | } | |
767 | } | |
768 | } | |
769 | else if (arg->arg_type == O_CHOP && | |
770 | (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) ) { | |
771 | opt = CFT_CHOP; | |
772 | cmd->c_stab = arg[1].arg_ptr.arg_stab; | |
773 | free_arg(arg); | |
774 | cmd->c_expr = Nullarg; | |
775 | } | |
776 | if (context & 4) | |
777 | opt |= CF_FLIP; | |
778 | cmd->c_flags |= opt; | |
779 | ||
780 | if (cmd->c_flags & CF_FLIP) { | |
781 | if (fliporflop == 1) { | |
782 | arg = cmd->c_expr; /* get back to O_FLIP arg */ | |
783 | arg[3].arg_ptr.arg_cmd = (CMD*)safemalloc(sizeof(CMD)); | |
784 | bcopy((char *)cmd, (char *)arg[3].arg_ptr.arg_cmd, sizeof(CMD)); | |
785 | arg[4].arg_ptr.arg_cmd = (CMD*)safemalloc(sizeof(CMD)); | |
786 | bcopy((char *)cmd, (char *)arg[4].arg_ptr.arg_cmd, sizeof(CMD)); | |
378cc40b | 787 | opt_arg(arg[4].arg_ptr.arg_cmd,2,acmd); |
8d063cd8 LW |
788 | arg->arg_len = 2; /* this is a lie */ |
789 | } | |
790 | else { | |
791 | if ((opt & CF_OPTIMIZE) == CFT_EVAL) | |
792 | cmd->c_flags = (cmd->c_flags & ~CF_OPTIMIZE) | CFT_UNFLIP; | |
793 | } | |
794 | } | |
795 | } | |
796 | ||
797 | ARG * | |
798 | mod_match(type,left,pat) | |
799 | register ARG *left; | |
800 | register ARG *pat; | |
801 | { | |
802 | ||
803 | register SPAT *spat; | |
804 | register ARG *newarg; | |
805 | ||
806 | if ((pat->arg_type == O_MATCH || | |
807 | pat->arg_type == O_SUBST || | |
808 | pat->arg_type == O_TRANS || | |
809 | pat->arg_type == O_SPLIT | |
810 | ) && | |
811 | pat[1].arg_ptr.arg_stab == defstab ) { | |
812 | switch (pat->arg_type) { | |
813 | case O_MATCH: | |
814 | newarg = make_op(type == O_MATCH ? O_MATCH : O_NMATCH, | |
815 | pat->arg_len, | |
816 | left,Nullarg,Nullarg,0); | |
817 | break; | |
818 | case O_SUBST: | |
819 | newarg = l(make_op(type == O_MATCH ? O_SUBST : O_NSUBST, | |
820 | pat->arg_len, | |
821 | left,Nullarg,Nullarg,0)); | |
822 | break; | |
823 | case O_TRANS: | |
824 | newarg = l(make_op(type == O_MATCH ? O_TRANS : O_NTRANS, | |
825 | pat->arg_len, | |
826 | left,Nullarg,Nullarg,0)); | |
827 | break; | |
828 | case O_SPLIT: | |
829 | newarg = make_op(type == O_MATCH ? O_SPLIT : O_SPLIT, | |
830 | pat->arg_len, | |
831 | left,Nullarg,Nullarg,0); | |
832 | break; | |
833 | } | |
834 | if (pat->arg_len >= 2) { | |
835 | newarg[2].arg_type = pat[2].arg_type; | |
836 | newarg[2].arg_ptr = pat[2].arg_ptr; | |
837 | newarg[2].arg_flags = pat[2].arg_flags; | |
838 | if (pat->arg_len >= 3) { | |
839 | newarg[3].arg_type = pat[3].arg_type; | |
840 | newarg[3].arg_ptr = pat[3].arg_ptr; | |
841 | newarg[3].arg_flags = pat[3].arg_flags; | |
842 | } | |
843 | } | |
844 | safefree((char*)pat); | |
845 | } | |
846 | else { | |
847 | spat = (SPAT *) safemalloc(sizeof (SPAT)); | |
848 | bzero((char *)spat, sizeof(SPAT)); | |
849 | spat->spat_next = spat_root; /* link into spat list */ | |
850 | spat_root = spat; | |
8d063cd8 LW |
851 | |
852 | spat->spat_runtime = pat; | |
853 | newarg = make_op(type,2,left,Nullarg,Nullarg,0); | |
854 | newarg[2].arg_type = A_SPAT; | |
855 | newarg[2].arg_ptr.arg_spat = spat; | |
856 | newarg[2].arg_flags = AF_SPECIAL; | |
857 | } | |
858 | ||
859 | return newarg; | |
860 | } | |
861 | ||
862 | CMD * | |
863 | add_label(lbl,cmd) | |
864 | char *lbl; | |
865 | register CMD *cmd; | |
866 | { | |
867 | if (cmd) | |
868 | cmd->c_label = lbl; | |
869 | return cmd; | |
870 | } | |
871 | ||
872 | CMD * | |
873 | addcond(cmd, arg) | |
874 | register CMD *cmd; | |
875 | register ARG *arg; | |
876 | { | |
877 | cmd->c_expr = arg; | |
378cc40b | 878 | opt_arg(cmd,1,0); |
8d063cd8 LW |
879 | cmd->c_flags |= CF_COND; |
880 | return cmd; | |
881 | } | |
882 | ||
883 | CMD * | |
884 | addloop(cmd, arg) | |
885 | register CMD *cmd; | |
886 | register ARG *arg; | |
887 | { | |
888 | cmd->c_expr = arg; | |
378cc40b | 889 | opt_arg(cmd,1,0); |
8d063cd8 LW |
890 | cmd->c_flags |= CF_COND|CF_LOOP; |
891 | if (cmd->c_type == C_BLOCK) | |
892 | cmd->c_flags &= ~CF_COND; | |
893 | else { | |
894 | arg = cmd->ucmd.acmd.ac_expr; | |
895 | if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_CMD) | |
896 | cmd->c_flags &= ~CF_COND; /* "do {} while" happens at least once */ | |
897 | if (arg && arg->arg_type == O_SUBR) | |
898 | cmd->c_flags &= ~CF_COND; /* likewise for "do subr() while" */ | |
899 | } | |
900 | return cmd; | |
901 | } | |
902 | ||
903 | CMD * | |
904 | invert(cmd) | |
905 | register CMD *cmd; | |
906 | { | |
907 | cmd->c_flags ^= CF_INVERT; | |
908 | return cmd; | |
909 | } | |
910 | ||
911 | yyerror(s) | |
912 | char *s; | |
913 | { | |
914 | char tmpbuf[128]; | |
915 | char *tname = tmpbuf; | |
916 | ||
917 | if (yychar > 256) { | |
918 | tname = tokename[yychar-256]; | |
919 | if (strEQ(tname,"word")) | |
920 | strcpy(tname,tokenbuf); | |
921 | else if (strEQ(tname,"register")) | |
922 | sprintf(tname,"$%s",tokenbuf); | |
923 | else if (strEQ(tname,"array_length")) | |
924 | sprintf(tname,"$#%s",tokenbuf); | |
925 | } | |
926 | else if (!yychar) | |
927 | strcpy(tname,"EOF"); | |
928 | else if (yychar < 32) | |
929 | sprintf(tname,"^%c",yychar+64); | |
930 | else if (yychar == 127) | |
931 | strcpy(tname,"^?"); | |
932 | else | |
933 | sprintf(tname,"%c",yychar); | |
a559c259 | 934 | sprintf(tokenbuf, "%s in file %s at line %d, next token \"%s\"\n", |
8d063cd8 | 935 | s,filename,line,tname); |
a559c259 LW |
936 | if (in_eval) |
937 | str_set(stabent("@",TRUE)->stab_val,tokenbuf); | |
938 | else | |
939 | fputs(tokenbuf,stderr); | |
8d063cd8 LW |
940 | } |
941 | ||
8d063cd8 LW |
942 | ARG * |
943 | make_op(type,newlen,arg1,arg2,arg3,dolist) | |
944 | int type; | |
945 | int newlen; | |
946 | ARG *arg1; | |
947 | ARG *arg2; | |
948 | ARG *arg3; | |
949 | int dolist; | |
950 | { | |
951 | register ARG *arg; | |
952 | register ARG *chld; | |
953 | register int doarg; | |
954 | ||
955 | arg = op_new(newlen); | |
956 | arg->arg_type = type; | |
957 | doarg = opargs[type]; | |
958 | if (chld = arg1) { | |
959 | if (!(doarg & 1)) | |
960 | arg[1].arg_flags |= AF_SPECIAL; | |
961 | if (doarg & 16) | |
962 | arg[1].arg_flags |= AF_NUMERIC; | |
963 | if (chld->arg_type == O_ITEM && | |
964 | (hoistable[chld[1].arg_type] || chld[1].arg_type == A_LVAL) ) { | |
965 | arg[1].arg_type = chld[1].arg_type; | |
966 | arg[1].arg_ptr = chld[1].arg_ptr; | |
967 | arg[1].arg_flags |= chld[1].arg_flags; | |
968 | free_arg(chld); | |
969 | } | |
970 | else { | |
971 | arg[1].arg_type = A_EXPR; | |
972 | arg[1].arg_ptr.arg_arg = chld; | |
973 | if (dolist & 1) { | |
974 | if (chld->arg_type == O_LIST) { | |
975 | if (newlen == 1) { /* we can hoist entire list */ | |
976 | chld->arg_type = type; | |
977 | free_arg(arg); | |
978 | arg = chld; | |
979 | } | |
980 | else { | |
981 | arg[1].arg_flags |= AF_SPECIAL; | |
982 | } | |
983 | } | |
378cc40b LW |
984 | else { |
985 | switch (chld->arg_type) { | |
986 | case O_ARRAY: | |
987 | if (chld->arg_len == 1) | |
988 | arg[1].arg_flags |= AF_SPECIAL; | |
989 | break; | |
990 | case O_ITEM: | |
991 | if (chld[1].arg_type == A_READ || | |
992 | chld[1].arg_type == A_INDREAD || | |
993 | chld[1].arg_type == A_GLOB) | |
994 | arg[1].arg_flags |= AF_SPECIAL; | |
995 | break; | |
996 | case O_SPLIT: | |
997 | case O_TMS: | |
998 | case O_EACH: | |
999 | case O_VALUES: | |
1000 | case O_KEYS: | |
1001 | case O_SORT: | |
1002 | arg[1].arg_flags |= AF_SPECIAL; | |
1003 | break; | |
1004 | } | |
1005 | } | |
8d063cd8 LW |
1006 | } |
1007 | } | |
1008 | } | |
1009 | if (chld = arg2) { | |
1010 | if (!(doarg & 2)) | |
1011 | arg[2].arg_flags |= AF_SPECIAL; | |
1012 | if (doarg & 32) | |
1013 | arg[2].arg_flags |= AF_NUMERIC; | |
1014 | if (chld->arg_type == O_ITEM && | |
1015 | (hoistable[chld[1].arg_type] || | |
1016 | (type == O_ASSIGN && | |
378cc40b LW |
1017 | ((chld[1].arg_type == A_READ && !(arg[1].arg_flags & AF_SPECIAL)) |
1018 | || | |
1019 | (chld[1].arg_type == A_INDREAD && !(arg[1].arg_flags & AF_SPECIAL)) | |
1020 | || | |
1021 | (chld[1].arg_type == A_GLOB && !(arg[1].arg_flags & AF_SPECIAL)) | |
1022 | || | |
8d063cd8 LW |
1023 | chld[1].arg_type == A_BACKTICK ) ) ) ) { |
1024 | arg[2].arg_type = chld[1].arg_type; | |
1025 | arg[2].arg_ptr = chld[1].arg_ptr; | |
1026 | free_arg(chld); | |
1027 | } | |
1028 | else { | |
1029 | arg[2].arg_type = A_EXPR; | |
1030 | arg[2].arg_ptr.arg_arg = chld; | |
1031 | if ((dolist & 2) && | |
1032 | (chld->arg_type == O_LIST || | |
1033 | (chld->arg_type == O_ARRAY && chld->arg_len == 1) )) | |
1034 | arg[2].arg_flags |= AF_SPECIAL; | |
1035 | } | |
1036 | } | |
1037 | if (chld = arg3) { | |
1038 | if (!(doarg & 4)) | |
1039 | arg[3].arg_flags |= AF_SPECIAL; | |
1040 | if (doarg & 64) | |
1041 | arg[3].arg_flags |= AF_NUMERIC; | |
1042 | if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type]) { | |
1043 | arg[3].arg_type = chld[1].arg_type; | |
1044 | arg[3].arg_ptr = chld[1].arg_ptr; | |
1045 | free_arg(chld); | |
1046 | } | |
1047 | else { | |
1048 | arg[3].arg_type = A_EXPR; | |
1049 | arg[3].arg_ptr.arg_arg = chld; | |
1050 | if ((dolist & 4) && | |
1051 | (chld->arg_type == O_LIST || | |
1052 | (chld->arg_type == O_ARRAY && chld->arg_len == 1) )) | |
1053 | arg[3].arg_flags |= AF_SPECIAL; | |
1054 | } | |
1055 | } | |
1056 | #ifdef DEBUGGING | |
1057 | if (debug & 16) { | |
1058 | fprintf(stderr,"%lx <= make_op(%s",arg,opname[arg->arg_type]); | |
1059 | if (arg1) | |
1060 | fprintf(stderr,",%s=%lx", | |
1061 | argname[arg[1].arg_type],arg[1].arg_ptr.arg_arg); | |
1062 | if (arg2) | |
1063 | fprintf(stderr,",%s=%lx", | |
1064 | argname[arg[2].arg_type],arg[2].arg_ptr.arg_arg); | |
1065 | if (arg3) | |
1066 | fprintf(stderr,",%s=%lx", | |
1067 | argname[arg[3].arg_type],arg[3].arg_ptr.arg_arg); | |
1068 | fprintf(stderr,")\n"); | |
1069 | } | |
1070 | #endif | |
1071 | evalstatic(arg); /* see if we can consolidate anything */ | |
1072 | return arg; | |
1073 | } | |
1074 | ||
1075 | /* turn 123 into 123 == $. */ | |
1076 | ||
1077 | ARG * | |
1078 | flipflip(arg) | |
1079 | register ARG *arg; | |
1080 | { | |
1081 | if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_SINGLE) { | |
1082 | arg = (ARG*)saferealloc((char*)arg,3*sizeof(ARG)); | |
1083 | arg->arg_type = O_EQ; | |
1084 | arg->arg_len = 2; | |
1085 | arg[2].arg_type = A_STAB; | |
1086 | arg[2].arg_flags = 0; | |
1087 | arg[2].arg_ptr.arg_stab = stabent(".",TRUE); | |
1088 | } | |
1089 | return arg; | |
1090 | } | |
1091 | ||
1092 | void | |
1093 | evalstatic(arg) | |
1094 | register ARG *arg; | |
1095 | { | |
1096 | register STR *str; | |
1097 | register STR *s1; | |
1098 | register STR *s2; | |
1099 | double value; /* must not be register */ | |
1100 | register char *tmps; | |
1101 | int i; | |
378cc40b | 1102 | unsigned long tmplong; |
8d063cd8 LW |
1103 | double exp(), log(), sqrt(), modf(); |
1104 | char *crypt(); | |
1105 | ||
1106 | if (!arg || !arg->arg_len) | |
1107 | return; | |
1108 | ||
1109 | if (arg[1].arg_type == A_SINGLE && | |
1110 | (arg->arg_len == 1 || arg[2].arg_type == A_SINGLE) ) { | |
1111 | str = str_new(0); | |
1112 | s1 = arg[1].arg_ptr.arg_str; | |
1113 | if (arg->arg_len > 1) | |
1114 | s2 = arg[2].arg_ptr.arg_str; | |
1115 | else | |
1116 | s2 = Nullstr; | |
1117 | switch (arg->arg_type) { | |
1118 | default: | |
1119 | str_free(str); | |
1120 | str = Nullstr; /* can't be evaluated yet */ | |
1121 | break; | |
1122 | case O_CONCAT: | |
1123 | str_sset(str,s1); | |
1124 | str_scat(str,s2); | |
1125 | break; | |
1126 | case O_REPEAT: | |
1127 | i = (int)str_gnum(s2); | |
378cc40b | 1128 | while (i-- > 0) |
8d063cd8 LW |
1129 | str_scat(str,s1); |
1130 | break; | |
1131 | case O_MULTIPLY: | |
1132 | value = str_gnum(s1); | |
1133 | str_numset(str,value * str_gnum(s2)); | |
1134 | break; | |
1135 | case O_DIVIDE: | |
378cc40b LW |
1136 | value = str_gnum(s2); |
1137 | if (value == 0.0) | |
1138 | fatal("Illegal division by constant zero"); | |
1139 | str_numset(str,str_gnum(s1) / value); | |
8d063cd8 LW |
1140 | break; |
1141 | case O_MODULO: | |
378cc40b LW |
1142 | tmplong = (unsigned long)str_gnum(s2); |
1143 | if (tmplong == 0L) | |
1144 | fatal("Illegal modulus of constant zero"); | |
1145 | str_numset(str,(double)(((unsigned long)str_gnum(s1)) % tmplong)); | |
8d063cd8 LW |
1146 | break; |
1147 | case O_ADD: | |
1148 | value = str_gnum(s1); | |
1149 | str_numset(str,value + str_gnum(s2)); | |
1150 | break; | |
1151 | case O_SUBTRACT: | |
1152 | value = str_gnum(s1); | |
1153 | str_numset(str,value - str_gnum(s2)); | |
1154 | break; | |
1155 | case O_LEFT_SHIFT: | |
1156 | value = str_gnum(s1); | |
378cc40b LW |
1157 | i = (int)str_gnum(s2); |
1158 | str_numset(str,(double)(((unsigned long)value) << i)); | |
8d063cd8 LW |
1159 | break; |
1160 | case O_RIGHT_SHIFT: | |
1161 | value = str_gnum(s1); | |
378cc40b LW |
1162 | i = (int)str_gnum(s2); |
1163 | str_numset(str,(double)(((unsigned long)value) >> i)); | |
8d063cd8 LW |
1164 | break; |
1165 | case O_LT: | |
1166 | value = str_gnum(s1); | |
1167 | str_numset(str,(double)(value < str_gnum(s2))); | |
1168 | break; | |
1169 | case O_GT: | |
1170 | value = str_gnum(s1); | |
1171 | str_numset(str,(double)(value > str_gnum(s2))); | |
1172 | break; | |
1173 | case O_LE: | |
1174 | value = str_gnum(s1); | |
1175 | str_numset(str,(double)(value <= str_gnum(s2))); | |
1176 | break; | |
1177 | case O_GE: | |
1178 | value = str_gnum(s1); | |
1179 | str_numset(str,(double)(value >= str_gnum(s2))); | |
1180 | break; | |
1181 | case O_EQ: | |
1182 | value = str_gnum(s1); | |
1183 | str_numset(str,(double)(value == str_gnum(s2))); | |
1184 | break; | |
1185 | case O_NE: | |
1186 | value = str_gnum(s1); | |
1187 | str_numset(str,(double)(value != str_gnum(s2))); | |
1188 | break; | |
1189 | case O_BIT_AND: | |
1190 | value = str_gnum(s1); | |
378cc40b LW |
1191 | str_numset(str,(double)(((unsigned long)value) & |
1192 | ((unsigned long)str_gnum(s2)))); | |
8d063cd8 LW |
1193 | break; |
1194 | case O_XOR: | |
1195 | value = str_gnum(s1); | |
378cc40b LW |
1196 | str_numset(str,(double)(((unsigned long)value) ^ |
1197 | ((unsigned long)str_gnum(s2)))); | |
8d063cd8 LW |
1198 | break; |
1199 | case O_BIT_OR: | |
1200 | value = str_gnum(s1); | |
378cc40b LW |
1201 | str_numset(str,(double)(((unsigned long)value) | |
1202 | ((unsigned long)str_gnum(s2)))); | |
8d063cd8 LW |
1203 | break; |
1204 | case O_AND: | |
1205 | if (str_true(s1)) | |
1206 | str = str_make(str_get(s2)); | |
1207 | else | |
1208 | str = str_make(str_get(s1)); | |
1209 | break; | |
1210 | case O_OR: | |
1211 | if (str_true(s1)) | |
1212 | str = str_make(str_get(s1)); | |
1213 | else | |
1214 | str = str_make(str_get(s2)); | |
1215 | break; | |
1216 | case O_COND_EXPR: | |
1217 | if (arg[3].arg_type != A_SINGLE) { | |
1218 | str_free(str); | |
1219 | str = Nullstr; | |
1220 | } | |
1221 | else { | |
1222 | str = str_make(str_get(str_true(s1) ? s2 : arg[3].arg_ptr.arg_str)); | |
1223 | str_free(arg[3].arg_ptr.arg_str); | |
1224 | } | |
1225 | break; | |
1226 | case O_NEGATE: | |
1227 | str_numset(str,(double)(-str_gnum(s1))); | |
1228 | break; | |
1229 | case O_NOT: | |
1230 | str_numset(str,(double)(!str_true(s1))); | |
1231 | break; | |
1232 | case O_COMPLEMENT: | |
1233 | str_numset(str,(double)(~(long)str_gnum(s1))); | |
1234 | break; | |
1235 | case O_LENGTH: | |
1236 | str_numset(str, (double)str_len(s1)); | |
1237 | break; | |
1238 | case O_SUBSTR: | |
a559c259 | 1239 | if (arg[3].arg_type != A_SINGLE || stabent("[",allstabs)) { |
8d063cd8 LW |
1240 | str_free(str); /* making the fallacious assumption */ |
1241 | str = Nullstr; /* that any $[ occurs before substr()*/ | |
1242 | } | |
1243 | else { | |
1244 | char *beg; | |
1245 | int len = (int)str_gnum(s2); | |
1246 | int tmp; | |
1247 | ||
1248 | for (beg = str_get(s1); *beg && len > 0; beg++,len--) ; | |
1249 | len = (int)str_gnum(arg[3].arg_ptr.arg_str); | |
1250 | str_free(arg[3].arg_ptr.arg_str); | |
1251 | if (len > (tmp = strlen(beg))) | |
1252 | len = tmp; | |
1253 | str_nset(str,beg,len); | |
1254 | } | |
1255 | break; | |
1256 | case O_SLT: | |
1257 | tmps = str_get(s1); | |
1258 | str_numset(str,(double)(strLT(tmps,str_get(s2)))); | |
1259 | break; | |
1260 | case O_SGT: | |
1261 | tmps = str_get(s1); | |
1262 | str_numset(str,(double)(strGT(tmps,str_get(s2)))); | |
1263 | break; | |
1264 | case O_SLE: | |
1265 | tmps = str_get(s1); | |
1266 | str_numset(str,(double)(strLE(tmps,str_get(s2)))); | |
1267 | break; | |
1268 | case O_SGE: | |
1269 | tmps = str_get(s1); | |
1270 | str_numset(str,(double)(strGE(tmps,str_get(s2)))); | |
1271 | break; | |
1272 | case O_SEQ: | |
1273 | tmps = str_get(s1); | |
1274 | str_numset(str,(double)(strEQ(tmps,str_get(s2)))); | |
1275 | break; | |
1276 | case O_SNE: | |
1277 | tmps = str_get(s1); | |
1278 | str_numset(str,(double)(strNE(tmps,str_get(s2)))); | |
1279 | break; | |
1280 | case O_CRYPT: | |
378cc40b | 1281 | #ifdef CRYPT |
8d063cd8 LW |
1282 | tmps = str_get(s1); |
1283 | str_set(str,crypt(tmps,str_get(s2))); | |
378cc40b LW |
1284 | #else |
1285 | fatal( | |
1286 | "The crypt() function is unimplemented due to excessive paranoia."); | |
1287 | #endif | |
8d063cd8 LW |
1288 | break; |
1289 | case O_EXP: | |
1290 | str_numset(str,exp(str_gnum(s1))); | |
1291 | break; | |
1292 | case O_LOG: | |
1293 | str_numset(str,log(str_gnum(s1))); | |
1294 | break; | |
1295 | case O_SQRT: | |
1296 | str_numset(str,sqrt(str_gnum(s1))); | |
1297 | break; | |
1298 | case O_INT: | |
378cc40b LW |
1299 | value = str_gnum(s1); |
1300 | if (value >= 0.0) | |
1301 | modf(value,&value); | |
1302 | else { | |
1303 | modf(-value,&value); | |
1304 | value = -value; | |
1305 | } | |
8d063cd8 LW |
1306 | str_numset(str,value); |
1307 | break; | |
1308 | case O_ORD: | |
1309 | str_numset(str,(double)(*str_get(s1))); | |
1310 | break; | |
1311 | } | |
1312 | if (str) { | |
1313 | arg->arg_type = O_ITEM; /* note arg1 type is already SINGLE */ | |
1314 | str_free(s1); | |
1315 | str_free(s2); | |
1316 | arg[1].arg_ptr.arg_str = str; | |
1317 | } | |
1318 | } | |
1319 | } | |
1320 | ||
1321 | ARG * | |
1322 | l(arg) | |
1323 | register ARG *arg; | |
1324 | { | |
1325 | register int i; | |
1326 | register ARG *arg1; | |
378cc40b | 1327 | ARG *tmparg; |
8d063cd8 LW |
1328 | |
1329 | arg->arg_flags |= AF_COMMON; /* XXX should cross-match */ | |
378cc40b LW |
1330 | /* this does unnecessary copying */ |
1331 | ||
1332 | if (arg[1].arg_type == A_ARYLEN) { | |
1333 | arg[1].arg_type = A_LARYLEN; | |
1334 | return arg; | |
1335 | } | |
8d063cd8 LW |
1336 | |
1337 | /* see if it's an array reference */ | |
1338 | ||
1339 | if (arg[1].arg_type == A_EXPR) { | |
1340 | arg1 = arg[1].arg_ptr.arg_arg; | |
1341 | ||
1342 | if (arg1->arg_type == O_LIST && arg->arg_type != O_ITEM) { | |
1343 | /* assign to list */ | |
1344 | arg[1].arg_flags |= AF_SPECIAL; | |
378cc40b | 1345 | dehoist(arg,2); |
8d063cd8 LW |
1346 | arg[2].arg_flags |= AF_SPECIAL; |
1347 | for (i = arg1->arg_len; i >= 1; i--) { | |
1348 | switch (arg1[i].arg_type) { | |
1349 | case A_STAB: case A_LVAL: | |
1350 | arg1[i].arg_type = A_LVAL; | |
1351 | break; | |
1352 | case A_EXPR: case A_LEXPR: | |
1353 | arg1[i].arg_type = A_LEXPR; | |
1354 | if (arg1[i].arg_ptr.arg_arg->arg_type == O_ARRAY) | |
1355 | arg1[i].arg_ptr.arg_arg->arg_type = O_LARRAY; | |
1356 | else if (arg1[i].arg_ptr.arg_arg->arg_type == O_HASH) | |
1357 | arg1[i].arg_ptr.arg_arg->arg_type = O_LHASH; | |
1358 | if (arg1[i].arg_ptr.arg_arg->arg_type == O_LARRAY) | |
1359 | break; | |
1360 | if (arg1[i].arg_ptr.arg_arg->arg_type == O_LHASH) | |
1361 | break; | |
1362 | /* FALL THROUGH */ | |
1363 | default: | |
1364 | sprintf(tokenbuf, | |
1365 | "Illegal item (%s) as lvalue",argname[arg1[i].arg_type]); | |
1366 | yyerror(tokenbuf); | |
1367 | } | |
1368 | } | |
1369 | } | |
1370 | else if (arg1->arg_type == O_ARRAY) { | |
1371 | if (arg1->arg_len == 1 && arg->arg_type != O_ITEM) { | |
1372 | /* assign to array */ | |
1373 | arg[1].arg_flags |= AF_SPECIAL; | |
378cc40b | 1374 | dehoist(arg,2); |
8d063cd8 LW |
1375 | arg[2].arg_flags |= AF_SPECIAL; |
1376 | } | |
1377 | else | |
1378 | arg1->arg_type = O_LARRAY; /* assign to array elem */ | |
1379 | } | |
1380 | else if (arg1->arg_type == O_HASH) | |
1381 | arg1->arg_type = O_LHASH; | |
378cc40b | 1382 | else if (arg1->arg_type != O_ASSIGN) { |
8d063cd8 LW |
1383 | sprintf(tokenbuf, |
1384 | "Illegal expression (%s) as lvalue",opname[arg1->arg_type]); | |
1385 | yyerror(tokenbuf); | |
1386 | } | |
1387 | arg[1].arg_type = A_LEXPR; | |
1388 | #ifdef DEBUGGING | |
1389 | if (debug & 16) | |
1390 | fprintf(stderr,"lval LEXPR\n"); | |
1391 | #endif | |
1392 | return arg; | |
1393 | } | |
1394 | ||
1395 | /* not an array reference, should be a register name */ | |
1396 | ||
1397 | if (arg[1].arg_type != A_STAB && arg[1].arg_type != A_LVAL) { | |
1398 | sprintf(tokenbuf, | |
1399 | "Illegal item (%s) as lvalue",argname[arg[1].arg_type]); | |
1400 | yyerror(tokenbuf); | |
1401 | } | |
1402 | arg[1].arg_type = A_LVAL; | |
1403 | #ifdef DEBUGGING | |
1404 | if (debug & 16) | |
1405 | fprintf(stderr,"lval LVAL\n"); | |
1406 | #endif | |
1407 | return arg; | |
1408 | } | |
1409 | ||
378cc40b LW |
1410 | dehoist(arg,i) |
1411 | ARG *arg; | |
1412 | { | |
1413 | ARG *tmparg; | |
1414 | ||
1415 | if (arg[i].arg_type != A_EXPR) { /* dehoist */ | |
1416 | tmparg = make_op(O_ITEM,1,Nullarg,Nullarg,Nullarg,0); | |
1417 | tmparg[1] = arg[i]; | |
1418 | arg[i].arg_ptr.arg_arg = tmparg; | |
1419 | arg[i].arg_type = A_EXPR; | |
1420 | } | |
1421 | } | |
1422 | ||
8d063cd8 LW |
1423 | ARG * |
1424 | addflags(i,flags,arg) | |
1425 | register ARG *arg; | |
1426 | { | |
1427 | arg[i].arg_flags |= flags; | |
1428 | return arg; | |
1429 | } | |
1430 | ||
1431 | ARG * | |
1432 | hide_ary(arg) | |
1433 | ARG *arg; | |
1434 | { | |
1435 | if (arg->arg_type == O_ARRAY) | |
1436 | return make_op(O_ITEM,1,arg,Nullarg,Nullarg,0); | |
1437 | return arg; | |
1438 | } | |
1439 | ||
1440 | ARG * | |
1441 | make_list(arg) | |
1442 | register ARG *arg; | |
1443 | { | |
1444 | register int i; | |
1445 | register ARG *node; | |
1446 | register ARG *nxtnode; | |
1447 | register int j; | |
1448 | STR *tmpstr; | |
1449 | ||
1450 | if (!arg) { | |
1451 | arg = op_new(0); | |
1452 | arg->arg_type = O_LIST; | |
1453 | } | |
1454 | if (arg->arg_type != O_COMMA) { | |
1455 | arg->arg_flags |= AF_LISTISH; /* see listish() below */ | |
1456 | return arg; | |
1457 | } | |
1458 | for (i = 2, node = arg; ; i++) { | |
1459 | if (node->arg_len < 2) | |
1460 | break; | |
1461 | if (node[2].arg_type != A_EXPR) | |
1462 | break; | |
1463 | node = node[2].arg_ptr.arg_arg; | |
1464 | if (node->arg_type != O_COMMA) | |
1465 | break; | |
1466 | } | |
1467 | if (i > 2) { | |
1468 | node = arg; | |
1469 | arg = op_new(i); | |
1470 | tmpstr = arg->arg_ptr.arg_str; | |
1471 | *arg = *node; /* copy everything except the STR */ | |
1472 | arg->arg_ptr.arg_str = tmpstr; | |
1473 | for (j = 1; ; ) { | |
378cc40b LW |
1474 | arg[j] = node[1]; |
1475 | ++j; /* Bug in Xenix compiler */ | |
8d063cd8 LW |
1476 | if (j >= i) { |
1477 | arg[j] = node[2]; | |
1478 | free_arg(node); | |
1479 | break; | |
1480 | } | |
1481 | nxtnode = node[2].arg_ptr.arg_arg; | |
1482 | free_arg(node); | |
1483 | node = nxtnode; | |
1484 | } | |
1485 | } | |
1486 | arg->arg_type = O_LIST; | |
1487 | arg->arg_len = i; | |
1488 | return arg; | |
1489 | } | |
1490 | ||
1491 | /* turn a single item into a list */ | |
1492 | ||
1493 | ARG * | |
1494 | listish(arg) | |
1495 | ARG *arg; | |
1496 | { | |
378cc40b | 1497 | if (arg->arg_flags & AF_LISTISH) { |
8d063cd8 | 1498 | arg = make_op(O_LIST,1,arg,Nullarg,Nullarg,0); |
378cc40b LW |
1499 | arg[1].arg_flags &= ~AF_SPECIAL; |
1500 | } | |
1501 | return arg; | |
1502 | } | |
1503 | ||
1504 | /* mark list of local variables */ | |
1505 | ||
1506 | ARG * | |
1507 | localize(arg) | |
1508 | ARG *arg; | |
1509 | { | |
1510 | arg->arg_flags |= AF_LOCAL; | |
8d063cd8 LW |
1511 | return arg; |
1512 | } | |
1513 | ||
1514 | ARG * | |
378cc40b | 1515 | stab2arg(atype,stab) |
8d063cd8 LW |
1516 | int atype; |
1517 | register STAB *stab; | |
1518 | { | |
1519 | register ARG *arg; | |
1520 | ||
1521 | arg = op_new(1); | |
1522 | arg->arg_type = O_ITEM; | |
1523 | arg[1].arg_type = atype; | |
1524 | arg[1].arg_ptr.arg_stab = stab; | |
1525 | return arg; | |
1526 | } | |
1527 | ||
1528 | ARG * | |
1529 | cval_to_arg(cval) | |
1530 | register char *cval; | |
1531 | { | |
1532 | register ARG *arg; | |
1533 | ||
1534 | arg = op_new(1); | |
1535 | arg->arg_type = O_ITEM; | |
1536 | arg[1].arg_type = A_SINGLE; | |
1537 | arg[1].arg_ptr.arg_str = str_make(cval); | |
1538 | safefree(cval); | |
1539 | return arg; | |
1540 | } | |
1541 | ||
1542 | ARG * | |
1543 | op_new(numargs) | |
1544 | int numargs; | |
1545 | { | |
1546 | register ARG *arg; | |
1547 | ||
1548 | arg = (ARG*)safemalloc((numargs + 1) * sizeof (ARG)); | |
1549 | bzero((char *)arg, (numargs + 1) * sizeof (ARG)); | |
1550 | arg->arg_ptr.arg_str = str_new(0); | |
1551 | arg->arg_len = numargs; | |
1552 | return arg; | |
1553 | } | |
1554 | ||
1555 | void | |
1556 | free_arg(arg) | |
1557 | ARG *arg; | |
1558 | { | |
1559 | str_free(arg->arg_ptr.arg_str); | |
1560 | safefree((char*)arg); | |
1561 | } | |
1562 | ||
1563 | ARG * | |
1564 | make_match(type,expr,spat) | |
1565 | int type; | |
1566 | ARG *expr; | |
1567 | SPAT *spat; | |
1568 | { | |
1569 | register ARG *arg; | |
1570 | ||
1571 | arg = make_op(type,2,expr,Nullarg,Nullarg,0); | |
1572 | ||
1573 | arg[2].arg_type = A_SPAT; | |
1574 | arg[2].arg_ptr.arg_spat = spat; | |
1575 | #ifdef DEBUGGING | |
1576 | if (debug & 16) | |
378cc40b | 1577 | fprintf(stderr,"make_match SPAT=%lx\n",(long)spat); |
8d063cd8 LW |
1578 | #endif |
1579 | ||
1580 | if (type == O_SUBST || type == O_NSUBST) { | |
1581 | if (arg[1].arg_type != A_STAB) | |
1582 | yyerror("Illegal lvalue"); | |
1583 | arg[1].arg_type = A_LVAL; | |
1584 | } | |
1585 | return arg; | |
1586 | } | |
1587 | ||
1588 | ARG * | |
1589 | cmd_to_arg(cmd) | |
1590 | CMD *cmd; | |
1591 | { | |
1592 | register ARG *arg; | |
1593 | ||
1594 | arg = op_new(1); | |
1595 | arg->arg_type = O_ITEM; | |
1596 | arg[1].arg_type = A_CMD; | |
1597 | arg[1].arg_ptr.arg_cmd = cmd; | |
1598 | return arg; | |
1599 | } | |
1600 | ||
1601 | CMD * | |
1602 | wopt(cmd) | |
1603 | register CMD *cmd; | |
1604 | { | |
1605 | register CMD *tail; | |
1606 | register ARG *arg = cmd->c_expr; | |
378cc40b | 1607 | STAB *asgnstab; |
8d063cd8 LW |
1608 | |
1609 | /* hoist "while (<channel>)" up into command block */ | |
1610 | ||
1611 | if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_READ) { | |
1612 | cmd->c_flags &= ~CF_OPTIMIZE; /* clear optimization type */ | |
1613 | cmd->c_flags |= CFT_GETS; /* and set it to do the input */ | |
1614 | cmd->c_stab = arg[1].arg_ptr.arg_stab; | |
1615 | if (arg[1].arg_ptr.arg_stab->stab_io->flags & IOF_ARGV) { | |
1616 | cmd->c_expr = l(make_op(O_ASSIGN, 2, /* fake up "$_ =" */ | |
378cc40b | 1617 | stab2arg(A_LVAL,defstab), arg, Nullarg,1 )); |
8d063cd8 LW |
1618 | } |
1619 | else { | |
1620 | free_arg(arg); | |
1621 | cmd->c_expr = Nullarg; | |
1622 | } | |
1623 | } | |
378cc40b LW |
1624 | else if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_INDREAD) { |
1625 | cmd->c_flags &= ~CF_OPTIMIZE; /* clear optimization type */ | |
1626 | cmd->c_flags |= CFT_INDGETS; /* and set it to do the input */ | |
1627 | cmd->c_stab = arg[1].arg_ptr.arg_stab; | |
1628 | free_arg(arg); | |
1629 | cmd->c_expr = Nullarg; | |
1630 | } | |
1631 | else if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_GLOB) { | |
1632 | if ((cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY) | |
1633 | asgnstab = cmd->c_stab; | |
1634 | else | |
1635 | asgnstab = defstab; | |
1636 | cmd->c_expr = l(make_op(O_ASSIGN, 2, /* fake up "$foo =" */ | |
1637 | stab2arg(A_LVAL,asgnstab), arg, Nullarg,1 )); | |
1638 | cmd->c_flags &= ~CF_OPTIMIZE; /* clear optimization type */ | |
1639 | } | |
8d063cd8 LW |
1640 | |
1641 | /* First find the end of the true list */ | |
1642 | ||
1643 | if (cmd->ucmd.ccmd.cc_true == Nullcmd) | |
1644 | return cmd; | |
1645 | for (tail = cmd->ucmd.ccmd.cc_true; tail->c_next; tail = tail->c_next) ; | |
1646 | ||
1647 | /* if there's a continue block, link it to true block and find end */ | |
1648 | ||
1649 | if (cmd->ucmd.ccmd.cc_alt != Nullcmd) { | |
1650 | tail->c_next = cmd->ucmd.ccmd.cc_alt; | |
1651 | for ( ; tail->c_next; tail = tail->c_next) ; | |
1652 | } | |
1653 | ||
1654 | /* Here's the real trick: link the end of the list back to the beginning, | |
1655 | * inserting a "last" block to break out of the loop. This saves one or | |
1656 | * two procedure calls every time through the loop, because of how cmd_exec | |
1657 | * does tail recursion. | |
1658 | */ | |
1659 | ||
1660 | tail->c_next = (CMD *) safemalloc(sizeof (CMD)); | |
1661 | tail = tail->c_next; | |
1662 | if (!cmd->ucmd.ccmd.cc_alt) | |
1663 | cmd->ucmd.ccmd.cc_alt = tail; /* every loop has a continue now */ | |
1664 | ||
1665 | bcopy((char *)cmd, (char *)tail, sizeof(CMD)); | |
1666 | tail->c_type = C_EXPR; | |
1667 | tail->c_flags ^= CF_INVERT; /* turn into "last unless" */ | |
1668 | tail->c_next = tail->ucmd.ccmd.cc_true; /* loop directly back to top */ | |
1669 | tail->ucmd.acmd.ac_expr = make_op(O_LAST,0,Nullarg,Nullarg,Nullarg,0); | |
1670 | tail->ucmd.acmd.ac_stab = Nullstab; | |
1671 | return cmd; | |
1672 | } | |
1673 | ||
378cc40b LW |
1674 | CMD * |
1675 | over(eachstab,cmd) | |
1676 | STAB *eachstab; | |
1677 | register CMD *cmd; | |
8d063cd8 | 1678 | { |
378cc40b LW |
1679 | /* hoist "for $foo (@bar)" up into command block */ |
1680 | ||
1681 | cmd->c_flags &= ~CF_OPTIMIZE; /* clear optimization type */ | |
1682 | cmd->c_flags |= CFT_ARRAY; /* and set it to do the iteration */ | |
1683 | cmd->c_stab = eachstab; | |
1684 | ||
1685 | return cmd; | |
1686 | } | |
1687 | ||
1688 | static int gensym = 0; | |
1689 | ||
1690 | STAB * | |
1691 | genstab() | |
1692 | { | |
1693 | sprintf(tokenbuf,"_GEN_%d",gensym++); | |
1694 | return stabent(tokenbuf,TRUE); | |
8d063cd8 | 1695 | } |
a559c259 | 1696 | |
378cc40b LW |
1697 | /* this routine is in perly.c by virtue of being sort of an alternate main() */ |
1698 | ||
a559c259 | 1699 | STR * |
378cc40b | 1700 | do_eval(str,optype) |
a559c259 | 1701 | STR *str; |
378cc40b | 1702 | int optype; |
a559c259 LW |
1703 | { |
1704 | int retval; | |
1705 | CMD *myroot; | |
378cc40b LW |
1706 | ARRAY *ar; |
1707 | int i; | |
1708 | char *oldfile = filename; | |
1709 | line_t oldline = line; | |
1710 | int oldtmps_base = tmps_base; | |
1711 | int oldsave = savestack->ary_fill; | |
a559c259 | 1712 | |
378cc40b | 1713 | tmps_base = tmps_max; |
a559c259 | 1714 | str_set(stabent("@",TRUE)->stab_val,""); |
378cc40b LW |
1715 | if (optype != O_DOFILE) { /* normal eval */ |
1716 | filename = "(eval)"; | |
1717 | line = 1; | |
1718 | str_sset(linestr,str); | |
1719 | } | |
1720 | else { | |
1721 | filename = savestr(str_get(str)); /* can't free this easily */ | |
1722 | str_set(linestr,""); | |
1723 | rsfp = fopen(filename,"r"); | |
1724 | ar = incstab->stab_array; | |
1725 | if (!rsfp && *filename != '/') { | |
1726 | for (i = 0; i <= ar->ary_fill; i++) { | |
1727 | sprintf(tokenbuf,"%s/%s",str_get(afetch(ar,i)),filename); | |
1728 | rsfp = fopen(tokenbuf,"r"); | |
1729 | if (rsfp) { | |
1730 | free(filename); | |
1731 | filename = savestr(tokenbuf); | |
1732 | break; | |
1733 | } | |
1734 | } | |
1735 | } | |
1736 | if (!rsfp) { | |
1737 | filename = oldfile; | |
1738 | tmps_base = oldtmps_base; | |
1739 | return &str_no; | |
1740 | } | |
1741 | line = 0; | |
1742 | } | |
1743 | in_eval++; | |
a559c259 LW |
1744 | bufptr = str_get(linestr); |
1745 | if (setjmp(eval_env)) | |
1746 | retval = 1; | |
1747 | else | |
1748 | retval = yyparse(); | |
1749 | myroot = eval_root; /* in case cmd_exec does another eval! */ | |
1750 | if (retval) | |
1751 | str = &str_no; | |
1752 | else { | |
378cc40b LW |
1753 | str = str_static(cmd_exec(eval_root)); |
1754 | /* if we don't save str, free zaps it */ | |
a559c259 LW |
1755 | cmd_free(myroot); /* can't free on error, for some reason */ |
1756 | } | |
1757 | in_eval--; | |
378cc40b LW |
1758 | filename = oldfile; |
1759 | line = oldline; | |
1760 | tmps_base = oldtmps_base; | |
1761 | if (savestack->ary_fill > oldsave) /* let them use local() */ | |
1762 | restorelist(oldsave); | |
a559c259 LW |
1763 | return str; |
1764 | } | |
1765 | ||
1766 | cmd_free(cmd) | |
1767 | register CMD *cmd; | |
1768 | { | |
1769 | register CMD *tofree; | |
1770 | register CMD *head = cmd; | |
1771 | ||
1772 | while (cmd) { | |
378cc40b LW |
1773 | if (cmd->c_type != C_WHILE) { /* WHILE block is duplicated */ |
1774 | if (cmd->c_label) | |
1775 | safefree(cmd->c_label); | |
1776 | if (cmd->c_short) | |
1777 | str_free(cmd->c_short); | |
1778 | if (cmd->c_spat) | |
1779 | spat_free(cmd->c_spat); | |
1780 | if (cmd->c_expr) | |
1781 | arg_free(cmd->c_expr); | |
1782 | } | |
a559c259 LW |
1783 | switch (cmd->c_type) { |
1784 | case C_WHILE: | |
1785 | case C_BLOCK: | |
1786 | case C_IF: | |
1787 | if (cmd->ucmd.ccmd.cc_true) | |
1788 | cmd_free(cmd->ucmd.ccmd.cc_true); | |
1789 | if (cmd->c_type == C_IF && cmd->ucmd.ccmd.cc_alt) | |
378cc40b | 1790 | cmd_free(cmd->ucmd.ccmd.cc_alt); |
a559c259 LW |
1791 | break; |
1792 | case C_EXPR: | |
a559c259 LW |
1793 | if (cmd->ucmd.acmd.ac_expr) |
1794 | arg_free(cmd->ucmd.acmd.ac_expr); | |
1795 | break; | |
1796 | } | |
1797 | tofree = cmd; | |
1798 | cmd = cmd->c_next; | |
1799 | safefree((char*)tofree); | |
1800 | if (cmd && cmd == head) /* reached end of while loop */ | |
1801 | break; | |
1802 | } | |
1803 | } | |
1804 | ||
1805 | arg_free(arg) | |
1806 | register ARG *arg; | |
1807 | { | |
1808 | register int i; | |
1809 | ||
1810 | for (i = 1; i <= arg->arg_len; i++) { | |
1811 | switch (arg[i].arg_type) { | |
1812 | case A_NULL: | |
1813 | break; | |
1814 | case A_LEXPR: | |
1815 | case A_EXPR: | |
1816 | arg_free(arg[i].arg_ptr.arg_arg); | |
1817 | break; | |
1818 | case A_CMD: | |
1819 | cmd_free(arg[i].arg_ptr.arg_cmd); | |
1820 | break; | |
378cc40b | 1821 | case A_WORD: |
a559c259 LW |
1822 | case A_STAB: |
1823 | case A_LVAL: | |
1824 | case A_READ: | |
378cc40b | 1825 | case A_GLOB: |
a559c259 LW |
1826 | case A_ARYLEN: |
1827 | break; | |
1828 | case A_SINGLE: | |
1829 | case A_DOUBLE: | |
1830 | case A_BACKTICK: | |
1831 | str_free(arg[i].arg_ptr.arg_str); | |
1832 | break; | |
1833 | case A_SPAT: | |
1834 | spat_free(arg[i].arg_ptr.arg_spat); | |
1835 | break; | |
1836 | case A_NUMBER: | |
1837 | break; | |
1838 | } | |
1839 | } | |
1840 | free_arg(arg); | |
1841 | } | |
1842 | ||
1843 | spat_free(spat) | |
1844 | register SPAT *spat; | |
1845 | { | |
1846 | register SPAT *sp; | |
1847 | ||
1848 | if (spat->spat_runtime) | |
1849 | arg_free(spat->spat_runtime); | |
1850 | if (spat->spat_repl) { | |
1851 | arg_free(spat->spat_repl); | |
1852 | } | |
378cc40b LW |
1853 | if (spat->spat_short) { |
1854 | str_free(spat->spat_short); | |
1855 | } | |
1856 | if (spat->spat_regexp) { | |
1857 | regfree(spat->spat_regexp); | |
1858 | } | |
a559c259 LW |
1859 | |
1860 | /* now unlink from spat list */ | |
1861 | if (spat_root == spat) | |
1862 | spat_root = spat->spat_next; | |
1863 | else { | |
1864 | for (sp = spat_root; sp->spat_next != spat; sp = sp->spat_next) ; | |
1865 | sp->spat_next = spat->spat_next; | |
1866 | } | |
1867 | ||
1868 | safefree((char*)spat); | |
1869 | } | |
378cc40b LW |
1870 | |
1871 | /* Recursively descend a command sequence and push the address of any string | |
1872 | * that needs saving on recursion onto the tosave array. | |
1873 | */ | |
1874 | ||
1875 | static int | |
1876 | cmd_tosave(cmd) | |
1877 | register CMD *cmd; | |
1878 | { | |
1879 | register CMD *head = cmd; | |
1880 | ||
1881 | while (cmd) { | |
1882 | if (cmd->c_spat) | |
1883 | spat_tosave(cmd->c_spat); | |
1884 | if (cmd->c_expr) | |
1885 | arg_tosave(cmd->c_expr); | |
1886 | switch (cmd->c_type) { | |
1887 | case C_WHILE: | |
1888 | case C_BLOCK: | |
1889 | case C_IF: | |
1890 | if (cmd->ucmd.ccmd.cc_true) | |
1891 | cmd_tosave(cmd->ucmd.ccmd.cc_true); | |
1892 | if (cmd->c_type == C_IF && cmd->ucmd.ccmd.cc_alt) | |
1893 | cmd_tosave(cmd->ucmd.ccmd.cc_alt); | |
1894 | break; | |
1895 | case C_EXPR: | |
1896 | if (cmd->ucmd.acmd.ac_expr) | |
1897 | arg_tosave(cmd->ucmd.acmd.ac_expr); | |
1898 | break; | |
1899 | } | |
1900 | cmd = cmd->c_next; | |
1901 | if (cmd && cmd == head) /* reached end of while loop */ | |
1902 | break; | |
1903 | } | |
1904 | } | |
1905 | ||
1906 | static int | |
1907 | arg_tosave(arg) | |
1908 | register ARG *arg; | |
1909 | { | |
1910 | register int i; | |
1911 | int saving = FALSE; | |
1912 | ||
1913 | for (i = 1; i <= arg->arg_len; i++) { | |
1914 | switch (arg[i].arg_type) { | |
1915 | case A_NULL: | |
1916 | break; | |
1917 | case A_LEXPR: | |
1918 | case A_EXPR: | |
1919 | saving |= arg_tosave(arg[i].arg_ptr.arg_arg); | |
1920 | break; | |
1921 | case A_CMD: | |
1922 | cmd_tosave(arg[i].arg_ptr.arg_cmd); | |
1923 | saving = TRUE; /* assume hanky panky */ | |
1924 | break; | |
1925 | case A_WORD: | |
1926 | case A_STAB: | |
1927 | case A_LVAL: | |
1928 | case A_READ: | |
1929 | case A_GLOB: | |
1930 | case A_ARYLEN: | |
1931 | case A_SINGLE: | |
1932 | case A_DOUBLE: | |
1933 | case A_BACKTICK: | |
1934 | break; | |
1935 | case A_SPAT: | |
1936 | saving |= spat_tosave(arg[i].arg_ptr.arg_spat); | |
1937 | break; | |
1938 | case A_NUMBER: | |
1939 | break; | |
1940 | } | |
1941 | } | |
1942 | switch (arg->arg_type) { | |
1943 | case O_EVAL: | |
1944 | case O_SUBR: | |
1945 | saving = TRUE; | |
1946 | } | |
1947 | if (saving) | |
1948 | apush(tosave,arg->arg_ptr.arg_str); | |
1949 | return saving; | |
1950 | } | |
1951 | ||
1952 | static int | |
1953 | spat_tosave(spat) | |
1954 | register SPAT *spat; | |
1955 | { | |
1956 | int saving = FALSE; | |
1957 | ||
1958 | if (spat->spat_runtime) | |
1959 | saving |= arg_tosave(spat->spat_runtime); | |
1960 | if (spat->spat_repl) { | |
1961 | saving |= arg_tosave(spat->spat_repl); | |
1962 | } | |
1963 | ||
1964 | return saving; | |
1965 | } |