[asperl] tweaks to make it build with the Borland compiler. Won't run

testsuite because @INC intuition from location of perlcore.dll seems
to be broken.  Also, system() and qx// seem broken as well.

p4raw-id: //depot/asperl@1033

14 files changed, 153 insertions, 50 deletions

diff --git a/ObjXSub.h b/ObjXSub.h
index 9880e8c3cb..f525cadb59 100644
--- a/ObjXSub.h
+++ b/ObjXSub.h
@@ -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
diff --git a/doio.c b/doio.c
index f6362b1c12..61c21b5c1c 100644
--- a/doio.c
+++ b/doio.c
@@ -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 */
diff --git a/objpp.h b/objpp.h
index 77b6c0dd8d..4bc40cdd34 100644
--- a/objpp.h
+++ b/objpp.h
@@ -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
diff --git a/perl.c b/perl.c
index bc55ba149e..e6d8e65284 100644
--- a/perl.c
+++ b/perl.c
@@ -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;
+}
+
+
diff --git a/perl.h b/perl.h
index 4513a07b8c..34f68b22d1 100644
--- a/perl.h
+++ b/perl.h
@@ -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
diff --git a/proto.h b/proto.h
index f984290b57..75a2aaac9f 100644
--- a/proto.h
+++ b/proto.h
@@ -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));
diff --git a/regcomp.c b/regcomp.c
index 4230b9c03d..4afa40ff97 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -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) {
diff --git a/regexec.c b/regexec.c
index 17a561b8e4..a38e97d15c 100644
--- a/regexec.c
+++ b/regexec.c
@@ -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;
diff --git a/toke.c b/toke.c
index c59a5bc2f5..d39f2da0c2 100644
--- a/toke.c
+++ b/toke.c
@@ -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 *