This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=8ca97482b01cf1a6aa538cc5a2d1f71fb60f080c The branch, stable-2.0 has been updated via 8ca97482b01cf1a6aa538cc5a2d1f71fb60f080c (commit) via 122f24cc8a3637ed42d7792ad1ff8ec0c49c58df (commit) from 611563fb05c18ca52f780746e9963ca9735e9bac (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 8ca97482b01cf1a6aa538cc5a2d1f71fb60f080c Author: Ludovic Courtès <[email protected]> Date: Thu Jan 16 23:43:31 2014 +0100 Custom binary input ports support 'setvbuf'. * libguile/r6rs-ports.c (CBIP_BUFFER_SIZE): Adjust comment. Set to 8KiB. (SCM_SET_CBIP_BYTEVECTOR): New macro. (cbip_setvbuf): New function. (make_cbip): Set PORT's 'setvbuf' internal field. (cbip_fill_input): Check whether PORT is buffered. When unbuffered, check whether BV can hold C_REQUESTED bytes, and allocate a new bytevector if not; copy the data back from BV to c_port->read_pos. Remove 'again' label, and don't loop there. * test-suite/tests/r6rs-ports.test ("7.2.7 Input Ports")["custom binary input port unbuffered & 'port-position'", "custom binary input port unbuffered & 'read!' calls", "custom binary input port, unbuffered then buffered", "custom binary input port, buffered then unbuffered"]: New tests. * doc/ref/api-io.texi (R6RS Binary Input): Document the buffering of custom binary input ports, and link to 'setvbuf'. commit 122f24cc8a3637ed42d7792ad1ff8ec0c49c58df Author: Ludovic Courtès <[email protected]> Date: Thu Jan 16 23:52:01 2014 +0100 Prepare 'setvbuf' to support for non-file ports. * libguile/ports-internal.h (struct scm_port_internal): Add setvbuf' field. Change 'pending_eof' to a 1-bit unsigned char. * libguile/ports.c (scm_new_port_table_entry): Clear 'pti->setvbuf'. * libguile/fports.c (scm_setvbuf): Accept any open port, and error out when PORT's setvbuf' field is NULL. Remove explicit 'scm_gc_free' calls. (scm_i_fdes_to_port): Set PORT's 'setvbuf' field. * test-suite/tests/ports.test ("setvbuf")["closed port", "string port"]: New tests. * doc/ref/posix.texi (Ports and File Descriptors): Suggest that 'setvbuf' works for different port types. ----------------------------------------------------------------------- Summary of changes: doc/ref/api-io.texi | 4 + doc/ref/posix.texi | 3 + libguile/fports.c | 42 ++++++++----- libguile/ports-internal.h | 14 ++++- libguile/ports.c | 8 ++- libguile/r6rs-ports.c | 94 ++++++++++++++++++++++++----- test-suite/tests/ports.test | 14 ++++- test-suite/tests/r6rs-ports.test | 123 ++++++++++++++++++++++++++++++++++++++ 8 files changed, 267 insertions(+), 35 deletions(-) diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi index f1170eb..02d92a2 100644 --- a/doc/ref/api-io.texi +++ b/doc/ref/api-io.texi @@ -1816,6 +1816,10 @@ indicating the position of the next byte is to read. Finally, if @var{close} is not @code{#f}, it must be a thunk. It is invoked when the custom binary input port is closed. +The returned port is fully buffered by default, but its buffering mode +can be changed using @code{setvbuf} (@pxref{Ports and File Descriptors, +@code{setvbuf}}). + Using a custom binary input port, the @code{open-bytevector-input-port} procedure could be implemented as follows: diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index b3a6a04..56f5c78 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -470,6 +470,9 @@ line buffered block buffered, using a newly allocated buffer of @var{size} bytes. If @var{size} is omitted, a default size will be used. @end defvar + +Only certain types of ports are supported, most importantly +file ports. @end deffn @deffn {Scheme Procedure} fcntl port/fd cmd [value] diff --git a/libguile/fports.c b/libguile/fports.c index 70732e5..365d3ff 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -1,5 +1,6 @@ /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, - * 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. + * 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, + * 2014 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -58,6 +59,7 @@ #include "libguile/hashtab.h" #include "libguile/fports.h" +#include "libguile/ports-internal.h" #if SIZEOF_OFF_T == SIZEOF_INT #define OFF_T_MAX INT_MAX @@ -78,10 +80,10 @@ scm_t_bits scm_tc16_fport; /* default buffer size, used if the O/S won't supply a value. */ static const size_t default_buffer_size = 1024; -/* create FPORT buffer with specified sizes (or -1 to use default size or - 0 for no buffer. */ +/* Create FPORT buffers with specified sizes (or -1 to use default size + or 0 for no buffer.) */ static void -scm_fport_buffer_add (SCM port, long read_size, int write_size) +scm_fport_buffer_add (SCM port, long read_size, long write_size) #define FUNC_NAME "scm_fport_buffer_add" { scm_t_port *pt = SCM_PTAB_ENTRY (port); @@ -147,7 +149,9 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, "@item _IOFBF\n" "block buffered, using a newly allocated buffer of @var{size} bytes.\n" "If @var{size} is omitted, a default size will be used.\n" - "@end table") + "@end table\n\n" + "Only certain types of ports are supported, most importantly\n" + "file ports.") #define FUNC_NAME s_scm_setvbuf { int cmode; @@ -155,10 +159,17 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, size_t ndrained; char *drained; scm_t_port *pt; + scm_t_port_internal *pti; port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPFPORT (1,port); + SCM_VALIDATE_OPENPORT (1, port); + pti = SCM_PORT_GET_INTERNAL (port); + + if (pti->setvbuf == NULL) + scm_wrong_type_arg_msg (FUNC_NAME, 1, port, + "port that supports 'setvbuf'"); + cmode = scm_to_int (mode); if (cmode != _IONBF && cmode != _IOFBF && cmode != _IOLBF) scm_out_of_range (FUNC_NAME, mode); @@ -169,9 +180,8 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, cmode = _IOFBF; } else - { - SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) & ~(scm_t_bits)SCM_BUFLINE); - } + SCM_SET_CELL_WORD_0 (port, + SCM_CELL_WORD_0 (port) & ~(scm_t_bits) SCM_BUFLINE); if (SCM_UNBNDP (size)) { @@ -216,12 +226,8 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, pt->read_end = pt->saved_read_end; pt->read_buf_size = pt->saved_read_buf_size; } - if (pt->read_buf != &pt->shortbuf) - scm_gc_free (pt->read_buf, pt->read_buf_size, "port buffer"); - if (pt->write_buf != &pt->shortbuf) - scm_gc_free (pt->write_buf, pt->write_buf_size, "port buffer"); - scm_fport_buffer_add (port, csize, csize); + pti->setvbuf (port, csize, csize); if (ndrained > 0) /* Put DRAINED back to PORT. */ @@ -542,6 +548,7 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name) { SCM port; scm_t_port *pt; + scm_t_port_internal *pti; /* Test that fdes is valid. */ #ifdef F_GETFL @@ -567,7 +574,12 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name) port = scm_new_port_table_entry (scm_tc16_fport); SCM_SET_CELL_TYPE(port, scm_tc16_fport | mode_bits); - pt = SCM_PTAB_ENTRY(port); + pt = SCM_PTAB_ENTRY (port); + + /* File ports support 'setvbuf'. */ + pti = SCM_PORT_GET_INTERNAL (port); + pti->setvbuf = scm_fport_buffer_add; + { scm_t_fport *fp = (scm_t_fport *) scm_gc_malloc_pointerless (sizeof (scm_t_fport), diff --git a/libguile/ports-internal.h b/libguile/ports-internal.h index 8a3a00b..48dcaa7 100644 --- a/libguile/ports-internal.h +++ b/libguile/ports-internal.h @@ -1,7 +1,7 @@ /* * ports-internal.h - internal-only declarations for ports. * - * Copyright (C) 2013 Free Software Foundation, Inc. + * Copyright (C) 2013, 2014 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -50,7 +50,17 @@ struct scm_port_internal unsigned at_stream_start_for_bom_write : 1; scm_t_port_encoding_mode encoding_mode; scm_t_iconv_descriptors *iconv_descriptors; - int pending_eof; + unsigned char pending_eof: 1; + + /* When non-NULL, this is the method called by 'setvbuf' for this port. + It must create read and write buffers for PORT with the specified + sizes (a size of 0 is for unbuffered ports, which should use the + 'shortbuf' field.) Size -1 means to use the port's preferred buffer + size. */ + /* XXX: In 2.2 make this a property of the 'scm_t_ptob_descriptor'. */ + void (*setvbuf) (SCM port, long read_size, long write_size); + + /* Key-value properties. */ SCM alist; }; diff --git a/libguile/ports.c b/libguile/ports.c index 4516160..4f401de 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -1,5 +1,5 @@ /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, 2006, - * 2007, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. + * 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -677,6 +677,12 @@ scm_new_port_table_entry (scm_t_bits tag) pti->pending_eof = 0; pti->alist = SCM_EOL; + /* Until Guile 2.0.9 included, 'setvbuf' would only work on file + ports. Now all port types can be supported, but it's not clear + that port types out in wild accept having someone else fiddle with + their buffer. Thus, conservatively turn it off by default. */ + pti->setvbuf = NULL; + SCM_SET_CELL_TYPE (z, tag); SCM_SETPTAB_ENTRY (z, entry); diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c index 0b1d162..30456a8 100644 --- a/libguile/r6rs-ports.c +++ b/libguile/r6rs-ports.c @@ -37,6 +37,7 @@ #include "libguile/validate.h" #include "libguile/values.h" #include "libguile/vectors.h" +#include "libguile/ports-internal.h" @@ -280,18 +281,59 @@ cbp_close (SCM port) static scm_t_bits custom_binary_input_port_type = 0; -/* Size of the buffer embedded in custom binary input ports. */ -#define CBIP_BUFFER_SIZE 4096 +/* Initial size of the buffer embedded in custom binary input ports. */ +#define CBIP_BUFFER_SIZE 8192 /* Return the bytevector associated with PORT. */ #define SCM_CBIP_BYTEVECTOR(_port) \ SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 4) +/* Set BV as the bytevector associated with PORT. */ +#define SCM_SET_CBIP_BYTEVECTOR(_port, _bv) \ + SCM_SIMPLE_VECTOR_SET (SCM_PACK (SCM_STREAM (_port)), 4, (_bv)) + /* Return the various procedures of PORT. */ #define SCM_CBIP_READ_PROC(_port) \ SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 0) +/* Set PORT's internal buffer according to READ_SIZE. */ +static void +cbip_setvbuf (SCM port, long read_size, long write_size) +{ + SCM bv; + scm_t_port *pt; + + pt = SCM_PTAB_ENTRY (port); + bv = SCM_CBIP_BYTEVECTOR (port); + + switch (read_size) + { + case 0: + /* Unbuffered: keep PORT's bytevector as is (it will be used in + future 'scm_c_read' calls), but point to the one-byte buffer. */ + pt->read_buf = &pt->shortbuf; + pt->read_buf_size = 1; + break; + + case -1: + /* Preferred size: keep the current bytevector and use it as the + backing store. */ + pt->read_buf = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv); + pt->read_buf_size = SCM_BYTEVECTOR_LENGTH (bv); + break; + + default: + /* Fully buffered: allocate a buffer of READ_SIZE bytes. */ + bv = scm_c_make_bytevector (read_size); + SCM_SET_CBIP_BYTEVECTOR (port, bv); + pt->read_buf = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv); + pt->read_buf_size = read_size; + } + + pt->read_pos = pt->read_end = pt->read_buf; +} + static inline SCM make_cbip (SCM read_proc, SCM get_position_proc, SCM set_position_proc, SCM close_proc) @@ -331,7 +373,10 @@ make_cbip (SCM read_proc, SCM get_position_proc, c_port->read_end = (unsigned char *) c_bv; c_port->read_buf_size = c_len; - /* Mark PORT as open, readable and unbuffered (hmm, how elegant...). */ + /* 'setvbuf' is supported. */ + SCM_PORT_GET_INTERNAL (port)->setvbuf = cbip_setvbuf; + + /* Mark PORT as open and readable. */ SCM_SET_CELL_TYPE (port, custom_binary_input_port_type | mode_bits); scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex); @@ -346,26 +391,39 @@ cbip_fill_input (SCM port) int result; scm_t_port *c_port = SCM_PTAB_ENTRY (port); - again: if (c_port->read_pos >= c_port->read_end) { /* Invoke the user's `read!' procedure. */ + int buffered; size_t c_octets, c_requested; SCM bv, read_proc, octets; c_requested = c_port->read_buf_size; + read_proc = SCM_CBIP_READ_PROC (port); - /* Use the bytevector associated with PORT as the buffer passed to the - `read!' procedure, thereby avoiding additional allocations. */ bv = SCM_CBIP_BYTEVECTOR (port); - read_proc = SCM_CBIP_READ_PROC (port); + buffered = + (c_port->read_buf == (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv)); - /* The assumption here is that C_PORT's internal buffer wasn't changed - behind our back. */ - assert (c_port->read_buf == - (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv)); - assert ((unsigned) c_port->read_buf_size - == SCM_BYTEVECTOR_LENGTH (bv)); + if (buffered) + /* Make sure the buffer isn't corrupt. BV can be passed directly + to READ_PROC. */ + assert (c_port->read_buf_size == SCM_BYTEVECTOR_LENGTH (bv)); + else + { + /* This is an unbuffered port. When called via the + 'get-bytevector-*' procedures, and thus via 'scm_c_read', we + are passed the caller-provided buffer, so we need to check its + size. */ + if (SCM_BYTEVECTOR_LENGTH (bv) < c_requested) + { + /* Bad luck: we have to make another allocation. Save that + bytevector for later reuse, in the hope that the application + has regular access patterns. */ + bv = scm_c_make_bytevector (c_requested); + SCM_SET_CBIP_BYTEVECTOR (port, bv); + } + } octets = scm_call_3 (read_proc, bv, SCM_INUM0, scm_from_size_t (c_requested)); @@ -373,11 +431,15 @@ cbip_fill_input (SCM port) if (SCM_UNLIKELY (c_octets > c_requested)) scm_out_of_range (FUNC_NAME, octets); - c_port->read_pos = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv); + if (!buffered) + /* Copy the data back to the internal buffer. */ + memcpy ((char *) c_port->read_pos, SCM_BYTEVECTOR_CONTENTS (bv), + c_octets); + c_port->read_end = (unsigned char *) c_port->read_pos + c_octets; - if (c_octets > 0) - goto again; + if (c_octets != 0 || c_requested == 0) + result = (int) *c_port->read_pos; else result = EOF; } diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test index 9b1c6c0..c2f4480 100644 --- a/test-suite/tests/ports.test +++ b/test-suite/tests/ports.test @@ -2,7 +2,7 @@ ;;;; Jim Blandy <[email protected]> --- May 1999 ;;;; ;;;; Copyright (C) 1999, 2001, 2004, 2006, 2007, 2009, 2010, -;;;; 2011, 2012, 2013 Free Software Foundation, Inc. +;;;; 2011, 2012, 2013, 2014 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -1499,6 +1499,18 @@ (with-test-prefix "setvbuf" + (pass-if-exception "closed port" + exception:wrong-type-arg + (let ((port (open-input-file "/dev/null"))) + (close-port port) + (setvbuf port _IOFBF))) + + (pass-if-exception "string port" + exception:wrong-type-arg + (let ((port (open-input-string "Hey!"))) + (close-port port) + (setvbuf port _IOFBF))) + (pass-if "line/column number preserved" ;; In Guile 2.0.5, `setvbuf' would erroneously decrease the port's ;; line and/or column number. diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test index 2b62bed..213c8b7 100644 --- a/test-suite/tests/r6rs-ports.test +++ b/test-suite/tests/r6rs-ports.test @@ -456,6 +456,129 @@ not `set-port-position!'" (u8-list->bytevector (map char->integer (string->list "Port!"))))))) + (pass-if-equal "custom binary input port unbuffered & 'port-position'" + '(0 2 5 11) + ;; Check that the value returned by 'port-position' is correct, and + ;; that each 'port-position' call leads one call to the + ;; 'get-position' method. + (let* ((str "Hello Port!") + (output (make-bytevector (string-length str))) + (source (with-fluids ((%default-port-encoding "UTF-8")) + (open-string-input-port str))) + (read! (lambda (bv start count) + (let ((r (get-bytevector-n! source bv start count))) + (if (eof-object? r) + 0 + r)))) + (pos '()) + (get-pos (lambda () + (let ((p (port-position source))) + (set! pos (cons p pos)) + p))) + (port (make-custom-binary-input-port "the port" read! + get-pos #f #f))) + (setvbuf port _IONBF) + (and (= 0 (port-position port)) + (begin + (get-bytevector-n! port output 0 2) + (= 2 (port-position port))) + (begin + (get-bytevector-n! port output 2 3) + (= 5 (port-position port))) + (let ((bv (string->utf8 (get-string-all port)))) + (bytevector-copy! bv 0 output 5 (bytevector-length bv)) + (= (string-length str) (port-position port))) + (bytevector=? output (string->utf8 str)) + (reverse pos)))) + + (pass-if-equal "custom binary input port unbuffered & 'read!' calls" + `((2 "He") (3 "llo") (42 " Port!")) + (let* ((str "Hello Port!") + (source (with-fluids ((%default-port-encoding "UTF-8")) + (open-string-input-port str))) + (reads '()) + (read! (lambda (bv start count) + (set! reads (cons count reads)) + (let ((r (get-bytevector-n! source bv start count))) + (if (eof-object? r) + 0 + r)))) + (port (make-custom-binary-input-port "the port" read! + #f #f #f))) + + (setvbuf port _IONBF) + (let ((ret (list (get-bytevector-n port 2) + (get-bytevector-n port 3) + (get-bytevector-n port 42)))) + (zip (reverse reads) + (map (lambda (obj) + (if (bytevector? obj) + (utf8->string obj) + obj)) + ret))))) + + (pass-if-equal "custom binary input port, unbuffered then buffered" + `((6 "Lorem ") (12 "ipsum dolor ") (777 "sit amet, consecteturâ¦") + (777 ,(eof-object))) + (let* ((str "Lorem ipsum dolor sit amet, consecteturâ¦") + (source (with-fluids ((%default-port-encoding "UTF-8")) + (open-string-input-port str))) + (reads '()) + (read! (lambda (bv start count) + (set! reads (cons count reads)) + (let ((r (get-bytevector-n! source bv start count))) + (if (eof-object? r) + 0 + r)))) + (port (make-custom-binary-input-port "the port" read! + #f #f #f))) + + (setvbuf port _IONBF) + (let ((ret (list (get-bytevector-n port 6) + (get-bytevector-n port 12) + (begin + (setvbuf port _IOFBF 777) + (get-bytevector-n port 42)) + (get-bytevector-n port 42)))) + (zip (reverse reads) + (map (lambda (obj) + (if (bytevector? obj) + (utf8->string obj) + obj)) + ret))))) + + (pass-if-equal "custom binary input port, buffered then unbuffered" + `((18 + 42 14 ; scm_c_read tries to fill the 42-byte buffer + 42) + ("Lorem " "ipsum dolor " "sit amet, consectetur blaâ¦" ,(eof-object))) + (let* ((str "Lorem ipsum dolor sit amet, consectetur blaâ¦") + (source (with-fluids ((%default-port-encoding "UTF-8")) + (open-string-input-port str))) + (reads '()) + (read! (lambda (bv start count) + (set! reads (cons count reads)) + (let ((r (get-bytevector-n! source bv start count))) + (if (eof-object? r) + 0 + r)))) + (port (make-custom-binary-input-port "the port" read! + #f #f #f))) + + (setvbuf port _IOFBF 18) + (let ((ret (list (get-bytevector-n port 6) + (get-bytevector-n port 12) + (begin + (setvbuf port _IONBF) + (get-bytevector-n port 42)) + (get-bytevector-n port 42)))) + (list (reverse reads) + (map (lambda (obj) + (if (bytevector? obj) + (utf8->string obj) + obj)) + ret))))) + (pass-if "custom binary input port `close-proc' is called" (let* ((closed? #f) (read! (lambda (bv start count) 0)) hooks/post-receive -- GNU Guile
