diff options
| -rw-r--r-- | ObjXSub.h | 18 | ||||
| -rw-r--r-- | doio.c | 8 | ||||
| -rw-r--r-- | embedvar.h | 3 | ||||
| -rw-r--r-- | ext/POSIX/POSIX.xs | 8 | ||||
| -rw-r--r-- | interp.sym | 2 | ||||
| -rw-r--r-- | intrpvar.h | 1 | ||||
| -rw-r--r-- | objpp.h | 12 | ||||
| -rw-r--r-- | perl.c | 50 | ||||
| -rw-r--r-- | perl.h | 10 | ||||
| -rw-r--r-- | perlvars.h | 2 | ||||
| -rw-r--r-- | proto.h | 80 | ||||
| -rw-r--r-- | regcomp.c | 5 | ||||
| -rw-r--r-- | regexec.c | 2 | ||||
| -rw-r--r-- | toke.c | 2 |
14 files changed, 153 insertions, 50 deletions
@@ -151,10 +151,8 @@ #define dowarn pPerl->Perl_dowarn #undef dumplvl #define dumplvl pPerl->Perl_dumplvl -#undef e_fp -#define e_fp pPerl->Perl_e_fp -#undef e_tmpname -#define e_tmpname pPerl->Perl_e_tmpname +#undef e_script +#define e_script pPerl->Perl_e_script #undef egid #define egid pPerl->Perl_egid #undef endav @@ -607,6 +605,8 @@ #define sv_undef pPerl->Perl_sv_undef #undef sv_yes #define sv_yes pPerl->Perl_sv_yes +#undef sys_intern +#define sys_intern pPerl->Perl_sys_intern #undef tainted #define tainted pPerl->Perl_tainted #undef tainting @@ -838,6 +838,8 @@ #define dounwind pPerl->Perl_dounwind #undef do_aexec #define do_aexec pPerl->Perl_do_aexec +#undef do_binmode +#define do_binmode pPerl->Perl_do_binmode #undef do_chomp #define do_chomp pPerl->Perl_do_chomp #undef do_chop @@ -892,6 +894,8 @@ #define filter_read pPerl->Perl_filter_read #undef find_threadsv #define find_threadsv pPerl->Perl_find_threadsv +#undef find_script +#define find_script pPerl->Perl_find_script #undef force_ident #define force_ident pPerl->Perl_force_ident #undef force_list @@ -1078,14 +1082,20 @@ #define magic_getpack pPerl->Perl_magic_getpack #undef magic_getglob #define magic_getglob pPerl->Perl_magic_getglob +#undef magic_getnkeys +#define magic_getnkeys pPerl->Perl_magic_getnkeys #undef magic_getpos #define magic_getpos pPerl->Perl_magic_getpos #undef magic_getsig #define magic_getsig pPerl->Perl_magic_getsig +#undef magic_getsubstr +#define magic_getsubstr pPerl->Perl_magic_getsubstr #undef magic_gettaint #define magic_gettaint pPerl->Perl_magic_gettaint #undef magic_getuvar #define magic_getuvar pPerl->Perl_magic_getuvar +#undef magic_getvec +#define magic_getvec pPerl->Perl_magic_getvec #undef magic_len #define magic_len pPerl->Perl_magic_len #undef magic_methpack @@ -741,7 +741,7 @@ do_binmode(PerlIO *fp, int iotype, int flag) * document this anywhere). GSAR 97-5-24 */ PerlIO_seek(fp,0L,0); - fp->flags |= _F_BIN; + ((FILE*)fp)->flags |= _F_BIN; #endif return 1; } @@ -1085,7 +1085,9 @@ apply(I32 type, register SV **mark, register SV **sp) SV **oldmark = mark; #define APPLY_TAINT_PROPER() \ - if (!(tainting && tainted)) {} else { goto taint_proper; } + STMT_START { \ + if (tainting && tainted) { goto taint_proper_label; } \ + } STMT_END /* This is a first heuristic; it doesn't catch tainting magic. */ if (tainting) { @@ -1265,7 +1267,7 @@ apply(I32 type, register SV **mark, register SV **sp) } return tot; - taint_proper: + taint_proper_label: TAINT_PROPER(what); return 0; /* this should never happen */ diff --git a/embedvar.h b/embedvar.h index 2e52562fb9..cd4701d1e9 100644 --- a/embedvar.h +++ b/embedvar.h @@ -122,6 +122,7 @@ #define eval_start (curinterp->Ieval_start) #define exitlist (curinterp->Iexitlist) #define exitlistlen (curinterp->Iexitlistlen) +#define extralen (curinterp->Iextralen) #define fdpid (curinterp->Ifdpid) #define filemode (curinterp->Ifilemode) #define firstgv (curinterp->Ifirstgv) @@ -285,6 +286,7 @@ #define Ieval_start eval_start #define Iexitlist exitlist #define Iexitlistlen exitlistlen +#define Iextralen extralen #define Ifdpid fdpid #define Ifilemode filemode #define Ifirstgv firstgv @@ -510,6 +512,7 @@ #define eval_start Perl_eval_start #define exitlist Perl_exitlist #define exitlistlen Perl_exitlistlen +#define extralen Perl_extralen #define fdpid Perl_fdpid #define filemode Perl_filemode #define firstgv Perl_firstgv diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 1dba9a61f8..b49fa4281e 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -5,6 +5,12 @@ #define PERLIO_NOT_STDIO 1 #include "perl.h" #include "XSUB.h" +#ifdef PERL_OBJECT +# undef signal +# undef open +# undef TAINT_PROPER +# define TAINT_PROPER(a) /* XXX hack */ +#endif #include <ctype.h> #ifdef I_DIRENT /* XXX maybe better to just rely on perl.h? */ #include <dirent.h> @@ -99,7 +105,7 @@ #if defined (WIN32) # undef mkfifo /* #defined in perl.h */ # define mkfifo(a,b) not_here("mkfifo") -# define ttyname(a) not_here("ttyname") +# define ttyname(a) (char*)not_here("ttyname") # define sigset_t long # define pid_t long # ifdef __BORLANDC__ diff --git a/interp.sym b/interp.sym index de164d559a..7a53ab35cf 100644 --- a/interp.sym +++ b/interp.sym @@ -50,6 +50,7 @@ eval_root eval_start exitlist exitlistlen +extralen fdpid filemode firstgv @@ -94,6 +95,7 @@ minus_l minus_n minus_p modglobal +modcount multiline mystrk nrs diff --git a/intrpvar.h b/intrpvar.h index 03435ac07b..de2578ab6b 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -162,7 +162,6 @@ PERLVAR(Isys_intern, struct interp_intern) /* platform internals */ /* more statics moved here */ PERLVAR(Imh, HE) /* from hv.c */ -PERLVAR(Imodcount, I32) /* from op.c */ PERLVARI(Igeneration, int, 100) /* from op.c */ PERLVAR(IDBcv, CV *) /* from perl.c */ PERLVAR(Iarchpat_auto, char*) /* from perl.c */ @@ -249,6 +249,8 @@ #define do_aexec CPerlObj::Perl_do_aexec #undef do_aspawn #define do_aspawn CPerlObj::do_aspawn +#undef do_binmode +#define do_binmode CPerlObj::Perl_do_binmode #undef do_chop #define do_chop CPerlObj::Perl_do_chop #undef do_close @@ -347,6 +349,8 @@ #define filter_read CPerlObj::Perl_filter_read #undef find_beginning #define find_beginning CPerlObj::find_beginning +#undef find_script +#define find_script CPerlObj::Perl_find_script #undef forbid_setid #define forbid_setid CPerlObj::forbid_setid #undef force_ident @@ -571,14 +575,20 @@ #define magic_getpack CPerlObj::Perl_magic_getpack #undef magic_getglob #define magic_getglob CPerlObj::Perl_magic_getglob +#undef magic_getnkeys +#define magic_getnkeys CPerlObj::Perl_magic_getnkeys #undef magic_getpos #define magic_getpos CPerlObj::Perl_magic_getpos #undef magic_getsig #define magic_getsig CPerlObj::Perl_magic_getsig +#undef magic_getsubstr +#define magic_getsubstr CPerlObj::Perl_magic_getsubstr #undef magic_gettaint #define magic_gettaint CPerlObj::Perl_magic_gettaint #undef magic_getuvar #define magic_getuvar CPerlObj::Perl_magic_getuvar +#undef magic_getvec +#define magic_getvec CPerlObj::Perl_magic_getvec #undef magic_len #define magic_len CPerlObj::Perl_magic_len #undef magic_methcall @@ -1021,6 +1031,8 @@ #define regtail CPerlObj::regtail #undef regtry #define regtry CPerlObj::regtry +#undef regwhite +#define regwhite CPerlObj::regwhite #undef repeatcpy #define repeatcpy CPerlObj::Perl_repeatcpy #undef restore_expect @@ -69,7 +69,9 @@ dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n"; mess_sv = Nullsv; \ } STMT_END -#ifndef PERL_OBJECT +#ifdef PERL_OBJECT +static I32 read_e_script _((CPerlObj* pPerl, int idx, SV *buf_sv, int maxlen)); +#else static void find_beginning _((void)); static void forbid_setid _((char *)); static void incpush _((char *, int)); @@ -384,7 +386,7 @@ perl_destruct(register PerlInterpreter *sv_interp) /* call exit list functions */ while (exitlistlen-- > 0) - exitlist[exitlistlen].fn(exitlist[exitlistlen].ptr); + exitlist[exitlistlen].fn(THIS_ exitlist[exitlistlen].ptr); Safefree(exitlist); @@ -595,7 +597,11 @@ perl_free(PerlInterpreter *sv_interp) } void +#ifdef PERL_OBJECT +CPerlObj::perl_atexit(void (*fn) (CPerlObj*,void *), void *ptr) +#else perl_atexit(void (*fn) (void *), void *ptr) +#endif { Renew(exitlist, exitlistlen+1, PerlExitListEntry); exitlist[exitlistlen].fn = fn; @@ -2219,22 +2225,6 @@ find_beginning(void) } -STATIC I32 -read_e_script(int idx, SV *buf_sv, int maxlen) -{ - char *p, *nl; - FILTER_READ(idx+1, buf_sv, maxlen); - p = SvPVX(e_script); - nl = strchr(p, '\n'); - nl = (nl) ? nl+1 : SvEND(e_script); - if (nl-p == 0) - return 0; - sv_catpvn(buf_sv, p, nl-p); - sv_chop(e_script, nl); - return 1; -} - - STATIC void init_ids(void) { @@ -2876,3 +2866,27 @@ my_exit_jump(void) JMPENV_JUMP(2); } + + +#include "XSUB.h" + +static I32 +#ifdef PERL_OBJECT +read_e_script(CPerlObj *pPerl, int idx, SV *buf_sv, int maxlen) +#else +read_e_script(int idx, SV *buf_sv, int maxlen) +#endif +{ + char *p, *nl; + FILTER_READ(idx+1, buf_sv, maxlen); + p = SvPVX(e_script); + nl = strchr(p, '\n'); + nl = (nl) ? nl+1 : SvEND(e_script); + if (nl-p == 0) + return 0; + sv_catpvn(buf_sv, p, nl-p); + sv_chop(e_script, nl); + return 1; +} + + @@ -110,6 +110,7 @@ class CPerlObj; #define _CPERLarg ,CPERLarg #define THIS this #define _THIS ,this +#define THIS_ this, #define CALLRUNOPS (this->*runops) #else /* !PERL_OBJECT */ @@ -1076,7 +1077,12 @@ typedef union any ANY; #include "handy.h" +#ifdef PERL_OBJECT +typedef I32 (*filter_t) _((CPerlObj*, int, SV *, int)); +#else typedef I32 (*filter_t) _((int, SV *, int)); +#endif + #define FILTER_READ(idx, sv, len) filter_read(idx, sv, len) #define FILTER_DATA(idx) (AvARRAY(rsfp_filters)[idx]) #define FILTER_ISREADER(idx) (idx >= AvFILLp(rsfp_filters)) @@ -1838,7 +1844,11 @@ public: /* Interpreter exitlist entry */ typedef struct exitlistentry { +#ifdef PERL_OBJECT + void (*fn) _((CPerlObj*, void*)); +#else void (*fn) _((void*)); +#endif void *ptr; } PerlExitListEntry; diff --git a/perlvars.h b/perlvars.h index a141c352ec..9f801fb64d 100644 --- a/perlvars.h +++ b/perlvars.h @@ -60,7 +60,7 @@ PERLVAR(Gnice_chunk, char *) /* a nice chunk of memory to reuse */ PERLVAR(Gnice_chunk_size, U32) /* how nice the chunk of memory is */ #ifdef PERL_OBJECT -PERLVARI(Grunops, runops_proc_t, RUNOPS_DEFAULT) +PERLVARI(Grunops, runops_proc_t, FUNC_NAME_TO_PTR(RUNOPS_DEFAULT)) #else PERLVARI(Grunops, runops_proc_t *, RUNOPS_DEFAULT) #endif @@ -80,7 +80,12 @@ VIRTUAL CV* cv_clone _((CV* proto)); VIRTUAL SV* cv_const_sv _((CV* cv)); VIRTUAL void cv_undef _((CV* cv)); #ifdef DEBUGGING -void cx_dump _((PERL_CONTEXT* cs)); +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)); @@ -151,20 +156,25 @@ VIRTUAL void do_vop _((I32 optype, SV* sv, SV* left, SV* right)); VIRTUAL I32 dowantarray _((void)); VIRTUAL void dump_all _((void)); #ifdef DEBUGGING -void dump_eval _((void)); +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 */ -int dump_fds _((char* s)); +VIRTUAL int dump_fds _((char* s)); #endif -void dump_form _((GV* gv)); -void dump_gv _((GV* gv)); +VIRTUAL void dump_form _((GV* gv)); +VIRTUAL void dump_gv _((GV* gv)); #ifdef MYMALLOC -void dump_mstats _((char* s)); +VIRTUAL void dump_mstats _((char* s)); #endif -void dump_op _((OP* arg)); -void dump_pm _((PMOP* pm)); -void dump_packsubs _((HV* stash)); -void dump_sub _((GV* gv)); +VIRTUAL void dump_op _((OP* arg)); +VIRTUAL void dump_pm _((PMOP* pm)); +VIRTUAL void dump_packsubs _((HV* stash)); +VIRTUAL void dump_sub _((GV* gv)); VIRTUAL void fbm_compile _((SV* sv, U32 flags)); VIRTUAL char* fbm_instr _((unsigned char* big, unsigned char* bigend, SV* littlesv)); VIRTUAL char* find_script _((char *scriptname, bool dosearch, char **search_ext, I32 flags)); @@ -314,10 +324,10 @@ VIRTUAL void my_exit _((U32 status)) __attribute__((noreturn)); VIRTUAL void my_failure_exit _((void)) __attribute__((noreturn)); VIRTUAL I32 my_lstat _((ARGSproto)); #if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP) -I32 my_memcmp _((char* s1, char* s2, I32 len)); +VIRTUAL I32 my_memcmp _((char* s1, char* s2, I32 len)); #endif #if !defined(HAS_MEMSET) -void* my_memset _((char* loc, I32 ch, I32 len)); +VIRTUAL void* my_memset _((char* loc, I32 ch, I32 len)); #endif #ifndef PERL_OBJECT VIRTUAL I32 my_pclose _((PerlIO* ptr)); @@ -402,7 +412,11 @@ VIRTUAL void peep _((OP* o)); #ifndef PERL_OBJECT PerlInterpreter* perl_alloc _((void)); #endif -VIRTUAL void perl_atexit _((void(*fn)(void *), void*)); +#ifdef PERL_OBJECT +VIRTUAL void perl_atexit _((void(*fn)(CPerlObj *, void *), void*)); +#else +void perl_atexit _((void(*fn)(void *), void*)); +#endif VIRTUAL I32 perl_call_argv _((char* sub_name, I32 flags, char** argv)); VIRTUAL I32 perl_call_method _((char* methname, I32 flags)); VIRTUAL I32 perl_call_pv _((char* sub_name, I32 flags)); @@ -457,14 +471,24 @@ 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 -void regdump _((regexp* r)); +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 -void regprop _((SV* sv, regnode* o)); +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)); @@ -587,7 +611,12 @@ VIRTUAL SV* sv_mortalcopy _((SV* oldsv)); VIRTUAL SV* sv_newmortal _((void)); VIRTUAL SV* sv_newref _((SV* sv)); #ifdef DEBUGGING -char* sv_peek _((SV* sv)); +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)); @@ -635,7 +664,12 @@ 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 -void watch _((char** addr)); +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)); @@ -743,6 +777,11 @@ 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)); @@ -829,6 +868,7 @@ void reginsert _((U8, regnode *)); void regoptail _((regnode *, regnode *)); void regset _((char *, I32)); void regtail _((regnode *, regnode *)); +char* regwhite _((char *, char *)); char* nextchar _((void)); regnode *dumpuntil _((regnode *start, regnode *node, regnode *last, SV* sv, I32 l)); void scan_commit _((scan_data_t *data)); @@ -850,6 +890,12 @@ 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 *bset_obj_store _((void *obj, I32 ix)); @@ -102,7 +102,6 @@ * Forward declarations for pregcomp()'s friends. */ -static char* regwhite _((char *, char *)); #ifndef PERL_OBJECT static regnode *reg _((I32, I32 *)); static regnode *reganode _((U8, U32)); @@ -116,8 +115,8 @@ static regnode *regpiece _((I32 *)); static void reginsert _((U8, regnode *)); static void regoptail _((regnode *, regnode *)); static void regtail _((regnode *, regnode *)); +static char* regwhite _((char *, char *)); static char* nextchar _((void)); - static void re_croak2 _((const char* pat1,const char* pat2,...)) __attribute__((noreturn)); #endif @@ -1798,7 +1797,7 @@ tryagain: return(ret); } -static char * +STATIC char * regwhite(char *p, char *e) { while (p < e) { @@ -852,7 +852,7 @@ regmatch(regnode *prog) s = (char *) OPERAND(scan); if (nextchr < 0) nextchr = UCHARAT(locinput); - if (!REGINCLASS(s, nextchar)) + if (!REGINCLASS(s, nextchr)) sayNO; if (!nextchr && locinput >= regeol) sayNO; @@ -1347,7 +1347,7 @@ filter_read(int idx, SV *buf_sv, int maxlen) /* Call function. The function is expected to */ /* call "FILTER_READ(idx+1, buf_sv)" first. */ /* Return: <0:error, =0:eof, >0:not eof */ - return (*funcp)(idx, buf_sv, maxlen); + return (*funcp)(THIS_ idx, buf_sv, maxlen); } STATIC char * |