perl 5.0 alpha 2
[perl.git] / oldcmdcruft
1 #ifdef NOTDEF
2     if (go_to) {
3         if (op->cop_label && strEQ(go_to,op->cop_label))
4             goto_targ = go_to = Nullch;         /* here at last */
5         else {
6             switch (op->cop_type) {
7             case COP_IF:
8                 oldspat = curspat;
9                 oldsave = savestack->av_fill;
10 #ifdef DEBUGGING
11                 olddlevel = dlevel;
12 #endif
13                 retstr = &sv_yes;
14                 newsp = -2;
15                 if (op->uop.ccop_true) {
16 #ifdef DEBUGGING
17                     if (debug) {
18                         debname[dlevel] = 't';
19                         debdelim[dlevel] = '_';
20                         if (++dlevel >= dlmax)
21                             deb_growlevel();
22                     }
23 #endif
24                     newsp = cop_exec(op->uop.ccop_true,gimme && (opflags & COPf_TERM),sp);
25                     st = stack->av_array;       /* possibly reallocated */
26                     retstr = st[newsp];
27                 }
28                 if (!goto_targ)
29                     go_to = Nullch;
30                 curspat = oldspat;
31                 if (savestack->av_fill > oldsave)
32                     leave_scope(oldsave);
33 #ifdef DEBUGGING
34                 dlevel = olddlevel;
35 #endif
36                 op = op->uop.ccop_alt;
37                 goto tail_recursion_entry;
38             case COP_ELSE:
39                 oldspat = curspat;
40                 oldsave = savestack->av_fill;
41 #ifdef DEBUGGING
42                 olddlevel = dlevel;
43 #endif
44                 retstr = &sv_undef;
45                 newsp = -2;
46                 if (op->uop.ccop_true) {
47 #ifdef DEBUGGING
48                     if (debug) {
49                         debname[dlevel] = 'e';
50                         debdelim[dlevel] = '_';
51                         if (++dlevel >= dlmax)
52                             deb_growlevel();
53                     }
54 #endif
55                     newsp = cop_exec(op->uop.ccop_true,gimme && (opflags & COPf_TERM),sp);
56                     st = stack->av_array;       /* possibly reallocated */
57                     retstr = st[newsp];
58                 }
59                 if (!goto_targ)
60                     go_to = Nullch;
61                 curspat = oldspat;
62                 if (savestack->av_fill > oldsave)
63                     leave_scope(oldsave);
64 #ifdef DEBUGGING
65                 dlevel = olddlevel;
66 #endif
67                 break;
68             case COP_BLOCK:
69             case COP_WHILE:
70                 if (!(opflags & COPf_ONCE)) {
71                     opflags |= COPf_ONCE;
72                     if (++loop_ptr >= loop_max) {
73                         loop_max += 128;
74                         Renew(loop_stack, loop_max, struct loop);
75                     }
76                     loop_stack[loop_ptr].loop_label = op->cop_label;
77                     loop_stack[loop_ptr].loop_sp = sp;
78 #ifdef DEBUGGING
79                     if (debug & 4) {
80                         deb("(Pushing label #%d %s)\n",
81                           loop_ptr, op->cop_label ? op->cop_label : "");
82                     }
83 #endif
84                 }
85 #ifdef JMPCLOBBER
86                 opparm = op;
87 #endif
88                 match = setjmp(loop_stack[loop_ptr].loop_env);
89                 if (match) {
90                     st = stack->av_array;       /* possibly reallocated */
91 #ifdef JMPCLOBBER
92                     op = opparm;
93                     opflags = op->cop_flags|COPf_ONCE;
94 #endif
95                     if (savestack->av_fill > oldsave)
96                         leave_scope(oldsave);
97                     switch (match) {
98                     default:
99                         fatal("longjmp returned bad value (%d)",match);
100                     case OP_LAST:       /* not done unless go_to found */
101                         go_to = Nullch;
102                         if (lastretstr) {
103                             retstr = lastretstr;
104                             newsp = -2;
105                         }
106                         else {
107                             newsp = sp + lastsize;
108                             retstr = st[newsp];
109                         }
110 #ifdef DEBUGGING
111                         olddlevel = dlevel;
112 #endif
113                         curspat = oldspat;
114                         goto next_op;
115                     case OP_NEXT:       /* not done unless go_to found */
116                         go_to = Nullch;
117 #ifdef JMPCLOBBER
118                         newsp = -2;
119                         retstr = &sv_undef;
120 #endif
121                         goto next_iter;
122                     case OP_REDO:       /* not done unless go_to found */
123                         go_to = Nullch;
124 #ifdef JMPCLOBBER
125                         newsp = -2;
126                         retstr = &sv_undef;
127 #endif
128                         goto doit;
129                     }
130                 }
131                 oldspat = curspat;
132                 oldsave = savestack->av_fill;
133 #ifdef DEBUGGING
134                 olddlevel = dlevel;
135 #endif
136                 if (op->uop.ccop_true) {
137 #ifdef DEBUGGING
138                     if (debug) {
139                         debname[dlevel] = 't';
140                         debdelim[dlevel] = '_';
141                         if (++dlevel >= dlmax)
142                             deb_growlevel();
143                     }
144 #endif
145                     newsp = cop_exec(op->uop.ccop_true,gimme && (opflags & COPf_TERM),sp);
146                     st = stack->av_array;       /* possibly reallocated */
147                     if (newsp >= 0)
148                         retstr = st[newsp];
149                 }
150                 if (!goto_targ) {
151                     go_to = Nullch;
152                     goto next_iter;
153                 }
154 #ifdef DEBUGGING
155                 dlevel = olddlevel;
156 #endif
157                 if (op->uop.ccop_alt) {
158 #ifdef DEBUGGING
159                     if (debug) {
160                         debname[dlevel] = 'a';
161                         debdelim[dlevel] = '_';
162                         if (++dlevel >= dlmax)
163                             deb_growlevel();
164                     }
165 #endif
166                     newsp = cop_exec(op->uop.ccop_alt,gimme && (opflags & COPf_TERM),sp);
167                     st = stack->av_array;       /* possibly reallocated */
168                     if (newsp >= 0)
169                         retstr = st[newsp];
170                 }
171                 if (goto_targ)
172                     break;
173                 go_to = Nullch;
174                 goto finish_while;
175             }
176             op = op->cop_next;
177             if (op && op->cop_head == op)
178                                         /* reached end of while loop */
179                 return sp;              /* targ isn't in this block */
180             if (opflags & COPf_ONCE) {
181 #ifdef DEBUGGING
182                 if (debug & 4) {
183                     tmps = loop_stack[loop_ptr].loop_label;
184                     deb("(Popping label #%d %s)\n",loop_ptr,
185                         tmps ? tmps : "" );
186                 }
187 #endif
188                 loop_ptr--;
189             }
190             goto tail_recursion_entry;
191         }
192     }
193 #endif
194
195 #ifdef DEBUGGING
196     if (debug) {
197         if (debug & 2) {
198             deb("%s     (%lx)   r%lx    t%lx    a%lx    n%lx    cs%lx\n",
199                 cop_name[op->cop_type],op,op->cop_expr,
200                 op->uop.ccop_true,op->uop.ccop_alt,op->cop_next,
201                 curspat);
202         }
203         debname[dlevel] = cop_name[op->cop_type][0];
204         debdelim[dlevel] = '!';
205         if (++dlevel >= dlmax)
206             deb_growlevel();
207     }
208 #endif
209
210     /* Here is some common optimization */
211
212     if (opflags & COPf_COND) {
213         switch (opflags & COPf_OPTIMIZE) {
214
215         case COPo_FALSE:
216             retstr = op->cop_short;
217             newsp = -2;
218             match = FALSE;
219             if (opflags & COPf_NESURE)
220                 goto maybe;
221             break;
222         case COPo_TRUE:
223             retstr = op->cop_short;
224             newsp = -2;
225             match = TRUE;
226             if (opflags & COPf_EQSURE)
227                 goto flipmaybe;
228             break;
229
230         case COPo_REG:
231             retstr = GV_STR(op->cop_stab);
232             newsp = -2;
233             match = SvTRUE(retstr);     /* => retstr = retstr, c2 should fix */
234             if (opflags & (match ? COPf_EQSURE : COPf_NESURE))
235                 goto flipmaybe;
236             break;
237
238         case COPo_ANCHOR:       /* /^pat/ optimization */
239             if (multiline) {
240                 if (*op->cop_short->sv_ptr && !(opflags & COPf_EQSURE))
241                     goto scanner;       /* just unanchor it */
242                 else
243                     break;              /* must evaluate */
244             }
245             match = 0;
246             goto strop;
247
248         case COPo_STROP:                /* string op optimization */
249             match = 1;
250           strop:
251             retstr = GV_STR(op->cop_stab);
252             newsp = -2;
253 #ifndef I286
254             if (*op->cop_short->sv_ptr == *SvPV(retstr) &&
255                     (match ? retstr->sv_cur == op->cop_slen - 1 :
256                              retstr->sv_cur >= op->cop_slen) &&
257                     bcmp(op->cop_short->sv_ptr, SvPV(retstr),
258                       op->cop_slen) == 0 ) {
259                 if (opflags & COPf_EQSURE) {
260                     if (sawampersand && (opflags & COPf_OPTIMIZE) != COPo_STROP) {
261                         curspat = Nullpm;
262                         if (leftstab)
263                             sv_setpvn(GvSV(leftstab),"",0);
264                         if (amperstab)
265                             sv_setsv(GvSV(amperstab),op->cop_short);
266                         if (rightstab)
267                             sv_setpvn(GvSV(rightstab),
268                               retstr->sv_ptr + op->cop_slen,
269                               retstr->sv_cur - op->cop_slen);
270                     }
271                     if (op->cop_spat)
272                         lastspat = op->cop_spat;
273                     match = !(opflags & COPf_FIRSTNEG);
274                     retstr = match ? &sv_yes : &sv_no;
275                     goto flipmaybe;
276                 }
277             }
278             else if (opflags & COPf_NESURE) {
279                 match = opflags & COPf_FIRSTNEG;
280                 retstr = match ? &sv_yes : &sv_no;
281                 goto flipmaybe;
282             }
283 #else
284             {
285                 char *zap1, *zap2, zap1c, zap2c;
286                 int  zaplen;
287                 int lenok;
288
289                 zap1 = op->cop_short->sv_ptr;
290                 zap2 = SvPV(retstr);
291                 zap1c = *zap1;
292                 zap2c = *zap2;
293                 zaplen = op->cop_slen;
294                 if (match)
295                     lenok = (retstr->sv_cur == op->cop_slen - 1);
296                 else
297                     lenok = (retstr->sv_cur >= op->cop_slen);
298                 if ((zap1c == zap2c) && lenok && (bcmp(zap1, zap2, zaplen) == 0)) {
299                     if (opflags & COPf_EQSURE) {
300                         if (sawampersand &&
301                           (opflags & COPf_OPTIMIZE) != COPo_STROP) {
302                             curspat = Nullpm;
303                             if (leftstab)
304                                 sv_setpvn(GvSV(leftstab),"",0);
305                             if (amperstab)
306                                 sv_setsv(GvSV(amperstab),op->cop_short);
307                             if (rightstab)
308                                 sv_setpvn(GvSV(rightstab),
309                                          retstr->sv_ptr + op->cop_slen,
310                                          retstr->sv_cur - op->cop_slen);
311                         }
312                         if (op->cop_spat)
313                             lastspat = op->cop_spat;
314                         match = !(opflags & COPf_FIRSTNEG);
315                         retstr = match ? &sv_yes : &sv_no;
316                         goto flipmaybe;
317                     }
318                 }
319                 else if (opflags & COPf_NESURE) {
320                     match = opflags & COPf_FIRSTNEG;
321                     retstr = match ? &sv_yes : &sv_no;
322                     goto flipmaybe;
323                 }
324             }
325 #endif
326             break;                      /* must evaluate */
327
328         case COPo_SCAN:                 /* non-anchored search */
329           scanner:
330             retstr = GV_STR(op->cop_stab);
331             newsp = -2;
332             if (retstr->sv_pok & SVp_STUDIED)
333                 if (screamfirst[op->cop_short->sv_rare] >= 0)
334                     tmps = screaminstr(retstr, op->cop_short);
335                 else
336                     tmps = Nullch;
337             else {
338                 tmps = SvPV(retstr);            /* make sure it's pok */
339 #ifndef lint
340                 tmps = fbm_instr((unsigned char*)tmps,
341                     (unsigned char*)tmps + retstr->sv_cur, op->cop_short);
342 #endif
343             }
344             if (tmps) {
345                 if (opflags & COPf_EQSURE) {
346                     ++op->cop_short->sv_u.sv_useful;
347                     if (sawampersand) {
348                         curspat = Nullpm;
349                         if (leftstab)
350                             sv_setpvn(GvSV(leftstab),retstr->sv_ptr,
351                               tmps - retstr->sv_ptr);
352                         if (amperstab)
353                             sv_setpvn(GvSV(amperstab),
354                               tmps, op->cop_short->sv_cur);
355                         if (rightstab)
356                             sv_setpvn(GvSV(rightstab),
357                               tmps + op->cop_short->sv_cur,
358                               retstr->sv_cur - (tmps - retstr->sv_ptr) -
359                                 op->cop_short->sv_cur);
360                     }
361                     lastspat = op->cop_spat;
362                     match = !(opflags & COPf_FIRSTNEG);
363                     retstr = match ? &sv_yes : &sv_no;
364                     goto flipmaybe;
365                 }
366                 else
367                     hint = tmps;
368             }
369             else {
370                 if (opflags & COPf_NESURE) {
371                     ++op->cop_short->sv_u.sv_useful;
372                     match = opflags & COPf_FIRSTNEG;
373                     retstr = match ? &sv_yes : &sv_no;
374                     goto flipmaybe;
375                 }
376             }
377             if (--op->cop_short->sv_u.sv_useful < 0) {
378                 opflags &= ~COPf_OPTIMIZE;
379                 opflags |= COPo_EVAL;   /* never try this optimization again */
380                 op->cop_flags = (opflags & ~COPf_ONCE);
381             }
382             break;                      /* must evaluate */
383
384         case COPo_NUMOP:                /* numeric op optimization */
385             retstr = GV_STR(op->cop_stab);
386             newsp = -2;
387             switch (op->cop_slen) {
388             case OP_EQ:
389                 if (dowarn) {
390                     if ((!retstr->sv_nok && !looks_like_number(retstr)))
391                         warn("Possible use of == on string value");
392                 }
393                 match = (SvNV(retstr) == op->cop_short->sv_u.sv_nv);
394                 break;
395             case OP_NE:
396                 match = (SvNV(retstr) != op->cop_short->sv_u.sv_nv);
397                 break;
398             case OP_LT:
399                 match = (SvNV(retstr) <  op->cop_short->sv_u.sv_nv);
400                 break;
401             case OP_LE:
402                 match = (SvNV(retstr) <= op->cop_short->sv_u.sv_nv);
403                 break;
404             case OP_GT:
405                 match = (SvNV(retstr) >  op->cop_short->sv_u.sv_nv);
406                 break;
407             case OP_GE:
408                 match = (SvNV(retstr) >= op->cop_short->sv_u.sv_nv);
409                 break;
410             }
411             if (match) {
412                 if (opflags & COPf_EQSURE) {
413                     retstr = &sv_yes;
414                     goto flipmaybe;
415                 }
416             }
417             else if (opflags & COPf_NESURE) {
418                 retstr = &sv_no;
419                 goto flipmaybe;
420             }
421             break;                      /* must evaluate */
422
423         case COPo_INDGETS:              /* while (<$foo>) */
424             last_in_stab = newGV(SvPV(GV_STR(op->cop_stab)),TRUE);
425             if (!GvIO(last_in_stab))
426                 GvIO(last_in_stab) = newIO();
427             goto dogets;
428         case COPo_GETS:                 /* really a while (<file>) */
429             last_in_stab = op->cop_stab;
430           dogets:
431             fp = GvIO(last_in_stab)->ifp;
432             retstr = GvSV(defstab);
433             newsp = -2;
434           keepgoing:
435             if (fp && sv_gets(retstr, fp, 0)) {
436                 if (*retstr->sv_ptr == '0' && retstr->sv_cur == 1)
437                     match = FALSE;
438                 else
439                     match = TRUE;
440                 GvIO(last_in_stab)->lines++;
441             }
442             else if (GvIO(last_in_stab)->flags & IOf_ARGV) {
443                 if (!fp)
444                     goto doeval;        /* first time through */
445                 fp = nextargv(last_in_stab);
446                 if (fp)
447                     goto keepgoing;
448                 (void)do_close(last_in_stab,FALSE);
449                 GvIO(last_in_stab)->flags |= IOf_START;
450                 retstr = &sv_undef;
451                 match = FALSE;
452             }
453             else {
454                 retstr = &sv_undef;
455                 match = FALSE;
456             }
457             goto flipmaybe;
458         case COPo_EVAL:
459             break;
460         case COPo_UNFLIP:
461             while (tmps_max > tmps_base) {      /* clean up after last oldeval */
462                 sv_free(tmps_list[tmps_max]);
463                 tmps_list[tmps_max--] = Nullsv;
464             }
465             newsp = oldeval(Nullsv,op->cop_expr,gimme && (opflags & COPf_TERM),sp);
466             st = stack->av_array;       /* possibly reallocated */
467             retstr = st[newsp];
468             match = SvTRUE(retstr);
469             if (op->cop_expr->arg_type == OP_FLIP)      /* undid itself? */
470                 opflags = copyopt(op,op->cop_expr[3].arg_ptr.arg_op);
471             goto maybe;
472         case COPo_CHOP:
473             retstr = GvSV(op->cop_stab);
474             newsp = -2;
475             match = (retstr->sv_cur != 0);
476             tmps = SvPV(retstr);
477             tmps += retstr->sv_cur - match;
478             sv_setpvn(&strchop,tmps,match);
479             *tmps = '\0';
480             retstr->sv_nok = 0;
481             retstr->sv_cur = tmps - retstr->sv_ptr;
482             SvSETMAGIC(retstr);
483             retstr = &strchop;
484             goto flipmaybe;
485         case COPo_ARRAY:
486             match = op->cop_short->sv_u.sv_useful; /* just to get register */
487
488             if (match < 0) {            /* first time through here? */
489                 ar = GvAVn(op->cop_expr[1].arg_ptr.arg_stab);
490                 aryoptsave = savestack->av_fill;
491                 save_sptr(&GvSV(op->cop_stab));
492                 save_long(&op->cop_short->sv_u.sv_useful);
493             }
494             else {
495                 ar = GvAV(op->cop_expr[1].arg_ptr.arg_stab);
496                 if (op->cop_type != COP_WHILE && savestack->av_fill > firstsave)
497                     leave_scope(firstsave);
498             }
499
500             if (match >= ar->av_fill) { /* we're in LAST, probably */
501                 if (match < 0 &&                /* er, probably not... */
502                   savestack->av_fill > aryoptsave)
503                     leave_scope(aryoptsave);
504                 retstr = &sv_undef;
505                 op->cop_short->sv_u.sv_useful = -1;     /* actually redundant */
506                 match = FALSE;
507             }
508             else {
509                 match++;
510                 if (!(retstr = ar->av_array[match]))
511                     retstr = av_fetch(ar,match,TRUE);
512                 GvSV(op->cop_stab) = retstr;
513                 op->cop_short->sv_u.sv_useful = match;
514                 match = TRUE;
515             }
516             newsp = -2;
517             goto maybe;
518         case COPo_D1:
519             break;
520         case COPo_D0:
521             if (DBsingle->sv_u.sv_nv != 0)
522                 break;
523             if (DBsignal->sv_u.sv_nv != 0)
524                 break;
525             if (DBtrace->sv_u.sv_nv != 0)
526                 break;
527             goto next_op;
528         }
529
530     /* we have tried to make this normal case as abnormal as possible */
531
532     doeval:
533         if (gimme == G_ARRAY) {
534             lastretstr = Nullsv;
535             lastspbase = sp;
536             lastsize = newsp - sp;
537             if (lastsize < 0)
538                 lastsize = 0;
539         }
540         else
541             lastretstr = retstr;
542         while (tmps_max > tmps_base) {  /* clean up after last oldeval */
543             sv_free(tmps_list[tmps_max]);
544             tmps_list[tmps_max--] = Nullsv;
545         }
546         newsp = oldeval(Nullsv,op->cop_expr,
547           gimme && (opflags & COPf_TERM) && op->cop_type == COP_EXPR &&
548                 !op->uop.acop_expr,
549           sp);
550         st = stack->av_array;   /* possibly reallocated */
551         retstr = st[newsp];
552         if (newsp > sp && retstr)
553             match = SvTRUE(retstr);
554         else
555             match = FALSE;
556         goto maybe;
557
558     /* if flipflop was true, flop it */
559
560     flipmaybe:
561         if (match && opflags & COPf_FLIP) {
562             while (tmps_max > tmps_base) {      /* clean up after last oldeval */
563                 sv_free(tmps_list[tmps_max]);
564                 tmps_list[tmps_max--] = Nullsv;
565             }
566             if (op->cop_expr->arg_type == OP_FLOP) {    /* currently toggled? */
567                 newsp = oldeval(Nullsv,op->cop_expr,G_SCALAR,sp);/*let oldeval undo it*/
568                 opflags = copyopt(op,op->cop_expr[3].arg_ptr.arg_op);
569             }
570             else {
571                 newsp = oldeval(Nullsv,op->cop_expr,G_SCALAR,sp);/* let oldeval do it */
572                 if (op->cop_expr->arg_type == OP_FLOP)  /* still toggled? */
573                     opflags = copyopt(op,op->cop_expr[4].arg_ptr.arg_op);
574             }
575         }
576         else if (opflags & COPf_FLIP) {
577             if (op->cop_expr->arg_type == OP_FLOP) {    /* currently toggled? */
578                 match = TRUE;                           /* force on */
579             }
580         }
581
582     /* at this point, match says whether our expression was true */
583
584     maybe:
585         if (opflags & COPf_INVERT)
586             match = !match;
587         if (!match)
588             goto next_op;
589     }
590 #ifdef TAINT
591     tainted = 0;        /* modifier doesn't affect regular expression */
592 #endif