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