sfos/ecl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

feature: export make-stream-from-fd interface

Browse source
This commit is contained in:
Daniel Kochmanski 2017-10-11 10:25:59 +02:00
parent 05871c943a
commit c771b46c5f
7 changed files with 46 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
contrib/sockets/sockets.lisp
View file

@ -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

1
src/c/symbols_list.h
View file

@ -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

1
src/c/symbols_list2.h
View file

@ -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

3
src/cmp/proclamations.lsp
View file

@ -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)

9
src/doc/help.lsp
View file

@ -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.")

3
src/h/external.h
View file

@ -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 */

30
src/lsp/mislib.lsp
View file

@ -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)))