C++ PTR2UV函数代码示例

int
Perl_runops_debug(pTHX)
{
#ifdef DEBUGGING
    if (!PL_op) {
	if (ckWARN_d(WARN_DEBUGGING))
	    Perl_warner(aTHX_ WARN_DEBUGGING, "NULL OP IN RUN");
	return 0;
    }

    do {
	PERL_ASYNC_CHECK();
	if (PL_debug) {
	    if (PL_watchaddr != 0 && *PL_watchaddr != PL_watchok)
		PerlIO_printf(Perl_debug_log,
			      "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
			      PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
			      PTR2UV(*PL_watchaddr));
	    DEBUG_s(debstack());
	    DEBUG_t(debop(PL_op));
	    DEBUG_P(debprof(PL_op));
	}
    } while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX)));

    TAINT_NOT;
    return 0;
#else
    return runops_standard();
#endif	/* DEBUGGING */
}

void
Perl_watch(pTHX_ char **addr)
{
#ifdef DEBUGGING
    PL_watchaddr = addr;
    PL_watchok = *addr;
    PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
	PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
#endif	/* DEBUGGING */
}

SV *
PLCB__viewhandle_new(PLCB_t *parent,
    const char *ddoc, const char *view, const char *options, int flags)
{
    AV *req = NULL;
    SV *blessed;
    lcb_CMDVIEWQUERY cmd = { 0 };
    lcb_VIEWHANDLE vh = NULL;
    lcb_error_t rc;

    req = newAV();
    rowreq_init_common(parent, req);
    blessed = newRV_noinc((SV*)req);
    sv_bless(blessed, parent->view_stash);

    lcb_view_query_initcmd(&cmd, ddoc, view, options, viewrow_callback);
    cmd.cmdflags = flags; /* Trust lcb on this */
    cmd.handle = &vh;

    rc = lcb_view_query(parent->instance, req, &cmd);

    if (rc != LCB_SUCCESS) {
        SvREFCNT_dec(blessed);
        die("Couldn't issue view query: (0x%x): %s", rc, lcb_strerror(NULL, rc));
    } else {
        SvREFCNT_inc(req); /* For the callback */
        av_store(req, PLCB_VHIDX_VHANDLE, newSVuv(PTR2UV(vh)));
    }
    return blessed;
}

static int eca_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param) {
  SV *sv = mg->mg_obj;
  ECAslot *dup = eca_dup(sv2slot(sv));
  sv_setuv(sv, PTR2UV(dup));
  PERL_UNUSED_VAR(param);
  return 0;
}

static SV *eca_new_sv(char *name, ECAtype type, SV *value, SV *check,
                      bool is_ro, SV *inject) {

  dTHX;
  ECAslot *slot = eca_init(name, type, value, check, is_ro, inject);
  SV *result_sv = newSVuv(PTR2UV(slot));
  MAGIC *mg =
      sv_magicext(result_sv, result_sv, PERL_MAGIC_ext, &ECA_TBL, NULL, 0);
  mg->mg_flags |= MGf_DUP; // to invoke attrs_dup
  return result_sv;
}

void
Perl_mro_register(pTHX_ const struct mro_alg *mro) {
    SV *wrapper = newSVuv(PTR2UV(mro));

    PERL_ARGS_ASSERT_MRO_REGISTER;

    
    if (!Perl_hv_common(aTHX_ PL_registered_mros, NULL,
			mro->name, mro->length, mro->kflags,
			HV_FETCH_ISSTORE, wrapper, mro->hash)) {
	SvREFCNT_dec(wrapper);
	Perl_croak(aTHX_ "panic: hv_store() failed in mro_register() "
		   "for '%.*s' %d", (int) mro->length, mro->name, mro->kflags);
    }
}

LISTOP *
pj_prepare_jit_op(pTHX_ const unsigned int nvariables, OP *origop)
{
  LISTOP *jitop;
  pj_jitop_aux_t *jit_aux;

  NewOp(1101, jitop, 1, LISTOP);
  jitop->op_type = (OPCODE)OP_CUSTOM;
  jitop->op_next = jitop;
  jitop->op_private = 0;
  jitop->op_flags = (nvariables > 0 ? (OPf_STACKED|OPf_KIDS) : 0);
  if (origop->op_private & OPpTARGET_MY) {
    /* If OPpTARGET_MY is set on the original OP, then we have a nasty situation.
     * In a nutshell, this is set as an optimization for scalar assignment
     * to a pad (== lexical) variable. If set, the addop will directly
     * assign to whichever pad variable would otherwise be set by the sassign
     * op. It won't bother putting a separate var on the stack.
     * This is great, but it uses the op_targ member of the OP struct to
     * define the offset into the pad where the output variable is to be found.
     * That's a problem because we're using op_targ to hang the jit aux struct
     * off of.
     */
    jitop->op_private |= OPpTARGET_MY;
  }

  /* Set it's implementation ptr */
  jitop->op_ppaddr = pj_pp_jit;

  /* Init jit_aux */
  jit_aux = malloc(sizeof(pj_jitop_aux_t));
  jit_aux->paramslist = (NV *)malloc(sizeof(NV) * nvariables);
  jit_aux->nparams = nvariables;
  jit_aux->jit_fun = NULL;
  jit_aux->saved_op_targ = origop->op_targ; /* save in case needed for sassign optimization */
  /* FIXME is copying op_targ good enough? */

  /* It may turn out that op_targ is not safe to use for custom OPs because
   * some core functions may meddle with it. But chances are it's fine.
   * If not, we'll need to become extra-creative... */
  jitop->op_targ = (PADOFFSET)PTR2UV(jit_aux);

  return jitop;
}

I32
Perl_debstackptrs(pTHX)
{
#ifdef DEBUGGING
    dVAR;
    PerlIO_printf(Perl_debug_log,
		  "%8"UVxf" %8"UVxf" %8"IVdf" %8"IVdf" %8"IVdf"\n",
		  PTR2UV(PL_curstack), PTR2UV(PL_stack_base),
		  (IV)*PL_markstack_ptr, (IV)(PL_stack_sp-PL_stack_base),
		  (IV)(PL_stack_max-PL_stack_base));
    PerlIO_printf(Perl_debug_log,
		  "%8"UVxf" %8"UVxf" %8"UVuf" %8"UVuf" %8"UVuf"\n",
		  PTR2UV(PL_mainstack), PTR2UV(AvARRAY(PL_curstack)),
		  PTR2UV(PL_mainstack), PTR2UV(AvFILLp(PL_curstack)),
		  PTR2UV(AvMAX(PL_curstack)));
#endif /* DEBUGGING */
    return 0;
}

STATIC void
S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
{
    const GV *const gv = CvGV(cv);

    PERL_ARGS_ASSERT_CROAK_XS_USAGE;

    if (gv) {
        const char *const gvname = GvNAME(gv);
        const HV *const stash = GvSTASH(gv);
        const char *const hvname = stash ? HvNAME(stash) : NULL;

        if (hvname)
            Perl_croak(aTHX_ "Usage: %s::%s(%s)", hvname, gvname, params);
        else
            Perl_croak(aTHX_ "Usage: %s(%s)", gvname, params);
    } else {
        /* Pants. I don't think that it should be possible to get here. */
        Perl_croak(aTHX_ "Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params);
    }
}

SV* THX_newMopMmV(pTHX_ SV* code, U32 flags) {
    SV* method;

    CV* cv = (CV*) newSV(0);
    sv_upgrade((SV*) cv, SVt_PVCV);
    CvISXSUB_on(cv);
    CvXSUB(cv) = _MopMmV_wrapper;
    CvXSUBANY(cv).any_uv = PTR2UV(code);
    CvFILE(cv) = __FILE__;    

    CvANON_off(cv);
    CvMETHOD_on(cv);

    SvREFCNT_inc(code);

    method = newMopOV(newRV_inc((SV*) cv));

    if (flags & MopMmVf_STEAL_STASH) {
        MopMmV_assign_to_stash(method, CvGV(SvRV(code)), CvSTASH(SvRV(code)));
    }

    return method;
}

    void c_test (int max){
        int i;
        for (f=1)
        
        
    }

#line 23 "ko_6_1_0_perllint_01cc.c"
#ifndef PERL_UNUSED_VAR
#  define PERL_UNUSED_VAR(var) if (0) var = var
#endif

#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
#define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)

/* prototype to pass -Wmissing-prototypes */
STATIC void
S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params);

STATIC void
S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
{
    const GV *const gv = CvGV(cv);

    PERL_ARGS_ASSERT_CROAK_XS_USAGE;

    if (gv) {
        const char *const gvname = GvNAME(gv);
        const HV *const stash = GvSTASH(gv);
        const char *const hvname = stash ? HvNAME(stash) : NULL;

        if (hvname)
            Perl_croak(aTHX_ "Usage: %s::%s(%s)", hvname, gvname, params);
        else
            Perl_croak(aTHX_ "Usage: %s(%s)", gvname, params);
    } else {
        /* Pants. I don't think that it should be possible to get here. */
        Perl_croak(aTHX_ "Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params);
    }
}
#undef  PERL_ARGS_ASSERT_CROAK_XS_USAGE

#ifdef PERL_IMPLICIT_CONTEXT
#define croak_xs_usage(a,b)	S_croak_xs_usage(aTHX_ a,b)
#else
#define croak_xs_usage		S_croak_xs_usage
#endif

#endif

/* NOTE: the prototype of newXSproto() is different in versions of perls,
 * so we define a portable version of newXSproto()
 */
#ifdef newXS_flags
#define newXSproto_portable(name, c_impl, file, proto) newXS_flags(name, c_impl, file, proto, 0)
#else
#define newXSproto_portable(name, c_impl, file, proto) (PL_Sv=(SV*)newXS(name, c_impl, file), sv_setpv(PL_Sv, proto), (CV*)PL_Sv)
#endif /* !defined(newXS_flags) */

#line 75 "ko_6_1_0_perllint_01cc.c"

XS(XS_main_c_test); /* prototype to pass -Wmissing-prototypes */
XS(XS_main_c_test)
{
#ifdef dVAR
    dVAR; dXSARGS;
#else
    dXSARGS;
#endif
    if (items != 1)
       croak_xs_usage(cv,  "max");
    PERL_UNUSED_VAR(ax); /* -Wall */
    SP -= items;
    {
	int	max = (int)SvIV(ST(0));
#line 22 "ko_6_1_0_perllint_01cc.xs"
	I32* temp;
#line 93 "ko_6_1_0_perllint_01cc.c"
#line 24 "ko_6_1_0_perllint_01cc.xs"
	temp = PL_markstack_ptr++;
	c_test(max);
	if (PL_markstack_ptr != temp) {
          /* truly void, because dXSARGS not invoked */
	  PL_markstack_ptr = temp;
	  XSRETURN_EMPTY; /* return empty stack */
        }
        /* must have used dXSARGS; list context implied */
	return; /* assume stack size is correct */
#line 104 "ko_6_1_0_perllint_01cc.c"
	PUTBACK;
	return;
    }
}

#ifdef __cplusplus
extern "C"
#endif
XS(boot_ko_6_1_0_perllint_01cc); /* prototype to pass -Wmissing-prototypes */
XS(boot_ko_6_1_0_perllint_01cc)
{
//.........这里部分代码省略.........