projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
perl 3.0 patch #4 Patch #2 continued
[p5sagit/p5-mst-13.2.git] / consarg.c
CommitLineData
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"
21static int nothing_in_common();
22static int arg_common();
23static int spat_common();
24
25ARG *
26make_split(stab,arg,limarg)
27register STAB *stab;
28register ARG *arg;
29ARG *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
69ARG *
70mod_match(type,left,pat)
71register ARG *left;
72register 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
132ARG *
133make_op(type,newlen,arg1,arg2,arg3)
134int type;
135int newlen;
136ARG *arg1;
137ARG *arg2;
138ARG *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
263void
264evalstatic(arg)
265register 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
535ARG *
536l(arg)
537register 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
745ARG *
746fixl(type,arg)
747int type;
748ARG *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
762dehoist(arg,i)
763ARG *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
775ARG *
776addflags(i,flags,arg)
777register ARG *arg;
778{
779 arg[i].arg_flags |= flags;
780 return arg;
781}
782
783ARG *
784hide_ary(arg)
785ARG *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
794ARG *
795jmaybe(arg)
796register 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
808ARG *
809make_list(arg)
810register 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
877ARG *
878listish(arg)
879ARG *arg;
880{
881 if (arg->arg_flags & AF_LISTISH)
882 arg = make_op(O_LIST,1,arg,Nullarg,Nullarg);
883 return arg;
884}
885
886ARG *
887maybelistish(optype, arg)
888int optype;
889ARG *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
900ARG *
901localize(arg)
902ARG *arg;
903{
904 arg->arg_flags |= AF_LOCAL;
905 return arg;
906}
907
908ARG *
909fixeval(arg)
910ARG *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
921ARG *
922rcatmaybe(arg)
923ARG *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
934ARG *
935stab2arg(atype,stab)
936int atype;
937register 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
948ARG *
949cval_to_arg(cval)
950register 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
962ARG *
963op_new(numargs)
964int 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
974void
975free_arg(arg)
976ARG *arg;
977{
978 str_free(arg->arg_ptr.arg_str);
979 Safefree(arg);
980}
981
982ARG *
983make_match(type,expr,spat)
984int type;
985ARG *expr;
986SPAT *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
1008ARG *
1009cmd_to_arg(cmd)
1010CMD *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
1023static int
1024nothing_in_common(arg1,arg2)
1025ARG *arg1;
1026ARG *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
1042static int
1043arg_common(arg,exprnum,marking)
1044register ARG *arg;
1045int exprnum;
1046int 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
1128static int
1129spat_common(spat,exprnum,marking)
1130register SPAT *spat;
1131int exprnum;
1132int 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}
Unnamed repository; edit this file to name it for gitweb.