#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
#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
#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
#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
#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
* document this anywhere). GSAR 97-5-24
*/
PerlIO_seek(fp,0L,0);
- fp->flags |= _F_BIN;
+ ((FILE*)fp)->flags |= _F_BIN;
#endif
return 1;
}
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) {
}
return tot;
- taint_proper:
+ taint_proper_label:
TAINT_PROPER(what);
return 0; /* this should never happen */
#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)
#define Ieval_start eval_start
#define Iexitlist exitlist
#define Iexitlistlen exitlistlen
+#define Iextralen extralen
#define Ifdpid fdpid
#define Ifilemode filemode
#define Ifirstgv firstgv
#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
#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>
#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__
eval_start
exitlist
exitlistlen
+extralen
fdpid
filemode
firstgv
minus_n
minus_p
modglobal
+modcount
multiline
mystrk
nrs
/* 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 */
#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
#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
#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
#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
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));
/* call exit list functions */
while (exitlistlen-- > 0)
- exitlist[exitlistlen].fn(exitlist[exitlistlen].ptr);
+ exitlist[exitlistlen].fn(THIS_ exitlist[exitlistlen].ptr);
Safefree(exitlist);
}
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;
}
-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)
{
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;
+}
+
+
#define _CPERLarg ,CPERLarg
#define THIS this
#define _THIS ,this
+#define THIS_ this,
#define CALLRUNOPS (this->*runops)
#else /* !PERL_OBJECT */
#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))
/* Interpreter exitlist entry */
typedef struct exitlistentry {
+#ifdef PERL_OBJECT
+ void (*fn) _((CPerlObj*, void*));
+#else
void (*fn) _((void*));
+#endif
void *ptr;
} PerlExitListEntry;
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
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));
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));
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));
#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));
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));
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));
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));
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));
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));
#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));
* Forward declarations for pregcomp()'s friends.
*/
-static char* regwhite _((char *, char *));
#ifndef PERL_OBJECT
static regnode *reg _((I32, I32 *));
static regnode *reganode _((U8, U32));
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
return(ret);
}
-static char *
+STATIC char *
regwhite(char *p, char *e)
{
while (p < e) {
s = (char *) OPERAND(scan);
if (nextchr < 0)
nextchr = UCHARAT(locinput);
- if (!REGINCLASS(s, nextchar))
+ if (!REGINCLASS(s, nextchr))
sayNO;
if (!nextchr && locinput >= regeol)
sayNO;
/* 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 *