探密perl-解析perl源码(3)
本系列为刘兴(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
?