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