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