探密perl-解析perl源码(1)

 

本系列为刘兴(http://deepfuture.iteye.com/)原创，未经笔者授权，任何人和机构不能转载 

op.c

 

* A Perl program is compiled into a tree of OPs. Each op contains

 * structural pointers (eg to its siblings and the next op in the

 * execution sequence)

perl程序编译成一指令集的树，每个指令包括一个结构指针(例如在执行序列中它的兄弟和下一个指令)， 

 

ops指令集被newFoo函数创建，该函数由perly.y解析器调用， 

* OPs are mainly created by the newFOO() functions, which are mainly

 * called from the parser (in perly.y) as the code is parsed.

注意看这个例子:

 * the Perl code $a + $b * $c 相当于以下的函数调用

 *

 *  newBINOP(OP_ADD, flags,

 * newSVREF($a),

 * newBINOP(OP_MULTIPLY, flags, newSVREF($b), newSVREF($c))

 *  )

注意随时查看EXTERN.h、perl.h、keywords.h这3个头文件

 

#include "EXTERN.h"

#define PERL_IN_OP_C

#include "perl.h"

#include "keywords.h"

 

#define CALL_PEEP(o) CALL_FPTR(PL_peepp)(aTHX_ o)

#define CALL_OPFREEHOOK(o) if (PL_opfreehook) CALL_FPTR(PL_opfreehook)(aTHX_ o)

 

#if defined(PL_OP_SLAB_ALLOC)

debug只读指令集

#ifdef PERL_DEBUG_READONLY_OPS

#  define PERL_SLAB_SIZE 4096

#  include <sys/mman.h>

#endif

定义PERL_SLAB_SIZE的默认大小为2048,perl片区的大小

#ifndef PERL__SIZE

#define PERL_SLAB_SIZE 2048

#endif

 

 

分配perl片区内存

void *Perl_Slab_Alloc(pTHX_ size_t sz)

 

查看perl.h中PERL_GET_VARS() 的相关定义

1、PERL_GET_VARS()定义

 

 

#ifdef PERL_GLOBAL_STRUCT

#  ifndef PERL_GET_VARS

#    ifdef PERL_GLOBAL_STRUCT_PRIVATE

       EXTERN_C struct perl_vars* Perl_GetVarsPrivate();

#      define PERL_GET_VARS() Perl_GetVarsPrivate() /* see miniperlmain.c */

#      ifndef PERLIO_FUNCS_CONST

#        define PERLIO_FUNCS_CONST /* Can't have these lying around. */

#      endif

#    else

#      define PERL_GET_VARS() 

#    endif

#  endif

#endif

 

PERL_GLOBAL_STRUCT已经定义后，

如果定义了 结构私有标志PERL_GLOBAL_STRUCT_PRIVATE，则PERL_GET_VARS()为Perl_GetVarsPrivate函数

 

 

EXTERN_C struct perl_vars* Perl_GetVarsPrivate();

define PERL_GET_VARS() Perl_GetVarsPrivate()

否则，PERL_GET_VARS()为PL_VarsPtr结构变量

 

 

2、 PL_VarsPtr定义

 

 

 

#ifdef PERL_GLOBAL_STRUCT

perl_vars结构，结构体的内容在perlvars.h中

struct perl_vars {

#  include "perlvars.h"

};

 

 

关于EXT,可以在EXTERN.h中找到

 

/*

 *   designates a global var which is defined in perl.h

 * dEXT designates a global var which is defined in another

 *      file, so we can't count on finding it in perl.h

 *      (this practice should be avoided).

 */

 perl.h中的EXT表示一个全局变量，其它文件中为dEXT

 

 

 

PERL_GLOBAL_STRUCT定义的情况下，

1、如果PERL_CORE定义,不是 结构私有标志PERL_GLOBAL_STRUCT_PRIVATE，则

 

 

 

 PL_Vars定义:

先定义 perl_vars结构变量PL_Vars:EXT struct perl_vars PL_Vars;

 

 

再定义 perl_vars结构变量指针PL_VarsPtr，并将其初始化:EXT struct perl_vars *PL_VarsPtr INIT(&PL_Vars);

 

然后， define PERL_GET_VARS() PL_VarsPtr

2、如果不是PERL_CORE，则

定义perl_vars结构变量指针PL_VarsPtr:  如果PL_VarsPtr非空，则返回PL_VarsPtr，否则调用Perl_GetVars(aTHX)得到PL_VarsPtr

 

 

 

 

 

struct perl_vars *PL_VarsPtr;

#    define PL_Vars (*((PL_VarsPtr) \

      ? PL_VarsPtr : (PL_VarsPtr = Perl_GetVars(aTHX))))

#  endif /* PERL_CORE */

 

 

 

 

 

 

 

 

 

 

 

 

#ifdef PERL_GLOBAL_STRUCT

struct perl_vars {

#  include "perlvars.h"

};

#  ifdef PERL_CORE

#    ifndef PERL_GLOBAL_STRUCT_PRIVATE

EXT struct perl_vars PL_Vars;

EXT struct perl_vars *PL_VarsPtr INIT(&PL_Vars);

#      undef PERL_GET_VARS

#      define PERL_GET_VARS() PL_VarsPtr

#    endif /* !PERL_GLOBAL_STRUCT_PRIVATE */

#  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(aTHX))))

#  endif /* PERL_CORE */

#endif /* PERL_GLOBAL_STRUCT */

 

 

 

 

 

 

 

 

 

 

3、dVAR 定义

在PERL_GLOBAL_STRUCT定义的情况下，实质为完成my_vars结构变量的指针赋值。

 

PERL_GLOBAL_STRUCT没有定义，则为dNOOP宏

dNOOP实质为0，即NULL或extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL

#define NOOP /*EMPTY*/(void)0

#if !defined(HASATTRIBUTE_UNUSED) && defined(__cplusplus)

#define dNOOP /*EMPTY*/(void)0 /* Older g++ has no __attribute((unused))__ */

#else

#define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL

#endif

 

 

#define pVAR    register struct perl_vars* my_vars PERL_UNUSED_DECL

 

#ifdef PERL_GLOBAL_STRUCT

#  define dVAR pVAR    = (struct perl_vars*)PERL_GET_VARS()

#else

#  define dVAR dNOOP

#endif