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