From: Gurusamy Sarathy Date: Tue, 26 May 1998 17:26:17 +0000 (+0000) Subject: [asperl] more changes to satisfy non-debug VC build (C-API doesn't X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=35ff78560a01016ce2a3dffe29f18ce851bc0b90;p=p5sagit%2Fp5-mst-13.2.git [asperl] more changes to satisfy non-debug VC build (C-API doesn't build, and the testsuite still won't run) p4raw-id: //depot/asperl@1035 --- diff --git a/ObjXSub.h b/ObjXSub.h index f525cad..43f360c 100644 --- a/ObjXSub.h +++ b/ObjXSub.h @@ -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 diff --git a/deb.c b/deb.c index fb9dfef..eb4e9f7 100644 --- a/deb.c +++ b/deb.c @@ -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\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("\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 b49fa42..c3bacb4 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 #ifdef I_DIRENT /* XXX maybe better to just rely on perl.h? */ diff --git a/globals.c b/globals.c index 320b8df..e3ca27e 100644 --- a/globals.c +++ b/globals.c @@ -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 */ diff --git a/proto.h b/proto.h index 75a2aaa..89dd593 100644 --- a/proto.h +++ b/proto.h @@ -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)); diff --git a/regcomp.c b/regcomp.c index 4afa40f..6815e13 100644 --- a/regcomp.c +++ b/regcomp.c @@ -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) diff --git a/run.c b/run.c index ac9752b..811e41a 100644 --- a/run.c +++ b/run.c @@ -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 */ - +} diff --git a/scope.c b/scope.c index 5b0cd78..99d87dd 100644 --- a/scope.c +++ b/scope.c @@ -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 +} diff --git a/sv.c b/sv.c index 390749d..fc2767f 100644 --- a/sv.c +++ b/sv.c @@ -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 - - - - diff --git a/util.c b/util.c index f58e51b..82aeca1 100644 --- a/util.c +++ b/util.c @@ -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 4988ab7..fe30933 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 <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*$/) {