source: trunk/third/perl/consarg.c @ 9009

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