Skip to content

Commit 1117f6f

Browse files
ben-schwenben-schwen
committed
add patch to devcontainer
1 parent ce5fcb5 commit 1117f6f

File tree

3 files changed

+324
-0
lines changed

3 files changed

+324
-0
lines changed

‎.devcontainer/r-devel-growable/Dockerfile‎

Lines changed: 55 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,55 @@
1+
FROM registry.gitlab.com/rdatatable/dockerfiles/r-devel-gcc
2+
3+
RUN apt-get -qq update \
4+
&& apt-get install -y --no-install-recommends \
5+
git \
6+
patch \
7+
subversion \
8+
rsync \
9+
texinfo \
10+
texlive-latex-base \
11+
texlive-latex-recommended \
12+
texlive-fonts-recommended \
13+
&& rm -rf /var/lib/apt/lists/*
14+
15+
COPY .devcontainer/r-devel-growable/growable-api.patch /opt/growable-api.patch
16+
17+
WORKDIR /opt/R-source
18+
RUN svn checkout https://svn.r-project.org/R/trunk R-devel && \
19+
cd R-devel && \
20+
patch -p0 < /opt/growable-api.patch
21+
22+
# Build patched R
23+
WORKDIR /opt/R-source/R-devel
24+
RUN ./configure \
25+
--prefix=/usr/local \
26+
--enable-R-shlib \
27+
--enable-memory-profiling \
28+
--with-blas \
29+
--with-lapack \
30+
--with-readline \
31+
--with-cairo \
32+
--with-libpng \
33+
--with-jpeglib \
34+
--with-libtiff \
35+
--disable-nls && \
36+
make -j$(nproc) && \
37+
make install
38+
39+
RUN echo 'Testing growable vectors...' && \
40+
/usr/local/bin/R --slave -e '.Internal(growvec_alloc(13L, 0, 10))'
41+
42+
ENV PATH=/usr/local/bin:$PATH
43+
ENV R_HOME=/usr/local/lib/R
44+
45+
COPY DESCRIPTION .
46+
RUN /usr/local/bin/Rscript -e ' \
47+
read.dcf("DESCRIPTION", c("Imports", "Suggests")) |> \
48+
tools:::.split_dependencies() |> \
49+
names() |> \
50+
setdiff(tools:::.get_standard_package_names()$base) |> \
51+
install.packages() \
52+
'
53+
54+
WORKDIR /root
55+
COPY .devcontainer/.Rprofile .

‎.devcontainer/r-devel-growable/devcontainer.json‎

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,15 @@
1+
{
2+
"name": "R-devel with Growable Vectors",
3+
"build": {
4+
"dockerfile": "Dockerfile",
5+
"context": "../.."
6+
},
7+
"customizations": {
8+
"vscode": {
9+
"extensions": [
10+
"REditorSupport.r",
11+
"ms-vscode.cpptools-extension-pack"
12+
]
13+
}
14+
}
15+
}

‎.devcontainer/r-devel-growable/growable-api.patch‎

Lines changed: 254 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,254 @@
1+
Index: src/include/Internal.h
2+
===================================================================
3+
--- src/include/Internal.h (revision 88869)
4+
+++ src/include/Internal.h (working copy)
5+
@@ -545,6 +545,13 @@
6+
SEXP do_retracemem(SEXP, SEXP, SEXP, SEXP);
7+
SEXP do_untracemem(SEXP, SEXP, SEXP, SEXP);
8+
9+
+SEXP do_growvec_alloc(SEXP, SEXP, SEXP, SEXP);
10+
+SEXP do_growvec_max_size(SEXP, SEXP, SEXP, SEXP);
11+
+SEXP do_growvec_resize(SEXP, SEXP, SEXP, SEXP);
12+
+SEXP do_growvec_is_growable(SEXP, SEXP, SEXP, SEXP);
13+
+SEXP do_growvec_make_growable(SEXP, SEXP, SEXP, SEXP);
14+
+SEXP do_growvec_trim(SEXP, SEXP, SEXP, SEXP);
15+
+
16+
/* ALTREP-related */
17+
18+
SEXP do_sorted_fpass(SEXP, SEXP, SEXP, SEXP);
19+
Index: src/include/Rgrowable.h
20+
===================================================================
21+
--- src/include/Rgrowable.h (nonexistent)
22+
+++ src/include/Rgrowable.h (working copy)
23+
@@ -0,0 +1,14 @@
24+
+#ifndef R_GROWABLE_H_
25+
+#define R_GROWABLE_H_
26+
+
27+
+#include <Rinternals.h>
28+
+
29+
+/* Minimal internal API for growable vectors. */
30+
+SEXP growable_allocate(SEXPTYPE type, R_xlen_t size, R_xlen_t max_size);
31+
+R_xlen_t growable_capacity(SEXP x);
32+
+void growable_resize(SEXP x, R_xlen_t newsize);
33+
+Rboolean is_growable(SEXP x);
34+
+SEXP make_growable(SEXP x);
35+
+SEXP growable_trim(SEXP x);
36+
+
37+
+#endif
38+
39+
===================================================================
40+
--- src/main/Makefile.in (revision 88869)
41+
+++ src/main/Makefile.in (working copy)
42+
@@ -23,7 +23,7 @@
43+
dotcode.c dounzip.c dstruct.c duplicate.c \
44+
edit.c engine.c envir.c errors.c eval.c \
45+
flexiblas.c format.c \
46+
- gevents.c gram.c gram-ex.c graphics.c grep.c \
47+
+ gevents.c gram.c gram-ex.c graphics.c grep.c growable.c \
48+
identical.c inlined.c inspect.c internet.c iosupport.c \
49+
lapack.c list.c localecharset.c logic.c \
50+
machine.c main.c mapply.c mask.c match.c memory.c \
51+
Index: src/main/growable.c
52+
===================================================================
53+
--- src/main/growable.c (nonexistent)
54+
+++ src/main/growable.c (working copy)
55+
@@ -0,0 +1,131 @@
56+
+#include <R.h>
57+
+#include <Rinternals.h>
58+
+#include <string.h>
59+
+#include <Rgrowable.h>
60+
+
61+
+static SEXP ensure_materialized(SEXP x) {
62+
+ if (!ALTREP(x)) return x;
63+
+ if (!isVector(x))
64+
+ Rf_error("make_growable: not a vector");
65+
+
66+
+ SEXPTYPE t = TYPEOF(x);
67+
+ R_xlen_t len = XLENGTH(x);
68+
+ SEXP y = PROTECT(Rf_allocVector(t, len));
69+
+ SETLENGTH(y, len);
70+
+ SET_TRUELENGTH(y, len);
71+
+ SET_GROWABLE_BIT(y);
72+
+ /* Copy using safe element accessors */
73+
+ switch (t) {
74+
+ case LGLSXP:
75+
+ case INTSXP: {
76+
+ int *yp = INTEGER(y);
77+
+ for (R_xlen_t i = 0; i < len; ++i) yp[i] = INTEGER_ELT(x, i);
78+
+ break;
79+
+ }
80+
+ case REALSXP: {
81+
+ double *yp = REAL(y);
82+
+ for (R_xlen_t i = 0; i < len; ++i) yp[i] = REAL_ELT(x, i);
83+
+ break;
84+
+ }
85+
+ case CPLXSXP: {
86+
+ Rcomplex *yp = COMPLEX(y);
87+
+ for (R_xlen_t i = 0; i < len; ++i) yp[i] = COMPLEX_ELT(x, i);
88+
+ break;
89+
+ }
90+
+ case RAWSXP: {
91+
+ Rbyte *yp = RAW(y);
92+
+ for (R_xlen_t i = 0; i < len; ++i) yp[i] = RAW_ELT(x, i);
93+
+ break;
94+
+ }
95+
+ case STRSXP: {
96+
+ for (R_xlen_t i = 0; i < len; ++i) SET_STRING_ELT(y, i, STRING_ELT(x, i));
97+
+ break;
98+
+ }
99+
+ case VECSXP:
100+
+ case EXPRSXP: {
101+
+ for (R_xlen_t i = 0; i < len; ++i) SET_VECTOR_ELT(y, i, VECTOR_ELT(x, i));
102+
+ break;
103+
+ }
104+
+ default:
105+
+ Rf_error("make_growable: unsupported type %d", (int)t);
106+
+ }
107+
+ DUPLICATE_ATTRIB(y, x);
108+
+ UNPROTECT(1);
109+
+ return y;
110+
+}
111+
+
112+
+SEXP growable_allocate(SEXPTYPE type, R_xlen_t size, R_xlen_t max_size) {
113+
+ if (!(type == LGLSXP || type == INTSXP || type == REALSXP || type == CPLXSXP || type == STRSXP || type == RAWSXP || type == VECSXP))
114+
+ Rf_error("growable_allocate: unsupported type %d", (int)type);
115+
+ if (size < 0 || max_size < 0)
116+
+ Rf_error("growable_allocate: negative size/capacity");
117+
+ if (size > max_size)
118+
+ Rf_error("growable_allocate: size (%lld) > max_size (%lld)",
119+
+ (long long)size, (long long)max_size);
120+
+
121+
+ SEXP ret = PROTECT(Rf_allocVector(type, max_size));
122+
+ SET_TRUELENGTH(ret, max_size);
123+
+ SET_GROWABLE_BIT(ret);
124+
+ SETLENGTH(ret, size);
125+
+ UNPROTECT(1);
126+
+ return ret;
127+
+}
128+
+
129+
+R_xlen_t growable_capacity(SEXP x) {
130+
+ return TRUELENGTH(x);
131+
+}
132+
+
133+
+void growable_resize(SEXP x, R_xlen_t newsize) {
134+
+ if (!isVector(x))
135+
+ Rf_error("growable_resize: 'x' must be a vector");
136+
+ if (newsize < 0)
137+
+ Rf_error("growable_resize: negative size");
138+
+ if (ALTREP(x))
139+
+ Rf_error("growable_resize: ALTREP must be materialized first (use make_growable())");
140+
+
141+
+ R_xlen_t cap = TRUELENGTH(x);
142+
+ if (newsize > cap) {
143+
+ Rf_error("growable_resize: newsize (%lld) > max_size (%lld)",
144+
+ (long long)newsize, (long long)cap);
145+
+ }
146+
+ SETLENGTH(x, newsize);
147+
+}
148+
+
149+
+Rboolean is_growable(SEXP x) {
150+
+ if (!isVector(x)) return FALSE;
151+
+ if (ALTREP(x)) return FALSE; // conservative, could be supported
152+
+ if (TRUELENGTH(x) < XLENGTH(x)) return FALSE;
153+
+ if (!IS_GROWABLE(x)) return FALSE;
154+
+ return TRUE;
155+
+}
156+
+
157+
+SEXP make_growable(SEXP x) {
158+
+ if (!isVector(x))
159+
+ Rf_error("make_growable: not a vector");
160+
+ if (ALTREP(x)) {
161+
+ return ensure_materialized(x);
162+
+ }
163+
+ if (TRUELENGTH(x) < XLENGTH(x)) {
164+
+ SET_TRUELENGTH(x, XLENGTH(x));
165+
+ }
166+
+ SET_GROWABLE_BIT(x);
167+
+ return x;
168+
+}
169+
+
170+
+SEXP growable_trim(SEXP x) {
171+
+ R_xlen_t len = XLENGTH(x);
172+
+ R_xlen_t max_len = TRUELENGTH(x);
173+
+ if (len == max_len) {
174+
+ return x;
175+
+ }
176+
+
177+
+ if (!is_growable(x)) {
178+
+ Rf_error("growable_trim: object is not growable");
179+
+ }
180+
+
181+
+ growable_resize(x, max_len); // set length to max_len to force reallocation
182+
+ SEXP ans = PROTECT(Rf_xlengthgets(x, len));
183+
+ SETLENGTH(x, len);
184+
+ UNPROTECT(1);
185+
+ return ans;
186+
+}
187+
188+
===================================================================
189+
--- src/main/names.c (revision 88869)
190+
+++ src/main/names.c (working copy)
191+
@@ -230,6 +230,12 @@
192+
/* .Internals */
193+
194+
{"vector", do_makevector, 0, 11, 2, {PP_FUNCALL, PREC_FN, 0}},
195+
+{"growvec_alloc", do_growvec_alloc, 0, 11, 3, {PP_FUNCALL, PREC_FN, 0}},
196+
+{"growvec_max_size", do_growvec_max_size, 0, 11, 1, {PP_FUNCALL, PREC_FN, 0}},
197+
+{"growvec_resize", do_growvec_resize, 0, 11, 2, {PP_FUNCALL, PREC_FN, 0}},
198+
+{"growvec_is_growable", do_growvec_is_growable, 0, 11, 1, {PP_FUNCALL, PREC_FN, 0}},
199+
+{"growvec_make_growable", do_growvec_make_growable, 0, 11, 1, {PP_FUNCALL, PREC_FN, 0}},
200+
+{"growvec_trim", do_growvec_trim, 0, 11, 1, {PP_FUNCALL, PREC_FN, 0}},
201+
{"complex", do_complex, 0, 11, 3, {PP_FUNCALL, PREC_FN, 0}},
202+
{"matrix", do_matrix, 0, 11, 7, {PP_FUNCALL, PREC_FN, 0}},
203+
{"array", do_array, 0, 11, 3, {PP_FUNCALL, PREC_FN, 0}},
204+
@@ -1451,3 +1457,50 @@
205+
{
206+
return PRIMNAME(object);
207+
}
208+
+
209+
+/* Growable vector wrapper functions */
210+
+extern SEXP growable_allocate(SEXPTYPE, R_xlen_t, R_xlen_t);
211+
+extern R_xlen_t growable_capacity(SEXP);
212+
+extern void growable_resize(SEXP, R_xlen_t);
213+
+extern Rboolean is_growable(SEXP);
214+
+extern SEXP make_growable(SEXP);
215+
+extern SEXP growable_trim(SEXP);
216+
+
217+
+SEXP do_growvec_alloc(SEXP call, SEXP op, SEXP args, SEXP env) {
218+
+ SEXP typeS = CAR(args); args = CDR(args);
219+
+ SEXP sizeS = CAR(args); args = CDR(args);
220+
+ SEXP capS = CAR(args);
221+
+ return growable_allocate(asInteger(typeS),
222+
+ (R_xlen_t)asReal(sizeS),
223+
+ (R_xlen_t)asReal(capS));
224+
+}
225+
+
226+
+SEXP do_growvec_max_size(SEXP call, SEXP op, SEXP args, SEXP env) {
227+
+ SEXP x = CAR(args);
228+
+ R_xlen_t max_size = growable_capacity(x);
229+
+ return ScalarReal((double)max_size);
230+
+}
231+
+
232+
+SEXP do_growvec_resize(SEXP call, SEXP op, SEXP args, SEXP env) {
233+
+ SEXP x = CAR(args); args = CDR(args);
234+
+ SEXP newsizeS = CAR(args);
235+
+ growable_resize(x, (R_xlen_t)asReal(newsizeS));
236+
+ return R_NilValue;
237+
+}
238+
+
239+
+SEXP do_growvec_is_growable(SEXP call, SEXP op, SEXP args, SEXP env) {
240+
+ SEXP x = CAR(args);
241+
+ Rboolean result = is_growable(x);
242+
+ return ScalarLogical(result);
243+
+}
244+
+
245+
+SEXP do_growvec_make_growable(SEXP call, SEXP op, SEXP args, SEXP env) {
246+
+ SEXP x = CAR(args);
247+
+ return make_growable(x);
248+
+}
249+
+
250+
+SEXP do_growvec_trim(SEXP call, SEXP op, SEXP args, SEXP env) {
251+
+ SEXP x = CAR(args);
252+
+ SEXP result = growable_trim(x);
253+
+ return result;
254+
+}

0 commit comments

Comments
 (0)