SEXP PKI_digest(SEXP what, SEXP sMD) { SEXP res; unsigned char hash[32]; /* really, at most 20 bytes are needed */ int len, md = asInteger(sMD); if (TYPEOF(what) != RAWSXP) Rf_error("what must be a raw vector"); switch (md) { case PKI_SHA1: SHA1((const unsigned char*) RAW(what), LENGTH(what), hash); len = SHA_DIGEST_LENGTH; break; case PKI_MD5: MD5((const unsigned char*) RAW(what), LENGTH(what), hash); len = MD5_DIGEST_LENGTH; break; default: Rf_error("unsupported hash function"); len = 0; /* dead code but needed to appease compilers */ } res = allocVector(RAWSXP, len); memcpy(RAW(res), hash, len); return res; }
SEXP PKI_load_public_RSA(SEXP what) { EVP_PKEY *key; RSA *rsa = 0; const unsigned char *ptr; if (TYPEOF(what) != RAWSXP) Rf_error("key must be a raw vector"); ptr = (const unsigned char *) RAW(what); rsa = d2i_RSA_PUBKEY(&rsa, &ptr, LENGTH(what)); if (!rsa) Rf_error("%s", ERR_error_string(ERR_get_error(), NULL)); key = EVP_PKEY_new(); EVP_PKEY_assign_RSA(key, rsa); return wrap_EVP_PKEY(key, PKI_KT_PUBLIC); }
SEXP R_gpg_import(SEXP pubkey) { gpgme_data_t KEY; bail(gpgme_data_new_from_mem(&KEY, (const char*) RAW(pubkey), LENGTH(pubkey), 0), "creating key buffer"); bail(gpgme_op_import(ctx, KEY), "importing pubkey"); gpgme_import_result_t result = gpgme_op_import_result(ctx); SEXP out = PROTECT(allocVector(INTSXP, 5)); INTEGER(out)[0] = result->considered; INTEGER(out)[1] = result->imported; INTEGER(out)[2] = result->secret_imported; INTEGER(out)[3] = result->new_signatures; INTEGER(out)[4] = result->new_revocations; UNPROTECT(1); return out; }
SEXP R_ring_buffer_tail_offset(SEXP extPtr, SEXP r_offset) { size_t offset = INTEGER(r_offset)[0]; ring_buffer * buffer = ring_buffer_get(extPtr, 1); SEXP ret = PROTECT(allocVector(RAWSXP, buffer->stride)); data_t *data = (data_t*) ring_buffer_tail_offset(buffer, offset); if (data == NULL) { Rf_error("Buffer underflow"); } memcpy(RAW(ret), data, buffer->stride); UNPROTECT(1); // NOTE: In C we return the tail position here but that is not done // for the R version. return ret; }
static int bind_params_to_stmt(RSQLiteParams* params, sqlite3_stmt* db_statement, int row) { int state = SQLITE_OK, j; for (j = 0; j < params->count; j++) { SEXP pdata = VECTOR_ELT(params->data, j), v_elt; int integer; double number; Rbyte* raw; switch (TYPEOF(pdata)) { case INTSXP: integer = INTEGER(pdata)[row]; if (integer == NA_INTEGER) state = sqlite3_bind_null(db_statement, j + 1); else state = sqlite3_bind_int(db_statement, j + 1, integer); break; case REALSXP: number = REAL(pdata)[row]; if (ISNA(number)) state = sqlite3_bind_null(db_statement, j + 1); else state = sqlite3_bind_double(db_statement, j + 1, number); break; case VECSXP: /* BLOB */ v_elt = VECTOR_ELT(pdata, row); if (v_elt == R_NilValue) { state = sqlite3_bind_null(db_statement, j + 1); } else { raw = RAW(v_elt); state = sqlite3_bind_blob(db_statement, j + 1, raw, LENGTH(v_elt), SQLITE_STATIC); } break; case STRSXP: /* falls through */ default: v_elt = STRING_ELT(pdata, row); if (NA_STRING == v_elt) state = sqlite3_bind_null(db_statement, j + 1); else state = sqlite3_bind_text(db_statement, j + 1, CHAR(v_elt), -1, SQLITE_STATIC); break; } if (state != SQLITE_OK) break; } return state; }
SEXP PKI_digest(SEXP sWhat, SEXP sMD) { SEXP res; unsigned char hash[32]; /* really, at most 20 bytes are needed */ int len, md = asInteger(sMD); const unsigned char *what; int what_len; PKI_init(); if (TYPEOF(sWhat) == RAWSXP) { what = (const unsigned char*) RAW(sWhat); what_len = LENGTH(sWhat); } else if (TYPEOF(sWhat) == STRSXP) { if (LENGTH(sWhat) < 1) return allocVector(RAWSXP, 0); /* good? */ what = (const unsigned char*) CHAR(STRING_ELT(sWhat, 0)); what_len = strlen((const char*) what); } else Rf_error("what must be a string or a raw vector"); switch (md) { case PKI_SHA1: SHA1(what, what_len, hash); len = SHA_DIGEST_LENGTH; break; case PKI_SHA256: SHA256(what, what_len, hash); len = SHA256_DIGEST_LENGTH; break; case PKI_MD5: MD5(what, what_len, hash); len = MD5_DIGEST_LENGTH; break; default: Rf_error("unsupported hash function"); len = 0; /* dead code but needed to appease compilers */ } res = allocVector(RAWSXP, len); memcpy(RAW(res), hash, len); return res; }
/** * \brief Erases a block of a SkipBlock NandFlash. * * \param skipBlock Pointer to a SkipBlockNandFlash instance. * \param block Number of block to erase. * \return the RawNandFlash_EraseBlock code or NandCommon_ERROR_WRONGSTATUS. */ uint8_t SkipBlockNandFlash_EraseBlock( struct SkipBlockNandFlash *skipBlock, uint16_t block, uint32_t eraseType) { uint8_t error; const struct NandSpareScheme *scheme; uint8_t spare[NandCommon_MAXPAGESPARESIZE]; // TRACE_INFO("SkipBlockNandFlash_EraseBlock(%d)\n\r", block); if (eraseType != SCRUB_ERASE) { /* Check block status */ if (SkipBlockNandFlash_CheckBlock(skipBlock, block) != GOODBLOCK) { TRACE_INFO("SkipBlockNandFlash_EraseBlock: Block is BAD\n\r"); return NandCommon_ERROR_BADBLOCK; } } /* Erase block */ error = RawNandFlash_EraseBlock(RAW(skipBlock), block); if (error) { /* Try to mark the block as BAD */ TRACE_ERROR("SkipBlockNandFlash_EraseBlock: Cannot erase block, try to mark it BAD\n\r"); /* Retrieve model scheme */ scheme = NandFlashModel_GetScheme(MODEL(skipBlock)); memset(spare, 0xFF, NandCommon_MAXPAGESPARESIZE); NandSpareScheme_WriteBadBlockMarker(scheme, spare, NandBlockStatus_BAD_skip); return RawNandFlash_WritePage(RAW(skipBlock), block, 0, 0, spare); } return 0; }
SEXP PKI_decrypt(SEXP what, SEXP sKey) { SEXP res; EVP_PKEY *key; RSA *rsa; int len; if (TYPEOF(what) != RAWSXP) Rf_error("invalid payload to sign - must be a raw vector"); if (!inherits(sKey, "private.key")) Rf_error("invalid key object"); key = (EVP_PKEY*) R_ExternalPtrAddr(sKey); if (!key) Rf_error("NULL key"); if (EVP_PKEY_type(key->type) != EVP_PKEY_RSA) Rf_error("Sorry only RSA keys are supported at this point"); rsa = EVP_PKEY_get1_RSA(key); if (!rsa) Rf_error("%s", ERR_error_string(ERR_get_error(), NULL)); len = RSA_private_decrypt(LENGTH(what), RAW(what), (unsigned char*) buf, rsa, RSA_PKCS1_PADDING); if (len < 0) Rf_error("%s", ERR_error_string(ERR_get_error(), NULL)); res = allocVector(RAWSXP, len); memcpy(RAW(res), buf, len); return res; }
/* BN_bn2bin() drops leading zeros which can alter openssh fingerprint */ SEXP bignum_to_r_size(const BIGNUM *bn, int bytes){ int bits = BN_num_bits(bn); if(bytes == 0) bytes = (bits/8) + 1; int numbytes = BN_num_bytes(bn); int diff = bytes - numbytes; SEXP res = PROTECT(allocVector(RAWSXP, bytes)); setAttrib(res, R_ClassSymbol, mkString("bignum")); UNPROTECT(1); unsigned char *ptr = RAW(res); memset(ptr, 0, diff); ptr += diff; BN_bn2bin(bn, ptr); return res; }
/* {{{ rberkeley_db_compact */ SEXP rberkeley_db_compact (SEXP _dbp, SEXP _txnid, SEXP _start, SEXP _stop, SEXP _c_data, SEXP _flags) { DB *dbp; DB_TXN *txnid; DBT start, stop, end; /*DB_COMPACT c_data;*/ u_int32_t flags; int ret; if(isNull(_txnid)) { txnid = R_ExternalPtrAddr(_txnid); } else { txnid = NULL; } if(!isNull(_start)) { memset(&start, 0, sizeof(DBT)); start.data = (unsigned char *)RAW(_start); start.size = length(_start); } if(!isNull(_stop)) { memset(&stop, 0, sizeof(DBT)); stop.data = (unsigned char *)RAW(_stop); stop.size = length(_stop); } flags = (u_int32_t)INTEGER(_flags)[0]; /*memset(&end, 0, sizeof(end));*/ dbp = R_ExternalPtrAddr(_dbp); if(R_ExternalPtrTag(_dbp) != RBerkeley_DB || dbp == NULL) error("invalid 'db' handle"); ret = dbp->compact(dbp, txnid, &start, &stop, NULL, flags, &end); return ScalarInteger(ret); }
SEXP graph_bitarray_transpose(SEXP bits) { SEXP ans; int nrow, i, j, len = length(bits); unsigned char *bytes = RAW(bits), *ans_bytes; ans = PROTECT(duplicate(bits)); /* dup to capture attributes */ ans_bytes = RAW(ans); memset(ans_bytes, 0, len); nrow = NROW(bits); /* FIXME: use a single loop, look at R's array.c */ for (i = 0; i < nrow; i++) { for (j = 0; j < nrow; j++) { int idx = COORD_TO_INDEX(i, j, nrow), tidx = COORD_TO_INDEX(j, i, nrow); int byteIndex = idx / 8, bitIndex = idx % 8, tBitIndex = tidx % 8; if (IS_SET(bytes, byteIndex, bitIndex)) ans_bytes[tidx / 8] |= (1 << tBitIndex); } } UNPROTECT(1); return ans; }
/* flexible and fast for long strings. Since short string are, well, short, the overhead of building a table should play no role */ SEXP C_URIencode(SEXP what, SEXP resrv) { SEXP res; char tab[256]; const unsigned char *c = (const unsigned char*) plain; if (TYPEOF(what) != STRSXP && TYPEOF(what) != RAWSXP) Rf_error("input must be a raw or character vector"); memset(tab, 0, sizeof(tab)); while (*c) tab[*(c++)] = 1; if (TYPEOF(resrv) == STRSXP) { int n = LENGTH(resrv), i; for (i = 0; i < n; i++) { c = (const unsigned char*) CHAR(STRING_ELT(resrv, i)); while (*c) tab[*(c++)] = 1; } } if (TYPEOF(what) == RAWSXP) { int len = 0; const unsigned char *cend = (c = (const unsigned char*) RAW(what)) + LENGTH(what); char *enc, *ce; while (c < cend) len += tab[*(c++)] ? 1 : 3; ce = enc = (char*) R_alloc(1, len + 1); c = (const unsigned char*) RAW(what); while (c < cend) if (tab[*c]) *(ce++) = *(c++); else { *(ce++) = '%'; *(ce++) = hex[*c >> 4]; *(ce++) = hex[*(c++) & 0x0F]; } *ce = 0; return mkString(enc); } else {
SEXP R_rsa_key_build(SEXP e, SEXP n, SEXP p, SEXP q, SEXP d, SEXP dp, SEXP dq, SEXP qi){ RSA *rsa = RSA_new(); MY_RSA_set0_key(rsa, new_bignum_from_r(n), new_bignum_from_r(e), new_bignum_from_r(d)); MY_RSA_set0_factors(rsa, new_bignum_from_r(p), new_bignum_from_r(q)); MY_RSA_set0_crt_params(rsa, new_bignum_from_r(dp), new_bignum_from_r(dq), new_bignum_from_r(qi)); bail(RSA_check_key(rsa)); unsigned char *buf = NULL; int len = i2d_RSAPrivateKey(rsa, &buf); bail(len); RSA_free(rsa); SEXP res = allocVector(RAWSXP, len); memcpy(RAW(res), buf, len); OPENSSL_free(buf); return res; }
SEXP R_dsa_pubkey_decompose(SEXP bin){ DSA *dsa = DSA_new(); const unsigned char *ptr = RAW(bin); bail(!!d2i_DSA_PUBKEY(&dsa, &ptr, LENGTH(bin))); const BIGNUM *p, *q, *g, *pub_key; MY_DSA_get0_pqg(dsa, &p, &q, &g); MY_DSA_get0_key(dsa, &pub_key, NULL); SEXP res = PROTECT(allocVector(VECSXP, 4)); SET_VECTOR_ELT(res, 0, bignum_to_r(p)); SET_VECTOR_ELT(res, 1, bignum_to_r(q)); SET_VECTOR_ELT(res, 2, bignum_to_r(g)); SET_VECTOR_ELT(res, 3, bignum_to_r(pub_key)); UNPROTECT(1); return res; }
SEXP parse_headers(SEXP sRaw) { SEXP res = PROTECT(allocVector(STRSXP, MAX_HDR_ENTRIES)), rn = allocVector(STRSXP, MAX_HDR_ENTRIES); Rf_setAttrib(res, R_NamesSymbol, rn); int i = 0; const char *cs = (const char*) RAW(sRaw), *c = cs, *e; R_xlen_t len = XLENGTH(sRaw), ct = 0; e = c + len; while (c < e) { const char *r = memchr(c, ':', e - c); if (!r) /* we jsut ignore trailing content - it shouldn't be there ... */ break; if (i == MAX_HDR_ENTRIES) Rf_error("Sorry, too many header entries, aborting"); /* we have header field entry - add it */ SET_STRING_ELT(rn, i, mkCharLen(c, r - c)); c = r + 1; while (c < e && (*c == ' ' || *c == '\t')) c++; const char *val = c; while (1) { r = memchr(c, '\n', e - c); /* if we don't find a newline then just use everything till the end */ if (!r) { while (e > c && (e[-1] == '\r' || e[-1] == '\n')) e--; SET_STRING_ELT(res, i, mkCharLen(val, e - val)); i++; c = e; /* end */ break; } /* advance */ c = r + 1; /* not a continuation? add it */ if (!(c < e && (*c == ' ' || *c == '\t'))) { /* trim newlines */ while (r > val && (*r == '\n' || *r == '\t')) r--; SET_STRING_ELT(res, i, mkCharLen(val, r - val)); i++; break; } /* continuation */ } } SETLENGTH(rn, i); SETLENGTH(res, i); UNPROTECT(1); return res; }
/* * Convert a raw binary unpacked SciDB array to a list. * M: Number of rows (int) to try to unpack * TYPES: Character vector of SciDB types, of length N * NULLABLE: Logical vector of SciDB nullability, of length N * DATA: R RAW vector with the binary SciDB data * OFFSET: Offset byte to start reading from (REAL) * * Output: An n+2-element list: * Elements 1,2,...,n are the parsed data vectors * Element n is the number of rows retrieved <= M * Element n+1 is the final byte offset into DATA */ SEXP scidb_parse (SEXP M, SEXP TYPES, SEXP NULLABLE, SEXP DATA, SEXP OFFSET) { int nullable, i=0,j; SEXP col, val, ans; int m = INTEGER(M)[0]; R_xlen_t n = XLENGTH(TYPES); double doffset = REAL(OFFSET)[0]; size_t offset = (size_t)doffset; R_xlen_t s = XLENGTH(DATA); char *p = (char *)RAW(DATA); char *q = p; p+=offset; // Check length mismatch if(n!=XLENGTH(NULLABLE)) error("length(TYPES) must match length(NULLABLE)"); // create the data frame list ans = PROTECT (NEW_LIST (n+2)); int protectCount = 1; // fill in the list with columns of an appropriate type and size for (j = 0; j < n; ++j) { SET_VECTOR_ELT(ans,j, PROTECT(scidb_type_vector(CHAR(STRING_ELT(TYPES,j)), m))); protectCount++; } // Make sure starting condition is valid if(p-q >= s) goto end; for(i=0;i<m;++i) { for(j=0;j<n;++j) { col = VECTOR_ELT(ans,j); // XXX Add max bytes allowed to read here... scidb_value(&p, CHAR(STRING_ELT(TYPES,j)), INTEGER(NULLABLE)[j], col, i); if(p-q >= s) { i++; goto end; } } } end: SET_VECTOR_ELT(ans, n, ScalarInteger(i)); SET_VECTOR_ELT(ans, n+1, ScalarReal((double)(p-q))); UNPROTECT (protectCount); return (ans); }
extern "C" SEXP unserializeFromRaw(SEXP object) { struct R_inpstream_st in; /* We might want to read from a long raw vector */ struct membuf_st mbs; if (TYPEOF(object) == RAWSXP) { void *data = RAW(object); R_xlen_t length = XLENGTH(object); InitMemInPStream(&in, &mbs, data, length, NULL, NULL); return R_Unserialize(&in); } error("can't unserialize object"); return(R_UnboundValue); }
SEXP ConvertBinary(bson_iter_t* iter){ bson_subtype_t subtype; uint32_t binary_len; const uint8_t *binary; bson_iter_binary(iter, &subtype, &binary_len, &binary); //create raw vector SEXP out = PROTECT(allocVector(RAWSXP, binary_len)); for (int i = 0; i < binary_len; i++) { RAW(out)[i] = binary[i]; } setAttrib(out, install("subtype"), ScalarInteger(subtype)); UNPROTECT(1); return out; }
SEXP R_unzReadCurrentFile(SEXP r_unzFile, SEXP r_buf, SEXP r_numBytes) { unzFile f = DEREF_REF_PTR_CLASS( r_unzFile, unzFile, unzContent ); int err = UNZ_OK; void *buf; int numBytes; numBytes = REAL(r_numBytes)[0]; buf = TYPEOF(r_buf) == RAWSXP ? RAW(r_buf) : (void*) CHAR(STRING_ELT(r_buf, 0)); err = unzReadCurrentFile(f, buf, numBytes); return(ScalarLogical(err > 0)); }
/* convert single precision object to a numeric vector */ SEXP float2double(SEXP fObject) { const float *f; double *d; SEXP res; int i, n; if (TYPEOF(fObject) != RAWSXP || !inherits(fObject, "clFloat")) Rf_error("invalid single precision object"); n = LENGTH(fObject) / sizeof(float); res = Rf_allocVector(REALSXP, n); d = REAL(res); f = (const float*) RAW(fObject); for (i = 0; i < n; i++) d[i] = f[i]; return res; }
SEXP R_ring_buffer_memcpy_from(SEXP extPtr, SEXP r_count) { size_t count = INTEGER(r_count)[0]; ring_buffer * buffer = ring_buffer_get(extPtr, 1); SEXP ret = PROTECT(allocVector(RAWSXP, count * buffer->stride)); if (ring_buffer_memcpy_from(RAW(ret), buffer, count) == NULL) { // TODO: this would be better reporting than just saying "Buffer // underflow". But we need to switch here on stride being 1 or // compute the byte size of `count` entries. Rf_error("Buffer underflow (requested %d bytes but %d available)", count, ring_buffer_used(buffer, 1) / buffer->stride); } UNPROTECT(1); // NOTE: In C we return the tail position here but that is not done // for the R version. return ret; }
int R_curl_callback_debug(CURL *handle, curl_infotype type_, char *data, size_t size, SEXP fun) { /* wrap type and msg into R types */ SEXP type = PROTECT(ScalarInteger(type_)); SEXP msg = PROTECT(allocVector(RAWSXP, size)); memcpy(RAW(msg), data, size); /* call the R function */ SEXP call = PROTECT(LCONS(fun, LCONS(type, LCONS(msg, R_NilValue)))); R_tryEval(call, R_GlobalEnv, NULL); UNPROTECT(3); // Debug function must always return 0 return 0; }
SEXP signRSA(SEXP messageVec, SEXP privateKey) { SEXP res; SEXP message; EVP_MD_CTX *mdctx; const EVP_MD *md; unsigned char digest[SHA256_DIGEST_LENGTH]; EVP_PKEY *key; RSA *rsa; unsigned char sig[8096]; unsigned int sigLen = 0; if (TYPEOF(messageVec) != STRSXP || LENGTH(messageVec) == 0) { Rf_error("Payload must be a character vector"); } message = STRING_ELT(messageVec, 0); md = EVP_sha256(); mdctx = EVP_MD_CTX_create(); EVP_DigestInit_ex(mdctx, md, NULL); EVP_DigestUpdate(mdctx, CHAR(message), LENGTH(message)); EVP_DigestFinal_ex(mdctx, digest, NULL); EVP_MD_CTX_destroy(mdctx); if (!inherits(privateKey, "private.key")) { Rf_error("Key does not have class private.key"); } key = (EVP_PKEY*) R_ExternalPtrAddr(privateKey); if (!key) { Rf_error("NULL key provided"); } if (EVP_PKEY_type(key->type) != EVP_PKEY_RSA) { Rf_error("Key must be RSA private key"); } rsa = EVP_PKEY_get1_RSA(key); if (!rsa) { Rf_error("%s", ERR_error_string(ERR_get_error(), NULL)); } if (RSA_sign(NID_sha256, (const unsigned char*) digest, SHA256_DIGEST_LENGTH, (unsigned char *) &sig, &sigLen, rsa) != 1) { Rf_error("%s", ERR_error_string(ERR_get_error(), NULL)); } res = PROTECT(allocVector(RAWSXP, sigLen)); memcpy(RAW(res), sig, sigLen); UNPROTECT(1); return res; }
SEXP grpDupAtomMatHash(SEXP x, SEXP MARGIN, SEXP fromLast) {/* returns an integer vector of duplicated rows of numeric matrix x */ SEXP out; int* dim; int nGrps; dim=INTEGER(getAttrib(x, R_DimSymbol)); out = PROTECT(allocVector(INTSXP, dim[*INTEGER(MARGIN)-1])); switch (TYPEOF(x)) { case REALSXP: nGrps = doubleVecMapHash.grpDuplicatedMat (REAL(x), dim, dim+1, INTEGER(out), *INTEGER(MARGIN)==1, (bool)(*(LOGICAL(fromLast))) ); break; case INTSXP: // factor type is also covered here // if(!inherits(x, "factor")) nGrps = intVecMapHash.grpDuplicatedMat (INTEGER(x), dim, dim+1, INTEGER(out), *INTEGER(MARGIN)==1, (bool)(*(LOGICAL(fromLast))) ); // else {;} break; case LGLSXP: nGrps = intVecMapHash.grpDuplicatedMat (LOGICAL(x), dim, dim+1, INTEGER(out), *INTEGER(MARGIN)==1, (bool)(*(LOGICAL(fromLast))) ); break; case STRSXP: { CharSEXP* charSexpPtr = new CharSEXP [ dim[0]*dim[1] ]; for(int i=dim[0]*dim[1]-1; i>=0; --i) charSexpPtr[i].sexp = STRING_ELT(x, i); nGrps = charsexpVecMapHash.grpDuplicatedMat (charSexpPtr, dim, dim+1, INTEGER(out), *INTEGER(MARGIN)==1, (bool)(*(LOGICAL(fromLast))) ); delete[] charSexpPtr; break; } case CPLXSXP: nGrps = cmplxVecMapHash.grpDuplicatedMat (COMPLEX(x), dim, dim+1, INTEGER(out), *INTEGER(MARGIN)==1, (bool)(*(LOGICAL(fromLast))) ); break; case RAWSXP: nGrps = rawVecMapHash.grpDuplicatedMat (RAW(x), dim, dim+1, INTEGER(out), *INTEGER(MARGIN)==1, (bool)(*(LOGICAL(fromLast))) ); break; default: error("C function 'grpDupAtomMatHash' only accepts REALSXP, LGLSXP, INTSXP and STRSXP"); } SEXP nLevels; nLevels = PROTECT(allocVector(INTSXP, 1)); INTEGER(nLevels)[0] = nGrps; setAttrib(out, install("nlevels"), nLevels); UNPROTECT(2); return out; }
void printVector(SEXP x, int indx, int quote) { /* print R vector x[]; if(indx) print indices; if(quote) quote strings */ R_xlen_t n; if ((n = XLENGTH(x)) != 0) { R_xlen_t n_pr = (n <= R_print.max +1) ? n : R_print.max; /* '...max +1' ==> will omit at least 2 ==> plural in msg below */ switch (TYPEOF(x)) { case LGLSXP: printLogicalVector(LOGICAL(x), n_pr, indx); break; case INTSXP: printIntegerVector(INTEGER(x), n_pr, indx); break; case REALSXP: printRealVector(REAL(x), n_pr, indx); break; case STRSXP: if (quote) printStringVector(STRING_PTR(x), n_pr, '"', indx); else printStringVector(STRING_PTR(x), n_pr, 0, indx); break; case CPLXSXP: printComplexVector(COMPLEX(x), n_pr, indx); break; case RAWSXP: printRawVector(RAW(x), n_pr, indx); break; } if(n_pr < n) Rprintf(" [ reached getOption(\"max.print\") -- omitted %d entries ]\n", n - n_pr); } else #define PRINT_V_0 \ switch (TYPEOF(x)) { \ case LGLSXP: Rprintf("logical(0)\n"); break; \ case INTSXP: Rprintf("integer(0)\n"); break; \ case REALSXP: Rprintf("numeric(0)\n"); break; \ case CPLXSXP: Rprintf("complex(0)\n"); break; \ case STRSXP: Rprintf("character(0)\n"); break; \ case RAWSXP: Rprintf("raw(0)\n"); break; \ } PRINT_V_0; }
/* convert a numeric vector to a single precision object */ SEXP double2float(SEXP dObject) { const double *d; float *f; SEXP res; int i, n; dObject = Rf_coerceVector(dObject, REALSXP); n = LENGTH(dObject); d = REAL(dObject); res = PROTECT(Rf_allocVector(RAWSXP, n * sizeof(float))); f = (float*) RAW(res); for (i = 0; i < n; i++) f[i] = d[i]; Rf_setAttrib(res, R_ClassSymbol, Rf_mkString("clFloat")); UNPROTECT(1); return res; }
template<> QByteArray from_sexp<QByteArray>(SEXP sexp, const SmokeType &type) { if (sexp == R_NilValue) return QByteArray(0); int len = 0; const char *data = NULL; if (TYPEOF(sexp) == STRSXP) { // do the equivalent of charToRaw() if (length(sexp) != 1) error("character vector must have length 1 for conversion to QByteArray"); sexp = STRING_ELT(sexp, 0); data = CHAR(sexp); } else { sexp = coerceVector(sexp, RAWSXP); data = (const char *)RAW(sexp); } return QByteArray(data, length(sexp)); }
//------------------------------------------------------------------------------ /// Physically writes the status of a block inside its first page spare area. /// Returns 0 if successful; otherwise returns a NandCommon_ERROR_xx code. /// \param managed Pointer to a ManagedNandFlash instance. /// \param block Raw block number. /// \param pStatus Pointer to status data. /// \param spare Pointer to allocated spare area (must be assigned). //------------------------------------------------------------------------------ static unsigned char WriteBlockStatus( const struct ManagedNandFlash *managed, unsigned short block, struct NandBlockStatus *pStatus, unsigned char *spare) { ASSERT(spare, "ManagedNandFlash_WriteBlockStatus: spare\n\r"); memset(spare, 0xFF, NandCommon_MAXPAGESPARESIZE); NandSpareScheme_WriteExtra(NandFlashModel_GetScheme(MODEL(managed)), spare, pStatus, 4, 0); return RawNandFlash_WritePage(RAW(managed), block, 0, 0, spare); }
extern "C" SEXP sourcetools_read_bytes(SEXP absolutePathSEXP) { const char* absolutePath = CHAR(STRING_ELT(absolutePathSEXP, 0)); std::string contents; bool result = sourcetools::read(absolutePath, &contents); if (!result) { Rf_warning("Failed to read file"); return R_NilValue; } sourcetools::r::Protect protect; SEXP resultSEXP = protect(Rf_allocVector(RAWSXP, contents.size())); std::memcpy(RAW(resultSEXP), contents.c_str(), contents.size()); return resultSEXP; }
//------------------------------------------------------------------------------ /// Initializes an EccNandFlash instance. /// \param ecc Pointer to an EccNandFlash instance. /// \param model Pointer to the underlying nand chip model. Can be 0. /// \param commandAddress Address at which commands are sent. /// \param addressAddress Address at which addresses are sent. /// \param dataAddress Address at which data is sent. /// \param pinChipEnable Pin controlling the CE signal of the NandFlash. /// \param pinReadyBusy Pin used to monitor the ready/busy signal of the Nand. //------------------------------------------------------------------------------ unsigned char EccNandFlash_Initialize( struct EccNandFlash *ecc, const struct NandFlashModel *model, unsigned int commandAddress, unsigned int addressAddress, unsigned int dataAddress, const Pin pinChipEnable, const Pin pinReadyBusy) { return RawNandFlash_Initialize(RAW(ecc), model, commandAddress, addressAddress, dataAddress, pinChipEnable, pinReadyBusy); }