File: inject_code.c

package info (click to toggle)
r-bioc-biostrings 2.42.1-1
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 14,652 kB
  • ctags: 721
  • sloc: ansic: 10,262; sh: 11; makefile: 2
file content (42 lines) | stat: -rw-r--r-- 1,142 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
#include "Biostrings.h"
#include "XVector_interface.h"
#include "IRanges_interface.h"
#include "S4Vectors_interface.h"

/*
 * --- .Call ENTRY POINT ---
 * Return an XString object.
 */
SEXP XString_inject_code(SEXP x, SEXP start, SEXP width, SEXP code)
{
	const char *x_classname;
	Chars_holder X;
	int nranges, i, s, w;
	const int *s_p, *w_p;
	SEXP tag, ans;

	x_classname = get_classname(x);
	X = hold_XRaw(x);
	nranges = LENGTH(start); /* must be == LENGTH(width) */
	PROTECT(tag = NEW_RAW(X.length));
	memcpy(RAW(tag), X.ptr, X.length);
	for (i = 0, s_p = INTEGER(start),  w_p = INTEGER(width);
	     i < nranges;
	     i++, s_p++, w_p++)
	{
		s = *s_p;
		w = *w_p;
		if (s == NA_INTEGER || w == NA_INTEGER)
			error("Biostrings internal error in XString_inject_code():"
			      "NAs in 'start' or 'width' are not supported");
		s--; // 0-based start (offset)
		if (s < 0 || w < 0 || s + w > X.length)
			error("Biostrings internal error in XString_inject_code():"
			      "invalid start/width values");
		memset(RAW(tag) + s, INTEGER(code)[0], w);
	}
	PROTECT(ans = new_XRaw_from_tag(x_classname, tag));
	UNPROTECT(2);
	return ans;
}