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