This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 1.0 patch 9: 3 portability problems
[perl5.git] / cmd.c
1 /* $Header: cmd.c,v 1.0.1.1 88/01/21 21:24:16 root Exp $
2  *
3  * $Log:        cmd.c,v $
4  * Revision 1.0.1.1  88/01/21  21:24:16  root
5  * The redo cmd got a segmentation fault because trace context stack overflowed.
6  * 
7  * Revision 1.0  87/12/18  13:04:51  root
8  * Initial revision
9  * 
10  */
11
12 #include "handy.h"
13 #include "EXTERN.h"
14 #include "search.h"
15 #include "util.h"
16 #include "perl.h"
17
18 static STR str_chop;
19
20 /* This is the main command loop.  We try to spend as much time in this loop
21  * as possible, so lots of optimizations do their activities in here.  This
22  * means things get a little sloppy.
23  */
24
25 STR *
26 cmd_exec(cmd)
27 register CMD *cmd;
28 {
29     SPAT *oldspat;
30 #ifdef DEBUGGING
31     int olddlevel;
32     int entdlevel;
33 #endif
34     register STR *retstr;
35     register char *tmps;
36     register int cmdflags;
37     register bool match;
38     register char *go_to = goto_targ;
39     ARG *arg;
40     FILE *fp;
41
42     retstr = &str_no;
43 #ifdef DEBUGGING
44     entdlevel = dlevel;
45 #endif
46 tail_recursion_entry:
47 #ifdef DEBUGGING
48     dlevel = entdlevel;
49 #endif
50     if (cmd == Nullcmd)
51         return retstr;
52     cmdflags = cmd->c_flags;    /* hopefully load register */
53     if (go_to) {
54         if (cmd->c_label && strEQ(go_to,cmd->c_label))
55             goto_targ = go_to = Nullch;         /* here at last */
56         else {
57             switch (cmd->c_type) {
58             case C_IF:
59                 oldspat = curspat;
60 #ifdef DEBUGGING
61                 olddlevel = dlevel;
62 #endif
63                 retstr = &str_yes;
64                 if (cmd->ucmd.ccmd.cc_true) {
65 #ifdef DEBUGGING
66                     debname[dlevel] = 't';
67                     debdelim[dlevel++] = '_';
68 #endif
69                     retstr = cmd_exec(cmd->ucmd.ccmd.cc_true);
70                 }
71                 if (!goto_targ) {
72                     go_to = Nullch;
73                 } else {
74                     retstr = &str_no;
75                     if (cmd->ucmd.ccmd.cc_alt) {
76 #ifdef DEBUGGING
77                         debname[dlevel] = 'e';
78                         debdelim[dlevel++] = '_';
79 #endif
80                         retstr = cmd_exec(cmd->ucmd.ccmd.cc_alt);
81                     }
82                 }
83                 if (!goto_targ)
84                     go_to = Nullch;
85                 curspat = oldspat;
86 #ifdef DEBUGGING
87                 dlevel = olddlevel;
88 #endif
89                 break;
90             case C_BLOCK:
91             case C_WHILE:
92                 if (!(cmdflags & CF_ONCE)) {
93                     cmdflags |= CF_ONCE;
94                     loop_ptr++;
95                     loop_stack[loop_ptr].loop_label = cmd->c_label;
96 #ifdef DEBUGGING
97                     if (debug & 4) {
98                         deb("(Pushing label #%d %s)\n",
99                           loop_ptr,cmd->c_label);
100                     }
101 #endif
102                 }
103                 switch (setjmp(loop_stack[loop_ptr].loop_env)) {
104                 case O_LAST:    /* not done unless go_to found */
105                     go_to = Nullch;
106                     retstr = &str_no;
107 #ifdef DEBUGGING
108                     olddlevel = dlevel;
109 #endif
110                     curspat = oldspat;
111 #ifdef DEBUGGING
112                     if (debug & 4) {
113                         deb("(Popping label #%d %s)\n",loop_ptr,
114                             loop_stack[loop_ptr].loop_label);
115                     }
116 #endif
117                     loop_ptr--;
118                     cmd = cmd->c_next;
119                     goto tail_recursion_entry;
120                 case O_NEXT:    /* not done unless go_to found */
121                     go_to = Nullch;
122                     goto next_iter;
123                 case O_REDO:    /* not done unless go_to found */
124                     go_to = Nullch;
125                     goto doit;
126                 }
127                 oldspat = curspat;
128 #ifdef DEBUGGING
129                 olddlevel = dlevel;
130 #endif
131                 if (cmd->ucmd.ccmd.cc_true) {
132 #ifdef DEBUGGING
133                     debname[dlevel] = 't';
134                     debdelim[dlevel++] = '_';
135 #endif
136                     cmd_exec(cmd->ucmd.ccmd.cc_true);
137                 }
138                 if (!goto_targ) {
139                     go_to = Nullch;
140                     goto next_iter;
141                 }
142 #ifdef DEBUGGING
143                 dlevel = olddlevel;
144 #endif
145                 if (cmd->ucmd.ccmd.cc_alt) {
146 #ifdef DEBUGGING
147                     debname[dlevel] = 'a';
148                     debdelim[dlevel++] = '_';
149 #endif
150                     cmd_exec(cmd->ucmd.ccmd.cc_alt);
151                 }
152                 if (goto_targ)
153                     break;
154                 go_to = Nullch;
155                 goto finish_while;
156             }
157             cmd = cmd->c_next;
158             if (cmd && cmd->c_head == cmd)      /* reached end of while loop */
159                 return retstr;          /* targ isn't in this block */
160             goto tail_recursion_entry;
161         }
162     }
163
164 until_loop:
165
166 #ifdef DEBUGGING
167     if (debug & 2) {
168         deb("%s (%lx)   r%lx    t%lx    a%lx    n%lx    cs%lx\n",
169             cmdname[cmd->c_type],cmd,cmd->c_expr,
170             cmd->ucmd.ccmd.cc_true,cmd->ucmd.ccmd.cc_alt,cmd->c_next,curspat);
171     }
172     debname[dlevel] = cmdname[cmd->c_type][0];
173     debdelim[dlevel++] = '!';
174 #endif
175     while (tmps_max >= 0)               /* clean up after last eval */
176         str_free(tmps_list[tmps_max--]);
177
178     /* Here is some common optimization */
179
180     if (cmdflags & CF_COND) {
181         switch (cmdflags & CF_OPTIMIZE) {
182
183         case CFT_FALSE:
184             retstr = cmd->c_first;
185             match = FALSE;
186             if (cmdflags & CF_NESURE)
187                 goto maybe;
188             break;
189         case CFT_TRUE:
190             retstr = cmd->c_first;
191             match = TRUE;
192             if (cmdflags & CF_EQSURE)
193                 goto flipmaybe;
194             break;
195
196         case CFT_REG:
197             retstr = STAB_STR(cmd->c_stab);
198             match = str_true(retstr);   /* => retstr = retstr, c2 should fix */
199             if (cmdflags & (match ? CF_EQSURE : CF_NESURE))
200                 goto flipmaybe;
201             break;
202
203         case CFT_ANCHOR:        /* /^pat/ optimization */
204             if (multiline) {
205                 if (*cmd->c_first->str_ptr && !(cmdflags & CF_EQSURE))
206                     goto scanner;       /* just unanchor it */
207                 else
208                     break;              /* must evaluate */
209             }
210             /* FALL THROUGH */
211         case CFT_STROP:         /* string op optimization */
212             retstr = STAB_STR(cmd->c_stab);
213             if (*cmd->c_first->str_ptr == *str_get(retstr) &&
214                     strnEQ(cmd->c_first->str_ptr, str_get(retstr),
215                       cmd->c_flen) ) {
216                 if (cmdflags & CF_EQSURE) {
217                     match = !(cmdflags & CF_FIRSTNEG);
218                     retstr = &str_yes;
219                     goto flipmaybe;
220                 }
221             }
222             else if (cmdflags & CF_NESURE) {
223                 match = cmdflags & CF_FIRSTNEG;
224                 retstr = &str_no;
225                 goto flipmaybe;
226             }
227             break;                      /* must evaluate */
228
229         case CFT_SCAN:                  /* non-anchored search */
230           scanner:
231             retstr = STAB_STR(cmd->c_stab);
232             if (instr(str_get(retstr),cmd->c_first->str_ptr)) {
233                 if (cmdflags & CF_EQSURE) {
234                     match = !(cmdflags & CF_FIRSTNEG);
235                     retstr = &str_yes;
236                     goto flipmaybe;
237                 }
238             }
239             else if (cmdflags & CF_NESURE) {
240                 match = cmdflags & CF_FIRSTNEG;
241                 retstr = &str_no;
242                 goto flipmaybe;
243             }
244             break;                      /* must evaluate */
245
246         case CFT_GETS:                  /* really a while (<file>) */
247             last_in_stab = cmd->c_stab;
248             fp = last_in_stab->stab_io->fp;
249             retstr = defstab->stab_val;
250             if (fp && str_gets(retstr, fp)) {
251                 last_in_stab->stab_io->lines++;
252                 match = TRUE;
253             }
254             else if (last_in_stab->stab_io->flags & IOF_ARGV)
255                 goto doeval;    /* doesn't necessarily count as EOF yet */
256             else {
257                 retstr = &str_no;
258                 match = FALSE;
259             }
260             goto flipmaybe;
261         case CFT_EVAL:
262             break;
263         case CFT_UNFLIP:
264             retstr = eval(cmd->c_expr,Null(char***));
265             match = str_true(retstr);
266             if (cmd->c_expr->arg_type == O_FLIP)        /* undid itself? */
267                 cmdflags = copyopt(cmd,cmd->c_expr[3].arg_ptr.arg_cmd);
268             goto maybe;
269         case CFT_CHOP:
270             retstr = cmd->c_stab->stab_val;
271             match = (retstr->str_cur != 0);
272             tmps = str_get(retstr);
273             tmps += retstr->str_cur - match;
274             str_set(&str_chop,tmps);
275             *tmps = '\0';
276             retstr->str_nok = 0;
277             retstr->str_cur = tmps - retstr->str_ptr;
278             retstr = &str_chop;
279             goto flipmaybe;
280         }
281
282     /* we have tried to make this normal case as abnormal as possible */
283
284     doeval:
285         retstr = eval(cmd->c_expr,Null(char***));
286         match = str_true(retstr);
287         goto maybe;
288
289     /* if flipflop was true, flop it */
290
291     flipmaybe:
292         if (match && cmdflags & CF_FLIP) {
293             if (cmd->c_expr->arg_type == O_FLOP) {      /* currently toggled? */
294                 retstr = eval(cmd->c_expr,Null(char***)); /* let eval undo it */
295                 cmdflags = copyopt(cmd,cmd->c_expr[3].arg_ptr.arg_cmd);
296             }
297             else {
298                 retstr = eval(cmd->c_expr,Null(char***)); /* let eval do it */
299                 if (cmd->c_expr->arg_type == O_FLOP)    /* still toggled? */
300                     cmdflags = copyopt(cmd,cmd->c_expr[4].arg_ptr.arg_cmd);
301             }
302         }
303         else if (cmdflags & CF_FLIP) {
304             if (cmd->c_expr->arg_type == O_FLOP) {      /* currently toggled? */
305                 match = TRUE;                           /* force on */
306             }
307         }
308
309     /* at this point, match says whether our expression was true */
310
311     maybe:
312         if (cmdflags & CF_INVERT)
313             match = !match;
314         if (!match && cmd->c_type != C_IF) {
315             cmd = cmd->c_next;
316             goto tail_recursion_entry;
317         }
318     }
319
320     /* now to do the actual command, if any */
321
322     switch (cmd->c_type) {
323     case C_NULL:
324         fatal("panic: cmd_exec\n");
325     case C_EXPR:                        /* evaluated for side effects */
326         if (cmd->ucmd.acmd.ac_expr) {   /* more to do? */
327             retstr = eval(cmd->ucmd.acmd.ac_expr,Null(char***));
328         }
329         break;
330     case C_IF:
331         oldspat = curspat;
332 #ifdef DEBUGGING
333         olddlevel = dlevel;
334 #endif
335         if (match) {
336             retstr = &str_yes;
337             if (cmd->ucmd.ccmd.cc_true) {
338 #ifdef DEBUGGING
339                 debname[dlevel] = 't';
340                 debdelim[dlevel++] = '_';
341 #endif
342                 retstr = cmd_exec(cmd->ucmd.ccmd.cc_true);
343             }
344         }
345         else {
346             retstr = &str_no;
347             if (cmd->ucmd.ccmd.cc_alt) {
348 #ifdef DEBUGGING
349                 debname[dlevel] = 'e';
350                 debdelim[dlevel++] = '_';
351 #endif
352                 retstr = cmd_exec(cmd->ucmd.ccmd.cc_alt);
353             }
354         }
355         curspat = oldspat;
356 #ifdef DEBUGGING
357         dlevel = olddlevel;
358 #endif
359         break;
360     case C_BLOCK:
361     case C_WHILE:
362         if (!(cmdflags & CF_ONCE)) {    /* first time through here? */
363             cmdflags |= CF_ONCE;
364             loop_ptr++;
365             loop_stack[loop_ptr].loop_label = cmd->c_label;
366 #ifdef DEBUGGING
367             if (debug & 4) {
368                 deb("(Pushing label #%d %s)\n",
369                   loop_ptr,cmd->c_label);
370             }
371 #endif
372         }
373         switch (setjmp(loop_stack[loop_ptr].loop_env)) {
374         case O_LAST:
375             retstr = &str_no;
376             curspat = oldspat;
377 #ifdef DEBUGGING
378             if (debug & 4) {
379                 deb("(Popping label #%d %s)\n",loop_ptr,
380                     loop_stack[loop_ptr].loop_label);
381             }
382 #endif
383             loop_ptr--;
384             cmd = cmd->c_next;
385             goto tail_recursion_entry;
386         case O_NEXT:
387             goto next_iter;
388         case O_REDO:
389 #ifdef DEBUGGING
390             dlevel = olddlevel;
391 #endif
392             goto doit;
393         }
394         oldspat = curspat;
395 #ifdef DEBUGGING
396         olddlevel = dlevel;
397 #endif
398     doit:
399         if (cmd->ucmd.ccmd.cc_true) {
400 #ifdef DEBUGGING
401             debname[dlevel] = 't';
402             debdelim[dlevel++] = '_';
403 #endif
404             cmd_exec(cmd->ucmd.ccmd.cc_true);
405         }
406         /* actually, this spot is never reached anymore since the above
407          * cmd_exec() returns through longjmp().  Hooray for structure.
408          */
409       next_iter:
410 #ifdef DEBUGGING
411         dlevel = olddlevel;
412 #endif
413         if (cmd->ucmd.ccmd.cc_alt) {
414 #ifdef DEBUGGING
415             debname[dlevel] = 'a';
416             debdelim[dlevel++] = '_';
417 #endif
418             cmd_exec(cmd->ucmd.ccmd.cc_alt);
419         }
420       finish_while:
421         curspat = oldspat;
422 #ifdef DEBUGGING
423         dlevel = olddlevel - 1;
424 #endif
425         if (cmd->c_type != C_BLOCK)
426             goto until_loop;    /* go back and evaluate conditional again */
427     }
428     if (cmdflags & CF_LOOP) {
429         cmdflags |= CF_COND;            /* now test the condition */
430         goto until_loop;
431     }
432     cmd = cmd->c_next;
433     goto tail_recursion_entry;
434 }
435
436 #ifdef DEBUGGING
437 /*VARARGS1*/
438 deb(pat,a1,a2,a3,a4,a5,a6,a7,a8)
439 char *pat;
440 {
441     register int i;
442
443     for (i=0; i<dlevel; i++)
444         fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
445     fprintf(stderr,pat,a1,a2,a3,a4,a5,a6,a7,a8);
446 }
447 #endif
448
449 copyopt(cmd,which)
450 register CMD *cmd;
451 register CMD *which;
452 {
453     cmd->c_flags &= CF_ONCE|CF_COND|CF_LOOP;
454     cmd->c_flags |= which->c_flags;
455     cmd->c_first = which->c_first;
456     cmd->c_flen = which->c_flen;
457     cmd->c_stab = which->c_stab;
458     return cmd->c_flags;
459 }