"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
--
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 [email protected].
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
