On Sat, Nov 11, 2023 at 05:55:11PM +0800, Qian Yun wrote:
> "sock_get_string_buf" is the most complicated FFI function in our
> code base, because we need to pass a "char *" buffer to it, and
> get the result back after its execution.
>
> Convert a C string pointer back to Lisp string is a common idiom,
> so I simplify the code with proper functions instead of the loop
> to search for NUL byte and BYTE-to-BYTE copy.
Does it work correctly? We want back Lisp string, while documentation
of 'sb-alien:cast' says that we will get foreign pointer ('c-string'
IIUC your code).
>
> (For GCL, I simply remove the duplicated "defentry".)
>
> - Qian
>
> diff --git a/src/lisp/fricas-lisp.lisp b/src/lisp/fricas-lisp.lisp
> index 6d7716ed..d28477b0 100644
> --- a/src/lisp/fricas-lisp.lisp
> +++ b/src/lisp/fricas-lisp.lisp
> @@ -690,9 +690,6 @@ with this hack and will try to convince the GCL crowd to
> fix this.
> #+:GCL
> (progn
>
> -(SI::defentry sock_get_string_buf (SI::int SI::object SI::int)
> - (SI::int "sock_get_string_buf_wrapper"))
> -
> ;; GCL may pass strings by value. 'sock_get_string_buf' should fill
> ;; string with data read from connection, therefore needs address of
> ;; actual string buffer. We use 'sock_get_string_buf_wrapper' to
> @@ -716,7 +713,7 @@ with this hack and will try to convince the GCL crowd to
> fix this.
> (eval '(FFI:DEF-CALL-OUT sock_get_string_buf
> (:NAME "sock_get_string_buf")
> (:arguments (purpose ffi:int)
> - (buf (FFI:C-POINTER (FFI:C-ARRAY FFI::char 10000)))
> + (buf FFI:C-POINTER)
> (len ffi:int))
> (:return-type ffi:int)
> (:language :stdc)))
> @@ -725,25 +722,9 @@ with this hack and will try to convince the GCL crowd
> to fix this.
>
> #+(and :clisp :ffi)
> (defun |sockGetStringFrom| (purpose)
> - (let ((buf nil))
> - (FFI:WITH-C-VAR (tmp-buf '(FFI:C-ARRAY
> - FFI::char 10000))
> - (sock_get_string_buf purpose (FFI:C-VAR-ADDRESS tmp-buf) 10000)
> - (prog ((len2 10000))
> - (dotimes (i 10000)
> - (if (eql 0 (FFI:ELEMENT tmp-buf i))
> - (progn
> - (setf len2 i)
> - (go nn1))))
> - nn1
> - (setf buf (make-string len2))
> - (dotimes (i len2)
> - (setf (aref buf i)
> - (code-char (FFI:ELEMENT tmp-buf i)))))
> - )
> - buf
> - )
> -)
> + (FFI:WITH-FOREIGN-OBJECT (buf '(FFI:C-ARRAY-MAX FFI:character 10000))
> + (sock_get_string_buf purpose buf 10000)
> + (FFI:FOREIGN-VALUE buf)))
>
> #+:openmcl
> (defun |sockGetStringFrom| (purpose)
> @@ -754,7 +735,6 @@ with this hack and will try to convince the GCL crowd to
> fix this.
>
> #+:cmu
> (defun |sockGetStringFrom| (purpose)
> - (let ((buf nil))
> (alien:with-alien ((tmp-buf (alien:array
> c-call:char 10000)))
> (alien:alien-funcall
> @@ -767,26 +747,12 @@ with this hack and will try to convince the GCL crowd
> to fix this.
> purpose
> (alien:addr (alien:deref tmp-buf 0))
> 10000)
> - (prog ((len2 10000))
> - (dotimes (i 10000)
> - (if (eql 0 (alien:deref tmp-buf i))
> - (progn
> - (setf len2 i)
> - (go nn1))))
> - nn1
> - (setf buf (make-string len2))
> - (dotimes (i len2)
> - (setf (aref buf i)
> - (code-char (alien:deref tmp-buf i))))
> - )
> + (alien:cast tmp-buf c-call:c-string)
> )
> - buf
> - )
> )
>
> #+:sbcl
> (defun |sockGetStringFrom| (purpose)
> - (let ((buf nil))
> (SB-ALIEN::with-alien ((tmp-buf (SB-ALIEN::array
> SB-ALIEN::char 10000)))
> (SB-ALIEN::alien-funcall
> @@ -799,21 +765,8 @@ with this hack and will try to convince the GCL crowd
> to fix this.
> purpose
> (SB-ALIEN::addr (SB-ALIEN::deref tmp-buf 0))
> 10000)
> - (prog ((len2 10000))
> - (dotimes (i 10000)
> - (if (eql 0 (SB-ALIEN::deref tmp-buf i))
> - (progn
> - (setf len2 i)
> - (go nn1))))
> - nn1
> - (setf buf (make-string len2))
> - (dotimes (i len2)
> - (setf (aref buf i)
> - (code-char (SB-ALIEN::deref tmp-buf i))))
> - )
> + (sb-alien::cast tmp-buf sb-alien::c-string)
> )
> - buf
> - )
> )
>
> #+:ecl
>
> --
> You received this message because you are subscribed to the Google Groups
> "FriCAS - computer algebra system" group.
> To unsubscribe from this group and stop receiving emails from it, send an
> email to fricas-devel+unsubscr...@googlegroups.com.
> To view this discussion on the web visit
> https://groups.google.com/d/msgid/fricas-devel/8bed01d4-8b98-4070-b93f-fc222c2bf69c%40gmail.com.
> diff --git a/src/lisp/fricas-lisp.lisp b/src/lisp/fricas-lisp.lisp
> index 6d7716ed..d28477b0 100644
> --- a/src/lisp/fricas-lisp.lisp
> +++ b/src/lisp/fricas-lisp.lisp
> @@ -690,9 +690,6 @@ with this hack and will try to convince the GCL crowd to
> fix this.
> #+:GCL
> (progn
>
> -(SI::defentry sock_get_string_buf (SI::int SI::object SI::int)
> - (SI::int "sock_get_string_buf_wrapper"))
> -
> ;; GCL may pass strings by value. 'sock_get_string_buf' should fill
> ;; string with data read from connection, therefore needs address of
> ;; actual string buffer. We use 'sock_get_string_buf_wrapper' to
> @@ -716,7 +713,7 @@ with this hack and will try to convince the GCL crowd to
> fix this.
> (eval '(FFI:DEF-CALL-OUT sock_get_string_buf
> (:NAME "sock_get_string_buf")
> (:arguments (purpose ffi:int)
> - (buf (FFI:C-POINTER (FFI:C-ARRAY FFI::char 10000)))
> + (buf FFI:C-POINTER)
> (len ffi:int))
> (:return-type ffi:int)
> (:language :stdc)))
> @@ -725,25 +722,9 @@ with this hack and will try to convince the GCL crowd to
> fix this.
>
> #+(and :clisp :ffi)
> (defun |sockGetStringFrom| (purpose)
> - (let ((buf nil))
> - (FFI:WITH-C-VAR (tmp-buf '(FFI:C-ARRAY
> - FFI::char 10000))
> - (sock_get_string_buf purpose (FFI:C-VAR-ADDRESS tmp-buf) 10000)
> - (prog ((len2 10000))
> - (dotimes (i 10000)
> - (if (eql 0 (FFI:ELEMENT tmp-buf i))
> - (progn
> - (setf len2 i)
> - (go nn1))))
> - nn1
> - (setf buf (make-string len2))
> - (dotimes (i len2)
> - (setf (aref buf i)
> - (code-char (FFI:ELEMENT tmp-buf i)))))
> - )
> - buf
> - )
> -)
> + (FFI:WITH-FOREIGN-OBJECT (buf '(FFI:C-ARRAY-MAX FFI:character 10000))
> + (sock_get_string_buf purpose buf 10000)
> + (FFI:FOREIGN-VALUE buf)))
>
> #+:openmcl
> (defun |sockGetStringFrom| (purpose)
> @@ -754,7 +735,6 @@ with this hack and will try to convince the GCL crowd to
> fix this.
>
> #+:cmu
> (defun |sockGetStringFrom| (purpose)
> - (let ((buf nil))
> (alien:with-alien ((tmp-buf (alien:array
> c-call:char 10000)))
> (alien:alien-funcall
> @@ -767,26 +747,12 @@ with this hack and will try to convince the GCL crowd
> to fix this.
> purpose
> (alien:addr (alien:deref tmp-buf 0))
> 10000)
> - (prog ((len2 10000))
> - (dotimes (i 10000)
> - (if (eql 0 (alien:deref tmp-buf i))
> - (progn
> - (setf len2 i)
> - (go nn1))))
> - nn1
> - (setf buf (make-string len2))
> - (dotimes (i len2)
> - (setf (aref buf i)
> - (code-char (alien:deref tmp-buf i))))
> - )
> + (alien:cast tmp-buf c-call:c-string)
> )
> - buf
> - )
> )
>
> #+:sbcl
> (defun |sockGetStringFrom| (purpose)
> - (let ((buf nil))
> (SB-ALIEN::with-alien ((tmp-buf (SB-ALIEN::array
> SB-ALIEN::char 10000)))
> (SB-ALIEN::alien-funcall
> @@ -799,21 +765,8 @@ with this hack and will try to convince the GCL crowd to
> fix this.
> purpose
> (SB-ALIEN::addr (SB-ALIEN::deref tmp-buf 0))
> 10000)
> - (prog ((len2 10000))
> - (dotimes (i 10000)
> - (if (eql 0 (SB-ALIEN::deref tmp-buf i))
> - (progn
> - (setf len2 i)
> - (go nn1))))
> - nn1
> - (setf buf (make-string len2))
> - (dotimes (i len2)
> - (setf (aref buf i)
> - (code-char (SB-ALIEN::deref tmp-buf i))))
> - )
> + (sb-alien::cast tmp-buf sb-alien::c-string)
> )
> - buf
> - )
> )
>
> #+:ecl
--
Waldek Hebisch
--
You received this message because you are subscribed to the Google Groups
"FriCAS - computer algebra system" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to fricas-devel+unsubscr...@googlegroups.com.
To view this discussion on the web visit
https://groups.google.com/d/msgid/fricas-devel/ZU/XombB1fPNQBFt%40fricas.org.
