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