nil
(if (eq ,locale :none)
(fast-native-to-string ,obj ,length)
- (excl:native-to-string
- ,obj
- ,@(when length (list :length length))
- :truncate (not ,null-terminated-p))))
+ (values
+ (excl:native-to-string
+ ,obj
+ ,@(when length (list :length length))
+ :truncate (not ,null-terminated-p)))))
#+lispworks
`(if (fli:null-pointer-p ,obj)
nil
#+mcl
`(if (ccl:%null-ptr-p ,obj)
nil
- (ccl:%get-cstring ,obj 0 ,@(if length (list length) nil)))
+ #+(and mcl (not openmcl)) (ccl:%get-cstring ,obj 0 ,@(if length (list length) nil))
+ #+openmcl ,@(if length
+ `((ccl:%str-from-ptr ,obj ,length))
+ `((ccl:%get-cstring ,obj))))
)
(* length sb-vm:n-byte-bits))
result)))
-
-(def-function "strlen"
- ((str (* :unsigned-char)))
- :returning :unsigned-int)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (def-function "strlen"
+ ((str (* :unsigned-char)))
+ :returning :unsigned-int))
(def-type char-ptr-def (* :unsigned-char))
(let* ((len (or len (strlen s)))
(str (make-string len)))
(dotimes (i len str)
- (setf (schar str i) (code-char (uffi:deref-array s '(:array :byte) i))))))
+ (setf (schar str i) (code-char (uffi:deref-array s '(:array :unsigned-byte) i))))))