SEXP R_mpc_mul(SEXP e1, SEXP e2) { /* N.B. We always use signed integers for e2 given R's type system. */ mpc_t *z = (mpc_t *)malloc(sizeof(mpc_t)); if (Rf_inherits(e1, "mpc")) { mpc_t *z1 = (mpc_t *)R_ExternalPtrAddr(e1); if (Rf_inherits(e2, "mpc")) { mpc_t *z2 = (mpc_t *)R_ExternalPtrAddr(e2); mpc_init2(*z, max(mpc_get_prec(*z1), mpc_get_prec(*z2))); mpc_mul(*z, *z1, *z2, Rmpc_get_rounding()); } else if (Rf_isInteger(e2)) { mpc_init2(*z, mpc_get_prec(*z1)); mpc_mul_si(*z, *z1, INTEGER(e2)[0], Rmpc_get_rounding()); } else if (Rf_isNumeric(e2)) { mpc_init2(*z, mpc_get_prec(*z1)); mpfr_t x; mpfr_init2(x, 53); mpfr_set_d(x, REAL(e2)[0], GMP_RNDN); mpc_mul_fr(*z, *z1, x, Rmpc_get_rounding()); } else { Rf_error("Invalid second operand for mpc multiplication."); } } else { Rf_error("Invalid first operand for MPC multiplication."); } SEXP retVal = PROTECT(R_MakeExternalPtr((void *)z, Rf_install("mpc ptr"), R_NilValue)); Rf_setAttrib(retVal, R_ClassSymbol, Rf_mkString("mpc")); R_RegisterCFinalizerEx(retVal, mpcFinalizer, TRUE); UNPROTECT(1); return retVal; }
void Lib_Mpcr_Mul_Si(MpcrPtr f, MpcrPtr g, int x, long rnd) { mpc_mul_si( (mpc_ptr) f, (mpc_ptr) g, x, (mpc_rnd_t) rnd); }