projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
perl 4.0 patch 13: patch #11, continued
[p5sagit/p5-mst-13.2.git] / consarg.c
CommitLineData
db4e6270 1/* $RCSfile: consarg.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 16:21:16 $
a687059c 2 *
2b317908 3 * Copyright (c) 1991, Larry Wall
a687059c 4 *
2b317908 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.
a687059c 7 *
8 * $Log: consarg.c,v $
db4e6270 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 *
2b317908 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 *
1c3d792e 20 * Revision 4.0.1.1 91/04/11 17:38:34 lwall
21 * patch1: fixed "Bad free" error
22 *
fe14fcc3 23 * Revision 4.0 91/03/20 01:06:15 lwall
24 * 4.0 baseline.
a687059c 25 *
26 */
27
28#include "EXTERN.h"
29#include "perl.h"
30static int nothing_in_common();
31static int arg_common();
32static int spat_common();
33
34ARG *
35make_split(stab,arg,limarg)
36register STAB *stab;
37register ARG *arg;
38ARG *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 {
ff8e2863 59 arg[3].arg_flags = 0;
a687059c 60 arg[3].arg_type = A_EXPR;
61 arg[3].arg_ptr.arg_arg = limarg;
62 }
63 }
db4e6270 64 else {
65 arg[3].arg_flags = 0;
a687059c 66 arg[3].arg_type = A_NULL;
db4e6270 67 arg[3].arg_ptr.arg_arg = Nullarg;
68 }
a687059c 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
82ARG *
83mod_match(type,left,pat)
84register ARG *left;
85register ARG *pat;
86{
87
88 register SPAT *spat;
89 register ARG *newarg;
90
39c3038c 91 if (!pat)
92 return Nullarg;
93
a687059c 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;
fe14fcc3 125 newarg[2].arg_len = pat[2].arg_len;
a687059c 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;
fe14fcc3 130 newarg[3].arg_len = pat[3].arg_len;
a687059c 131 newarg[3].arg_flags = pat[3].arg_flags;
132 }
133 }
fe14fcc3 134 free_arg(pat);
a687059c 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
150ARG *
151make_op(type,newlen,arg1,arg2,arg3)
152int type;
153int newlen;
154ARG *arg1;
155ARG *arg2;
156ARG *arg3;
157{
158 register ARG *arg;
159 register ARG *chld;
39c3038c 160 register unsigned doarg;
161 register int i;
a687059c 162 extern ARG *arg4; /* should be normal arguments, really */
163 extern ARG *arg5;
164
165 arg = op_new(newlen);
166 arg->arg_type = type;
db4e6270 167 /*SUPPRESS 560*/
a687059c 168 if (chld = arg1) {
169 if (chld->arg_type == O_ITEM &&
39c3038c 170 (hoistable[ i = (chld[1].arg_type&A_MASK)] || i == A_LVAL ||
171 (i == A_LEXPR &&
a687059c 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 }
a687059c 186 }
db4e6270 187 /*SUPPRESS 560*/
a687059c 188 if (chld = arg2) {
189 if (chld->arg_type == O_ITEM &&
39c3038c 190 (hoistable[chld[1].arg_type&A_MASK] ||
a687059c 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 }
a687059c 207 }
db4e6270 208 /*SUPPRESS 560*/
a687059c 209 if (chld = arg3) {
39c3038c 210 if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
a687059c 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 }
a687059c 220 }
221 if (newlen >= 4 && (chld = arg4)) {
39c3038c 222 if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
a687059c 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)) {
39c3038c 234 if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
a687059c 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 }
39c3038c 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 }
a687059c 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
2b317908 274 arg = evalstatic(arg); /* see if we can consolidate anything */
a687059c 275 return arg;
276}
277
2b317908 278ARG *
a687059c 279evalstatic(arg)
280register ARG *arg;
281{
2b317908 282 static STR *str = Nullstr;
a687059c 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)
2b317908 295 return arg;
a687059c 296
2b317908 297 if (!str)
a687059c 298 str = Str_new(20,0);
2b317908 299
300 if (arg[1].arg_type == A_SINGLE)
a687059c 301 s1 = arg[1].arg_ptr.arg_str;
2b317908 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;
db4e6270 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;
2b317908 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);
db4e6270 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 }
2b317908 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");
a687059c 368 else
db4e6270 369#ifdef SLOPPYDIVIDE
2b317908 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;
fe14fcc3 381 }
2b317908 382 str_numset(str,value);
383 }
fe14fcc3 384#else
2b317908 385 str_numset(str,str_gnum(s1) / value);
fe14fcc3 386#endif
2b317908 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);
a687059c 396#ifndef lint
2b317908 397 if (tmp2 >= 0)
398 str_numset(str,(double)(tmp2 % tmplong));
399 else
400 str_numset(str,(double)((tmplong-((-tmp2 - 1) % tmplong)) - 1));
a687059c 401#else
2b317908 402 tmp2 = tmp2;
a687059c 403#endif
2b317908 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);
a687059c 419#ifndef lint
2b317908 420 str_numset(str,(double)(((long)value) << i));
a687059c 421#endif
2b317908 422 break;
423 case O_RIGHT_SHIFT:
424 CHECK12;
425 value = str_gnum(s1);
426 i = (int)str_gnum(s2);
a687059c 427#ifndef lint
2b317908 428 str_numset(str,(double)(((long)value) >> i));
a687059c 429#endif
2b317908 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);
a687059c 479#ifndef lint
2b317908 480 str_numset(str,(double)(U_L(value) & U_L(str_gnum(s2))));
a687059c 481#endif
2b317908 482 break;
483 case O_XOR:
484 CHECK12;
485 value = str_gnum(s1);
a687059c 486#ifndef lint
2b317908 487 str_numset(str,(double)(U_L(value) ^ U_L(str_gnum(s2))));
a687059c 488#endif
2b317908 489 break;
490 case O_BIT_OR:
491 CHECK12;
492 value = str_gnum(s1);
a687059c 493#ifndef lint
2b317908 494 str_numset(str,(double)(U_L(value) | U_L(str_gnum(s2))));
a687059c 495#endif
2b317908 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;
db4e6270 528#ifdef NOTNOT
529 { char xxx = str_true(s1); str_numset(str,(double)!xxx); }
530#else
2b317908 531 str_numset(str,(double)(!str_true(s1)));
db4e6270 532#endif
2b317908 533 break;
534 case O_COMPLEMENT:
535 CHECK1;
a687059c 536#ifndef lint
2b317908 537 str_numset(str,(double)(~U_L(str_gnum(s1))));
a687059c 538#endif
2b317908 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;
fe14fcc3 597#ifdef HAS_CRYPT
2b317908 598 tmps = str_get(s1);
599 str_set(str,crypt(tmps,str_get(s2)));
a687059c 600#else
2b317908 601 yyerror(
602 "The crypt() function is unimplemented due to excessive paranoia.");
a687059c 603#endif
2b317908 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;
a687059c 630#ifndef I286
2b317908 631 str_numset(str,(double)(*str_get(s1)));
a687059c 632#else
2b317908 633 {
634 int zapc;
635 char *zaps;
a687059c 636
2b317908 637 zaps = str_get(s1);
638 zapc = (int) *zaps;
639 str_numset(str,(double)(zapc));
a687059c 640 }
2b317908 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;
a687059c 651 }
2b317908 652 str = Nullstr;
653
654 return arg;
a687059c 655}
656
657ARG *
658l(arg)
659register 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;
db4e6270 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;
a687059c 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)
0d3e774c 765 if (arg->arg_type == O_DEFINED)
766 arg1->arg_type = O_AELEM;
767 else
768 arg1->arg_type = O_LAELEM;
a687059c 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;
afd9f252 776 if (!(spat->spat_flags & SPAT_ONCE) &&
a687059c 777 nothing_in_common(arg1,spat->spat_repl)) {
778 spat->spat_repl[1].arg_ptr.arg_stab =
779 arg1[1].arg_ptr.arg_stab;
fe14fcc3 780 arg1[1].arg_ptr.arg_stab = Nullstab;
afd9f252 781 spat->spat_flags |= SPAT_ONCE;
a687059c 782 arg_free(arg1); /* recursive */
fe14fcc3 783 arg[1].arg_ptr.arg_arg = Nullarg;
a687059c 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 }
bf38876a 795 else if (arg->arg_type == O_ASSIGN)
796 arg[1].arg_flags |= AF_ARYOK;
a687059c 797 }
798 else if (arg1->arg_type == O_HELEM || arg1->arg_type == O_LHELEM)
0d3e774c 799 if (arg->arg_type == O_DEFINED)
800 arg1->arg_type = O_HELEM; /* avoid creating one */
801 else
802 arg1->arg_type = O_LHELEM;
a687059c 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 }
bf38876a 815 else if (arg->arg_type == O_ASSIGN)
816 arg[1].arg_flags |= AF_ARYOK;
a687059c 817 }
818 else if (arg1->arg_type == O_ASLICE) {
819 arg1->arg_type = O_LASLICE;
820 if (arg->arg_type == O_ASSIGN) {
7e1cf235 821 dehoist(arg,2);
a687059c 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) {
7e1cf235 829 dehoist(arg,2);
a687059c 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 }
db4e6270 843 else if (arg1->arg_type == O_ASSIGN)
844 /*SUPPRESS 530*/
845 ;
a687059c 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
883ARG *
884fixl(type,arg)
885int type;
886ARG *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
900dehoist(arg,i)
901ARG *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
913ARG *
914addflags(i,flags,arg)
915register ARG *arg;
916{
917 arg[i].arg_flags |= flags;
918 return arg;
919}
920
921ARG *
922hide_ary(arg)
923ARG *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
932ARG *
933jmaybe(arg)
934register 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
946ARG *
947make_list(arg)
948register 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 */
fe14fcc3 963 arg->arg_flags |= AF_LISTISH; /* see listish() below */
a687059c 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
1016ARG *
1017listish(arg)
1018ARG *arg;
1019{
db4e6270 1020 if (arg && arg->arg_flags & AF_LISTISH)
a687059c 1021 arg = make_op(O_LIST,1,arg,Nullarg,Nullarg);
1022 return arg;
1023}
1024
1025ARG *
1026maybelistish(optype, arg)
1027int optype;
1028ARG *arg;
1029{
ff2452de 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 ||
a687059c 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
1048ARG *
1049localize(arg)
1050ARG *arg;
1051{
1052 arg->arg_flags |= AF_LOCAL;
1053 return arg;
1054}
1055
1056ARG *
a687059c 1057rcatmaybe(arg)
1058ARG *arg;
1059{
fe14fcc3 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 }
a687059c 1070 }
1071 return arg;
1072}
1073
1074ARG *
1075stab2arg(atype,stab)
1076int atype;
1077register 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
1088ARG *
1089cval_to_arg(cval)
1090register 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
1102ARG *
1103op_new(numargs)
1104int 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
1114void
1115free_arg(arg)
1116ARG *arg;
1117{
1118 str_free(arg->arg_ptr.arg_str);
1119 Safefree(arg);
1120}
1121
1122ARG *
1123make_match(type,expr,spat)
1124int type;
1125ARG *expr;
1126SPAT *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
1148ARG *
1149cmd_to_arg(cmd)
1150CMD *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
1163static int
1164nothing_in_common(arg1,arg2)
1165ARG *arg1;
1166ARG *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 {} */
7e1cf235 1173 stab_lastexpr(defstab) = thisexpr; /* pretend to hit @_ */
a687059c 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
1183static int
1184arg_common(arg,exprnum,marking)
1185register ARG *arg;
1186int exprnum;
1187int 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]) {
fe14fcc3 1224 s = scanident(s,send,tokenbuf);
a687059c 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
1269static int
1270spat_common(spat,exprnum,marking)
1271register SPAT *spat;
1272int exprnum;
1273int 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}
Unnamed repository; edit this file to name it for gitweb.