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