探密perl-解析perl源码(三)
本系列为刘兴(http://deepfuture.iteye.com/)原创，未经笔者授权，任何人和机构不能转载
如果是调试模式，则定义Perl_pending_Slabs_to_ro、S_Slab_to_rw、Perl_op_refcnt_inc、Perl_op_refcnt_dec
否则定义空的Slab_to_rw(op)
Slab_to_rw(op)
#ifdef PERL_DEBUG_READONLY_OPS，
void
Perl_pending_Slabs_to_ro(pTHX) {将所有分配片区转为只读
/* Turn all the allocated op slabs read only. */
U32 count = PL_slab_count;
I32 **const slabs = PL_slabs;
/* Reset the array of pending OP slabs, as we're about to turn this lot
read only. Also, do it ahead of the loop in case the warn triggers,
and a warn handler has an eval */
重置片区数组，我们将其转化为只读，当提前循环时，发出警告，警告程序有一个eval
PL_slabs = NULL;
PL_slab_count = 0;
/* Force a new slab for any further allocation. */
PL_OpSpace = 0;
while (count--) {//处理slabs数组中的每个片区，使用mprotect(start, size, PROT_READ)将其转化为只读，如果出错，则提示
mprotect改变使用mmap映射区域的权限，因为每个片区在调试模式下使用mmap映射的内存区域
void *const start = slabs[count];
const size_t size = PERL_SLAB_SIZE* sizeof(I32*);
if(mprotect(start, size, PROT_READ)) {
Perl_warn(aTHX_ "mprotect for %p %lu failed with %d",
start, (unsigned long) size, errno);
}
}
free(slabs);
}
STATIC void
S_Slab_to_rw(pTHX_ void *op)
{将所有分配片区转为读写
I32 * const * const ptr = (I32 **) op;
I32 * const slab = ptr[-1];
PERL_ARGS_ASSERT_SLAB_TO_RW;
assert( ptr-1 > (I32 **) slab );
assert( ptr < ( (I32 **) slab + PERL_SLAB_SIZE) );
assert( *slab > 0 );
if(mprotect(slab, PERL_SLAB_SIZE*sizeof(I32*), PROT_READ|PROT_WRITE)) {
Perl_warn(aTHX_ "mprotect RW for %p %lu failed with %d",
slab, (unsigned long) PERL_SLAB_SIZE*sizeof(I32*), errno);
}
}
OP *
Perl_op_refcnt_inc(pTHX_ OP *o)
{增加OP引用
if(o) {
Slab_to_rw(o);
++o->op_targ;//使用OP可读写，然后修改
}
return o;
}
PADOFFSET
Perl_op_refcnt_dec(pTHX_ OP *o)
{减少OP引用
PERL_ARGS_ASSERT_OP_REFCNT_DEC;
Slab_to_rw(o);//使用OP可读写，然后修改
return --o->op_targ;
}
#else
# define Slab_to_rw(op)
#endif