This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 5.0 alpha 4
[perl5.git] / run.c
1 #include "EXTERN.h"
2 #include "perl.h"
3
4 char **watchaddr = 0;
5 char *watchok;
6
7 #ifndef DEBUGGING
8
9 run() {
10     while ( op = (*op->op_ppaddr)() ) ;
11 }
12
13 #else
14
15 run() {
16     if (!op) {
17         warn("NULL OP IN RUN");
18         return;
19     }
20     do {
21         if (debug) {
22             if (watchaddr != 0 && *watchaddr != watchok)
23                 fprintf(stderr, "WARNING: %lx changed from %lx to %lx\n",
24                     watchaddr, watchok, *watchaddr);
25             DEBUG_s(debstack());
26             DEBUG_t(debop(op));
27         }
28     } while ( op = (*op->op_ppaddr)() );
29 }
30
31 #endif
32
33 I32
34 getgimme(op)
35 OP *op;
36 {
37     return cxstack[cxstack_ix].blk_gimme;
38 }
39
40 I32
41 debop(op)
42 OP *op;
43 {
44     SV *sv;
45     deb("%s", op_name[op->op_type]);
46     switch (op->op_type) {
47     case OP_CONST:
48         fprintf(stderr, "(%s)", SvPEEK(cSVOP->op_sv));
49         break;
50     case OP_GVSV:
51     case OP_GV:
52         if (cGVOP->op_gv) {
53             sv = NEWSV(0,0);
54             gv_fullname(sv, cGVOP->op_gv);
55             fprintf(stderr, "(%s)", SvPV(sv, na));
56             sv_free(sv);
57         }
58         else
59             fprintf(stderr, "(NULL)");
60         break;
61     }
62     fprintf(stderr, "\n");
63     return 0;
64 }
65
66 void
67 watch(addr)
68 char **addr;
69 {
70     watchaddr = addr;
71     watchok = *addr;
72     fprintf(stderr, "WATCHING, %lx is currently %lx\n",
73         watchaddr, watchok);
74 }