#define USE_STDIO
#endif /* PERL_FOR_X2P */
+#define VOIDUSED 1
+#include "config.h"
+
+/* XXXXXX testing threads via implicit pointer */
+#ifdef USE_THREADS
+#define PERL_IMPLICIT_CONTEXT
+#endif
+
#ifdef PERL_OBJECT
/* PERL_OBJECT explained - DickH and DougL @ ActiveState.com
#define STATIC
#define CPERLscope(x) CPerlObj::x
-#define CPERLproto CPerlObj *
-#define _CPERLproto ,CPERLproto
-#define CPERLarg CPerlObj *pPerl
-#define CPERLarg_ CPERLarg,
-#define _CPERLarg ,CPERLarg
-#define PERL_OBJECT_THIS this
-#define _PERL_OBJECT_THIS ,this
-#define PERL_OBJECT_THIS_ this,
#define CALL_FPTR(fptr) (this->*fptr)
+#define pTHXo CPerlObj *pPerl
+#define pTHXo_ pTHXo,
+#define _pTHXo ,pTHXo
+#define aTHXo this
+#define aTHXo_ this,
+#define _aTHXo ,this
+#define PERL_OBJECT_THIS aTHXo
+#define PERL_OBJECT_THIS_ aTHXo_
+#define _PERL_OBJECT_THIS _aTHXo
+
+#define pTHXx void
+#define pTHXx_
+#define _pTHXx
+#define aTHXx
+#define aTHXx_
+#define _aTHXx
+
#else /* !PERL_OBJECT */
#define STATIC static
#define CPERLscope(x) x
-#define CPERLproto
-#define _CPERLproto
#define CPERLarg void
#define CPERLarg_
#define _CPERLarg
#define CALLREGEXEC CALL_FPTR(PL_regexecp)
#define CALLPROTECT CALL_FPTR(PL_protect)
-#define VOIDUSED 1
-#include "config.h"
+#define NOOP (void)0
+#define dNOOP extern int Perl___notused
-/* XXXXXX testing threads via implicit pointer */
-#ifdef USE_THREADS
-#define PERL_IMPLICIT_CONTEXT
+#ifdef PERL_IMPLICIT_CONTEXT
+# ifdef USE_THREADS
+struct perl_thread;
+# define pTHX register struct perl_thread *thr
+# define aTHX thr
+# define dTHXa(a) pTHX = (struct perl_thread *)a
+# define dTHX dTHXa(SvPVX(PL_thrsv))
+# define dTHR dNOOP
+# else
+# define MULTIPLICITY
+# define pTHX register PerlInterpreter *my_perl
+# define aTHX my_perl
+# define dTHXa(a) pTHX = (PerlInterpreter *)a
+# define dTHX dTHXa(PL_curinterp)
+# endif
+# define pTHX_ pTHX,
+# define _pTHX ,pTHX
+# define aTHX_ aTHX,
+# define _aTHX ,aTHX
+#endif
+
+#ifndef pTHX
+# define pTHX void
+# define pTHX_
+# define _pTHX
+# define aTHX
+# define aTHX_
+# define _aTHX
+# define dTHXa(a) dNOOP
+# define dTHX dNOOP
+#endif
+
+#ifndef pTHXo
+# define pTHXo pTHX
+# define pTHXo_ pTHX_
+# define _pTHXo _pTHX
+# define aTHXo aTHX
+# define aTHXo_ aTHX_
+# define _aTHXo _aTHX
+#endif
+
+#ifndef pTHXx
+# define pTHXx register PerlInterpreter *my_perl
+# define pTHXx_ pTHXx,
+# define _pTHXx ,pTHXx
+# define aTHXx my_perl
+# define aTHXx_ aTHXx,
+# define _aTHXx ,aTHXx
#endif
#undef START_EXTERN_C
#else
# define START_EXTERN_C
# define END_EXTERN_C
-# define EXTERN_C
+# define EXTERN_C extern
#endif
#ifdef OP_IN_REGISTER
# endif
#endif
-#define NOOP (void)0
-#define dNOOP extern int Perl___notused
+#define WITH_THX(s) STMT_START { dTHX; s; } STMT_END
#define WITH_THR(s) STMT_START { dTHR; s; } STMT_END
/*
*/
/* define this once if either system, instead of cluttering up the src */
-#if defined(MSDOS) || defined(atarist) || defined(WIN32) || defined(CYGWIN32)
+#if defined(MSDOS) || defined(atarist) || defined(WIN32)
#define DOSISH 1
#endif
-#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus)
+#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined( EPOC)
# define STANDARD_C 1
#endif
-#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) || defined(__DGUX)
+#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) || defined(__DGUX) || defined( EPOC)
# define DONT_DECLARE_STD 1
#endif
# endif
#endif
-#include "iperlsys.h"
-
#ifdef USE_NEXT_CTYPE
#if NX_CURRENT_COMPILER_RELEASE >= 500
# include <stdlib.h>
#endif
-#if !defined(PERL_FOR_X2P)
+#if !defined(PERL_FOR_X2P) && !defined(PERL_OBJECT)
# include "embed.h"
#endif
# if defined(__VOS__)
# include "vosish.h"
# else
-# include "unixish.h"
+# if defined(EPOC)
+# include "epocish.h"
+# else
+# include "unixish.h"
+# endif
# endif
# endif
# endif
(PerlLIO_setmode(PerlIO_fileno(fp), O_BINARY) != -1 ? TRUE : NULL)
#endif
-#ifdef PERL_IMPLICIT_CONTEXT
-# ifdef USE_THREADS
-struct perl_thread;
-# define pTHX struct perl_thread *thr
-# define pTHX_ pTHX,
-# define _pTHX ,pTHX
-# define aTHX thr
-# define aTHX_ aTHX,
-# define _aTHX ,aTHX
-# define dTHX pTHX = (struct perl_thread *)SvPVX(PL_thrsv)
-# define dTHR dNOOP
-# else
-# define MULTIPLICITY
-# define pTHX PerlInterpreter *my_perl
-# define pTHX_ pTHX,
-# define _pTHX ,pTHX
-# define aTHX my_perl
-# define aTHX_ aTHX,
-# define _aTHX ,aTHX
-# define dTHX pTHX = PL_curinterp
-# endif
-#endif
-
-#ifndef pTHX
-# define pTHX void
-# define pTHX_
-# define _pTHX
-# define aTHX
-# define aTHX_
-# define _aTHX
-# define dTHX dNOOP
-#endif
-
-#define WITH_THX(s) STMT_START { dTHX; s; } STMT_END
-
-#ifndef STATIC
-# define STATIC static
-#endif
-
#ifdef UNION_ANY_DEFINITION
UNION_ANY_DEFINITION;
#else
#define ARGSproto
#endif /* USE_THREADS */
-#ifdef PERL_OBJECT
-typedef I32 (*filter_t) (CPerlObj*, int, SV *, int);
-#else
-typedef I32 (*filter_t) (pTHX_ int, SV *, int);
+#if defined(CYGWIN32)
+/* USEMYBINMODE
+ * This symbol, if defined, indicates that the program should
+ * use the routine my_binmode(FILE *fp, char iotype) to insure
+ * that a file is in "binary" mode -- that is, that no translation
+ * of bytes occurs on read or write operations.
+ */
+#define USEMYBINMODE / **/
+#define my_binmode(fp, iotype) \
+ (PerlLIO_setmode(PerlIO_fileno(fp), O_BINARY) != -1 ? TRUE : FALSE)
#endif
+typedef I32 (*filter_t) (pTHXo_ int, SV *, int);
+
#define FILTER_READ(idx, sv, len) filter_read(idx, sv, len)
#define FILTER_DATA(idx) (AvARRAY(PL_rsfp_filters)[idx])
#define FILTER_ISREADER(idx) (idx >= AvFILLp(PL_rsfp_filters))
+#ifdef WIN32
+#include "win32.h"
+#endif
+
+#include "iperlsys.h"
#include "regexp.h"
#include "sv.h"
#include "util.h"
#include "form.h"
#include "gv.h"
#include "cv.h"
-#ifndef PERL_OBJECT
-#include "opcode.h"
-#endif
#include "op.h"
#include "cop.h"
#include "av.h"
#define DEBUG_o(a) if (PL_debug & 16) a
#define DEBUG_c(a) if (PL_debug & 32) a
#define DEBUG_P(a) if (PL_debug & 64) a
-# if defined(PERL_OBJECT) || defined(PERL_IMPLICIT_CONTEXT)
+# if defined(PERL_OBJECT)
# define DEBUG_m(a) if (PL_debug & 128) a
# else
# define DEBUG_m(a) if (PL_curinterp && PL_debug & 128) a
# ifndef getenv
char *getenv (const char*);
# endif /* !getenv */
+#ifndef EPOC
Off_t lseek (int,Off_t,int);
+#endif
# endif /* !DONT_DECLARE_STD */
char *getlogin (void);
#endif /* !__cplusplus */
#endif
-/*
- * These need prototyping here because <proto.h> isn't
- * included until after runops is initialised.
- */
-
-#ifndef PERL_OBJECT
-typedef int (*runops_proc_t) (pTHX);
-int Perl_runops_standard (pTHX);
-#ifdef DEBUGGING
-int Perl_runops_debug (pTHX);
-#endif
-#endif
+typedef int (CPERLscope(*runops_proc_t)) (pTHX);
+typedef OP* (CPERLscope(*PPADDR_t)[]) (pTHX);
/* _ (for $_) must be first in the following list (DEFSV requires it) */
#define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@"
# if !defined(DONT_DECLARE_STD) || \
(defined(__svr4__) && defined(__GNUC__) && defined(sun)) || \
defined(__sgi) || \
- defined(__DGUX)
+ defined(__DGUX) || defined(EPOC)
extern char ** environ; /* environment variables supplied via exec */
# endif
# endif
#endif
+START_EXTERN_C
+
/* handy constants */
EXTCONST char PL_warn_uninit[]
INIT("Use of uninitialized value");
#endif
#endif
+END_EXTERN_C
+
/*****************************************************************************/
/* This lexer/parser stuff is currently global since yacc is hard to reenter */
/*****************************************************************************/
/* Note: the lowest 8 bits are reserved for
stuffing into op->op_private */
+#define HINT_PRIVATE_MASK 0x000000ff
#define HINT_INTEGER 0x00000001
#define HINT_STRICT_REFS 0x00000002
/* #define HINT_notused4 0x00000004 */
#define RsRECORD(sv) (SvROK(sv) && (SvIV(SvRV(sv)) > 0))
/* Enable variables which are pointers to functions */
-#ifdef PERL_OBJECT
-typedef regexp*(CPerlObj::*regcomp_t) (char* exp, char* xend, PMOP* pm);
-typedef I32 (CPerlObj::*regexec_t) (regexp* prog, char* stringarg,
- char* strend, char* strbeg,
- I32 minend, SV* screamer, void* data,
- U32 flags);
-#else
-typedef regexp*(*regcomp_t) (pTHX_ char* exp, char* xend, PMOP* pm);
-typedef I32 (*regexec_t) (pTHX_ regexp* prog, char* stringarg, char* strend, char*
- strbeg, I32 minend, SV* screamer, void* data,
- U32 flags);
+typedef regexp*(CPERLscope(*regcomp_t)) (pTHX_ char* exp, char* xend, PMOP* pm);
+typedef I32 (CPERLscope(*regexec_t)) (pTHX_ regexp* prog, char* stringarg,
+ char* strend, char* strbeg, I32 minend,
+ SV* screamer, void* data, U32 flags);
-#endif
/* Set up PERLVAR macros for populating structs */
#define PERLVAR(var,type) type var;
/* Interpreter exitlist entry */
typedef struct exitlistentry {
-#ifdef PERL_OBJECT
- void (*fn) (CPerlObj*, void*);
-#else
- void (*fn) (pTHX_ void*);
-#endif
+ void (*fn) (pTHXo_ void*);
void *ptr;
} PerlExitListEntry;
#ifdef PERL_OBJECT
-extern "C" CPerlObj* perl_alloc (IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*);
-
-#ifdef PERL_OBJECT
-typedef int (CPerlObj::*runops_proc_t) (void);
-#endif /* PERL_OBJECT */
+#undef perl_alloc
+#define perl_alloc Perl_alloc
+CPerlObj* Perl_alloc (IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*);
#undef EXT
#define EXT
# define VIRTUAL virtual PERL_CALLCONV
#else
# define VIRTUAL PERL_CALLCONV
-START_EXTERN_C
+/*START_EXTERN_C*/
#endif
#ifndef NEXT30_NO_ATTRIBUTE
int Perl_yylex(pTHX_ YYSTYPE *lvalp, int *lcharp);
#endif
-typedef void (*DESTRUCTORFUNC_t) (pTHX_ void*);
-typedef void (*SVFUNC_t) (pTHX_ SV*);
-typedef I32 (*SVCOMPARE_t) (pTHX_ SV*, SV*);
-typedef void (*XSINIT_t) (pTHX);
-typedef void (*ATEXIT_t) (pTHX_ void*);
-typedef void (*XSUBADDR_t) (pTHX_ CV *);
+typedef void (CPERLscope(*DESTRUCTORFUNC_t)) (pTHX_ void*);
+typedef void (CPERLscope(*SVFUNC_t)) (pTHX_ SV*);
+typedef I32 (CPERLscope(*SVCOMPARE_t)) (pTHX_ SV*, SV*);
+typedef void (*XSINIT_t) (pTHXo);
+typedef void (*ATEXIT_t) (pTHXo_ void*);
+typedef void (*XSUBADDR_t) (pTHXo_ CV *);
+
+#ifdef PERL_OBJECT
+#define PERL_DECL_PROT
+#define perl_alloc Perl_alloc
+#endif
#include "proto.h"
+#undef PERL_CKDEF
+#undef PERL_PPDEF
+#define PERL_CKDEF(s) OP *s (pTHX_ OP *o);
+#define PERL_PPDEF(s) OP *s (pTHX);
+#ifdef PERL_OBJECT
+public:
+#endif
+
#include "pp_proto.h"
+#ifdef PERL_OBJECT
+VIRTUAL int CPerlObj::fprintf (PerlIO *pf, const char *pat, ...);
+VIRTUAL int CPerlObj::do_aspawn (void *vreally, void **vmark, void **vsp);
+#undef PERL_DECL_PROT
+#else
+/*END_EXTERN_C*/
+#endif
+
#ifndef PERL_OBJECT
-END_EXTERN_C
+/* this has structure inits, so it cannot be included before here */
+# include "opcode.h"
#endif
/* The following must follow proto.h as #defines mess up syntax */
#define PERLVARIC(var,type,init) EXTCONST type PL_##var INIT(init);
#ifndef PERL_GLOBAL_STRUCT
-#include "perlvars.h"
+# ifndef PERL_OBJECT
+START_EXTERN_C
+# endif
+
+# include "perlvars.h"
+
+# ifndef PERL_OBJECT
+END_EXTERN_C
+# endif
#endif
#ifndef MULTIPLICITY
#undef PERLVARI
#undef PERLVARIC
-#if defined(HASATTRIBUTE) && defined(WIN32) && !defined(CYGWIN32)
-/*
- * This provides a layer of functions and macros to ensure extensions will
- * get to use the same RTL functions as the core.
- * It has to go here or #define of printf messes up __attribute__
- * stuff in proto.h
- */
-#ifndef PERL_OBJECT
-# include <win32iop.h>
-#endif /* PERL_OBJECT */
-#endif /* WIN32 */
+START_EXTERN_C
#ifdef DOINIT
EXTCONST char * PL_AMG_names[NofAMmeth];
#endif /* def INITAMAGIC */
+END_EXTERN_C
+
struct am_table {
long was_ok_sub;
long was_ok_am;
set_numeric_local(); \
} STMT_END
+#define IS_NUMERIC_RADIX(c) \
+ ((PL_hints & HINT_LOCALE) && \
+ PL_numeric_radix && (c) == PL_numeric_radix)
+
+#define RESTORE_NUMERIC_LOCAL() if ((PL_hints & HINT_LOCALE) && PL_numeric_standard) SET_NUMERIC_LOCAL()
+#define RESTORE_NUMERIC_STANDARD() if ((PL_hints & HINT_LOCALE) && PL_numeric_local) SET_NUMERIC_STANDARD()
+#define Atof my_atof
+
#else /* !USE_LOCALE_NUMERIC */
-#define SET_NUMERIC_STANDARD() /**/
-#define SET_NUMERIC_LOCAL() /**/
+#define SET_NUMERIC_STANDARD() /**/
+#define SET_NUMERIC_LOCAL() /**/
+#define IS_NUMERIC_RADIX(c) (0)
+#define RESTORE_NUMERIC_LOCAL() /**/
+#define RESTORE_NUMERIC_STANDARD() /**/
+#define Atof atof
#endif /* !USE_LOCALE_NUMERIC */