diff options
| -rw-r--r-- | ObjXSub.h | 36 | ||||
| -rw-r--r-- | deb.c | 14 | ||||
| -rw-r--r-- | dump.c | 29 | ||||
| -rw-r--r-- | ext/POSIX/POSIX.xs | 5 | ||||
| -rw-r--r-- | globals.c | 10 | ||||
| -rw-r--r-- | proto.h | 73 | ||||
| -rw-r--r-- | regcomp.c | 8 | ||||
| -rw-r--r-- | run.c | 20 | ||||
| -rw-r--r-- | scope.c | 5 | ||||
| -rw-r--r-- | sv.c | 19 | ||||
| -rw-r--r-- | util.c | 6 | ||||
| -rw-r--r-- | win32/GenCAPI.pl | 17 |
12 files changed, 118 insertions, 124 deletions
@@ -820,10 +820,22 @@ #define cv_const_sv pPerl->Perl_cv_const_sv #undef cv_undef #define cv_undef pPerl->Perl_cv_undef +#undef cx_dump +#define cx_dump pPerl->Perl_cx_dump #undef cxinc #define cxinc pPerl->Perl_cxinc #undef deb #define deb pPerl->Perl_deb +#undef deb_growlevel +#define deb_growlevel pPerl->Perl_deb_growlevel +#undef debprofdump +#define debprofdump pPerl->Perl_debprofdump +#undef debop +#define debop pPerl->Perl_debop +#undef debstack +#define debstack pPerl->Perl_debstack +#undef debstackptrs +#define debstackptrs pPerl->Perl_debstackptrs #undef delimcpy #define delimcpy pPerl->Perl_delimcpy #undef deprecate @@ -882,6 +894,22 @@ #define dowantarray pPerl->Perl_dowantarray #undef dump_all #define dump_all pPerl->Perl_dump_all +#undef dump_eval +#define dump_eval pPerl->Perl_dump_eval +#undef dump_form +#define dump_form pPerl->Perl_dump_form +#undef dump_gv +#define dump_gv pPerl->Perl_dump_gv +#undef dump_mstats +#define dump_mstats pPerl->Perl_dump_mstats +#undef dump_op +#define dump_op pPerl->Perl_dump_op +#undef dump_pm +#define dump_pm pPerl->Perl_dump_pm +#undef dump_packsubs +#define dump_packsubs pPerl->Perl_dump_packsubs +#undef dump_sub +#define dump_sub pPerl->Perl_dump_sub #undef fbm_compile #define fbm_compile pPerl->Perl_fbm_compile #undef fbm_instr @@ -1447,10 +1475,14 @@ #define pregexec pPerl->Perl_pregexec #undef pregfree #define pregfree pPerl->Perl_pregfree +#undef regdump +#define regdump pPerl->Perl_regdump #undef regnext #define regnext pPerl->Perl_regnext #undef regnoderegnext #define regnoderegnext pPerl->regnoderegnext +#undef regprop +#define regprop pPerl->Perl_regprop #undef repeatcpy #define repeatcpy pPerl->Perl_repeatcpy #undef rninstr @@ -1693,6 +1725,8 @@ #define sv_newref pPerl->Perl_sv_newref #undef sv_nv #define sv_nv pPerl->Perl_sv_nv +#undef sv_peek +#define sv_peek pPerl->Perl_sv_peek #undef sv_pvn #define sv_pvn pPerl->Perl_sv_pvn #undef sv_pvn_force @@ -1779,6 +1813,8 @@ #define wait4pid pPerl->Perl_wait4pid #undef warn #define warn pPerl->Perl_warn +#undef watch +#define watch pPerl->Perl_watch #undef whichsig #define whichsig pPerl->Perl_whichsig #undef yyerror @@ -15,7 +15,6 @@ #include "EXTERN.h" #include "perl.h" -#ifdef DEBUGGING #if !defined(I_STDARG) && !defined(I_VARARGS) /* @@ -27,6 +26,7 @@ void deb(pat,a1,a2,a3,a4,a5,a6,a7,a8) char *pat; { +#ifdef DEBUGGING dTHR; register I32 i; GV* gv = curcop->cop_filegv; @@ -44,6 +44,7 @@ deb(pat,a1,a2,a3,a4,a5,a6,a7,a8) for (i=0; i<dlevel; i++) PerlIO_printf(Perl_debug_log, "%c%c ",debname[i],debdelim[i]); PerlIO_printf(Perl_debug_log, pat,a1,a2,a3,a4,a5,a6,a7,a8); +#endif /* DEBUGGING */ } #else /* !defined(I_STDARG) && !defined(I_VARARGS) */ @@ -59,6 +60,7 @@ deb(pat, va_alist) va_dcl # endif { +#ifdef DEBUGGING dTHR; va_list args; register I32 i; @@ -84,20 +86,24 @@ deb(pat, va_alist) # endif (void) PerlIO_vprintf(Perl_debug_log,pat,args); va_end( args ); +#endif /* DEBUGGING */ } #endif /* !defined(I_STDARG) && !defined(I_VARARGS) */ void deb_growlevel(void) { +#ifdef DEBUGGING dlmax += 128; Renew(debname, dlmax, char); Renew(debdelim, dlmax, char); +#endif /* DEBUGGING */ } I32 debstackptrs(void) { +#ifdef DEBUGGING dTHR; PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n", (unsigned long)curstack, (unsigned long)stack_base, @@ -106,12 +112,14 @@ debstackptrs(void) PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n", (unsigned long)mainstack, (unsigned long)AvARRAY(curstack), (long)mainstack, (long)AvFILLp(curstack), (long)AvMAX(curstack)); +#endif /* DEBUGGING */ return 0; } I32 debstack(void) { +#ifdef DEBUGGING dTHR; I32 top = stack_sp - stack_base; register I32 i = top - 30; @@ -148,8 +156,6 @@ debstack(void) } while (1); PerlIO_printf(Perl_debug_log, "\n"); +#endif /* DEBUGGING */ return 0; } -#else -static int dummy; /* avoid totally empty deb.o file */ -#endif /* DEBUGGING */ @@ -15,13 +15,6 @@ #include "EXTERN.h" #include "perl.h" -#ifndef DEBUGGING -void -dump_all(void) -{ -} -#else /* Rest of file is for DEBUGGING */ - #ifndef PERL_OBJECT #ifdef I_STDARG static void dump(char *pat, ...); @@ -33,16 +26,19 @@ static void dump(); void dump_all(void) { +#ifdef DEBUGGING dTHR; PerlIO_setlinebuf(Perl_debug_log); if (main_root) dump_op(main_root); dump_packsubs(defstash); +#endif /* DEBUGGING */ } void dump_packsubs(HV *stash) { +#ifdef DEBUGGING dTHR; I32 i; HE *entry; @@ -62,11 +58,13 @@ dump_packsubs(HV *stash) dump_packsubs(hv); /* nested package */ } } +#endif /* DEBUGGING */ } void dump_sub(GV *gv) { +#ifdef DEBUGGING SV *sv = sv_newmortal(); gv_fullname3(sv, gv, Nullch); @@ -79,11 +77,13 @@ dump_sub(GV *gv) dump_op(CvROOT(GvCV(gv))); else dump("<undef>\n"); +#endif /* DEBUGGING */ } void dump_form(GV *gv) { +#ifdef DEBUGGING SV *sv = sv_newmortal(); gv_fullname3(sv, gv, Nullch); @@ -92,17 +92,21 @@ dump_form(GV *gv) dump_op(CvROOT(GvFORM(gv))); else dump("<undef>\n"); +#endif /* DEBUGGING */ } void dump_eval(void) { +#ifdef DEBUGGING dump_op(eval_root); +#endif /* DEBUGGING */ } void dump_op(OP *o) { +#ifdef DEBUGGING dump("{\n"); if (o->op_seq) PerlIO_printf(Perl_debug_log, "%-4d", o->op_seq); @@ -311,11 +315,13 @@ dump_op(OP *o) } dumplvl--; dump("}\n"); +#endif /* DEBUGGING */ } void dump_gv(GV *gv) { +#ifdef DEBUGGING SV *sv; if (!gv) { @@ -334,11 +340,13 @@ dump_gv(GV *gv) dump("\n"); dumplvl--; dump("}\n"); +#endif /* DEBUGGING */ } void dump_pm(PMOP *pm) { +#ifdef DEBUGGING char ch; if (!pm) { @@ -393,6 +401,7 @@ dump_pm(PMOP *pm) dumplvl--; dump("}\n"); +#endif /* DEBUGGING */ } @@ -402,11 +411,13 @@ static void dump(arg1,arg2,arg3,arg4,arg5) char *arg1; long arg2, arg3, arg4, arg5; { +#ifdef DEBUGGING I32 i; for (i = dumplvl*4; i; i--) (void)PerlIO_putc(Perl_debug_log,' '); PerlIO_printf(Perl_debug_log, arg1, arg2, arg3, arg4, arg5); +#endif /* DEBUGGING */ } #else @@ -422,6 +433,7 @@ dump(pat,va_alist) va_dcl #endif { +#ifdef DEBUGGING I32 i; va_list args; @@ -434,7 +446,6 @@ dump(pat,va_alist) (void)PerlIO_putc(Perl_debug_log,' '); PerlIO_vprintf(Perl_debug_log,pat,args); va_end(args); +#endif /* DEBUGGING */ } #endif - -#endif diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index b49fa4281e..c3bacb4e29 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -5,11 +5,12 @@ #define PERLIO_NOT_STDIO 1 #include "perl.h" #include "XSUB.h" -#ifdef PERL_OBJECT +#ifdef PERL_OBJECT /* XXX _very_ temporary hacks */ # undef signal # undef open +# define open PerlLIO_open3 # undef TAINT_PROPER -# define TAINT_PROPER(a) /* XXX hack */ +# define TAINT_PROPER(a) #endif #include <ctype.h> #ifdef I_DIRENT /* XXX maybe better to just rely on perl.h? */ @@ -1464,14 +1464,4 @@ do_aspawn(void *vreally, void **vmark, void **vsp) } #endif /* WIN32 */ -#ifndef DEBUGGING -/* create a matching set of virtual entries for the non debugging version */ -void CPerlObj::deb_place_holder _((const char* pat,...)) {}; -void CPerlObj::deb_growlevel_place_holder _((void)) {}; -void CPerlObj::debprofdump_place_holder _((void)) {}; -I32 CPerlObj::debop_place_holder _((OP* o)) { return 0; }; -I32 CPerlObj::debstack_place_holder _((void)) { return 0; }; -I32 CPerlObj::debstackptrs_place_holder _((void)) { return 0; }; -#endif - #endif /* PERL_OBJECT */ @@ -79,14 +79,7 @@ VIRTUAL void cv_ckproto _((CV* cv, GV* gv, char* p)); VIRTUAL CV* cv_clone _((CV* proto)); VIRTUAL SV* cv_const_sv _((CV* cv)); VIRTUAL void cv_undef _((CV* cv)); -#ifdef DEBUGGING VIRTUAL void cx_dump _((PERL_CONTEXT* cs)); -#else -#ifdef PERL_OBJECT -/* create a matching set of virtual entries for the non debugging version */ -VIRTUAL void cx_dump_place_holder _((PERL_CONTEXT* cs)); -#endif -#endif VIRTUAL SV* filter_add _((filter_t funcp, SV* datasv)); VIRTUAL void filter_del _((filter_t funcp)); VIRTUAL I32 filter_read _((int idx, SV* buffer, int maxlen)); @@ -95,24 +88,12 @@ VIRTUAL char ** get_op_names _((void)); VIRTUAL char * get_no_modify _((void)); VIRTUAL U32 * get_opargs _((void)); VIRTUAL I32 cxinc _((void)); -#ifdef DEBUGGING VIRTUAL void deb _((const char* pat,...)) __attribute__((format(printf,1,2))); VIRTUAL void deb_growlevel _((void)); VIRTUAL void debprofdump _((void)); VIRTUAL I32 debop _((OP* o)); VIRTUAL I32 debstack _((void)); VIRTUAL I32 debstackptrs _((void)); -#else -#ifdef PERL_OBJECT -/* create a matching set of virtual entries for the non debugging version */ -VIRTUAL void deb_place_holder _((const char* pat,...)); -VIRTUAL void deb_growlevel_place_holder _((void)); -VIRTUAL void debprofdump_place_holder _((void)); -VIRTUAL I32 debop_place_holder _((OP* o)); -VIRTUAL I32 debstack_place_holder _((void)); -VIRTUAL I32 debstackptrs_place_holder _((void)); -#endif -#endif VIRTUAL char* delimcpy _((char* to, char* toend, char* from, char* fromend, int delim, I32* retlen)); VIRTUAL void deprecate _((char* s)); @@ -155,16 +136,9 @@ VIRTUAL void do_vecset _((SV* sv)); VIRTUAL void do_vop _((I32 optype, SV* sv, SV* left, SV* right)); VIRTUAL I32 dowantarray _((void)); VIRTUAL void dump_all _((void)); -#ifdef DEBUGGING VIRTUAL void dump_eval _((void)); -#else -#ifdef PERL_OBJECT -/* create a matching set of virtual entries for the non debugging version */ -VIRTUAL void dump_eval_place_holder _((void)); -#endif -#endif #ifdef DUMP_FDS /* See util.c */ -VIRTUAL int dump_fds _((char* s)); +VIRTUAL void dump_fds _((char* s)); #endif VIRTUAL void dump_form _((GV* gv)); VIRTUAL void dump_gv _((GV* gv)); @@ -413,7 +387,7 @@ VIRTUAL void peep _((OP* o)); PerlInterpreter* perl_alloc _((void)); #endif #ifdef PERL_OBJECT -VIRTUAL void perl_atexit _((void(*fn)(CPerlObj *, void *), void*)); +VIRTUAL void perl_atexit _((void(*fn)(CPerlObj *, void *), void* ptr)); #else void perl_atexit _((void(*fn)(void *), void*)); #endif @@ -470,26 +444,12 @@ VIRTUAL void push_scope _((void)); VIRTUAL regexp* pregcomp _((char* exp, char* xend, PMOP* pm)); VIRTUAL OP* ref _((OP* o, I32 type)); VIRTUAL OP* refkids _((OP* o, I32 type)); -#ifdef DEBUGGING VIRTUAL void regdump _((regexp* r)); -#else -#ifdef PERL_OBJECT -/* create a matching set of virtual entries for the non debugging version */ -VIRTUAL void regdump_place_holder _((regexp* r)); -#endif -#endif VIRTUAL I32 pregexec _((regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, U32 nosave)); VIRTUAL I32 regexec_flags _((regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, void* data, U32 flags)); VIRTUAL void pregfree _((struct regexp* r)); VIRTUAL regnode* regnext _((regnode* p)); -#ifdef DEBUGGING VIRTUAL void regprop _((SV* sv, regnode* o)); -#else -#ifdef PERL_OBJECT -/* create a matching set of virtual entries for the non debugging version */ -VIRTUAL void regprop_place_holder _((SV* sv, regnode* o)); -#endif -#endif VIRTUAL void repeatcpy _((char* to, char* from, I32 len, I32 count)); VIRTUAL char* rninstr _((char* big, char* bigend, char* little, char* lend)); VIRTUAL Sighandler_t rsignal _((int i, Sighandler_t t)); @@ -610,14 +570,7 @@ VIRTUAL void sv_magic _((SV* sv, SV* obj, int how, char* name, I32 namlen)); VIRTUAL SV* sv_mortalcopy _((SV* oldsv)); VIRTUAL SV* sv_newmortal _((void)); VIRTUAL SV* sv_newref _((SV* sv)); -#ifdef DEBUGGING VIRTUAL char* sv_peek _((SV* sv)); -#else -#ifdef PERL_OBJECT -/* create a matching set of virtual entries for the non debugging version */ -VIRTUAL char* sv_peek_place_holder _((SV* sv)); -#endif -#endif VIRTUAL char* sv_pvn_force _((SV* sv, STRLEN* lp)); VIRTUAL char* sv_reftype _((SV* sv, int ob)); VIRTUAL void sv_replace _((SV* sv, SV* nsv)); @@ -663,14 +616,7 @@ VIRTUAL void vivify_defelem _((SV* sv)); VIRTUAL void vivify_ref _((SV* sv, U32 to_what)); VIRTUAL I32 wait4pid _((int pid, int* statusp, int flags)); VIRTUAL void warn _((const char* pat,...)); -#ifdef DEBUGGING VIRTUAL void watch _((char** addr)); -#else -#ifdef PERL_OBJECT -/* create a matching set of virtual entries for the non debugging version */ -VIRTUAL void watch_place_holder _((char** addr)); -#endif -#endif VIRTUAL I32 whichsig _((char* sig)); VIRTUAL int yyerror _((char* s)); VIRTUAL int yylex _((void)); @@ -775,14 +721,7 @@ SV *is_an_int _((char *s, STRLEN l)); int div128 _((SV *pnum, bool *done)); int runops_standard _((void)); -#ifdef DEBUGGING int runops_debug _((void)); -#else -#ifdef PERL_OBJECT -/* create a matching set of virtual entries for the non debugging version */ -int runops_debug_place_holder _((void)); -#endif -#endif void check_uni _((void)); void force_next _((I32 type)); char *force_version _((char *start)); @@ -889,14 +828,8 @@ int do_aspawn _((void *vreally, void **vmark, void **vsp)); #ifdef DEBUGGING void del_sv _((SV *p)); -void debprof _((OP *o)); -#else -#ifdef PERL_OBJECT -/* create a matching set of virtual entries for the non debugging version */ -void del_sv_place_holder _((SV *p)); -void debprof_place_holder _((OP *o)); -#endif #endif +void debprof _((OP *o)); void *bset_obj_store _((void *obj, I32 ix)); OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp)); @@ -2231,11 +2231,11 @@ regcurly(register char *s) return TRUE; } -#ifdef DEBUGGING STATIC regnode * dumpuntil(regnode *start, regnode *node, regnode *last, SV* sv, I32 l) { +#ifdef DEBUGGING register char op = EXACT; /* Arbitrary non-END op. */ register regnode *next, *onode; @@ -2292,6 +2292,7 @@ dumpuntil(regnode *start, regnode *node, regnode *last, SV* sv, I32 l) else if (op == WHILEM) l--; } +#endif /* DEBUGGING */ return node; } @@ -2301,6 +2302,7 @@ dumpuntil(regnode *start, regnode *node, regnode *last, SV* sv, I32 l) void regdump(regexp *r) { +#ifdef DEBUGGING SV *sv = sv_newmortal(); (void)dumpuntil(r->program, r->program + 1, NULL, sv, 0); @@ -2353,6 +2355,7 @@ regdump(regexp *r) PerlIO_printf(Perl_debug_log, "implicit "); PerlIO_printf(Perl_debug_log, "minlen %ld ", (long) r->minlen); PerlIO_printf(Perl_debug_log, "\n"); +#endif /* DEBUGGING */ } /* @@ -2361,6 +2364,7 @@ regdump(regexp *r) void regprop(SV *sv, regnode *o) { +#ifdef DEBUGGING register char *p = 0; sv_setpv(sv, ":"); @@ -2558,8 +2562,8 @@ regprop(SV *sv, regnode *o) } if (p) sv_catpv(sv, p); -} #endif /* DEBUGGING */ +} void pregfree(struct regexp *r) @@ -32,8 +32,6 @@ runops_standard(void) { return 0; } -#ifdef DEBUGGING - dEXT char **watchaddr = 0; dEXT char *watchok; @@ -42,7 +40,9 @@ static void debprof _((OP*o)); #endif int -runops_debug(void) { +runops_debug(void) +{ +#ifdef DEBUGGING dTHR; if (!op) { warn("NULL OP IN RUN"); @@ -62,11 +62,15 @@ runops_debug(void) { TAINT_NOT; return 0; +#else + return runops_standard(); +#endif /* DEBUGGING */ } I32 debop(OP *o) { +#ifdef DEBUGGING SV *sv; deb("%s", op_name[o->op_type]); switch (o->op_type) { @@ -88,29 +92,35 @@ debop(OP *o) break; } PerlIO_printf(Perl_debug_log, "\n"); +#endif /* DEBUGGING */ return 0; } void watch(char **addr) { +#ifdef DEBUGGING watchaddr = addr; watchok = *addr; PerlIO_printf(Perl_debug_log, "WATCHING, %lx is currently %lx\n", (long)watchaddr, (long)watchok); +#endif /* DEBUGGING */ } STATIC void debprof(OP *o) { +#ifdef DEBUGGING if (!profiledata) New(000, profiledata, MAXO, U32); ++profiledata[o->op_type]; +#endif /* DEBUGGING */ } void debprofdump(void) { +#ifdef DEBUGGING unsigned i; if (!profiledata) return; @@ -119,7 +129,5 @@ debprofdump(void) PerlIO_printf(Perl_debug_log, "%u\t%lu\n", i, (unsigned long)profiledata[i]); } -} - #endif /* DEBUGGING */ - +} @@ -807,11 +807,10 @@ leave_scope(I32 base) } } -#ifdef DEBUGGING - void cx_dump(PERL_CONTEXT *cx) { +#ifdef DEBUGGING dTHR; PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), block_type[cx->cx_type]); if (cx->cx_type != CXt_SUBST) { @@ -900,5 +899,5 @@ cx_dump(PERL_CONTEXT *cx) (long)cx->sb_rxres); break; } -} #endif +} @@ -919,10 +919,10 @@ sv_upgrade(register SV *sv, U32 mt) return TRUE; } -#ifdef DEBUGGING char * sv_peek(SV *sv) { +#ifdef DEBUGGING SV *t = sv_newmortal(); STRLEN prevlen; int unref = 0; @@ -1064,8 +1064,10 @@ sv_peek(SV *sv) sv_catpv(t, ")"); } return SvPV(t, na); +#else /* DEBUGGING */ + return ""; +#endif /* DEBUGGING */ } -#endif int sv_backoff(register SV *sv) @@ -4820,10 +4822,10 @@ sv_vcatpvfn(SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, } } -#ifdef DEBUGGING void sv_dump(SV *sv) { +#ifdef DEBUGGING SV *d = sv_newmortal(); char *s; U32 flags; @@ -5087,14 +5089,5 @@ sv_dump(SV *sv) PerlIO_printf(Perl_debug_log, " FLAGS = 0x%lx\n", (long)IoFLAGS(sv)); break; } +#endif /* DEBUGGING */ } -#else -void -sv_dump(SV *sv) -{ -} -#endif - - - - @@ -1935,8 +1935,8 @@ char *mode; #endif /* !DOSISH */ #ifdef DUMP_FDS -dump_fds(s) -char *s; +void +dump_fds(char *s) { int fd; struct stat tmpstatbuf; @@ -1948,7 +1948,7 @@ char *s; } PerlIO_printf(PerlIO_stderr(),"\n"); } -#endif +#endif /* DUMP_FDS */ #ifndef HAS_DUP2 int diff --git a/win32/GenCAPI.pl b/win32/GenCAPI.pl index 4988ab7e93..fe3093308b 100644 --- a/win32/GenCAPI.pl +++ b/win32/GenCAPI.pl @@ -284,6 +284,20 @@ ENDCODE print OUTFILE "#endif\n" unless ($separateObj == 0); next; } + # handle special case for perl_atexit + if ($name eq "perl_atexit") { + print OUTFILE <<ENDCODE; + +#undef $name +extern "C" $type $name ($args) +{ + return pPerl->perl_atexit(fn, ptr); +} +ENDCODE + print OUTFILE "#endif\n" unless ($separateObj == 0); + next; + } + if($name eq "byterun" and $args eq "struct bytestream bs") { next; @@ -310,9 +324,8 @@ ENDCODE #undef $name extern "C" $type $funcName ($args) { -$return pPerl->$funcName ENDCODE - + print OUTFILE "$return pPerl->$funcName"; $doneone = 0; foreach $arg (@args) { if ($arg =~ /(\w+)\W*$/) { |