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