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