projects
/
uffi.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Version 1.8.3: patch from Stelian Ionescu
[uffi.git]
/
src
/
strings.lisp
diff --git
a/src/strings.lisp
b/src/strings.lisp
index eedc1b6e241b717df37af94ac2c94608c21ecbad..fc7a282628cd471a13ab2800192dc15cd18a4979 100644
(file)
--- a/
src/strings.lisp
+++ b/
src/strings.lisp
@@
-57,7
+57,7
@@
that LW/CMU automatically converts strings from c-calls."
)
(defmacro free-cstring (obj)
)
(defmacro free-cstring (obj)
-
#+(or cmu sbcl scl lispworks) (declare (ignor
e obj))
+
(declare (ignorabl
e obj))
#+allegro
(let ((stored (gensym)))
`(let ((,stored ,obj))
#+allegro
(let ((stored (gensym)))
`(let ((,stored ,obj))
@@
-100,6
+100,7
@@
that LW/CMU automatically converts strings from c-calls."
;;; Foreign string functions
(defun %convert-to-foreign-string (str foreign-encoding)
;;; Foreign string functions
(defun %convert-to-foreign-string (str foreign-encoding)
+ (declare (ignorable str foreign-encoding))
#+(or cmu scl)
(etypecase str
(null
#+(or cmu scl)
(etypecase str
(null
@@
-114,25
+115,25
@@
that LW/CMU automatically converts strings from c-calls."
(dotimes (i size)
(declare (fixnum i))
(setf (alien:deref storage i)
(dotimes (i size)
(declare (fixnum i))
(setf (alien:deref storage i)
- (char-code (char st
ored-obj
i))))
- (setf (alien:deref storage size) 0)
)
-
storage
)))
+ (char-code (char st
r
i))))
+ (setf (alien:deref storage size) 0)
+
storage)
)))
#+(and sbcl (not sb-unicode))
#+(and sbcl (not sb-unicode))
- (etypecase st
ored-obj
+ (etypecase st
r
(null
(sb-alien:sap-alien (sb-sys:int-sap 0) (* (sb-alien:unsigned 8))))
(string
(locally
(declare (optimize (speed 3) (safety 0)))
(null
(sb-alien:sap-alien (sb-sys:int-sap 0) (* (sb-alien:unsigned 8))))
(string
(locally
(declare (optimize (speed 3) (safety 0)))
- (let* ((size (length st
ored-obj
))
+ (let* ((size (length st
r
))
(storage (sb-alien:make-alien (sb-alien:unsigned 8) (1+ size))))
(declare (fixnum i))
(setq storage (sb-alien:cast storage (* (sb-alien:unsigned 8))))
(dotimes (i size)
(declare (fixnum i))
(setf (sb-alien:deref storage i)
(storage (sb-alien:make-alien (sb-alien:unsigned 8) (1+ size))))
(declare (fixnum i))
(setq storage (sb-alien:cast storage (* (sb-alien:unsigned 8))))
(dotimes (i size)
(declare (fixnum i))
(setf (sb-alien:deref storage i)
- (char-code (char st
ored-obj
i))))
+ (char-code (char st
r
i))))
(setf (sb-alien:deref storage size) 0))
storage)))
(setf (sb-alien:deref storage size) 0))
storage)))
@@
-144,7
+145,7
@@
that LW/CMU automatically converts strings from c-calls."
(locally
(declare (optimize (speed 3) (safety 0)))
(let* ((fe (or foreign-encoding *default-foreign-encoding*))
(locally
(declare (optimize (speed 3) (safety 0)))
(let* ((fe (or foreign-encoding *default-foreign-encoding*))
- (ife (when fe (
implementation
-foreign-encoding fe))))
+ (ife (when fe (
lookup
-foreign-encoding fe))))
(if ife
(let* ((octets (sb-ext:string-to-octets str :external-format ife))
(size (length octets))
(if ife
(let* ((octets (sb-ext:string-to-octets str :external-format ife))
(size (length octets))
@@
-166,7
+167,7
@@
that LW/CMU automatically converts strings from c-calls."
(dotimes (i size)
(declare (fixnum i))
(setf (sb-alien:deref storage i)
(dotimes (i size)
(declare (fixnum i))
(setf (sb-alien:deref storage i)
- (char-code (char st
ored-obj
i))))
+ (char-code (char st
r
i))))
(setf (sb-alien:deref storage size) 0)
storage))))))
(setf (sb-alien:deref storage size) 0)
storage))))))
@@
-176,7
+177,7
@@
that LW/CMU automatically converts strings from c-calls."
(locally
(declare (optimize (speed 3) (safety 0)))
(let* ((fe (or foreign-encoding *default-foreign-encoding*))
(locally
(declare (optimize (speed 3) (safety 0)))
(let* ((fe (or foreign-encoding *default-foreign-encoding*))
- (ife (when fe (
implementation
-foreign-encoding fe))))
+ (ife (when fe (
lookup
-foreign-encoding fe))))
(if ife
(let* ((octets (ccl:encode-string-to-octets str :external-format ife))
(size (length octets))
(if ife
(let* ((octets (ccl:encode-string-to-octets str :external-format ife))
(size (length octets))
@@
-201,11
+202,11
@@
that LW/CMU automatically converts strings from c-calls."
ptr))
#+(or allegro lispworks)
ptr))
#+(or allegro lispworks)
- (declare (ignore str foreign-encoding))
-
+ nil
)
(defmacro convert-to-foreign-string (obj &optional foreign-encoding)
)
(defmacro convert-to-foreign-string (obj &optional foreign-encoding)
+ (declare (ignorable foreign-encoding))
#+allegro
(let ((stored (gensym "STR-"))
(fe (gensym "FE-"))
#+allegro
(let ((stored (gensym "STR-"))
(fe (gensym "FE-"))
@@
-213,7
+214,7
@@
that LW/CMU automatically converts strings from c-calls."
`(let* ((,stored ,obj)
(,fe (or foreign-encoding *default-foreign-encoding*))
(,ife (when ,fe
`(let* ((,stored ,obj)
(,fe (or foreign-encoding *default-foreign-encoding*))
(,ife (when ,fe
- (
implementation
-foreign-encoding ,fe))))
+ (
lookup
-foreign-encoding ,fe))))
(cond
((null ,stored)
0)
(cond
((null ,stored)
0)
@@
-229,7
+230,7
@@
that LW/CMU automatically converts strings from c-calls."
`(let* ((,stored ,obj)
(,fe (or ,foreign-encoding *default-foreign-encoding*))
(,ife (when ,fe
`(let* ((,stored ,obj)
(,fe (or ,foreign-encoding *default-foreign-encoding*))
(,ife (when ,fe
- (
implementation
-foreign-encoding ,fe))))
+ (
lookup
-foreign-encoding ,fe))))
(cond
((null ,stored)
+null-cstring-pointer+)
(cond
((null ,stored)
+null-cstring-pointer+)
@@
-239,7
+240,7
@@
that LW/CMU automatically converts strings from c-calls."
(fli:convert-to-foreign-string ,stored :external-format ,ife)))))
#+(or cmu scl sbcl digitool openmcl)
(fli:convert-to-foreign-string ,stored :external-format ,ife)))))
#+(or cmu scl sbcl digitool openmcl)
- `(%convert-to-foreign-string ,obj (
implementation
-foreign-encoding
+ `(%convert-to-foreign-string ,obj (
lookup
-foreign-encoding
(or ,foreign-encoding *default-foreign-encoding*)))
)
(or ,foreign-encoding *default-foreign-encoding*)))
)
@@
-249,6
+250,7
@@
that LW/CMU automatically converts strings from c-calls."
length
foreign-encoding
(null-terminated-p t))
length
foreign-encoding
(null-terminated-p t))
+ (declare (ignorable length foreign-encoding null-terminated-p))
#+allegro
(let ((stored-obj (gensym "STR-"))
(fe (gensym "FE-"))
#+allegro
(let ((stored-obj (gensym "STR-"))
(fe (gensym "FE-"))
@@
-257,7
+259,7
@@
that LW/CMU automatically converts strings from c-calls."
(if (zerop ,stored-obj)
nil
(let* ((,fe (or ,foreign-encoding *default-foreign-encoding*))
(if (zerop ,stored-obj)
nil
(let* ((,fe (or ,foreign-encoding *default-foreign-encoding*))
- (,ife (when ,fe (
implementation
-foreign-encoding ,fe))))
+ (,ife (when ,fe (
lookup
-foreign-encoding ,fe))))
(if ,ife
(values
(excl:native-to-string
(if ,ife
(values
(excl:native-to-string
@@
-288,7
+290,7
@@
that LW/CMU automatically converts strings from c-calls."
(if (fli:null-pointer-p ,stored-obj)
nil
(let* ((,fe (or ,foreign-encoding *default-foreign-encoding*))
(if (fli:null-pointer-p ,stored-obj)
nil
(let* ((,fe (or ,foreign-encoding *default-foreign-encoding*))
- (,ife (when ,fe (
implementation
-foreign-encoding ,fe))))
+ (,ife (when ,fe (
lookup
-foreign-encoding ,fe))))
(if ,ife
(fli:convert-from-foreign-string
,stored-obj
(if ,ife
(fli:convert-from-foreign-string
,stored-obj
@@
-323,13
+325,11
@@
that LW/CMU automatically converts strings from c-calls."
(if (null-pointer-p ,stored-obj)
nil
(let* ((,fe (or ,foreign-encoding *default-foreign-encoding*))
(if (null-pointer-p ,stored-obj)
nil
(let* ((,fe (or ,foreign-encoding *default-foreign-encoding*))
- (,ife (when ,fe (
implementation
-foreign-encoding ,fe))))
+ (,ife (when ,fe (
lookup
-foreign-encoding ,fe))))
(sb-alien::c-string-to-string (sb-alien:alien-sap ,stored-obj)
(or ,ife sb-impl::*default-external-format* :latin-1)
'character)))))
(sb-alien::c-string-to-string (sb-alien:alien-sap ,stored-obj)
(or ,ife sb-impl::*default-external-format* :latin-1)
'character)))))
- #+(or openmcl digitool)
- (declare (ignore null-terminated-p))
#+(or openmcl digitool)
(let ((stored-obj (gensym "STR-"))
(fe (gensym "FE-")))
#+(or openmcl digitool)
(let ((stored-obj (gensym "STR-"))
(fe (gensym "FE-")))
@@
-355,6
+355,7
@@
that LW/CMU automatically converts strings from c-calls."
(defmacro allocate-foreign-string (size &key (unsigned t))
(defmacro allocate-foreign-string (size &key (unsigned t))
+ (declare (ignorable unsigned))
#+ignore
(let ((array-def (gensym)))
`(let ((,array-def (list 'alien:array 'c-call:char ,size)))
#+ignore
(let ((array-def (gensym)))
`(let ((,array-def (list 'alien:array 'c-call:char ,size)))
@@
-382,12
+383,8
@@
that LW/CMU automatically converts strings from c-calls."
:char)
:nelems ,size)
#+allegro
:char)
:nelems ,size)
#+allegro
- (declare (ignore unsigned))
- #+allegro
`(ff:allocate-fobject :char :c ,size)
#+(or openmcl digitool)
`(ff:allocate-fobject :char :c ,size)
#+(or openmcl digitool)
- (declare (ignore unsigned))
- #+(or openmcl digitool)
`(new-ptr ,size)
)
`(new-ptr ,size)
)