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

akyou56

　　本系列为刘兴(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