projects
/
uffi.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
r10917: 2006-04-17 Kevin Rosenberg (kevin@rosenberg.net)
[uffi.git]
/
src
/
strings.lisp
diff --git
a/src/strings.lisp
b/src/strings.lisp
index c81562862714c1f9ed722d57fcef3df23ea29145..69f1f02836f9fbf0ff37b21af145a076029ed091 100644
(file)
--- a/
src/strings.lisp
+++ b/
src/strings.lisp
@@
-19,7
+19,7
@@
#+(or cmu sbcl scl) nil
#+allegro 0
#+lispworks (fli:make-pointer :address 0 :type '(:unsigned :char))
#+(or cmu sbcl scl) nil
#+allegro 0
#+lispworks (fli:make-pointer :address 0 :type '(:unsigned :char))
- #+
mcl
(ccl:%null-ptr)
+ #+
(or openmcl digitool)
(ccl:%null-ptr)
)
(defmacro convert-from-cstring (obj)
)
(defmacro convert-from-cstring (obj)
@@
-32,7
+32,7
@@
that LW/CMU automatically converts strings from c-calls."
(if (zerop ,stored)
nil
(values (excl:native-to-string ,stored)))))
(if (zerop ,stored)
nil
(values (excl:native-to-string ,stored)))))
- #+
mcl
+ #+
(or openmcl digitool)
(let ((stored (gensym)))
`(let ((,stored ,obj))
(if (ccl:%null-ptr-p ,stored)
(let ((stored (gensym)))
`(let ((,stored ,obj))
(if (ccl:%null-ptr-p ,stored)
@@
-48,7
+48,7
@@
that LW/CMU automatically converts strings from c-calls."
(if (null ,stored)
0
(values (excl:string-to-native ,stored)))))
(if (null ,stored)
0
(values (excl:string-to-native ,stored)))))
- #+
mcl
+ #+
(or openmcl digitool)
(let ((stored (gensym)))
`(let ((,stored ,obj))
(if (null ,stored)
(let ((stored (gensym)))
`(let ((,stored ,obj))
(if (null ,stored)
@@
-65,7
+65,7
@@
that LW/CMU automatically converts strings from c-calls."
`(let ((,stored ,obj))
(unless (zerop ,stored)
(ff:free-fobject ,stored))))
`(let ((,stored ,obj))
(unless (zerop ,stored)
(ff:free-fobject ,stored))))
- #+
mcl
+ #+
(or openmcl digitool)
(let ((stored (gensym)))
`(let ((,stored ,obj))
(unless (ccl:%null-ptr-p ,stored)
(let ((stored (gensym)))
`(let ((,stored ,obj))
(unless (ccl:%null-ptr-p ,stored)
@@
-82,7
+82,7
@@
that LW/CMU automatically converts strings from c-calls."
(excl:with-native-string (,acl-native ,stored-lisp-string)
(let ((,cstring (if ,stored-lisp-string ,acl-native 0)))
,@body))))
(excl:with-native-string (,acl-native ,stored-lisp-string)
(let ((,cstring (if ,stored-lisp-string ,acl-native 0)))
,@body))))
- #+
mcl
+ #+
(or openmcl digitool)
(let ((stored-lisp-string (gensym)))
`(let ((,stored-lisp-string ,lisp-string))
(if (stringp ,stored-lisp-string)
(let ((stored-lisp-string (gensym)))
`(let ((,stored-lisp-string ,lisp-string))
(if (stringp ,stored-lisp-string)
@@
-158,7
+158,7
@@
that LW/CMU automatically converts strings from c-calls."
(char-code (char ,stored-obj ,i))))
(setf (sb-alien:deref ,storage ,size) 0))
,storage)))))
(char-code (char ,stored-obj ,i))))
(setf (sb-alien:deref ,storage ,size) 0))
,storage)))))
- #+
mcl
+ #+
(or openmcl digitool)
(let ((stored-obj (gensym)))
`(let ((,stored-obj ,obj))
(if (null ,stored-obj)
(let ((stored-obj (gensym)))
`(let ((,stored-obj ,obj))
(if (null ,stored-obj)
@@
-214,14
+214,14
@@
that LW/CMU automatically converts strings from c-calls."
(sbcl-naturalize-cstring (sb-alien:alien-sap ,stored-obj)
:length ,length
:null-terminated-p ,null-terminated-p))))
(sbcl-naturalize-cstring (sb-alien:alien-sap ,stored-obj)
:length ,length
:null-terminated-p ,null-terminated-p))))
- #+
mcl
+ #+
(or openmcl digitool)
(declare (ignore null-terminated-p))
(declare (ignore null-terminated-p))
- #+
mcl
+ #+
(or openmcl digitool)
(let ((stored-obj (gensym)))
`(let ((,stored-obj ,obj))
(if (ccl:%null-ptr-p ,stored-obj)
nil
(let ((stored-obj (gensym)))
`(let ((,stored-obj ,obj))
(if (ccl:%null-ptr-p ,stored-obj)
nil
- #+
(and mcl (not openmcl))
(ccl:%get-cstring
+ #+
digitool
(ccl:%get-cstring
,stored-obj 0
,@(if length (list length) nil))
#+openmcl ,@(if length
,stored-obj 0
,@(if length (list length) nil))
#+openmcl ,@(if length
@@
-261,9
+261,9
@@
that LW/CMU automatically converts strings from c-calls."
(declare (ignore unsigned))
#+allegro
`(ff:allocate-fobject :char :c ,size)
(declare (ignore unsigned))
#+allegro
`(ff:allocate-fobject :char :c ,size)
- #+
mcl
+ #+
(or openmcl digitool)
(declare (ignore unsigned))
(declare (ignore unsigned))
- #+
mcl
+ #+
(or openmcl digitool)
`(new-ptr ,size)
)
`(new-ptr ,size)
)
@@
-284,6
+284,11
@@
that LW/CMU automatically converts strings from c-calls."
(free-foreign-object ,foreign-string)
,result)))
(free-foreign-object ,foreign-string)
,result)))
+(defmacro with-foreign-strings (bindings &body body)
+ `(with-foreign-string ,(car bindings)
+ ,@(if (cdr bindings)
+ `((with-foreign-strings ,(cdr bindings) ,@body))
+ body)))
;; Modified from CMUCL's source to handle non-null terminated strings
#+cmu
;; Modified from CMUCL's source to handle non-null terminated strings
#+cmu