[10723] | 1 | /* run.c |
---|
| 2 | * |
---|
[14544] | 3 | * Copyright (c) 1991-2000, Larry Wall |
---|
[10723] | 4 | * |
---|
| 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. |
---|
| 7 | * |
---|
| 8 | */ |
---|
| 9 | |
---|
| 10 | #include "EXTERN.h" |
---|
[14544] | 11 | #define PERL_IN_RUN_C |
---|
[10723] | 12 | #include "perl.h" |
---|
| 13 | |
---|
| 14 | /* |
---|
| 15 | * "Away now, Shadowfax! Run, greatheart, run as you have never run before! |
---|
| 16 | * Now we are come to the lands where you were foaled, and every stone you |
---|
| 17 | * know. Run now! Hope is in speed!" --Gandalf |
---|
| 18 | */ |
---|
| 19 | |
---|
| 20 | int |
---|
[14544] | 21 | Perl_runops_standard(pTHX) |
---|
| 22 | { |
---|
| 23 | dTHR; |
---|
[10723] | 24 | |
---|
[14544] | 25 | while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))) { |
---|
| 26 | PERL_ASYNC_CHECK(); |
---|
| 27 | } |
---|
[10723] | 28 | |
---|
| 29 | TAINT_NOT; |
---|
| 30 | return 0; |
---|
| 31 | } |
---|
| 32 | |
---|
| 33 | int |
---|
[14544] | 34 | Perl_runops_debug(pTHX) |
---|
| 35 | { |
---|
| 36 | #ifdef DEBUGGING |
---|
| 37 | dTHR; |
---|
| 38 | if (!PL_op) { |
---|
| 39 | if (ckWARN_d(WARN_DEBUGGING)) |
---|
| 40 | Perl_warner(aTHX_ WARN_DEBUGGING, "NULL OP IN RUN"); |
---|
[10723] | 41 | return 0; |
---|
| 42 | } |
---|
| 43 | |
---|
| 44 | do { |
---|
[14544] | 45 | PERL_ASYNC_CHECK(); |
---|
| 46 | if (PL_debug) { |
---|
| 47 | if (PL_watchaddr != 0 && *PL_watchaddr != PL_watchok) |
---|
| 48 | PerlIO_printf(Perl_debug_log, |
---|
| 49 | "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n", |
---|
| 50 | PTR2UV(PL_watchaddr), PTR2UV(PL_watchok), |
---|
| 51 | PTR2UV(*PL_watchaddr)); |
---|
[10723] | 52 | DEBUG_s(debstack()); |
---|
[14544] | 53 | DEBUG_t(debop(PL_op)); |
---|
| 54 | DEBUG_P(debprof(PL_op)); |
---|
[10723] | 55 | } |
---|
[14544] | 56 | } while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))); |
---|
[10723] | 57 | |
---|
| 58 | TAINT_NOT; |
---|
| 59 | return 0; |
---|
[14544] | 60 | #else |
---|
| 61 | return runops_standard(); |
---|
| 62 | #endif /* DEBUGGING */ |
---|
[10723] | 63 | } |
---|
| 64 | |
---|
| 65 | I32 |
---|
[14544] | 66 | Perl_debop(pTHX_ OP *o) |
---|
[10723] | 67 | { |
---|
[14544] | 68 | #ifdef DEBUGGING |
---|
[10723] | 69 | SV *sv; |
---|
[14544] | 70 | STRLEN n_a; |
---|
| 71 | Perl_deb(aTHX_ "%s", PL_op_name[o->op_type]); |
---|
| 72 | switch (o->op_type) { |
---|
[10723] | 73 | case OP_CONST: |
---|
[14544] | 74 | PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv)); |
---|
[10723] | 75 | break; |
---|
| 76 | case OP_GVSV: |
---|
| 77 | case OP_GV: |
---|
[14544] | 78 | if (cGVOPo_gv) { |
---|
[10723] | 79 | sv = NEWSV(0,0); |
---|
[14544] | 80 | gv_fullname3(sv, cGVOPo_gv, Nullch); |
---|
| 81 | PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, n_a)); |
---|
[10723] | 82 | SvREFCNT_dec(sv); |
---|
| 83 | } |
---|
| 84 | else |
---|
| 85 | PerlIO_printf(Perl_debug_log, "(NULL)"); |
---|
| 86 | break; |
---|
| 87 | default: |
---|
| 88 | break; |
---|
| 89 | } |
---|
| 90 | PerlIO_printf(Perl_debug_log, "\n"); |
---|
[14544] | 91 | #endif /* DEBUGGING */ |
---|
[10723] | 92 | return 0; |
---|
| 93 | } |
---|
| 94 | |
---|
| 95 | void |
---|
[14544] | 96 | Perl_watch(pTHX_ char **addr) |
---|
[10723] | 97 | { |
---|
[14544] | 98 | #ifdef DEBUGGING |
---|
| 99 | dTHR; |
---|
| 100 | PL_watchaddr = addr; |
---|
| 101 | PL_watchok = *addr; |
---|
| 102 | PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n", |
---|
| 103 | PTR2UV(PL_watchaddr), PTR2UV(PL_watchok)); |
---|
| 104 | #endif /* DEBUGGING */ |
---|
[10723] | 105 | } |
---|
| 106 | |
---|
[14544] | 107 | STATIC void |
---|
| 108 | S_debprof(pTHX_ OP *o) |
---|
[10723] | 109 | { |
---|
[14544] | 110 | #ifdef DEBUGGING |
---|
| 111 | if (!PL_profiledata) |
---|
| 112 | Newz(000, PL_profiledata, MAXO, U32); |
---|
| 113 | ++PL_profiledata[o->op_type]; |
---|
| 114 | #endif /* DEBUGGING */ |
---|
[10723] | 115 | } |
---|
| 116 | |
---|
| 117 | void |
---|
[14544] | 118 | Perl_debprofdump(pTHX) |
---|
[10723] | 119 | { |
---|
[14544] | 120 | #ifdef DEBUGGING |
---|
[10723] | 121 | unsigned i; |
---|
[14544] | 122 | if (!PL_profiledata) |
---|
[10723] | 123 | return; |
---|
| 124 | for (i = 0; i < MAXO; i++) { |
---|
[14544] | 125 | if (PL_profiledata[i]) |
---|
[10723] | 126 | PerlIO_printf(Perl_debug_log, |
---|
[14544] | 127 | "%5lu %s\n", (unsigned long)PL_profiledata[i], |
---|
| 128 | PL_op_name[i]); |
---|
[10723] | 129 | } |
---|
[14544] | 130 | #endif /* DEBUGGING */ |
---|
[10723] | 131 | } |
---|