projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
perl 4.0 patch 31: patch #20, continued
[p5sagit/p5-mst-13.2.git] / consarg.c
CommitLineData
68decaef 1/* $RCSfile: consarg.c,v $$Revision: 4.0.1.4 $$Date: 92/06/08 12:26:27 $
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 $
68decaef 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 *
db4e6270 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 *
2b317908 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 *
1c3d792e 26 * Revision 4.0.1.1 91/04/11 17:38:34 lwall
27 * patch1: fixed "Bad free" error
28 *
fe14fcc3 29 * Revision 4.0 91/03/20 01:06:15 lwall
30 * 4.0 baseline.
a687059c 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 {
ff8e2863 65 arg[3].arg_flags = 0;
68decaef 66 arg[3].arg_len = 0;
a687059c 67 arg[3].arg_type = A_EXPR;
68 arg[3].arg_ptr.arg_arg = limarg;
69 }
70 }
db4e6270 71 else {
72 arg[3].arg_flags = 0;
68decaef 73 arg[3].arg_len = 0;
a687059c 74 arg[3].arg_type = A_NULL;
db4e6270 75 arg[3].arg_ptr.arg_arg = Nullarg;
76 }
a687059c 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
39c3038c 99 if (!pat)
100 return Nullarg;
101
a687059c 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;
fe14fcc3 133 newarg[2].arg_len = pat[2].arg_len;
a687059c 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;
fe14fcc3 138 newarg[3].arg_len = pat[3].arg_len;
a687059c 139 newarg[3].arg_flags = pat[3].arg_flags;
140 }
141 }
fe14fcc3 142 free_arg(pat);
a687059c 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;
39c3038c 168 register unsigned doarg;
169 register int i;
a687059c 170 extern ARG *arg4; /* should be normal arguments, really */
171 extern ARG *arg5;
172
173 arg = op_new(newlen);
174 arg->arg_type = type;
db4e6270 175 /*SUPPRESS 560*/
a687059c 176 if (chld = arg1) {
177 if (chld->arg_type == O_ITEM &&
39c3038c 178 (hoistable[ i = (chld[1].arg_type&A_MASK)] || i == A_LVAL ||
179 (i == A_LEXPR &&
a687059c 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 }
a687059c 194 }
db4e6270 195 /*SUPPRESS 560*/
a687059c 196 if (chld = arg2) {
197 if (chld->arg_type == O_ITEM &&
39c3038c 198 (hoistable[chld[1].arg_type&A_MASK] ||
a687059c 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 }
a687059c 215 }
db4e6270 216 /*SUPPRESS 560*/
a687059c 217 if (chld = arg3) {
39c3038c 218 if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
a687059c 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 }
a687059c 228 }
229 if (newlen >= 4 && (chld = arg4)) {
39c3038c 230 if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
a687059c 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)) {
39c3038c 242 if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
a687059c 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 }
39c3038c 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 }
a687059c 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
2b317908 282 arg = evalstatic(arg); /* see if we can consolidate anything */
a687059c 283 return arg;
284}
285
2b317908 286ARG *
a687059c 287evalstatic(arg)
288register ARG *arg;
289{
2b317908 290 static STR *str = Nullstr;
a687059c 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)
2b317908 303 return arg;
a687059c 304
2b317908 305 if (!str)
a687059c 306 str = Str_new(20,0);
2b317908 307
308 if (arg[1].arg_type == A_SINGLE)
a687059c 309 s1 = arg[1].arg_ptr.arg_str;
2b317908 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;
db4e6270 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;
2b317908 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:
68decaef 355 CHECK2;
356 if (dowarn && !s2->str_nok && !looks_like_number(s2))
357 warn("Right operand of x is not numeric");
358 CHECK1;
2b317908 359 i = (int)str_gnum(s2);
360 tmps = str_get(s1);
361 str_nset(str,"",0);
db4e6270 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 }
2b317908 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");
a687059c 379 else
db4e6270 380#ifdef SLOPPYDIVIDE
2b317908 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;
fe14fcc3 392 }
2b317908 393 str_numset(str,value);
394 }
fe14fcc3 395#else
2b317908 396 str_numset(str,str_gnum(s1) / value);
fe14fcc3 397#endif
2b317908 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 }
68decaef 406 value = str_gnum(s1);
a687059c 407#ifndef lint
68decaef 408 if (value >= 0.0)
409 str_numset(str,(double)(((unsigned long)value) % tmplong));
410 else {
411 tmp2 = (long)value;
2b317908 412 str_numset(str,(double)((tmplong-((-tmp2 - 1) % tmplong)) - 1));
68decaef 413 }
a687059c 414#else
2b317908 415 tmp2 = tmp2;
a687059c 416#endif
2b317908 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);
a687059c 432#ifndef lint
2b317908 433 str_numset(str,(double)(((long)value) << i));
a687059c 434#endif
2b317908 435 break;
436 case O_RIGHT_SHIFT:
437 CHECK12;
438 value = str_gnum(s1);
439 i = (int)str_gnum(s2);
a687059c 440#ifndef lint
2b317908 441 str_numset(str,(double)(((long)value) >> i));
a687059c 442#endif
2b317908 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);
a687059c 492#ifndef lint
2b317908 493 str_numset(str,(double)(U_L(value) & U_L(str_gnum(s2))));
a687059c 494#endif
2b317908 495 break;
496 case O_XOR:
497 CHECK12;
498 value = str_gnum(s1);
a687059c 499#ifndef lint
2b317908 500 str_numset(str,(double)(U_L(value) ^ U_L(str_gnum(s2))));
a687059c 501#endif
2b317908 502 break;
503 case O_BIT_OR:
504 CHECK12;
505 value = str_gnum(s1);
a687059c 506#ifndef lint
2b317908 507 str_numset(str,(double)(U_L(value) | U_L(str_gnum(s2))));
a687059c 508#endif
2b317908 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;
db4e6270 541#ifdef NOTNOT
542 { char xxx = str_true(s1); str_numset(str,(double)!xxx); }
543#else
2b317908 544 str_numset(str,(double)(!str_true(s1)));
db4e6270 545#endif
2b317908 546 break;
547 case O_COMPLEMENT:
548 CHECK1;
a687059c 549#ifndef lint
2b317908 550 str_numset(str,(double)(~U_L(str_gnum(s1))));
a687059c 551#endif
2b317908 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;
fe14fcc3 610#ifdef HAS_CRYPT
2b317908 611 tmps = str_get(s1);
612 str_set(str,crypt(tmps,str_get(s2)));
a687059c 613#else
2b317908 614 yyerror(
615 "The crypt() function is unimplemented due to excessive paranoia.");
a687059c 616#endif
2b317908 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;
a687059c 643#ifndef I286
2b317908 644 str_numset(str,(double)(*str_get(s1)));
a687059c 645#else
2b317908 646 {
647 int zapc;
648 char *zaps;
a687059c 649
2b317908 650 zaps = str_get(s1);
651 zapc = (int) *zaps;
652 str_numset(str,(double)(zapc));
a687059c 653 }
2b317908 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;
a687059c 664 }
2b317908 665 str = Nullstr;
666
667 return arg;
a687059c 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;
db4e6270 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;
a687059c 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)
0d3e774c 778 if (arg->arg_type == O_DEFINED)
779 arg1->arg_type = O_AELEM;
780 else
781 arg1->arg_type = O_LAELEM;
a687059c 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;
afd9f252 789 if (!(spat->spat_flags & SPAT_ONCE) &&
a687059c 790 nothing_in_common(arg1,spat->spat_repl)) {
791 spat->spat_repl[1].arg_ptr.arg_stab =
792 arg1[1].arg_ptr.arg_stab;
fe14fcc3 793 arg1[1].arg_ptr.arg_stab = Nullstab;
afd9f252 794 spat->spat_flags |= SPAT_ONCE;
a687059c 795 arg_free(arg1); /* recursive */
fe14fcc3 796 arg[1].arg_ptr.arg_arg = Nullarg;
a687059c 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 }
bf38876a 808 else if (arg->arg_type == O_ASSIGN)
809 arg[1].arg_flags |= AF_ARYOK;
a687059c 810 }
811 else if (arg1->arg_type == O_HELEM || arg1->arg_type == O_LHELEM)
0d3e774c 812 if (arg->arg_type == O_DEFINED)
813 arg1->arg_type = O_HELEM; /* avoid creating one */
814 else
815 arg1->arg_type = O_LHELEM;
a687059c 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 }
bf38876a 828 else if (arg->arg_type == O_ASSIGN)
829 arg[1].arg_flags |= AF_ARYOK;
a687059c 830 }
831 else if (arg1->arg_type == O_ASLICE) {
832 arg1->arg_type = O_LASLICE;
833 if (arg->arg_type == O_ASSIGN) {
7e1cf235 834 dehoist(arg,2);
a687059c 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) {
7e1cf235 842 dehoist(arg,2);
a687059c 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 }
db4e6270 856 else if (arg1->arg_type == O_ASSIGN)
857 /*SUPPRESS 530*/
858 ;
a687059c 859 else {
860 (void)sprintf(tokenbuf,
861 "Illegal expression (%s) as lvalue",opname[arg1->arg_type]);
862 yyerror(tokenbuf);
68decaef 863 return arg;
a687059c 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);
68decaef 888 return arg;
a687059c 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
68decaef 915void
a687059c 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 */
fe14fcc3 979 arg->arg_flags |= AF_LISTISH; /* see listish() below */
a687059c 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;
68decaef 995 StructCopy(node, arg, ARG); /* copy everything except the STR */
a687059c 996 arg->arg_ptr.arg_str = tmpstr;
997 for (j = i; ; ) {
68decaef 998 StructCopy(node+2, arg+j, ARG);
a687059c 999 arg[j].arg_flags |= AF_ARYOK;
1000 --j; /* Bug in Xenix compiler */
1001 if (j < 2) {
68decaef 1002 StructCopy(node+1, arg+1, ARG);
a687059c 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;
68decaef 1015 str_free(arg->arg_ptr.arg_str);
1016 arg->arg_ptr.arg_str = Nullstr;
a687059c 1017 return arg;
1018}
1019
1020/* turn a single item into a list */
1021
1022ARG *
1023listish(arg)
1024ARG *arg;
1025{
db4e6270 1026 if (arg && arg->arg_flags & AF_LISTISH)
a687059c 1027 arg = make_op(O_LIST,1,arg,Nullarg,Nullarg);
1028 return arg;
1029}
1030
1031ARG *
1032maybelistish(optype, arg)
1033int optype;
1034ARG *arg;
1035{
ff2452de 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 ||
a687059c 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 *
a687059c 1063rcatmaybe(arg)
1064ARG *arg;
1065{
fe14fcc3 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 }
a687059c 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 {} */
7e1cf235 1179 stab_lastexpr(defstab) = thisexpr; /* pretend to hit @_ */
a687059c 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]) {
fe14fcc3 1230 s = scanident(s,send,tokenbuf);
a687059c 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}
Unnamed repository; edit this file to name it for gitweb.