perl.h

ARM上的如果你对底层感兴趣

    want_vtbl_regexp,
    want_vtbl_collxfrm,
    want_vtbl_amagic,
    want_vtbl_amagicelem,
#ifdef USE_THREADS
    want_vtbl_mutex,
#endif
};


				/* Note: the lowest 8 bits are reserved for
				   stuffing into op->op_private */
#define HINT_INTEGER		0x00000001
#define HINT_STRICT_REFS	0x00000002

#define HINT_BLOCK_SCOPE	0x00000100
#define HINT_STRICT_SUBS	0x00000200
#define HINT_STRICT_VARS	0x00000400
#define HINT_LOCALE		0x00000800

#define HINT_NEW_INTEGER	0x00001000
#define HINT_NEW_FLOAT		0x00002000
#define HINT_NEW_BINARY		0x00004000
#define HINT_NEW_STRING		0x00008000
#define HINT_NEW_RE		0x00010000
#define HINT_LOCALIZE_HH	0x00020000 /* %^H needs to be copied */

#define HINT_RE_TAINT		0x00100000
#define HINT_RE_EVAL		0x00200000

/* Various states of an input record separator SV (rs, nrs) */
#define RsSNARF(sv)   (! SvOK(sv))
#define RsSIMPLE(sv)  (SvOK(sv) && SvCUR(sv))
#define RsPARA(sv)    (SvOK(sv) && ! SvCUR(sv))
#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) _((char* exp, char* xend, PMOP* pm));
typedef I32 (*regexec_t) _((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;
#define PERLVARI(var,type,init) type var;
#define PERLVARIC(var,type,init) type var;

/* Interpreter exitlist entry */
typedef struct exitlistentry {
#ifdef PERL_OBJECT
    void (*fn) _((CPerlObj*, void*));
#else
    void (*fn) _((void*));
#endif
    void *ptr;
} PerlExitListEntry;

#ifdef PERL_OBJECT
extern "C" CPerlObj* perl_alloc _((IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*));

typedef int (CPerlObj::*runops_proc_t) _((void));
#undef EXT
#define EXT
#undef EXTCONST
#define EXTCONST
#undef INIT
#define INIT(x)

class CPerlObj {
public:
	CPerlObj(IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*);
	void Init(void);
	void* operator new(size_t nSize, IPerlMem *pvtbl);
#endif /* PERL_OBJECT */

#ifdef PERL_GLOBAL_STRUCT
struct perl_vars {
#include "perlvars.h"
};

#ifdef PERL_CORE
EXT struct perl_vars PL_Vars;
EXT struct perl_vars *PL_VarsPtr INIT(&PL_Vars);
#else /* PERL_CORE */
#if !defined(__GNUC__) || !defined(WIN32)
EXT
#endif /* WIN32 */
struct perl_vars *PL_VarsPtr;
#define PL_Vars (*((PL_VarsPtr) ? PL_VarsPtr : (PL_VarsPtr =  Perl_GetVars())))
#endif /* PERL_CORE */
#endif /* PERL_GLOBAL_STRUCT */

#ifdef MULTIPLICITY
/* If we have multiple interpreters define a struct 
   holding variables which must be per-interpreter
   If we don't have threads anything that would have 
   be per-thread is per-interpreter.
*/

struct interpreter {
#ifndef USE_THREADS
#include "thrdvar.h"
#endif
#include "intrpvar.h"
};

#else
struct interpreter {
    char broiled;
};
#endif

#ifdef USE_THREADS
/* If we have threads define a struct with all the variables
 * that have to be per-thread
 */


struct perl_thread {
#include "thrdvar.h"
};

typedef struct perl_thread *Thread;

#else
typedef void *Thread;
#endif

/* Done with PERLVAR macros for now ... */
#undef PERLVAR
#undef PERLVARI
#undef PERLVARIC

#include "thread.h"
#include "pp.h"
#include "proto.h"

#ifdef EMBED
#define Perl_sv_setptrobj(rv,ptr,name) Perl_sv_setref_iv(rv,name,(IV)ptr)
#define Perl_sv_setptrref(rv,ptr) Perl_sv_setref_iv(rv,Nullch,(IV)ptr)
#else
#define sv_setptrobj(rv,ptr,name) sv_setref_iv(rv,name,(IV)ptr)
#define sv_setptrref(rv,ptr) sv_setref_iv(rv,Nullch,(IV)ptr)
#endif

/* The following must follow proto.h as #defines mess up syntax */

#include "embedvar.h"

/* Now include all the 'global' variables 
 * If we don't have threads or multiple interpreters
 * these include variables that would have been their struct-s 
 */
                         
#define PERLVAR(var,type) EXT type PL_##var;
#define PERLVARI(var,type,init) EXT type  PL_##var INIT(init);
#define PERLVARIC(var,type,init) EXTCONST type PL_##var INIT(init);

#ifndef PERL_GLOBAL_STRUCT
#include "perlvars.h"
#endif

#ifndef MULTIPLICITY

#  include "intrpvar.h"
#  ifndef USE_THREADS
#    include "thrdvar.h"
#  endif

#endif

#ifdef PERL_OBJECT
/* from perly.c */
#undef  yydebug
#undef  yynerrs
#undef  yyerrflag
#undef  yychar
#undef  yyssp
#undef  yyvsp
#undef  yyval
#undef  yylval
#define yydebug	    PL_yydebug
#define yynerrs	    PL_yynerrs
#define yyerrflag   PL_yyerrflag
#define yychar	    PL_yychar
#define yyssp	    PL_yyssp
#define yyvsp	    PL_yyvsp
#define yyval	    PL_yyval
#define yylval	    PL_yylval
PERLVAR(yydebug,		int)
PERLVAR(yynerrs,		int)
PERLVAR(yyerrflag,		int)
PERLVAR(yychar,			int)
PERLVAR(yyssp,			short*)
PERLVAR(yyvsp,			YYSTYPE*)
PERLVAR(yyval,			YYSTYPE)
PERLVAR(yylval,			YYSTYPE)

#define efloatbuf		PL_efloatbuf
#define efloatsize		PL_efloatsize
PERLVAR(efloatbuf,		char *)
PERLVAR(efloatsize,		STRLEN)

#define glob_index		PL_glob_index
#define srand_called	PL_srand_called
#define uudmap			PL_uudmap
#define bitcount		PL_bitcount
#define filter_debug	PL_filter_debug
PERLVAR(glob_index,		int)
PERLVAR(srand_called,	bool)
PERLVAR(uudmap[256],	char)
PERLVAR(bitcount,		char*)
PERLVAR(filter_debug,	int)


/*
 * The following is a buffer where new variables must
 * be defined to maintain binary compatibility with PERL_OBJECT
 * for 5.005
 */
PERLVAR(object_compatibility[30],	char)
};

#include "objpp.h"
#ifdef DOINIT
#include "INTERN.h"
#else
#include "EXTERN.h"
#endif
#endif  /* PERL_OBJECT */


#undef PERLVAR
#undef PERLVARI
#undef PERLVARIC

#if defined(HASATTRIBUTE) && defined(WIN32)
/*
 * 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 */

#ifdef DOINIT

EXT MGVTBL vtbl_sv =	{magic_get,
				magic_set,
					magic_len,
						0,	0};
EXT MGVTBL vtbl_env =	{0,	magic_set_all_env,
				0,	magic_clear_all_env,
							0};
EXT MGVTBL vtbl_envelem =	{0,	magic_setenv,
					0,	magic_clearenv,
							0};
EXT MGVTBL vtbl_sig =	{0,	0,		 0, 0, 0};
EXT MGVTBL vtbl_sigelem =	{magic_getsig,
					magic_setsig,
					0,	magic_clearsig,
							0};
EXT MGVTBL vtbl_pack =	{0,	0,	magic_sizepack,	magic_wipepack,
							0};
EXT MGVTBL vtbl_packelem =	{magic_getpack,
				magic_setpack,
					0,	magic_clearpack,
							0};
EXT MGVTBL vtbl_dbline =	{0,	magic_setdbline,
					0,	0,	0};
EXT MGVTBL vtbl_isa =	{0,	magic_setisa,
					0,	magic_setisa,
							0};
EXT MGVTBL vtbl_isaelem =	{0,	magic_setisa,
					0,	0,	0};
EXT MGVTBL vtbl_arylen =	{magic_getarylen,
				magic_setarylen,
					0,	0,	0};
EXT MGVTBL vtbl_glob =	{magic_getglob,
				magic_setglob,
					0,	0,	0};
EXT MGVTBL vtbl_mglob =	{0,	magic_setmglob,
					0,	0,	0};
EXT MGVTBL vtbl_nkeys =	{magic_getnkeys,
				magic_setnkeys,
					0,	0,	0};
EXT MGVTBL vtbl_taint =	{magic_gettaint,magic_settaint,
					0,	0,	0};
EXT MGVTBL vtbl_substr =	{magic_getsubstr, magic_setsubstr,
					0,	0,	0};
EXT MGVTBL vtbl_vec =	{magic_getvec,
				magic_setvec,
					0,	0,	0};
EXT MGVTBL vtbl_pos =	{magic_getpos,
				magic_setpos,
					0,	0,	0};
EXT MGVTBL vtbl_bm =	{0,	magic_setbm,
					0,	0,	0};
EXT MGVTBL vtbl_fm =	{0,	magic_setfm,
					0,	0,	0};
EXT MGVTBL vtbl_uvar =	{magic_getuvar,
				magic_setuvar,
					0,	0,	0};
#ifdef USE_THREADS
EXT MGVTBL vtbl_mutex =	{0,	0,	0,	0,	magic_mutexfree};
#endif /* USE_THREADS */
EXT MGVTBL vtbl_defelem = {magic_getdefelem,magic_setdefelem,
					0,	0,	0};

EXT MGVTBL vtbl_regexp = {0,0,0,0, magic_freeregexp};

#ifdef USE_LOCALE_COLLATE
EXT MGVTBL vtbl_collxfrm = {0,
				magic_setcollxfrm,
					0,	0,	0};
#endif

#ifdef OVERLOAD
EXT MGVTBL vtbl_amagic =       {0,     magic_setamagic,
                                        0,      0,      magic_setamagic};
EXT MGVTBL vtbl_amagicelem =   {0,     magic_setamagic,
                                        0,      0,      magic_setamagic};
#endif /* OVERLOAD */

#else /* !DOINIT */

EXT MGVTBL vtbl_sv;
EXT MGVTBL vtbl_env;
EXT MGVTBL vtbl_envelem;
EXT MGVTBL vtbl_sig;
EXT MGVTBL vtbl_sigelem;
EXT MGVTBL vtbl_pack;
EXT MGVTBL vtbl_packelem;
EXT MGVTBL vtbl_dbline;
EXT MGVTBL vtbl_isa;
EXT MGVTBL vtbl_isaelem;
EXT MGVTBL vtbl_arylen;
EXT MGVTBL vtbl_glob;
EXT MGVTBL vtbl_mglob;
EXT MGVTBL vtbl_nkeys;
EXT MGVTBL vtbl_taint;
EXT MGVTBL vtbl_substr;
EXT MGVTBL vtbl_vec;
EXT MGVTBL vtbl_pos;
EXT MGVTBL vtbl_bm;
EXT MGVTBL vtbl_fm;
EXT MGVTBL vtbl_uvar;

#ifdef USE_THREADS
EXT MGVTBL vtbl_mutex;
#endif /* USE_THREADS */

EXT MGVTBL vtbl_defelem;
EXT MGVTBL vtbl_regexp;

#ifdef USE_LOCALE_COLLATE
EXT MGVTBL vtbl_collxfrm;
#endif

#ifdef OVERLOAD
EXT MGVTBL vtbl_amagic;
EXT MGVTBL vtbl_amagicelem;
#endif /* OVERLOAD */

#endif /* !DOINIT */

#ifdef OVERLOAD

#define NofAMmeth 58
#ifdef DOINIT
EXTCONST char * AMG_names[NofAMmeth] = {
  "fallback",	"abs",			/* "fallback" should be the first. */
  "bool",	"nomethod",
  "\"\"",	"0+",
  "+",		"+=",
  "-",		"-=",
  "*",		"*=",
  "/",		"/=",
  "%",		"%=",
  "**",		"**=",
  "<<",		"<<=",
  ">>",		">>=",
  "&",		"&=",
  "|",		"|=",
  "^",		"^=",
  "<",		"<=",
  ">",		">=",
  "==",		"!=",
  "<=>",	"cmp",
  "lt",		"le",
  "gt",		"ge",
  "eq",		"ne",
  "!",		"~",
  "++",		"--",
  "atan2",	"cos",
  "sin",	"exp",
  "log",	"sqrt",
  "x",		"x=",
  ".",		".=",
  "=",		"neg"
};
#else
EXTCONST char * AMG_names[NofAMmeth];
#endif /* def INITAMAGIC */

struct am_table {
  long was_ok_sub;
  long was_ok_am;
  U32 flags;
  CV* table[NofAMmeth];
  long fallback;
};
struct am_table_short {
  long was_ok_sub;
  long was_ok_am;
  U32 flags;
};
typedef struct am_table AMT;
typedef struct am_table_short AMTS;

#define AMGfallNEVER	1
#define AMGfallNO	2
#define AMGfallYES	3

#define AMTf_AMAGIC		1
#define AMT_AMAGIC(amt)		((amt)->flags & AMTf_AMAGIC)
#define AMT_AMAGIC_on(amt)	((amt)->flags |= AMTf_AMAGIC)
#define AMT_AMAGIC_off(amt)	((amt)->flags &= ~AMTf_AMAGIC)

enum {
  fallback_amg,	abs_amg,
  bool__amg,	nomethod_amg,
  string_amg,	numer_amg,
  add_amg,	add_ass_amg,
  subtr_amg,	subtr_ass_amg,
  mult_amg,	mult_ass_amg,
  div_amg,	div_ass_amg,
  modulo_amg,	modulo_ass_amg,
  pow_amg,	pow_ass_amg,
  lshift_amg,	lshift_ass_amg,
  rshift_amg,	rshift_ass_amg,
  band_amg,	band_ass_amg,
  bor_amg,	bor_ass_amg,
  bxor_amg,	bxor_ass_amg,
  lt_amg,	le_amg,
  gt_amg,	ge_amg,
  eq_amg,	ne_amg,
  ncmp_amg,	scmp_amg,
  slt_amg,	sle_amg,
  sgt_amg,	sge_amg,
  seq_amg,	sne_amg,
  not_amg,	compl_amg,
  inc_amg,	dec_amg,
  atan2_amg,	cos_amg,
  sin_amg,	exp_amg,
  log_amg,	sqrt_amg,
  repeat_amg,   repeat_ass_amg,
  concat_amg,	concat_ass_amg,
  copy_amg,	neg_amg
};

/*
 * some compilers like to redefine cos et alia as faster
 * (and less accurate?) versions called F_cos et cetera (Quidquid
 * latine dictum sit, altum viditur.)  This trick collides with
 * the Perl overloading (amg