perl 3.0 patch #21 patch #19, continued
[perl.git] / consarg.c
1 /* $Header: consarg.c,v 3.0.1.6 90/08/09 02:38:51 lwall Locked $
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 $
9  * Revision 3.0.1.6  90/08/09  02:38:51  lwall
10  * patch19: fixed problem with % of negative number
11  * 
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  * 
15  * Revision 3.0.1.4  90/03/12  16:24:40  lwall
16  * patch13: return (@array) did counter-intuitive things
17  * 
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  * 
22  * Revision 3.0.1.2  89/11/17  15:11:34  lwall
23  * patch5: defined $foo{'bar'} should not create element
24  * 
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  * 
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"
37 static int nothing_in_common();
38 static int arg_common();
39 static int spat_common();
40
41 ARG *
42 make_split(stab,arg,limarg)
43 register STAB *stab;
44 register ARG *arg;
45 ARG *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 {
66             arg[3].arg_flags = 0;
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
86 ARG *
87 mod_match(type,left,pat)
88 register ARG *left;
89 register 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
149 ARG *
150 make_op(type,newlen,arg1,arg2,arg3)
151 int type;
152 int newlen;
153 ARG *arg1;
154 ARG *arg2;
155 ARG *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
280 void
281 evalstatic(arg)
282 register 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;
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);
328             tmps = str_get(s1);
329             str_nset(str,"",0);
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';
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:
347             tmplong = (unsigned long)str_gnum(s2);
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
357                 str_numset(str,(double)(tmplong - ((-tmp2 - 1) % tmplong))) - 1;
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
416             str_numset(str,(double)(U_L(value) & U_L(str_gnum(s2))));
417 #endif
418             break;
419         case O_XOR:
420             value = str_gnum(s1);
421 #ifndef lint
422             str_numset(str,(double)(U_L(value) ^ U_L(str_gnum(s2))));
423 #endif
424             break;
425         case O_BIT_OR:
426             value = str_gnum(s1);
427 #ifndef lint
428             str_numset(str,(double)(U_L(value) | U_L(str_gnum(s2))));
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
464             str_numset(str,(double)(~U_L(str_gnum(s1))));
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
554 ARG *
555 l(arg)
556 register 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)
656             if (arg->arg_type == O_DEFINED)
657                 arg1->arg_type = O_AELEM;
658             else
659                 arg1->arg_type = O_LAELEM;
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;
667                     if (!(spat->spat_flags & SPAT_ONCE) &&
668                       nothing_in_common(arg1,spat->spat_repl)) {
669                         spat->spat_repl[1].arg_ptr.arg_stab =
670                             arg1[1].arg_ptr.arg_stab;
671                         spat->spat_flags |= SPAT_ONCE;
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             }
684             else if (arg->arg_type == O_ASSIGN)
685                 arg[1].arg_flags |= AF_ARYOK;
686         }
687         else if (arg1->arg_type == O_HELEM || arg1->arg_type == O_LHELEM)
688             if (arg->arg_type == O_DEFINED)
689                 arg1->arg_type = O_HELEM;       /* avoid creating one */
690             else
691                 arg1->arg_type = O_LHELEM;
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             }
704             else if (arg->arg_type == O_ASSIGN)
705                 arg[1].arg_flags |= AF_ARYOK;
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
771 ARG *
772 fixl(type,arg)
773 int type;
774 ARG *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
788 dehoist(arg,i)
789 ARG *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
801 ARG *
802 addflags(i,flags,arg)
803 register ARG *arg;
804 {
805     arg[i].arg_flags |= flags;
806     return arg;
807 }
808
809 ARG *
810 hide_ary(arg)
811 ARG *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
820 ARG *
821 jmaybe(arg)
822 register 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
834 ARG *
835 make_list(arg)
836 register 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
903 ARG *
904 listish(arg)
905 ARG *arg;
906 {
907     if (arg->arg_flags & AF_LISTISH)
908         arg = make_op(O_LIST,1,arg,Nullarg,Nullarg);
909     return arg;
910 }
911
912 ARG *
913 maybelistish(optype, arg)
914 int optype;
915 ARG *arg;
916 {
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 ||
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
935 ARG *
936 localize(arg)
937 ARG *arg;
938 {
939     arg->arg_flags |= AF_LOCAL;
940     return arg;
941 }
942
943 ARG *
944 fixeval(arg)
945 ARG *arg;
946 {
947     Renew(arg, 3, ARG);
948     if (arg->arg_len == 0)
949         arg[1].arg_type = A_NULL;
950     arg->arg_len = 2;
951     arg[2].arg_flags = 0;
952     arg[2].arg_ptr.arg_hash = curstash;
953     arg[2].arg_type = A_NULL;
954     return arg;
955 }
956
957 ARG *
958 rcatmaybe(arg)
959 ARG *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
970 ARG *
971 stab2arg(atype,stab)
972 int atype;
973 register 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
984 ARG *
985 cval_to_arg(cval)
986 register 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
998 ARG *
999 op_new(numargs)
1000 int 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
1010 void
1011 free_arg(arg)
1012 ARG *arg;
1013 {
1014     str_free(arg->arg_ptr.arg_str);
1015     Safefree(arg);
1016 }
1017
1018 ARG *
1019 make_match(type,expr,spat)
1020 int type;
1021 ARG *expr;
1022 SPAT *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
1044 ARG *
1045 cmd_to_arg(cmd)
1046 CMD *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
1059 static int
1060 nothing_in_common(arg1,arg2)
1061 ARG *arg1;
1062 ARG *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
1078 static int
1079 arg_common(arg,exprnum,marking)
1080 register ARG *arg;
1081 int exprnum;
1082 int 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
1164 static int
1165 spat_common(spat,exprnum,marking)
1166 register SPAT *spat;
1167 int exprnum;
1168 int 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 }