thr3ads.net - R devel - [Rd] RFC: "loop connections" [Aug 2005]

If this information is useful, please help other people find it:
Share via:

dhinds@sonic.net

2005-Aug-22 23:34 UTC

[Rd] RFC: "loop connections"

I've just implemented a generalization of R's text connections, to
also support reading/writing raw binary data.  There is very little
new code to speak of.  For input connections, I wrote code to populate
the old text connection buffer from a raw vector, and provided a new
raw_read() method.  For output connections, I wrote a raw_write() to
append to a raw vector.  On input, the mode (text or binary) is
determined by the data type of the input object; on output, I use the
requested output mode (i.e. "w" / "wb").  For example:

 > con <- loopConnection("r", "wb")
 > a <- c(10,100,1000)
 > writeBin(a, con, size=4)
 > r
  [1] 00 00 20 41 00 00 c8 42 00 00 7a 44
 > close(con)
 > con <- loopConnection(r)
 > readBin(con, "double", n=3, size=4)
 [1]   10  100 1000
 > close(con)

I think "loop connection" is a better name for this sort of connection
than "text connection" was even for the old version; that confuses the
mode of the connection (text vs binary) with the mechanism (file,
socket, etc).

I've appended a patch to the end of this message.  As implemented
here, textConnection is replaced by loopConnection but functionally
this is a superset of the old textConnection.  For compatibility, one
could add:

  textConnection <- function(...) loopConnection(...)

The patch is against R-2.1.1.  I can investigate whether any changes
are required for the current development tree.  I can also update the
documentation files as required.  I thought I'd first check whether
anyone else thought this was worth inclusion before spending more time
on it.

The raw_write() code could be improved with smarter memory allocation
(grabbing bigger chunks rather than reallocating the raw vector for
every write), but this is at least a proof of principle.

-- David Hinds



--- src/main/connections.c.orig	2005-06-17 19:05:02.000000000 -0700
+++ src/main/connections.c	2005-08-22 15:54:03.156038200 -0700
@@ -1644,13 +1644,13 @@
     return ans;
 }
 
-/* ------------------- text connections --------------------- */
+/* ------------------- loop connections --------------------- */
 
 /* read a R character vector into a buffer */
 static void text_init(Rconnection con, SEXP text)
 {
     int i, nlines = length(text), nchars = 0;
-    Rtextconn this = (Rtextconn)con->private;
+    Rloopconn this = (Rloopconn)con->private;
 
     for(i = 0; i < nlines; i++)
 	nchars += strlen(CHAR(STRING_ELT(text, i))) + 1;
@@ -1668,19 +1668,35 @@
     this->cur = this->save = 0;
 }
 
-static Rboolean text_open(Rconnection con)
+/* read a R raw vector into a buffer */
+static void raw_init(Rconnection con, SEXP raw)
+{
+    int nbytes = length(raw);
+    Rloopconn this = (Rloopconn)con->private;
+
+    this->data = (char *) malloc(nbytes);
+    if(!this->data) {
+	free(this); free(con->description); free(con->class); free(con);
+	error(_("cannot allocate memory for raw connection"));
+    }
+    memcpy(this->data, RAW(raw), nbytes);
+    this->nchars = nbytes;
+    this->cur = this->save = 0;
+}
+
+static Rboolean loop_open(Rconnection con)
 {
     con->save = -1000;
     return TRUE;
 }
 
-static void text_close(Rconnection con)
+static void loop_close(Rconnection con)
 {
 }
 
-static void text_destroy(Rconnection con)
+static void loop_destroy(Rconnection con)
 {
-    Rtextconn this = (Rtextconn)con->private;
+    Rloopconn this = (Rloopconn)con->private;
 
     free(this->data);
     /* this->cur = this->nchars = 0; */
@@ -1689,7 +1705,7 @@
 
 static int text_fgetc(Rconnection con)
 {
-    Rtextconn this = (Rtextconn)con->private;
+    Rloopconn this = (Rloopconn)con->private;
     if(this->save) {
 	int c;
 	c = this->save;
@@ -1700,48 +1716,69 @@
     else return (int) (this->data[this->cur++]);
 }
 
-static double text_seek(Rconnection con, double where, int origin, int rw)
+static double loop_seek(Rconnection con, double where, int origin, int rw)
 {
-    if(where >= 0) error(_("seek is not relevant for text
connection"));
+    if(where >= 0) error(_("seek is not relevant for loop
connection"));
     return 0; /* if just asking, always at the beginning */
 }
 
-static Rconnection newtext(char *description, SEXP text)
+static size_t raw_read(void *ptr, size_t size, size_t nitems,
+		       Rconnection con)
+{
+    Rloopconn this = (Rloopconn)con->private;
+    if (this->cur + size*nitems > this->nchars) {
+	nitems = (this->nchars - this->cur)/size;
+	memcpy(ptr, this->data+this->cur, size*nitems);
+	this->cur = this->nchars;
+    } else {
+	memcpy(ptr, this->data+this->cur, size*nitems);
+	this->cur += size*nitems;
+    }
+    return nitems;
+}
+
+static Rconnection newloop(char *description, SEXP data)
 {
     Rconnection new;
     new = (Rconnection) malloc(sizeof(struct Rconn));
-    if(!new) error(_("allocation of text connection failed"));
-    new->class = (char *) malloc(strlen("textConnection") + 1);
+    if(!new) error(_("allocation of loop connection failed"));
+    new->class = (char *) malloc(strlen("loopConnection") + 1);
     if(!new->class) {
 	free(new);
-	error(_("allocation of text connection failed"));
+	error(_("allocation of loop connection failed"));
     }
-    strcpy(new->class, "textConnection");
+    strcpy(new->class, "loopConnection");
     new->description = (char *) malloc(strlen(description) + 1);
     if(!new->description) {
 	free(new->class); free(new);
-	error(_("allocation of text connection failed"));
+	error(_("allocation of loop connection failed"));
     }
     init_con(new, description, "r");
     new->isopen = TRUE;
     new->canwrite = FALSE;
-    new->open = &text_open;
-    new->close = &text_close;
-    new->destroy = &text_destroy;
-    new->fgetc = &text_fgetc;
-    new->seek = &text_seek;
-    new->private = (void*) malloc(sizeof(struct textconn));
+    new->open = &loop_open;
+    new->close = &loop_close;
+    new->destroy = &loop_destroy;
+    new->seek = &loop_seek;
+    new->private = (void*) malloc(sizeof(struct loopconn));
     if(!new->private) {
 	free(new->description); free(new->class); free(new);
-	error(_("allocation of text connection failed"));
+	error(_("allocation of loop connection failed"));
+    }
+    new->text = isString(data);
+    if (new->text) {
+	new->fgetc = &text_fgetc;
+	text_init(new, data);
+    } else {
+	new->read = &raw_read;
+	raw_init(new, data);
     }
-    text_init(new, text);
     return new;
 }
 
-static void outtext_close(Rconnection con)
+static void outloop_close(Rconnection con)
 {
-    Routtextconn this = (Routtextconn)con->private;
+    Routloopconn this = (Routloopconn)con->private;
     SEXP tmp;
     int idx = ConnIndex(con);
 
@@ -1755,9 +1792,9 @@
     SET_VECTOR_ELT(OutTextData, idx, R_NilValue);
 }
 
-static void outtext_destroy(Rconnection con)
+static void outloop_destroy(Rconnection con)
 {
-    Routtextconn this = (Routtextconn)con->private;
+    Routloopconn this = (Routloopconn)con->private;
     free(this->lastline); free(this);
 }
 
@@ -1765,7 +1802,7 @@
 
 static int text_vfprintf(Rconnection con, const char *format, va_list ap)
 {
-    Routtextconn this = (Routtextconn)con->private;
+    Routloopconn this = (Routloopconn)con->private;
     char buf[BUFSIZE], *b = buf, *p, *q, *vmax = vmaxget();
     int res = 0, usedRalloc = FALSE, buffree,
 	already = strlen(this->lastline);
@@ -1830,24 +1867,41 @@
     return res;
 }
 
-static void outtext_init(Rconnection con, char *mode, int idx)
+static size_t raw_write(const void *ptr, size_t size, size_t nitems,
+			Rconnection con)
+{
+    Routloopconn this = (Routloopconn)con->private;
+    SEXP tmp;
+    int idx = ConnIndex(con);
+
+    PROTECT(tmp = lengthgets(this->data, this->len + size*nitems));
+    memcpy(RAW(tmp)+this->len, ptr, size*nitems);
+    this->len += size*nitems;
+    defineVar(this->namesymbol, tmp, VECTOR_ELT(OutTextData, idx));
+    this->data = tmp;
+    UNPROTECT(1);
+    return nitems;
+}
+
+static void outloop_init(Rconnection con, char *mode, int idx)
 {
-    Routtextconn this = (Routtextconn)con->private;
+    Routloopconn this = (Routloopconn)con->private;
+    int st = (con->text ? STRSXP : RAWSXP);
     SEXP val;
 
     this->namesymbol = install(con->description);
-    if(strcmp(mode, "w") == 0) {
+    if(strncmp(mode, "w", 1) == 0) {
 	/* create variable pointed to by con->description */
-	PROTECT(val = allocVector(STRSXP, 0));
+	PROTECT(val = allocVector(st, 0));
 	defineVar(this->namesymbol, val, VECTOR_ELT(OutTextData, idx));
 	UNPROTECT(1);
     } else {
 	/* take over existing variable */
 	val = findVar1(this->namesymbol, VECTOR_ELT(OutTextData, idx),
-		       STRSXP, FALSE);
+		       st, FALSE);
 	if(val == R_UnboundValue) {
-	    warning(_("text connection: appending to a non-existent char
vector"));
-	    PROTECT(val = allocVector(STRSXP, 0));
+	    warning(_("loop connection: appending to a non-existent
vector"));
+	    PROTECT(val = allocVector(st, 0));
 	    defineVar(this->namesymbol, val, VECTOR_ELT(OutTextData, idx));
 	    UNPROTECT(1);
 	}
@@ -1859,49 +1913,55 @@
 }
 
 
-static Rconnection newouttext(char *description, SEXP sfile, char *mode,
+static Rconnection newoutloop(char *description, SEXP sfile, char *mode,
 			      int idx)
 {
+    int isText = (mode[1] != 'b');
     Rconnection new;
     void *tmp;
 
     new = (Rconnection) malloc(sizeof(struct Rconn));
-    if(!new) error(_("allocation of text connection failed"));
-    new->class = (char *) malloc(strlen("textConnection") + 1);
+    if(!new) error(_("allocation of loop connection failed"));
+    new->class = (char *) malloc(strlen("loopConnection") + 1);
     if(!new->class) {
 	free(new);
-	error(_("allocation of text connection failed"));
+	error(_("allocation of loop connection failed"));
     }
-    strcpy(new->class, "textConnection");
+    strcpy(new->class, "loopConnection");
     new->description = (char *) malloc(strlen(description) + 1);
     if(!new->description) {
 	free(new->class); free(new);
-	error(_("allocation of text connection failed"));
+	error(_("allocation of loop connection failed"));
     }
     init_con(new, description, mode);
+    new->text = isText;
     new->isopen = TRUE;
     new->canread = FALSE;
-    new->open = &text_open;
-    new->close = &outtext_close;
-    new->destroy = &outtext_destroy;
-    new->vfprintf = &text_vfprintf;
-    new->seek = &text_seek;
-    new->private = (void*) malloc(sizeof(struct outtextconn));
+    new->open = &loop_open;
+    new->close = &outloop_close;
+    new->destroy = &outloop_destroy;
+    new->seek = &loop_seek;
+    new->private = (void*) malloc(sizeof(struct outloopconn));
     if(!new->private) {
 	free(new->description); free(new->class); free(new);
-	error(_("allocation of text connection failed"));
+	error(_("allocation of loop connection failed"));
     }
-    ((Routtextconn)new->private)->lastline = tmp = malloc(LAST_LINE_LEN);
+    ((Routloopconn)new->private)->lastline = tmp = malloc(LAST_LINE_LEN);
     if(!tmp) {
 	free(new->private);
 	free(new->description); free(new->class); free(new);
-	error(_("allocation of text connection failed"));
+	error(_("allocation of loop connection failed"));
     }
-    outtext_init(new, mode, idx);
+    if (isText) {
+	new->vfprintf = &text_vfprintf;
+    } else {
+	new->write = &raw_write;
+    }
+    outloop_init(new, mode, idx);
     return new;
 }
 
-SEXP do_textconnection(SEXP call, SEXP op, SEXP args, SEXP env)
+SEXP do_loopconnection(SEXP call, SEXP op, SEXP args, SEXP env)
 {
     SEXP sfile, stext, sopen, ans, class, venv;
     char *desc, *open;
@@ -1914,8 +1974,6 @@
 	error(_("invalid 'description' argument"));
     desc = CHAR(STRING_ELT(sfile, 0));
     stext = CADR(args);
-    if(!isString(stext))
-	error(_("invalid 'text' argument"));
     sopen = CADDR(args);
     if(!isString(sopen) || length(sopen) != 1)
     error(_("invalid 'open' argument"));
@@ -1924,16 +1982,20 @@
     if (!isEnvironment(venv) && venv != R_NilValue)
 	error(_("invalid 'environment' argument"));
     ncon = NextConnection();
-    if(!strlen(open) || strncmp(open, "r", 1) == 0)
-	con = Connections[ncon] = newtext(desc, stext);
-    else if (strncmp(open, "w", 1) == 0 || strncmp(open,
"a", 1) == 0) {
+    if(!strlen(open) || strncmp(open, "r", 1) == 0) {
+	if(!isString(stext) && (TYPEOF(stext) != RAWSXP))
+	    error(_("invalid 'object' argument"));
+	con = Connections[ncon] = newloop(desc, stext);
+    } else if (strncmp(open, "w", 1) == 0 || strncmp(open,
"a", 1) == 0) {
+	if(!isString(stext))
+	    error(_("invalid 'object' argument"));
 	if (OutTextData == NULL) {
 	    OutTextData = allocVector(VECSXP, NCONNECTIONS);
 	    R_PreserveObject(OutTextData);
 	}
 	SET_VECTOR_ELT(OutTextData, ncon, venv);
 	con = Connections[ncon] -	    newouttext(CHAR(STRING_ELT(stext, 0)), sfile,
open, ncon);
+	    newoutloop(CHAR(STRING_ELT(stext, 0)), sfile, open, ncon);
     }
     else
 	errorcall(call, _("unsupported mode"));
@@ -1942,7 +2004,7 @@
     PROTECT(ans = allocVector(INTSXP, 1));
     INTEGER(ans)[0] = ncon;
     PROTECT(class = allocVector(STRSXP, 2));
-    SET_STRING_ELT(class, 0, mkChar("textConnection"));
+    SET_STRING_ELT(class, 0, mkChar("loopConnection"));
     SET_STRING_ELT(class, 1, mkChar("connection"));
     classgets(ans, class);
     UNPROTECT(2);
--- src/main/names.c.orig	2005-05-20 05:51:46.000000000 -0700
+++ src/main/names.c	2005-08-22 15:59:47.968828400 -0700
@@ -866,7 +866,7 @@
 {"pushBack", 	do_pushback,	0,      11,     3,      {PP_FUNCALL,
PREC_FN,	0}},
 {"clearPushBackLength",do_clearpushback,0,  11,     1,     
{PP_FUNCALL, PREC_FN,	0}},
 {"pushBackLength",do_pushbacklength,0,  11,     1,      {PP_FUNCALL,
PREC_FN,	0}},
-{"textConnection",do_textconnection,0,	11,     4,      {PP_FUNCALL,
PREC_FN,	0}},
+{"loopConnection",do_loopconnection,0,	11,     4,      {PP_FUNCALL,
PREC_FN,	0}},
 {"socketConnection",do_sockconn,0,	11,     6,      {PP_FUNCALL,
PREC_FN,	0}},
 {"sockSelect",do_sockselect,0,	11,     3,      {PP_FUNCALL, PREC_FN,
0}},
 {"getAllConnections",do_getallconnections,0,11, 0,      {PP_FUNCALL,
PREC_FN,	0}},
--- src/include/Rconnections.h.orig	2005-04-18 04:34:02.000000000 -0700
+++ src/include/Rconnections.h	2005-08-22 15:40:02.582767400 -0700
@@ -82,19 +82,19 @@
     int cp;
 } *Rgzfileconn;
 
-typedef struct textconn {
+typedef struct loopconn {
     char *data;  /* all the data */
     int cur, nchars; /* current pos and number of chars */
     char save; /* pushback */
-} *Rtextconn;
+} *Rloopconn;
 
-typedef struct outtextconn {
+typedef struct outloopconn {
     int len;  /* number of lines */
     SEXP namesymbol;
     SEXP data;
     char *lastline;
     int lastlinelength; /* buffer size */
-} *Routtextconn;
+} *Routloopconn;
 
 typedef enum {HTTPsh, FTPsh} UrlScheme;
 
--- src/library/base/R/connections.R.orig	2005-04-18 04:34:17.000000000 -0700
+++ src/library/base/R/connections.R	2005-08-22 16:18:22.095231400 -0700
@@ -83,10 +83,10 @@
                              encoding = getOption("encoding"))
     .Internal(socketConnection(host, port, server, blocking, open, encoding))
 
-textConnection <- function(object, open = "r", local = FALSE) {
+loopConnection <- function(object, open = "r", local = FALSE) {
     if (local) env <- parent.frame()
     else env <- .GlobalEnv
-    .Internal(textConnection(deparse(substitute(object)), object, open, env))
+    .Internal(loopConnection(deparse(substitute(object)), object, open, env))
 }
 
 seek <- function(con, ...)

dhinds@sonic.net

2005-Aug-26 20:51 UTC

head link

[Rd] RFC: "loop connections"

I accidentally left one small change out of my previous patch.

So... no response to my request for comments.  Does that mean no one
has an opinion about whether this is a good idea or not?  I'd
appreciate a response from an R core member one way or the other; if
this is not the right way to get a response, should I email people
instead?

-- David Hinds


--- src/include/Internal.h.orig	2005-05-20 05:51:37.000000000 -0700
+++ src/include/Internal.h	2005-08-22 15:46:48.968190600 -0700
@@ -518,7 +518,7 @@
 SEXP do_pushback(SEXP, SEXP, SEXP, SEXP);
 SEXP do_pushbacklength(SEXP, SEXP, SEXP, SEXP);
 SEXP do_clearpushback(SEXP, SEXP, SEXP, SEXP);
-SEXP do_textconnection(SEXP, SEXP, SEXP, SEXP);
+SEXP do_loopconnection(SEXP, SEXP, SEXP, SEXP);
 SEXP do_getallconnections(SEXP, SEXP, SEXP, SEXP);
 SEXP do_sumconnection(SEXP, SEXP, SEXP, SEXP);
 SEXP do_download(SEXP, SEXP, SEXP, SEXP);

Martin Maechler

2005-Aug-27 10:18 UTC

head link

[Rd] RFC: "loop connections"

>>>>> "David" == David Hinds <dhinds at
sonic.net>
>>>>>     on Mon, 22 Aug 2005 23:34:15 +0000 (UTC) writes:
    David> I've just implemented a generalization of R's text
connections, to
    David> also support reading/writing raw binary data.  There is very
little
    David> new code to speak of.  For input connections, I wrote code to
populate
    David> the old text connection buffer from a raw vector, and provided a
new
    David> raw_read() method.  For output connections, I wrote a raw_write()
to
    David> append to a raw vector.  On input, the mode (text or binary) is
    David> determined by the data type of the input object; on output, I use
the
    David> requested output mode (i.e. "w" / "wb").  For
example:

    > con <- loopConnection("r", "wb")
    > a <- c(10,100,1000)
    > writeBin(a, con, size=4)
    > r
     [1] 00 00 20 41 00 00 c8 42 00 00 7a 44
    > close(con)
    > con <- loopConnection(r)
    > readBin(con, "double", n=3, size=4)
     [1]   10  100 1000
    > close(con)

    David> I think "loop connection" is a better name for this
    David> sort of connection than "text connection" was even
    David> for the old version; that confuses the mode of the
    David> connection (text vs binary) with the mechanism (file,
    David> socket, etc).

    ..........

In the mean time, I think it has become clear that
"loopconnection" isn't necessarily a better name, and that
textConnection() has been there in "the S litterature" for a
good reason and for quite a while.
Let's forget about the naming and the exact UI for the moment.

I think the main point of David's proposal is still worth
consideration:  One way to see text connections is as a way to
treat some kind of R objects as "generalized files" i.e., connections.
And AFAICS David proposes to enlarge the kind of R objects that
can be dealt with as connections 
  from  {"character"} 
  to    {"character", "raw"} 
something which has some appeal to me.
IIUC, Brian Ripley is doubting the potential use for the
proposed generalization, whereas David makes a point of someone
else (the 'caTools' author) having written raw2bin / bin2raw function
for a related use case.

Maybe you can elaborate on the above a bit, David?
In any case, as you might have guessed by now, R-core would have
been more positive to a proposal to generalize current
textConnection() - fully back-compatibly - rather than renaming
it first.

Best regards,
Martin

Reasonably Related Threads

Search for more maybe matching threads

R devel - Aug 2005 - RFC: "loop connections"

[Rd] RFC: "loop connections"

[Rd] RFC: "loop connections"

[Rd] RFC: "loop connections"

Reasonably Related Threads