[PATCH] simplify FFI function "sock_get_string_buf"

[Qian Yun]

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

(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

[Waldek Hebisch]

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

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

--
Waldek Hebisch

[Qian Yun]

See the ":naturalize-gen" method in sbcl/src/code/c-call.lisp,
finally it calls "c-string-to-string" or "%naturalize-c-string" depends
on sb-unicode. Lisp trace confirms this function is called and
Lisp string is returned.

Also see following code in sbcl/src/code/unix.lisp:

(defun unix-gethostname ()
(with-alien ((buf (array char 256)))
(syscall ("gethostname" (* char) int)
(cast buf c-string)
(cast buf (* char)) 256)))

With this patch, HyperDoc works and can be confirmed with trace:
(1) -> )lisp (trace |sockGetStringFrom|)
Value = (|sockGetStringFrom|)
(1) -> 0: (FRICAS-LISP:|sockGetStringFrom| 3)
0: |sockGetStringFrom| returned "(|bcDifferentiate|)"

- Qian

[Waldek Hebisch]

On Sun, Nov 12, 2023 at 09:59:33AM +0800, Qian Yun wrote:
> See the ":naturalize-gen" method in sbcl/src/code/c-call.lisp,
> finally it calls "c-string-to-string" or "%naturalize-c-string" depends
> on sb-unicode. Lisp trace confirms this function is called and
> Lisp string is returned.

OK, so please commit.

--
Waldek Hebisch