Commit | Line | Data |
68decaef |
1 | /* $RCSfile: consarg.c,v $$Revision: 4.0.1.4 $$Date: 92/06/08 12:26:27 $ |
a687059c |
2 | * |
2b317908 |
3 | * Copyright (c) 1991, Larry Wall |
a687059c |
4 | * |
2b317908 |
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. |
a687059c |
7 | * |
8 | * $Log: consarg.c,v $ |
68decaef |
9 | * Revision 4.0.1.4 92/06/08 12:26:27 lwall |
10 | * patch20: new warning for use of x with non-numeric right operand |
11 | * patch20: modulus with highest bit in left operand set didn't always work |
12 | * patch20: illegal lvalue message could be followed by core dump |
13 | * patch20: deleted some minor memory leaks |
14 | * |
db4e6270 |
15 | * Revision 4.0.1.3 91/11/05 16:21:16 lwall |
16 | * patch11: random cleanup |
17 | * patch11: added eval {} |
18 | * patch11: added sort {} LIST |
19 | * patch11: "foo" x -1 dumped core |
20 | * patch11: substr() and vec() weren't allowed in an lvalue list |
21 | * |
2b317908 |
22 | * Revision 4.0.1.2 91/06/07 10:33:12 lwall |
23 | * patch4: new copyright notice |
24 | * patch4: length($`), length($&), length($') now optimized to avoid string copy |
25 | * |
1c3d792e |
26 | * Revision 4.0.1.1 91/04/11 17:38:34 lwall |
27 | * patch1: fixed "Bad free" error |
28 | * |
fe14fcc3 |
29 | * Revision 4.0 91/03/20 01:06:15 lwall |
30 | * 4.0 baseline. |
a687059c |
31 | * |
32 | */ |
33 | |
34 | #include "EXTERN.h" |
35 | #include "perl.h" |
36 | static int nothing_in_common(); |
37 | static int arg_common(); |
38 | static int spat_common(); |
39 | |
40 | ARG * |
41 | make_split(stab,arg,limarg) |
42 | register STAB *stab; |
43 | register ARG *arg; |
44 | ARG *limarg; |
45 | { |
46 | register SPAT *spat; |
47 | |
48 | if (arg->arg_type != O_MATCH) { |
49 | Newz(201,spat,1,SPAT); |
50 | spat->spat_next = curstash->tbl_spatroot; /* link into spat list */ |
51 | curstash->tbl_spatroot = spat; |
52 | |
53 | spat->spat_runtime = arg; |
54 | arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat); |
55 | } |
56 | Renew(arg,4,ARG); |
57 | arg->arg_len = 3; |
58 | if (limarg) { |
59 | if (limarg->arg_type == O_ITEM) { |
60 | Copy(limarg+1,arg+3,1,ARG); |
61 | limarg[1].arg_type = A_NULL; |
62 | arg_free(limarg); |
63 | } |
64 | else { |
ff8e2863 |
65 | arg[3].arg_flags = 0; |
68decaef |
66 | arg[3].arg_len = 0; |
a687059c |
67 | arg[3].arg_type = A_EXPR; |
68 | arg[3].arg_ptr.arg_arg = limarg; |
69 | } |
70 | } |
db4e6270 |
71 | else { |
72 | arg[3].arg_flags = 0; |
68decaef |
73 | arg[3].arg_len = 0; |
a687059c |
74 | arg[3].arg_type = A_NULL; |
db4e6270 |
75 | arg[3].arg_ptr.arg_arg = Nullarg; |
76 | } |
a687059c |
77 | arg->arg_type = O_SPLIT; |
78 | spat = arg[2].arg_ptr.arg_spat; |
79 | spat->spat_repl = stab2arg(A_STAB,aadd(stab)); |
80 | if (spat->spat_short) { /* exact match can bypass regexec() */ |
81 | if (!((spat->spat_flags & SPAT_SCANFIRST) && |
82 | (spat->spat_flags & SPAT_ALL) )) { |
83 | str_free(spat->spat_short); |
84 | spat->spat_short = Nullstr; |
85 | } |
86 | } |
87 | return arg; |
88 | } |
89 | |
90 | ARG * |
91 | mod_match(type,left,pat) |
92 | register ARG *left; |
93 | register ARG *pat; |
94 | { |
95 | |
96 | register SPAT *spat; |
97 | register ARG *newarg; |
98 | |
39c3038c |
99 | if (!pat) |
100 | return Nullarg; |
101 | |
a687059c |
102 | if ((pat->arg_type == O_MATCH || |
103 | pat->arg_type == O_SUBST || |
104 | pat->arg_type == O_TRANS || |
105 | pat->arg_type == O_SPLIT |
106 | ) && |
107 | pat[1].arg_ptr.arg_stab == defstab ) { |
108 | switch (pat->arg_type) { |
109 | case O_MATCH: |
110 | newarg = make_op(type == O_MATCH ? O_MATCH : O_NMATCH, |
111 | pat->arg_len, |
112 | left,Nullarg,Nullarg); |
113 | break; |
114 | case O_SUBST: |
115 | newarg = l(make_op(type == O_MATCH ? O_SUBST : O_NSUBST, |
116 | pat->arg_len, |
117 | left,Nullarg,Nullarg)); |
118 | break; |
119 | case O_TRANS: |
120 | newarg = l(make_op(type == O_MATCH ? O_TRANS : O_NTRANS, |
121 | pat->arg_len, |
122 | left,Nullarg,Nullarg)); |
123 | break; |
124 | case O_SPLIT: |
125 | newarg = make_op(type == O_MATCH ? O_SPLIT : O_SPLIT, |
126 | pat->arg_len, |
127 | left,Nullarg,Nullarg); |
128 | break; |
129 | } |
130 | if (pat->arg_len >= 2) { |
131 | newarg[2].arg_type = pat[2].arg_type; |
132 | newarg[2].arg_ptr = pat[2].arg_ptr; |
fe14fcc3 |
133 | newarg[2].arg_len = pat[2].arg_len; |
a687059c |
134 | newarg[2].arg_flags = pat[2].arg_flags; |
135 | if (pat->arg_len >= 3) { |
136 | newarg[3].arg_type = pat[3].arg_type; |
137 | newarg[3].arg_ptr = pat[3].arg_ptr; |
fe14fcc3 |
138 | newarg[3].arg_len = pat[3].arg_len; |
a687059c |
139 | newarg[3].arg_flags = pat[3].arg_flags; |
140 | } |
141 | } |
fe14fcc3 |
142 | free_arg(pat); |
a687059c |
143 | } |
144 | else { |
145 | Newz(202,spat,1,SPAT); |
146 | spat->spat_next = curstash->tbl_spatroot; /* link into spat list */ |
147 | curstash->tbl_spatroot = spat; |
148 | |
149 | spat->spat_runtime = pat; |
150 | newarg = make_op(type,2,left,Nullarg,Nullarg); |
151 | newarg[2].arg_type = A_SPAT | A_DONT; |
152 | newarg[2].arg_ptr.arg_spat = spat; |
153 | } |
154 | |
155 | return newarg; |
156 | } |
157 | |
158 | ARG * |
159 | make_op(type,newlen,arg1,arg2,arg3) |
160 | int type; |
161 | int newlen; |
162 | ARG *arg1; |
163 | ARG *arg2; |
164 | ARG *arg3; |
165 | { |
166 | register ARG *arg; |
167 | register ARG *chld; |
39c3038c |
168 | register unsigned doarg; |
169 | register int i; |
a687059c |
170 | extern ARG *arg4; /* should be normal arguments, really */ |
171 | extern ARG *arg5; |
172 | |
173 | arg = op_new(newlen); |
174 | arg->arg_type = type; |
db4e6270 |
175 | /*SUPPRESS 560*/ |
a687059c |
176 | if (chld = arg1) { |
177 | if (chld->arg_type == O_ITEM && |
39c3038c |
178 | (hoistable[ i = (chld[1].arg_type&A_MASK)] || i == A_LVAL || |
179 | (i == A_LEXPR && |
a687059c |
180 | (chld[1].arg_ptr.arg_arg->arg_type == O_LIST || |
181 | chld[1].arg_ptr.arg_arg->arg_type == O_ARRAY || |
182 | chld[1].arg_ptr.arg_arg->arg_type == O_HASH )))) |
183 | { |
184 | arg[1].arg_type = chld[1].arg_type; |
185 | arg[1].arg_ptr = chld[1].arg_ptr; |
186 | arg[1].arg_flags |= chld[1].arg_flags; |
187 | arg[1].arg_len = chld[1].arg_len; |
188 | free_arg(chld); |
189 | } |
190 | else { |
191 | arg[1].arg_type = A_EXPR; |
192 | arg[1].arg_ptr.arg_arg = chld; |
193 | } |
a687059c |
194 | } |
db4e6270 |
195 | /*SUPPRESS 560*/ |
a687059c |
196 | if (chld = arg2) { |
197 | if (chld->arg_type == O_ITEM && |
39c3038c |
198 | (hoistable[chld[1].arg_type&A_MASK] || |
a687059c |
199 | (type == O_ASSIGN && |
200 | ((chld[1].arg_type == A_READ && !(arg[1].arg_type & A_DONT)) |
201 | || |
202 | (chld[1].arg_type == A_INDREAD && !(arg[1].arg_type & A_DONT)) |
203 | || |
204 | (chld[1].arg_type == A_GLOB && !(arg[1].arg_type & A_DONT)) |
205 | ) ) ) ) { |
206 | arg[2].arg_type = chld[1].arg_type; |
207 | arg[2].arg_ptr = chld[1].arg_ptr; |
208 | arg[2].arg_len = chld[1].arg_len; |
209 | free_arg(chld); |
210 | } |
211 | else { |
212 | arg[2].arg_type = A_EXPR; |
213 | arg[2].arg_ptr.arg_arg = chld; |
214 | } |
a687059c |
215 | } |
db4e6270 |
216 | /*SUPPRESS 560*/ |
a687059c |
217 | if (chld = arg3) { |
39c3038c |
218 | if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) { |
a687059c |
219 | arg[3].arg_type = chld[1].arg_type; |
220 | arg[3].arg_ptr = chld[1].arg_ptr; |
221 | arg[3].arg_len = chld[1].arg_len; |
222 | free_arg(chld); |
223 | } |
224 | else { |
225 | arg[3].arg_type = A_EXPR; |
226 | arg[3].arg_ptr.arg_arg = chld; |
227 | } |
a687059c |
228 | } |
229 | if (newlen >= 4 && (chld = arg4)) { |
39c3038c |
230 | if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) { |
a687059c |
231 | arg[4].arg_type = chld[1].arg_type; |
232 | arg[4].arg_ptr = chld[1].arg_ptr; |
233 | arg[4].arg_len = chld[1].arg_len; |
234 | free_arg(chld); |
235 | } |
236 | else { |
237 | arg[4].arg_type = A_EXPR; |
238 | arg[4].arg_ptr.arg_arg = chld; |
239 | } |
240 | } |
241 | if (newlen >= 5 && (chld = arg5)) { |
39c3038c |
242 | if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) { |
a687059c |
243 | arg[5].arg_type = chld[1].arg_type; |
244 | arg[5].arg_ptr = chld[1].arg_ptr; |
245 | arg[5].arg_len = chld[1].arg_len; |
246 | free_arg(chld); |
247 | } |
248 | else { |
249 | arg[5].arg_type = A_EXPR; |
250 | arg[5].arg_ptr.arg_arg = chld; |
251 | } |
252 | } |
39c3038c |
253 | doarg = opargs[type]; |
254 | for (i = 1; i <= newlen; ++i) { |
255 | if (!(doarg & 1)) |
256 | arg[i].arg_type |= A_DONT; |
257 | if (doarg & 2) |
258 | arg[i].arg_flags |= AF_ARYOK; |
259 | doarg >>= 2; |
260 | } |
a687059c |
261 | #ifdef DEBUGGING |
262 | if (debug & 16) { |
263 | fprintf(stderr,"%lx <= make_op(%s",arg,opname[arg->arg_type]); |
264 | if (arg1) |
265 | fprintf(stderr,",%s=%lx", |
266 | argname[arg[1].arg_type&A_MASK],arg[1].arg_ptr.arg_arg); |
267 | if (arg2) |
268 | fprintf(stderr,",%s=%lx", |
269 | argname[arg[2].arg_type&A_MASK],arg[2].arg_ptr.arg_arg); |
270 | if (arg3) |
271 | fprintf(stderr,",%s=%lx", |
272 | argname[arg[3].arg_type&A_MASK],arg[3].arg_ptr.arg_arg); |
273 | if (newlen >= 4) |
274 | fprintf(stderr,",%s=%lx", |
275 | argname[arg[4].arg_type&A_MASK],arg[4].arg_ptr.arg_arg); |
276 | if (newlen >= 5) |
277 | fprintf(stderr,",%s=%lx", |
278 | argname[arg[5].arg_type&A_MASK],arg[5].arg_ptr.arg_arg); |
279 | fprintf(stderr,")\n"); |
280 | } |
281 | #endif |
2b317908 |
282 | arg = evalstatic(arg); /* see if we can consolidate anything */ |
a687059c |
283 | return arg; |
284 | } |
285 | |
2b317908 |
286 | ARG * |
a687059c |
287 | evalstatic(arg) |
288 | register ARG *arg; |
289 | { |
2b317908 |
290 | static STR *str = Nullstr; |
a687059c |
291 | register STR *s1; |
292 | register STR *s2; |
293 | double value; /* must not be register */ |
294 | register char *tmps; |
295 | int i; |
296 | unsigned long tmplong; |
297 | long tmp2; |
298 | double exp(), log(), sqrt(), modf(); |
299 | char *crypt(); |
300 | double sin(), cos(), atan2(), pow(); |
301 | |
302 | if (!arg || !arg->arg_len) |
2b317908 |
303 | return arg; |
a687059c |
304 | |
2b317908 |
305 | if (!str) |
a687059c |
306 | str = Str_new(20,0); |
2b317908 |
307 | |
308 | if (arg[1].arg_type == A_SINGLE) |
a687059c |
309 | s1 = arg[1].arg_ptr.arg_str; |
2b317908 |
310 | else |
311 | s1 = Nullstr; |
312 | if (arg->arg_len >= 2 && arg[2].arg_type == A_SINGLE) |
313 | s2 = arg[2].arg_ptr.arg_str; |
314 | else |
315 | s2 = Nullstr; |
316 | |
317 | #define CHECK1 if (!s1) return arg |
318 | #define CHECK2 if (!s2) return arg |
319 | #define CHECK12 if (!s1 || !s2) return arg |
320 | |
321 | switch (arg->arg_type) { |
322 | default: |
323 | return arg; |
db4e6270 |
324 | case O_SORT: |
325 | if (arg[1].arg_type == A_CMD) |
326 | arg[1].arg_type |= A_DONT; |
327 | return arg; |
328 | case O_EVAL: |
329 | if (arg[1].arg_type == A_CMD) { |
330 | arg->arg_type = O_TRY; |
331 | arg[1].arg_type |= A_DONT; |
332 | return arg; |
333 | } |
334 | CHECK1; |
335 | arg->arg_type = O_EVALONCE; |
336 | return arg; |
2b317908 |
337 | case O_AELEM: |
338 | CHECK2; |
339 | i = (int)str_gnum(s2); |
340 | if (i < 32767 && i >= 0) { |
341 | arg->arg_type = O_ITEM; |
342 | arg->arg_len = 1; |
343 | arg[1].arg_type = A_ARYSTAB; /* $abc[123] is hoistable now */ |
344 | arg[1].arg_len = i; |
345 | str_free(s2); |
346 | Renew(arg, 2, ARG); |
347 | } |
348 | return arg; |
349 | case O_CONCAT: |
350 | CHECK12; |
351 | str_sset(str,s1); |
352 | str_scat(str,s2); |
353 | break; |
354 | case O_REPEAT: |
68decaef |
355 | CHECK2; |
356 | if (dowarn && !s2->str_nok && !looks_like_number(s2)) |
357 | warn("Right operand of x is not numeric"); |
358 | CHECK1; |
2b317908 |
359 | i = (int)str_gnum(s2); |
360 | tmps = str_get(s1); |
361 | str_nset(str,"",0); |
db4e6270 |
362 | if (i > 0) { |
363 | STR_GROW(str, i * s1->str_cur + 1); |
364 | repeatcpy(str->str_ptr, tmps, s1->str_cur, i); |
365 | str->str_cur = i * s1->str_cur; |
366 | str->str_ptr[str->str_cur] = '\0'; |
367 | } |
2b317908 |
368 | break; |
369 | case O_MULTIPLY: |
370 | CHECK12; |
371 | value = str_gnum(s1); |
372 | str_numset(str,value * str_gnum(s2)); |
373 | break; |
374 | case O_DIVIDE: |
375 | CHECK12; |
376 | value = str_gnum(s2); |
377 | if (value == 0.0) |
378 | yyerror("Illegal division by constant zero"); |
a687059c |
379 | else |
db4e6270 |
380 | #ifdef SLOPPYDIVIDE |
2b317908 |
381 | /* insure that 20./5. == 4. */ |
382 | { |
383 | double x; |
384 | int k; |
385 | x = str_gnum(s1); |
386 | if ((double)(int)x == x && |
387 | (double)(int)value == value && |
388 | (k = (int)x/(int)value)*(int)value == (int)x) { |
389 | value = k; |
390 | } else { |
391 | value = x/value; |
fe14fcc3 |
392 | } |
2b317908 |
393 | str_numset(str,value); |
394 | } |
fe14fcc3 |
395 | #else |
2b317908 |
396 | str_numset(str,str_gnum(s1) / value); |
fe14fcc3 |
397 | #endif |
2b317908 |
398 | break; |
399 | case O_MODULO: |
400 | CHECK12; |
401 | tmplong = (unsigned long)str_gnum(s2); |
402 | if (tmplong == 0L) { |
403 | yyerror("Illegal modulus of constant zero"); |
404 | return arg; |
405 | } |
68decaef |
406 | value = str_gnum(s1); |
a687059c |
407 | #ifndef lint |
68decaef |
408 | if (value >= 0.0) |
409 | str_numset(str,(double)(((unsigned long)value) % tmplong)); |
410 | else { |
411 | tmp2 = (long)value; |
2b317908 |
412 | str_numset(str,(double)((tmplong-((-tmp2 - 1) % tmplong)) - 1)); |
68decaef |
413 | } |
a687059c |
414 | #else |
2b317908 |
415 | tmp2 = tmp2; |
a687059c |
416 | #endif |
2b317908 |
417 | break; |
418 | case O_ADD: |
419 | CHECK12; |
420 | value = str_gnum(s1); |
421 | str_numset(str,value + str_gnum(s2)); |
422 | break; |
423 | case O_SUBTRACT: |
424 | CHECK12; |
425 | value = str_gnum(s1); |
426 | str_numset(str,value - str_gnum(s2)); |
427 | break; |
428 | case O_LEFT_SHIFT: |
429 | CHECK12; |
430 | value = str_gnum(s1); |
431 | i = (int)str_gnum(s2); |
a687059c |
432 | #ifndef lint |
2b317908 |
433 | str_numset(str,(double)(((long)value) << i)); |
a687059c |
434 | #endif |
2b317908 |
435 | break; |
436 | case O_RIGHT_SHIFT: |
437 | CHECK12; |
438 | value = str_gnum(s1); |
439 | i = (int)str_gnum(s2); |
a687059c |
440 | #ifndef lint |
2b317908 |
441 | str_numset(str,(double)(((long)value) >> i)); |
a687059c |
442 | #endif |
2b317908 |
443 | break; |
444 | case O_LT: |
445 | CHECK12; |
446 | value = str_gnum(s1); |
447 | str_numset(str,(value < str_gnum(s2)) ? 1.0 : 0.0); |
448 | break; |
449 | case O_GT: |
450 | CHECK12; |
451 | value = str_gnum(s1); |
452 | str_numset(str,(value > str_gnum(s2)) ? 1.0 : 0.0); |
453 | break; |
454 | case O_LE: |
455 | CHECK12; |
456 | value = str_gnum(s1); |
457 | str_numset(str,(value <= str_gnum(s2)) ? 1.0 : 0.0); |
458 | break; |
459 | case O_GE: |
460 | CHECK12; |
461 | value = str_gnum(s1); |
462 | str_numset(str,(value >= str_gnum(s2)) ? 1.0 : 0.0); |
463 | break; |
464 | case O_EQ: |
465 | CHECK12; |
466 | if (dowarn) { |
467 | if ((!s1->str_nok && !looks_like_number(s1)) || |
468 | (!s2->str_nok && !looks_like_number(s2)) ) |
469 | warn("Possible use of == on string value"); |
470 | } |
471 | value = str_gnum(s1); |
472 | str_numset(str,(value == str_gnum(s2)) ? 1.0 : 0.0); |
473 | break; |
474 | case O_NE: |
475 | CHECK12; |
476 | value = str_gnum(s1); |
477 | str_numset(str,(value != str_gnum(s2)) ? 1.0 : 0.0); |
478 | break; |
479 | case O_NCMP: |
480 | CHECK12; |
481 | value = str_gnum(s1); |
482 | value -= str_gnum(s2); |
483 | if (value > 0.0) |
484 | value = 1.0; |
485 | else if (value < 0.0) |
486 | value = -1.0; |
487 | str_numset(str,value); |
488 | break; |
489 | case O_BIT_AND: |
490 | CHECK12; |
491 | value = str_gnum(s1); |
a687059c |
492 | #ifndef lint |
2b317908 |
493 | str_numset(str,(double)(U_L(value) & U_L(str_gnum(s2)))); |
a687059c |
494 | #endif |
2b317908 |
495 | break; |
496 | case O_XOR: |
497 | CHECK12; |
498 | value = str_gnum(s1); |
a687059c |
499 | #ifndef lint |
2b317908 |
500 | str_numset(str,(double)(U_L(value) ^ U_L(str_gnum(s2)))); |
a687059c |
501 | #endif |
2b317908 |
502 | break; |
503 | case O_BIT_OR: |
504 | CHECK12; |
505 | value = str_gnum(s1); |
a687059c |
506 | #ifndef lint |
2b317908 |
507 | str_numset(str,(double)(U_L(value) | U_L(str_gnum(s2)))); |
a687059c |
508 | #endif |
2b317908 |
509 | break; |
510 | case O_AND: |
511 | CHECK12; |
512 | if (str_true(s1)) |
513 | str_sset(str,s2); |
514 | else |
515 | str_sset(str,s1); |
516 | break; |
517 | case O_OR: |
518 | CHECK12; |
519 | if (str_true(s1)) |
520 | str_sset(str,s1); |
521 | else |
522 | str_sset(str,s2); |
523 | break; |
524 | case O_COND_EXPR: |
525 | CHECK12; |
526 | if ((arg[3].arg_type & A_MASK) != A_SINGLE) |
527 | return arg; |
528 | if (str_true(s1)) |
529 | str_sset(str,s2); |
530 | else |
531 | str_sset(str,arg[3].arg_ptr.arg_str); |
532 | str_free(arg[3].arg_ptr.arg_str); |
533 | Renew(arg, 3, ARG); |
534 | break; |
535 | case O_NEGATE: |
536 | CHECK1; |
537 | str_numset(str,(double)(-str_gnum(s1))); |
538 | break; |
539 | case O_NOT: |
540 | CHECK1; |
db4e6270 |
541 | #ifdef NOTNOT |
542 | { char xxx = str_true(s1); str_numset(str,(double)!xxx); } |
543 | #else |
2b317908 |
544 | str_numset(str,(double)(!str_true(s1))); |
db4e6270 |
545 | #endif |
2b317908 |
546 | break; |
547 | case O_COMPLEMENT: |
548 | CHECK1; |
a687059c |
549 | #ifndef lint |
2b317908 |
550 | str_numset(str,(double)(~U_L(str_gnum(s1)))); |
a687059c |
551 | #endif |
2b317908 |
552 | break; |
553 | case O_SIN: |
554 | CHECK1; |
555 | str_numset(str,sin(str_gnum(s1))); |
556 | break; |
557 | case O_COS: |
558 | CHECK1; |
559 | str_numset(str,cos(str_gnum(s1))); |
560 | break; |
561 | case O_ATAN2: |
562 | CHECK12; |
563 | value = str_gnum(s1); |
564 | str_numset(str,atan2(value, str_gnum(s2))); |
565 | break; |
566 | case O_POW: |
567 | CHECK12; |
568 | value = str_gnum(s1); |
569 | str_numset(str,pow(value, str_gnum(s2))); |
570 | break; |
571 | case O_LENGTH: |
572 | if (arg[1].arg_type == A_STAB) { |
573 | arg->arg_type = O_ITEM; |
574 | arg[1].arg_type = A_LENSTAB; |
575 | return arg; |
576 | } |
577 | CHECK1; |
578 | str_numset(str, (double)str_len(s1)); |
579 | break; |
580 | case O_SLT: |
581 | CHECK12; |
582 | str_numset(str,(double)(str_cmp(s1,s2) < 0)); |
583 | break; |
584 | case O_SGT: |
585 | CHECK12; |
586 | str_numset(str,(double)(str_cmp(s1,s2) > 0)); |
587 | break; |
588 | case O_SLE: |
589 | CHECK12; |
590 | str_numset(str,(double)(str_cmp(s1,s2) <= 0)); |
591 | break; |
592 | case O_SGE: |
593 | CHECK12; |
594 | str_numset(str,(double)(str_cmp(s1,s2) >= 0)); |
595 | break; |
596 | case O_SEQ: |
597 | CHECK12; |
598 | str_numset(str,(double)(str_eq(s1,s2))); |
599 | break; |
600 | case O_SNE: |
601 | CHECK12; |
602 | str_numset(str,(double)(!str_eq(s1,s2))); |
603 | break; |
604 | case O_SCMP: |
605 | CHECK12; |
606 | str_numset(str,(double)(str_cmp(s1,s2))); |
607 | break; |
608 | case O_CRYPT: |
609 | CHECK12; |
fe14fcc3 |
610 | #ifdef HAS_CRYPT |
2b317908 |
611 | tmps = str_get(s1); |
612 | str_set(str,crypt(tmps,str_get(s2))); |
a687059c |
613 | #else |
2b317908 |
614 | yyerror( |
615 | "The crypt() function is unimplemented due to excessive paranoia."); |
a687059c |
616 | #endif |
2b317908 |
617 | break; |
618 | case O_EXP: |
619 | CHECK1; |
620 | str_numset(str,exp(str_gnum(s1))); |
621 | break; |
622 | case O_LOG: |
623 | CHECK1; |
624 | str_numset(str,log(str_gnum(s1))); |
625 | break; |
626 | case O_SQRT: |
627 | CHECK1; |
628 | str_numset(str,sqrt(str_gnum(s1))); |
629 | break; |
630 | case O_INT: |
631 | CHECK1; |
632 | value = str_gnum(s1); |
633 | if (value >= 0.0) |
634 | (void)modf(value,&value); |
635 | else { |
636 | (void)modf(-value,&value); |
637 | value = -value; |
638 | } |
639 | str_numset(str,value); |
640 | break; |
641 | case O_ORD: |
642 | CHECK1; |
a687059c |
643 | #ifndef I286 |
2b317908 |
644 | str_numset(str,(double)(*str_get(s1))); |
a687059c |
645 | #else |
2b317908 |
646 | { |
647 | int zapc; |
648 | char *zaps; |
a687059c |
649 | |
2b317908 |
650 | zaps = str_get(s1); |
651 | zapc = (int) *zaps; |
652 | str_numset(str,(double)(zapc)); |
a687059c |
653 | } |
2b317908 |
654 | #endif |
655 | break; |
656 | } |
657 | arg->arg_type = O_ITEM; /* note arg1 type is already SINGLE */ |
658 | str_free(s1); |
659 | arg[1].arg_ptr.arg_str = str; |
660 | if (s2) { |
661 | str_free(s2); |
662 | arg[2].arg_ptr.arg_str = Nullstr; |
663 | arg[2].arg_type = A_NULL; |
a687059c |
664 | } |
2b317908 |
665 | str = Nullstr; |
666 | |
667 | return arg; |
a687059c |
668 | } |
669 | |
670 | ARG * |
671 | l(arg) |
672 | register ARG *arg; |
673 | { |
674 | register int i; |
675 | register ARG *arg1; |
676 | register ARG *arg2; |
677 | SPAT *spat; |
678 | int arghog = 0; |
679 | |
680 | i = arg[1].arg_type & A_MASK; |
681 | |
682 | arg->arg_flags |= AF_COMMON; /* assume something in common */ |
683 | /* which forces us to copy things */ |
684 | |
685 | if (i == A_ARYLEN) { |
686 | arg[1].arg_type = A_LARYLEN; |
687 | return arg; |
688 | } |
689 | if (i == A_ARYSTAB) { |
690 | arg[1].arg_type = A_LARYSTAB; |
691 | return arg; |
692 | } |
693 | |
694 | /* see if it's an array reference */ |
695 | |
696 | if (i == A_EXPR || i == A_LEXPR) { |
697 | arg1 = arg[1].arg_ptr.arg_arg; |
698 | |
699 | if (arg1->arg_type == O_LIST || arg1->arg_type == O_ITEM) { |
700 | /* assign to list */ |
701 | if (arg->arg_len > 1) { |
702 | dehoist(arg,2); |
703 | arg2 = arg[2].arg_ptr.arg_arg; |
704 | if (nothing_in_common(arg1,arg2)) |
705 | arg->arg_flags &= ~AF_COMMON; |
706 | if (arg->arg_type == O_ASSIGN) { |
707 | if (arg1->arg_flags & AF_LOCAL) |
708 | arg->arg_flags |= AF_LOCAL; |
709 | arg[1].arg_flags |= AF_ARYOK; |
710 | arg[2].arg_flags |= AF_ARYOK; |
711 | } |
712 | } |
713 | else if (arg->arg_type != O_CHOP) |
714 | arg->arg_type = O_ASSIGN; /* possible local(); */ |
715 | for (i = arg1->arg_len; i >= 1; i--) { |
716 | switch (arg1[i].arg_type) { |
717 | case A_STAR: case A_LSTAR: |
718 | arg1[i].arg_type = A_LSTAR; |
719 | break; |
720 | case A_STAB: case A_LVAL: |
721 | arg1[i].arg_type = A_LVAL; |
722 | break; |
723 | case A_ARYLEN: case A_LARYLEN: |
724 | arg1[i].arg_type = A_LARYLEN; |
725 | break; |
726 | case A_ARYSTAB: case A_LARYSTAB: |
727 | arg1[i].arg_type = A_LARYSTAB; |
728 | break; |
729 | case A_EXPR: case A_LEXPR: |
730 | arg1[i].arg_type = A_LEXPR; |
731 | switch(arg1[i].arg_ptr.arg_arg->arg_type) { |
732 | case O_ARRAY: case O_LARRAY: |
733 | arg1[i].arg_ptr.arg_arg->arg_type = O_LARRAY; |
734 | arghog = 1; |
735 | break; |
736 | case O_AELEM: case O_LAELEM: |
737 | arg1[i].arg_ptr.arg_arg->arg_type = O_LAELEM; |
738 | break; |
739 | case O_HASH: case O_LHASH: |
740 | arg1[i].arg_ptr.arg_arg->arg_type = O_LHASH; |
741 | arghog = 1; |
742 | break; |
743 | case O_HELEM: case O_LHELEM: |
744 | arg1[i].arg_ptr.arg_arg->arg_type = O_LHELEM; |
745 | break; |
746 | case O_ASLICE: case O_LASLICE: |
747 | arg1[i].arg_ptr.arg_arg->arg_type = O_LASLICE; |
748 | break; |
749 | case O_HSLICE: case O_LHSLICE: |
750 | arg1[i].arg_ptr.arg_arg->arg_type = O_LHSLICE; |
751 | break; |
db4e6270 |
752 | case O_SUBSTR: case O_VEC: |
753 | (void)l(arg1[i].arg_ptr.arg_arg); |
754 | Renewc(arg1[i].arg_ptr.arg_arg->arg_ptr.arg_str, 1, |
755 | struct lstring, STR); |
756 | /* grow string struct to hold an lstring struct */ |
757 | break; |
a687059c |
758 | default: |
759 | goto ill_item; |
760 | } |
761 | break; |
762 | default: |
763 | ill_item: |
764 | (void)sprintf(tokenbuf, "Illegal item (%s) as lvalue", |
765 | argname[arg1[i].arg_type&A_MASK]); |
766 | yyerror(tokenbuf); |
767 | } |
768 | } |
769 | if (arg->arg_len > 1) { |
770 | if (arg2->arg_type == O_SPLIT && !arg2[3].arg_type && !arghog) { |
771 | arg2[3].arg_type = A_SINGLE; |
772 | arg2[3].arg_ptr.arg_str = |
773 | str_nmake((double)arg1->arg_len + 1); /* limit split len*/ |
774 | } |
775 | } |
776 | } |
777 | else if (arg1->arg_type == O_AELEM || arg1->arg_type == O_LAELEM) |
0d3e774c |
778 | if (arg->arg_type == O_DEFINED) |
779 | arg1->arg_type = O_AELEM; |
780 | else |
781 | arg1->arg_type = O_LAELEM; |
a687059c |
782 | else if (arg1->arg_type == O_ARRAY || arg1->arg_type == O_LARRAY) { |
783 | arg1->arg_type = O_LARRAY; |
784 | if (arg->arg_len > 1) { |
785 | dehoist(arg,2); |
786 | arg2 = arg[2].arg_ptr.arg_arg; |
787 | if (arg2->arg_type == O_SPLIT) { /* use split's builtin =?*/ |
788 | spat = arg2[2].arg_ptr.arg_spat; |
afd9f252 |
789 | if (!(spat->spat_flags & SPAT_ONCE) && |
a687059c |
790 | nothing_in_common(arg1,spat->spat_repl)) { |
791 | spat->spat_repl[1].arg_ptr.arg_stab = |
792 | arg1[1].arg_ptr.arg_stab; |
fe14fcc3 |
793 | arg1[1].arg_ptr.arg_stab = Nullstab; |
afd9f252 |
794 | spat->spat_flags |= SPAT_ONCE; |
a687059c |
795 | arg_free(arg1); /* recursive */ |
fe14fcc3 |
796 | arg[1].arg_ptr.arg_arg = Nullarg; |
a687059c |
797 | free_arg(arg); /* non-recursive */ |
798 | return arg2; /* split has builtin assign */ |
799 | } |
800 | } |
801 | else if (nothing_in_common(arg1,arg2)) |
802 | arg->arg_flags &= ~AF_COMMON; |
803 | if (arg->arg_type == O_ASSIGN) { |
804 | arg[1].arg_flags |= AF_ARYOK; |
805 | arg[2].arg_flags |= AF_ARYOK; |
806 | } |
807 | } |
bf38876a |
808 | else if (arg->arg_type == O_ASSIGN) |
809 | arg[1].arg_flags |= AF_ARYOK; |
a687059c |
810 | } |
811 | else if (arg1->arg_type == O_HELEM || arg1->arg_type == O_LHELEM) |
0d3e774c |
812 | if (arg->arg_type == O_DEFINED) |
813 | arg1->arg_type = O_HELEM; /* avoid creating one */ |
814 | else |
815 | arg1->arg_type = O_LHELEM; |
a687059c |
816 | else if (arg1->arg_type == O_HASH || arg1->arg_type == O_LHASH) { |
817 | arg1->arg_type = O_LHASH; |
818 | if (arg->arg_len > 1) { |
819 | dehoist(arg,2); |
820 | arg2 = arg[2].arg_ptr.arg_arg; |
821 | if (nothing_in_common(arg1,arg2)) |
822 | arg->arg_flags &= ~AF_COMMON; |
823 | if (arg->arg_type == O_ASSIGN) { |
824 | arg[1].arg_flags |= AF_ARYOK; |
825 | arg[2].arg_flags |= AF_ARYOK; |
826 | } |
827 | } |
bf38876a |
828 | else if (arg->arg_type == O_ASSIGN) |
829 | arg[1].arg_flags |= AF_ARYOK; |
a687059c |
830 | } |
831 | else if (arg1->arg_type == O_ASLICE) { |
832 | arg1->arg_type = O_LASLICE; |
833 | if (arg->arg_type == O_ASSIGN) { |
7e1cf235 |
834 | dehoist(arg,2); |
a687059c |
835 | arg[1].arg_flags |= AF_ARYOK; |
836 | arg[2].arg_flags |= AF_ARYOK; |
837 | } |
838 | } |
839 | else if (arg1->arg_type == O_HSLICE) { |
840 | arg1->arg_type = O_LHSLICE; |
841 | if (arg->arg_type == O_ASSIGN) { |
7e1cf235 |
842 | dehoist(arg,2); |
a687059c |
843 | arg[1].arg_flags |= AF_ARYOK; |
844 | arg[2].arg_flags |= AF_ARYOK; |
845 | } |
846 | } |
847 | else if ((arg->arg_type == O_DEFINED || arg->arg_type == O_UNDEF) && |
848 | (arg1->arg_type == (perldb ? O_DBSUBR : O_SUBR)) ) { |
849 | arg[1].arg_type |= A_DONT; |
850 | } |
851 | else if (arg1->arg_type == O_SUBSTR || arg1->arg_type == O_VEC) { |
852 | (void)l(arg1); |
853 | Renewc(arg1->arg_ptr.arg_str, 1, struct lstring, STR); |
854 | /* grow string struct to hold an lstring struct */ |
855 | } |
db4e6270 |
856 | else if (arg1->arg_type == O_ASSIGN) |
857 | /*SUPPRESS 530*/ |
858 | ; |
a687059c |
859 | else { |
860 | (void)sprintf(tokenbuf, |
861 | "Illegal expression (%s) as lvalue",opname[arg1->arg_type]); |
862 | yyerror(tokenbuf); |
68decaef |
863 | return arg; |
a687059c |
864 | } |
865 | arg[1].arg_type = A_LEXPR | (arg[1].arg_type & A_DONT); |
866 | if (arg->arg_type == O_ASSIGN && (arg1[1].arg_flags & AF_ARYOK)) { |
867 | arg[1].arg_flags |= AF_ARYOK; |
868 | if (arg->arg_len > 1) |
869 | arg[2].arg_flags |= AF_ARYOK; |
870 | } |
871 | #ifdef DEBUGGING |
872 | if (debug & 16) |
873 | fprintf(stderr,"lval LEXPR\n"); |
874 | #endif |
875 | return arg; |
876 | } |
877 | if (i == A_STAR || i == A_LSTAR) { |
878 | arg[1].arg_type = A_LSTAR | (arg[1].arg_type & A_DONT); |
879 | return arg; |
880 | } |
881 | |
882 | /* not an array reference, should be a register name */ |
883 | |
884 | if (i != A_STAB && i != A_LVAL) { |
885 | (void)sprintf(tokenbuf, |
886 | "Illegal item (%s) as lvalue",argname[arg[1].arg_type&A_MASK]); |
887 | yyerror(tokenbuf); |
68decaef |
888 | return arg; |
a687059c |
889 | } |
890 | arg[1].arg_type = A_LVAL | (arg[1].arg_type & A_DONT); |
891 | #ifdef DEBUGGING |
892 | if (debug & 16) |
893 | fprintf(stderr,"lval LVAL\n"); |
894 | #endif |
895 | return arg; |
896 | } |
897 | |
898 | ARG * |
899 | fixl(type,arg) |
900 | int type; |
901 | ARG *arg; |
902 | { |
903 | if (type == O_DEFINED || type == O_UNDEF) { |
904 | if (arg->arg_type != O_ITEM) |
905 | arg = hide_ary(arg); |
906 | if (arg->arg_type == O_ITEM) { |
907 | type = arg[1].arg_type & A_MASK; |
908 | if (type == A_EXPR || type == A_LEXPR) |
909 | arg[1].arg_type = A_LEXPR|A_DONT; |
910 | } |
911 | } |
912 | return arg; |
913 | } |
914 | |
68decaef |
915 | void |
a687059c |
916 | dehoist(arg,i) |
917 | ARG *arg; |
918 | { |
919 | ARG *tmparg; |
920 | |
921 | if (arg[i].arg_type != A_EXPR) { /* dehoist */ |
922 | tmparg = make_op(O_ITEM,1,Nullarg,Nullarg,Nullarg); |
923 | tmparg[1] = arg[i]; |
924 | arg[i].arg_ptr.arg_arg = tmparg; |
925 | arg[i].arg_type = A_EXPR; |
926 | } |
927 | } |
928 | |
929 | ARG * |
930 | addflags(i,flags,arg) |
931 | register ARG *arg; |
932 | { |
933 | arg[i].arg_flags |= flags; |
934 | return arg; |
935 | } |
936 | |
937 | ARG * |
938 | hide_ary(arg) |
939 | ARG *arg; |
940 | { |
941 | if (arg->arg_type == O_ARRAY || arg->arg_type == O_HASH) |
942 | return make_op(O_ITEM,1,arg,Nullarg,Nullarg); |
943 | return arg; |
944 | } |
945 | |
946 | /* maybe do a join on multiple array dimensions */ |
947 | |
948 | ARG * |
949 | jmaybe(arg) |
950 | register ARG *arg; |
951 | { |
952 | if (arg && arg->arg_type == O_COMMA) { |
953 | arg = listish(arg); |
954 | arg = make_op(O_JOIN, 2, |
955 | stab2arg(A_STAB,stabent(";",TRUE)), |
956 | make_list(arg), |
957 | Nullarg); |
958 | } |
959 | return arg; |
960 | } |
961 | |
962 | ARG * |
963 | make_list(arg) |
964 | register ARG *arg; |
965 | { |
966 | register int i; |
967 | register ARG *node; |
968 | register ARG *nxtnode; |
969 | register int j; |
970 | STR *tmpstr; |
971 | |
972 | if (!arg) { |
973 | arg = op_new(0); |
974 | arg->arg_type = O_LIST; |
975 | } |
976 | if (arg->arg_type != O_COMMA) { |
977 | if (arg->arg_type != O_ARRAY) |
978 | arg->arg_flags |= AF_LISTISH; /* see listish() below */ |
fe14fcc3 |
979 | arg->arg_flags |= AF_LISTISH; /* see listish() below */ |
a687059c |
980 | return arg; |
981 | } |
982 | for (i = 2, node = arg; ; i++) { |
983 | if (node->arg_len < 2) |
984 | break; |
985 | if (node[1].arg_type != A_EXPR) |
986 | break; |
987 | node = node[1].arg_ptr.arg_arg; |
988 | if (node->arg_type != O_COMMA) |
989 | break; |
990 | } |
991 | if (i > 2) { |
992 | node = arg; |
993 | arg = op_new(i); |
994 | tmpstr = arg->arg_ptr.arg_str; |
68decaef |
995 | StructCopy(node, arg, ARG); /* copy everything except the STR */ |
a687059c |
996 | arg->arg_ptr.arg_str = tmpstr; |
997 | for (j = i; ; ) { |
68decaef |
998 | StructCopy(node+2, arg+j, ARG); |
a687059c |
999 | arg[j].arg_flags |= AF_ARYOK; |
1000 | --j; /* Bug in Xenix compiler */ |
1001 | if (j < 2) { |
68decaef |
1002 | StructCopy(node+1, arg+1, ARG); |
a687059c |
1003 | free_arg(node); |
1004 | break; |
1005 | } |
1006 | nxtnode = node[1].arg_ptr.arg_arg; |
1007 | free_arg(node); |
1008 | node = nxtnode; |
1009 | } |
1010 | } |
1011 | arg[1].arg_flags |= AF_ARYOK; |
1012 | arg[2].arg_flags |= AF_ARYOK; |
1013 | arg->arg_type = O_LIST; |
1014 | arg->arg_len = i; |
68decaef |
1015 | str_free(arg->arg_ptr.arg_str); |
1016 | arg->arg_ptr.arg_str = Nullstr; |
a687059c |
1017 | return arg; |
1018 | } |
1019 | |
1020 | /* turn a single item into a list */ |
1021 | |
1022 | ARG * |
1023 | listish(arg) |
1024 | ARG *arg; |
1025 | { |
db4e6270 |
1026 | if (arg && arg->arg_flags & AF_LISTISH) |
a687059c |
1027 | arg = make_op(O_LIST,1,arg,Nullarg,Nullarg); |
1028 | return arg; |
1029 | } |
1030 | |
1031 | ARG * |
1032 | maybelistish(optype, arg) |
1033 | int optype; |
1034 | ARG *arg; |
1035 | { |
ff2452de |
1036 | ARG *tmparg = arg; |
1037 | |
1038 | if (optype == O_RETURN && arg->arg_type == O_ITEM && |
1039 | arg[1].arg_type == A_EXPR && (tmparg = arg[1].arg_ptr.arg_arg) && |
1040 | ((tmparg->arg_flags & AF_LISTISH) || (tmparg->arg_type == O_ARRAY) )) { |
1041 | tmparg = listish(tmparg); |
1042 | free_arg(arg); |
1043 | arg = tmparg; |
1044 | } |
1045 | else if (optype == O_PRTF || |
a687059c |
1046 | (arg->arg_type == O_ASLICE || arg->arg_type == O_HSLICE || |
1047 | arg->arg_type == O_F_OR_R) ) |
1048 | arg = listish(arg); |
1049 | return arg; |
1050 | } |
1051 | |
1052 | /* mark list of local variables */ |
1053 | |
1054 | ARG * |
1055 | localize(arg) |
1056 | ARG *arg; |
1057 | { |
1058 | arg->arg_flags |= AF_LOCAL; |
1059 | return arg; |
1060 | } |
1061 | |
1062 | ARG * |
a687059c |
1063 | rcatmaybe(arg) |
1064 | ARG *arg; |
1065 | { |
fe14fcc3 |
1066 | ARG *arg2; |
1067 | |
1068 | if (arg->arg_type == O_CONCAT && arg[2].arg_type == A_EXPR) { |
1069 | arg2 = arg[2].arg_ptr.arg_arg; |
1070 | if (arg2->arg_type == O_ITEM && arg2[1].arg_type == A_READ) { |
1071 | arg->arg_type = O_RCAT; |
1072 | arg[2].arg_type = arg2[1].arg_type; |
1073 | arg[2].arg_ptr = arg2[1].arg_ptr; |
1074 | free_arg(arg2); |
1075 | } |
a687059c |
1076 | } |
1077 | return arg; |
1078 | } |
1079 | |
1080 | ARG * |
1081 | stab2arg(atype,stab) |
1082 | int atype; |
1083 | register STAB *stab; |
1084 | { |
1085 | register ARG *arg; |
1086 | |
1087 | arg = op_new(1); |
1088 | arg->arg_type = O_ITEM; |
1089 | arg[1].arg_type = atype; |
1090 | arg[1].arg_ptr.arg_stab = stab; |
1091 | return arg; |
1092 | } |
1093 | |
1094 | ARG * |
1095 | cval_to_arg(cval) |
1096 | register char *cval; |
1097 | { |
1098 | register ARG *arg; |
1099 | |
1100 | arg = op_new(1); |
1101 | arg->arg_type = O_ITEM; |
1102 | arg[1].arg_type = A_SINGLE; |
1103 | arg[1].arg_ptr.arg_str = str_make(cval,0); |
1104 | Safefree(cval); |
1105 | return arg; |
1106 | } |
1107 | |
1108 | ARG * |
1109 | op_new(numargs) |
1110 | int numargs; |
1111 | { |
1112 | register ARG *arg; |
1113 | |
1114 | Newz(203,arg, numargs + 1, ARG); |
1115 | arg->arg_ptr.arg_str = Str_new(21,0); |
1116 | arg->arg_len = numargs; |
1117 | return arg; |
1118 | } |
1119 | |
1120 | void |
1121 | free_arg(arg) |
1122 | ARG *arg; |
1123 | { |
1124 | str_free(arg->arg_ptr.arg_str); |
1125 | Safefree(arg); |
1126 | } |
1127 | |
1128 | ARG * |
1129 | make_match(type,expr,spat) |
1130 | int type; |
1131 | ARG *expr; |
1132 | SPAT *spat; |
1133 | { |
1134 | register ARG *arg; |
1135 | |
1136 | arg = make_op(type,2,expr,Nullarg,Nullarg); |
1137 | |
1138 | arg[2].arg_type = A_SPAT|A_DONT; |
1139 | arg[2].arg_ptr.arg_spat = spat; |
1140 | #ifdef DEBUGGING |
1141 | if (debug & 16) |
1142 | fprintf(stderr,"make_match SPAT=%lx\n",(long)spat); |
1143 | #endif |
1144 | |
1145 | if (type == O_SUBST || type == O_NSUBST) { |
1146 | if (arg[1].arg_type != A_STAB) { |
1147 | yyerror("Illegal lvalue"); |
1148 | } |
1149 | arg[1].arg_type = A_LVAL; |
1150 | } |
1151 | return arg; |
1152 | } |
1153 | |
1154 | ARG * |
1155 | cmd_to_arg(cmd) |
1156 | CMD *cmd; |
1157 | { |
1158 | register ARG *arg; |
1159 | |
1160 | arg = op_new(1); |
1161 | arg->arg_type = O_ITEM; |
1162 | arg[1].arg_type = A_CMD; |
1163 | arg[1].arg_ptr.arg_cmd = cmd; |
1164 | return arg; |
1165 | } |
1166 | |
1167 | /* Check two expressions to see if there is any identifier in common */ |
1168 | |
1169 | static int |
1170 | nothing_in_common(arg1,arg2) |
1171 | ARG *arg1; |
1172 | ARG *arg2; |
1173 | { |
1174 | static int thisexpr = 0; /* I don't care if this wraps */ |
1175 | |
1176 | thisexpr++; |
1177 | if (arg_common(arg1,thisexpr,1)) |
1178 | return 0; /* hit eval or do {} */ |
7e1cf235 |
1179 | stab_lastexpr(defstab) = thisexpr; /* pretend to hit @_ */ |
a687059c |
1180 | if (arg_common(arg2,thisexpr,0)) |
1181 | return 0; /* hit identifier again */ |
1182 | return 1; |
1183 | } |
1184 | |
1185 | /* Recursively descend an expression and mark any identifier or check |
1186 | * it to see if it was marked already. |
1187 | */ |
1188 | |
1189 | static int |
1190 | arg_common(arg,exprnum,marking) |
1191 | register ARG *arg; |
1192 | int exprnum; |
1193 | int marking; |
1194 | { |
1195 | register int i; |
1196 | |
1197 | if (!arg) |
1198 | return 0; |
1199 | for (i = arg->arg_len; i >= 1; i--) { |
1200 | switch (arg[i].arg_type & A_MASK) { |
1201 | case A_NULL: |
1202 | break; |
1203 | case A_LEXPR: |
1204 | case A_EXPR: |
1205 | if (arg_common(arg[i].arg_ptr.arg_arg,exprnum,marking)) |
1206 | return 1; |
1207 | break; |
1208 | case A_CMD: |
1209 | return 1; /* assume hanky panky */ |
1210 | case A_STAR: |
1211 | case A_LSTAR: |
1212 | case A_STAB: |
1213 | case A_LVAL: |
1214 | case A_ARYLEN: |
1215 | case A_LARYLEN: |
1216 | if (marking) |
1217 | stab_lastexpr(arg[i].arg_ptr.arg_stab) = exprnum; |
1218 | else if (stab_lastexpr(arg[i].arg_ptr.arg_stab) == exprnum) |
1219 | return 1; |
1220 | break; |
1221 | case A_DOUBLE: |
1222 | case A_BACKTICK: |
1223 | { |
1224 | register char *s = arg[i].arg_ptr.arg_str->str_ptr; |
1225 | register char *send = s + arg[i].arg_ptr.arg_str->str_cur; |
1226 | register STAB *stab; |
1227 | |
1228 | while (*s) { |
1229 | if (*s == '$' && s[1]) { |
fe14fcc3 |
1230 | s = scanident(s,send,tokenbuf); |
a687059c |
1231 | stab = stabent(tokenbuf,TRUE); |
1232 | if (marking) |
1233 | stab_lastexpr(stab) = exprnum; |
1234 | else if (stab_lastexpr(stab) == exprnum) |
1235 | return 1; |
1236 | continue; |
1237 | } |
1238 | else if (*s == '\\' && s[1]) |
1239 | s++; |
1240 | s++; |
1241 | } |
1242 | } |
1243 | break; |
1244 | case A_SPAT: |
1245 | if (spat_common(arg[i].arg_ptr.arg_spat,exprnum,marking)) |
1246 | return 1; |
1247 | break; |
1248 | case A_READ: |
1249 | case A_INDREAD: |
1250 | case A_GLOB: |
1251 | case A_WORD: |
1252 | case A_SINGLE: |
1253 | break; |
1254 | } |
1255 | } |
1256 | switch (arg->arg_type) { |
1257 | case O_ARRAY: |
1258 | case O_LARRAY: |
1259 | if ((arg[1].arg_type & A_MASK) == A_STAB) |
1260 | (void)aadd(arg[1].arg_ptr.arg_stab); |
1261 | break; |
1262 | case O_HASH: |
1263 | case O_LHASH: |
1264 | if ((arg[1].arg_type & A_MASK) == A_STAB) |
1265 | (void)hadd(arg[1].arg_ptr.arg_stab); |
1266 | break; |
1267 | case O_EVAL: |
1268 | case O_SUBR: |
1269 | case O_DBSUBR: |
1270 | return 1; |
1271 | } |
1272 | return 0; |
1273 | } |
1274 | |
1275 | static int |
1276 | spat_common(spat,exprnum,marking) |
1277 | register SPAT *spat; |
1278 | int exprnum; |
1279 | int marking; |
1280 | { |
1281 | if (spat->spat_runtime) |
1282 | if (arg_common(spat->spat_runtime,exprnum,marking)) |
1283 | return 1; |
1284 | if (spat->spat_repl) { |
1285 | if (arg_common(spat->spat_repl,exprnum,marking)) |
1286 | return 1; |
1287 | } |
1288 | return 0; |
1289 | } |