mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-03-07 12:50:34 -08:00
The socket functions now accept an optional :ELEMENT-TYPE keyword argument, in addition to :EXTERNAL-FORMAT
This commit is contained in:
Juan Jose Garcia Ripoll
parent
a1948e845c
commit
e6d180e7df
4 changed files with 48 additions and 29 deletions
|
|
@ -1180,7 +1180,8 @@ also known as unix-domain sockets."))
|
|||
(defun dup (fd)
|
||||
(ffi:c-inline (fd) (:int) :int "dup(#0)" :one-liner t))
|
||||
|
||||
(defun make-stream-from-fd (fd mode &key buffering external-format (name "FD-STREAM"))
|
||||
(defun make-stream-from-fd (fd mode &key buffering element-type external-format
|
||||
(name "FD-STREAM"))
|
||||
(assert (stringp name) (name) "name must be a string.")
|
||||
(let* ((smm-mode (ecase mode
|
||||
(:input (c-constant "smm_input"))
|
||||
|
|
@ -1193,9 +1194,13 @@ also known as unix-domain sockets."))
|
|||
#+:wsock
|
||||
(:input-output-wsock (c-constant "smm_io_wsock"))
|
||||
))
|
||||
(stream (ffi:c-inline (name fd smm-mode) (t :int :int) t
|
||||
"ecl_make_stream_from_fd(#0,#1,(enum ecl_smmode)#2,8,
|
||||
ECL_STREAM_DEFAULT_FORMAT,Cnil)"
|
||||
(stream (ffi:c-inline (name fd smm-mode element-type)
|
||||
(t :int :int t)
|
||||
t
|
||||
"
|
||||
ecl_make_stream_from_fd(#0,#1,(enum ecl_smmode)#2,
|
||||
ecl_normalize_stream_element_type(#3),
|
||||
ECL_STREAM_DEFAULT_FORMAT,Cnil)"
|
||||
:one-liner t)))
|
||||
(when buffering
|
||||
(si::set-buffering-mode stream buffering))
|
||||
|
|
@ -1209,7 +1214,7 @@ also known as unix-domain sockets."))
|
|||
"(#0)->stream.flags |= ECL_STREAM_CLOSE_COMPONENTS"
|
||||
:one-liner t))
|
||||
|
||||
(defun socket-make-stream-inner (fd input output buffering external-format)
|
||||
(defun socket-make-stream-inner (fd input output buffering element-type external-format)
|
||||
;; In Unix we have to create one stream per channel. The reason is
|
||||
;; that buffered I/O is done using ANSI C FILEs which do not support
|
||||
;; concurrent reads and writes -- if one thread is listening to the
|
||||
|
|
@ -1221,25 +1226,36 @@ also known as unix-domain sockets."))
|
|||
(cond ((and input output)
|
||||
#+wsock
|
||||
(make-stream-from-fd fd :input-output-wsock
|
||||
:buffering buffering :external-format external-format)
|
||||
:buffering buffering
|
||||
:element-type element-type
|
||||
:external-format external-format)
|
||||
#-wsock
|
||||
(let* ((in (socket-make-stream-inner (dup fd) t nil buffering external-format))
|
||||
(out (socket-make-stream-inner fd nil t buffering external-format))
|
||||
(let* ((in (socket-make-stream-inner (dup fd) t nil buffering
|
||||
element-type external-format))
|
||||
(out (socket-make-stream-inner fd nil t buffering
|
||||
element-type external-format))
|
||||
(stream (make-two-way-stream in out)))
|
||||
(auto-close-two-way-stream stream)
|
||||
stream))
|
||||
(input
|
||||
(make-stream-from-fd fd #-wsock :input #+wsock :input-wsock
|
||||
:buffering buffering :external-format external-format))
|
||||
:buffering buffering
|
||||
:element-type element-type
|
||||
:external-format external-format))
|
||||
(output
|
||||
(make-stream-from-fd fd #-wsock :output #+wsock :output-wsock
|
||||
:buffering buffering :external-format external-format))
|
||||
:buffering buffering
|
||||
:element-type element-type
|
||||
:external-format external-format))
|
||||
(t
|
||||
(error "SOCKET-MAKE-STREAM: at least one of :INPUT or :OUTPUT has to be true."))))
|
||||
|
||||
(defmethod socket-make-stream ((socket socket)
|
||||
&key (input nil input-p) (output nil output-p)
|
||||
(buffering :full) (external-format :default))
|
||||
&key (input nil input-p)
|
||||
(output nil output-p)
|
||||
(buffering :full)
|
||||
(element-type 'base-char)
|
||||
(external-format :default))
|
||||
(let ((stream (and (slot-boundp socket 'stream)
|
||||
(slot-value socket 'stream))))
|
||||
(unless stream
|
||||
|
|
@ -1248,7 +1264,8 @@ also known as unix-domain sockets."))
|
|||
(unless (or input-p output-p)
|
||||
(setf input t output t))
|
||||
(setf stream (socket-make-stream-inner (socket-file-descriptor socket)
|
||||
input output buffering external-format))
|
||||
input output buffering element-type
|
||||
external-format))
|
||||
(setf (slot-value socket 'stream) stream)
|
||||
#+ ignore
|
||||
(sb-ext:cancel-finalization socket))
|
||||
|
|
|
|||
|
|
@ -152,6 +152,8 @@ ECL 11.1.2
|
|||
|
||||
* Bugs fixed:
|
||||
|
||||
- Fixed several dozens of typos.
|
||||
|
||||
- ENSURE-DIRECTORIES-EXIST did not work properly with logical pathnames.
|
||||
|
||||
- EXT:SET-LIMIT with option EXT:FRAME-STACK corrupted the frame stack.
|
||||
|
|
@ -167,6 +169,7 @@ ECL 11.1.2
|
|||
the one stored in *COMMAND-ARGS*, and this may be "cleared" by the
|
||||
user.
|
||||
|
||||
- SOCKET-MAKE-STREAM now accepts an :ELEMENT-TYPE argument.
|
||||
|
||||
;;; Local Variables: ***
|
||||
;;; mode:text ***
|
||||
|
|
|
|||
30
src/c/file.d
30
src/c/file.d
|
|
@ -4432,12 +4432,22 @@ si_copy_stream(cl_object in, cl_object out)
|
|||
* FILE OPENING AND CLOSING
|
||||
*/
|
||||
|
||||
static cl_fixnum
|
||||
normalize_stream_element_type(cl_object element_type)
|
||||
cl_fixnum
|
||||
ecl_normalize_stream_element_type(cl_object element_type)
|
||||
{
|
||||
cl_fixnum sign = 0;
|
||||
cl_index size;
|
||||
if (funcall(3, @'subtypep', element_type, @'unsigned-byte') != Cnil) {
|
||||
if (element_type == @'signed-byte') {
|
||||
return -8;
|
||||
} else if (element_type == @'unsigned-byte') {
|
||||
return 8;
|
||||
} else if (element_type == @':default') {
|
||||
return 0;
|
||||
} else if (element_type == @'base-char' || element_type == @'character') {
|
||||
return 0;
|
||||
} else if (funcall(3, @'subtypep', element_type, @'character') != Cnil) {
|
||||
return 0;
|
||||
} else if (funcall(3, @'subtypep', element_type, @'unsigned-byte') != Cnil) {
|
||||
sign = +1;
|
||||
} else if (funcall(3, @'subtypep', element_type, @'signed-byte') != Cnil) {
|
||||
sign = -1;
|
||||
|
|
@ -4640,19 +4650,7 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists,
|
|||
FEerror("~S is an illegal DIRECTION for OPEN.",
|
||||
1, direction);
|
||||
}
|
||||
if (element_type == @'signed-byte') {
|
||||
byte_size = -8;
|
||||
} else if (element_type == @'unsigned-byte') {
|
||||
byte_size = 8;
|
||||
} else if (element_type == @':default') {
|
||||
byte_size = 0;
|
||||
} else if (element_type == @'base-char' || element_type == @'character') {
|
||||
byte_size = 0;
|
||||
} else if (funcall(3, @'subtypep', element_type, @'character') != Cnil) {
|
||||
byte_size = 0;
|
||||
} else {
|
||||
byte_size = normalize_stream_element_type(element_type);
|
||||
}
|
||||
byte_size = ecl_normalize_stream_element_type(element_type);
|
||||
if (byte_size != 0) {
|
||||
if (flags & ECL_STREAM_FORMAT) {
|
||||
FEerror("Cannot specify a character external format for binary streams.", 0);
|
||||
|
|
|
|||
|
|
@ -714,6 +714,7 @@ extern ECL_API cl_object ecl_file_position(cl_object strm);
|
|||
extern ECL_API cl_object ecl_file_position_set(cl_object strm, cl_object disp);
|
||||
extern ECL_API cl_object ecl_file_length(cl_object strm);
|
||||
extern ECL_API int ecl_file_column(cl_object strm);
|
||||
extern ECL_API cl_fixnum ecl_normalize_stream_element_type(cl_object element);
|
||||
extern ECL_API cl_object ecl_make_stream_from_fd(cl_object fname, int fd, enum ecl_smmode smm, cl_fixnum byte_size, int flags, cl_object external_format);
|
||||
extern ECL_API cl_object ecl_make_stream_from_FILE(cl_object fname, void *fd, enum ecl_smmode smm, cl_fixnum byte_size, int flags, cl_object external_format);
|
||||
extern ECL_API cl_object si_file_stream_fd(cl_object s);
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue