- `(if (fli:null-pointer-p ,obj)
- nil
- (fli:convert-from-foreign-string
- ,obj
- ,@(if length (list :length length) (values))
- :null-terminated-p ,null-terminated-p
- :external-format '(:latin-1 :eol-style :lf)))
- #+cmu
- `(if (null-pointer-p ,obj)
- nil
- (cmucl-naturalize-cstring (alien:alien-sap ,obj)
- :length ,length
- :null-terminated-p ,null-terminated-p))
- #+sbcl
- `(if (null-pointer-p ,obj)
- nil
- (sbcl-naturalize-cstring (sb-alien:alien-sap ,obj)
- :length ,length
- :null-terminated-p ,null-terminated-p))
- #+mcl
+ ;; FAST-NATIVE-TO-STRING (suprisingly) works just fine with UTF-8 multibyte character strings
+ ;; However, without knowledge of specific-encoding, the LENGTH call in FAST-NATIVE-TO-STRING
+ ;; may not be incorrect for some encodings/strings.
+ ;; This is a stop-gap until get tech support on why the below fails.
+ (let ((stored-obj (gensym "STR-")))
+ `(let ((,stored-obj ,obj))
+ (if (fli:null-pointer-p ,stored-obj)
+ nil
+ (fast-native-to-string ,stored-obj ,length))))
+ ;; Below code doesn't work on tesing with LW 6.0 testing with a UTF-8 string.
+ ;; fli:convert-from-foreign-string with :external-format of :UTF-8 doesn't
+ ;; properly code multibyte characters.
+#|
+ (let ((stored-obj (gensym "STR-"))
+ (fe (gensym "FE-"))
+ (ife (gensym "IFE-")))
+ `(let ((,stored-obj ,obj))
+ (if (fli:null-pointer-p ,stored-obj)
+ nil
+ (let* ((,fe (or ,foreign-encoding *default-foreign-encoding*))
+ (,ife (when ,fe (implementation-foreign-encoding ,fe))))
+ (if ,ife
+ (fli:convert-from-foreign-string
+ ,stored-obj
+ ,@(when length (list :length length))
+ :null-terminated-p ,null-terminated-p
+ :external-format (list ,ife :eol-style :lf))
+ (fast-native-to-string ,stored-obj ,length))))))
+|#
+
+ #+(or cmu scl)
+ (let ((stored-obj (gensym)))
+ `(let ((,stored-obj ,obj))
+ (if (null-pointer-p ,stored-obj)
+ nil
+ (cmucl-naturalize-cstring (alien:alien-sap ,stored-obj)
+ :length ,length
+ :null-terminated-p ,null-terminated-p))))
+ #+(and sbcl (not sb-unicode))
+ (let ((stored-obj (gensym)))
+ `(let ((,stored-obj ,obj))
+ (if (null-pointer-p ,stored-obj)
+ nil
+ (sbcl-naturalize-cstring (sb-alien:alien-sap ,stored-obj)
+ :length ,length
+ :null-terminated-p ,null-terminated-p))))
+
+ #+(and sbcl sb-unicode)
+ (let ((stored-obj (gensym "STR-"))
+ (fe (gensym "FE-"))
+ (ife (gensym "IFE-")))
+ `(let ((,stored-obj ,obj))
+ (if (null-pointer-p ,stored-obj)
+ nil
+ (let* ((,fe (or ,foreign-encoding *default-foreign-encoding*))
+ (,ife (when ,fe (implementation-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)))))
+
+ #+(or openmcl digitool)