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