From c771b46c5f37bdf24877fb5def3c7df257481319 Mon Sep 17 00:00:00 2001 From: Daniel Kochmanski Date: Wed, 11 Oct 2017 10:25:59 +0200 Subject: [PATCH] feature: export make-stream-from-fd interface --- contrib/sockets/sockets.lisp | 27 --------------------------- src/c/symbols_list.h | 1 + src/c/symbols_list2.h | 1 + src/cmp/proclamations.lsp | 3 +++ src/doc/help.lsp | 9 +++++++++ src/h/external.h | 3 ++- src/lsp/mislib.lsp | 30 ++++++++++++++++++++++++++++++ 7 files changed, 46 insertions(+), 28 deletions(-) diff --git a/contrib/sockets/sockets.lisp b/contrib/sockets/sockets.lisp index 6f09dc88b..195a2559a 100755 --- a/contrib/sockets/sockets.lisp +++ b/contrib/sockets/sockets.lisp @@ -1246,33 +1246,6 @@ 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 element-type (external-format :default) - (name "FD-STREAM")) - (assert (stringp name) (name) "name must be a string.") - (let* ((smm-mode (ecase mode - (:input (c-constant "ecl_smm_input")) - (:output (c-constant "ecl_smm_output")) - (:input-output (c-constant "ecl_smm_io")) - #+:wsock - (:input-wsock (c-constant "ecl_smm_input_wsock")) - #+:wsock - (:output-wsock (c-constant "ecl_smm_output_wsock")) - #+:wsock - (:input-output-wsock (c-constant "ecl_smm_io_wsock")) - )) - (external-format (unless (subtypep element-type 'integer) external-format)) - (stream (ffi:c-inline (name fd smm-mode element-type external-format) - (t :int :int t t) - t - " -ecl_make_stream_from_fd(#0,#1,(enum ecl_smmode)#2, - ecl_normalize_stream_element_type(#3), - 0,#4)" - :one-liner t))) - (when buffering - (si::set-buffering-mode stream buffering)) - stream)) - (defun auto-close-two-way-stream (stream) (declare (si::c-local)) (ffi:c-inline (stream) (t) :void diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index 0c400815e..ffe8c65e3 100755 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -1152,6 +1152,7 @@ cl_symbols[] = { {EXT_ "FILE-KIND", EXT_ORDINARY, si_file_kind, 2, OBJNULL}, {SYS_ "FILL-POINTER-SET", SI_ORDINARY, si_fill_pointer_set, 2, OBJNULL}, {EXT_ "FILE-STREAM-FD", EXT_ORDINARY, si_file_stream_fd, 1, OBJNULL}, +{EXT_ "MAKE-STREAM-FROM-FD", EXT_ORDINARY, NULL, -1, OBJNULL}, {EXT_ "FIXNUMP", EXT_ORDINARY, si_fixnump, 1, OBJNULL}, {SYS_ "FORMAT-ERROR", SI_ORDINARY, NULL, -1, OBJNULL}, #ifdef ECL_CMU_FORMAT diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h index 9dde2585c..acd1b8442 100644 --- a/src/c/symbols_list2.h +++ b/src/c/symbols_list2.h @@ -1152,6 +1152,7 @@ cl_symbols[] = { {EXT_ "FILE-KIND","si_file_kind"}, {SYS_ "FILL-POINTER-SET","si_fill_pointer_set"}, {EXT_ "FILE-STREAM-FD","si_file_stream_fd"}, +{EXT_ "MAKE-STREAM-FROM-FD",NULL}, {EXT_ "FIXNUMP","si_fixnump"}, {SYS_ "FORMAT-ERROR",NULL}, #ifdef ECL_CMU_FORMAT diff --git a/src/cmp/proclamations.lsp b/src/cmp/proclamations.lsp index 2c58ed650..4a350c592 100644 --- a/src/cmp/proclamations.lsp +++ b/src/cmp/proclamations.lsp @@ -1341,6 +1341,9 @@ (values (or null two-way-stream) (or null integer) ext:external-process)) +(proclamation ext:file-stream-fd (stream) fixnum) +(proclamation ext:make-stream-from-fd (fixnum keyword &key) stream) + (proclamation si:waitpid (fixnum gen-bool) (values (or null keyword) (or null fixnum) diff --git a/src/doc/help.lsp b/src/doc/help.lsp index 255afda12..391cf5864 100644 --- a/src/doc/help.lsp +++ b/src/doc/help.lsp @@ -1989,6 +1989,15 @@ Creates and returns a random-state object. If RANDOM-STATE is NIL, copies the value of *RANDOM-STATE*. If RANDOM-STATE is a random-state, copies it. If RANDOM-STATE is T, creates a random-state randomly.") +(docfun ext:make-stream-from-fd function + (fd direction &key buffering element-type (external-format :default) (name "FD-STREAM")) " +Creates and returns a new stream build on top of given FD file descriptor. + +DIRECTION may be :INPUT, :OUTPUT and :IO. On Windows it may be +also :INPUT-WSOCK, :OUTPUT-WSOCK, :IO-WSOCK and :IO-WCON. + +BUFFERING may be :NONE, :LINE and :FULL.") + (docfun make-string function (length &key (initial-element #\Space)) " Creates and returns a new string of the given LENGTH, whose elements are all INITIAL-ELEMENT.") diff --git a/src/h/external.h b/src/h/external.h index 1d7b6870e..79e96a0a3 100755 --- a/src/h/external.h +++ b/src/h/external.h @@ -735,8 +735,8 @@ 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 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 si_file_stream_fd(cl_object s); extern ECL_API int ecl_stream_to_handle(cl_object s, bool output); @@ -2023,6 +2023,7 @@ extern ECL_API cl_object cl_get_decoded_time(); extern ECL_API cl_object cl_ensure_directories_exist _ECL_ARGS((cl_narg narg, cl_object V1, ...)); extern ECL_API cl_object si_simple_program_error _ECL_ARGS((cl_narg narg, cl_object format, ...)) ecl_attr_noreturn; extern ECL_API cl_object si_signal_simple_error _ECL_ARGS((cl_narg narg, cl_object condition, cl_object continuable, cl_object format, cl_object args, ...)); +extern ECL_API cl_object si_make_stream_from_fd _ECL_ARGS((cl_narg narg, cl_object fd, cl_object direction, ...)); /* module.lsp */ diff --git a/src/lsp/mislib.lsp b/src/lsp/mislib.lsp index 54b96af0b..b48299f39 100644 --- a/src/lsp/mislib.lsp +++ b/src/lsp/mislib.lsp @@ -320,3 +320,33 @@ hash table; otherwise it signals that we have reached the end of the hash table. (defun si::simple-program-error (message &rest datum) (signal-simple-error 'program-error nil message datum)) + +#-ecl-min +(defun make-stream-from-fd (fd direction &key buffering + element-type + (external-format :default) + (name "FD-STREAM")) + (check-type name string "name must be a string.") + (macrolet ((c-const (string) `(ffi:c-inline () () :int ,string :one-liner t))) + (let* ((smm-mode + (ecase direction + (:input (c-const "ecl_smm_input")) + (:output (c-const "ecl_smm_output")) + ((:io :input-output) (c-const "ecl_smm_io")) + #+:wsock (:input-wsock (c-const "ecl_smm_input_wsock")) + #+:wsock (:output-wsock (c-const "ecl_smm_output_wsock")) + #+:wsock ((:io-wsock :input-output-wsock) (c-const "ecl_smm_io_wsock")) + #+:wsock ((:io-wcon :input-output-wcon) (c-const "ecl_smm_io_wcon")))) + ;; if external-format is not NIL, flags are ignored + (external-format (unless (subtypep element-type 'integer) external-format)) + (stream (ffi:c-inline (name fd smm-mode element-type external-format) + (t :int :int t t) stream + " +ecl_make_stream_from_fd(#0,#1,(enum ecl_smmode)#2, + ecl_normalize_stream_element_type(#3), + ECL_STREAM_BINARY, + #4)" + :one-liner t))) + (when buffering + (si::set-buffering-mode stream buffering)) + stream)))