r8999: add new function FOREIGN-STRING-LENGTH

diff --git a/ChangeLog b/ChangeLog
index 0b99ac92d20f8988149e44525d118da8b664613c..4c50f909efc00beb4a0aad04cb65a54c1714d292 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,6 @@
+2004-04-13 Kevin Rosenberg (kevin@rosenberg.net)
+       * str/string.lisp: Add new FOREIGN-STRING-LENGTH
+
 2003-08-15 Kevin Rosenberg (kevin@rosenberg.net)
        * Added with-cast-pointer and def-foreign-var (patches submitted
        by Edi Weitz). 

diff --git a/debian/changelog b/debian/changelog
index d4f6e8a8cd545184d88b75d1e3c0a7205b226801..111c2678dfded4ad50cf5fad94930fdf8534ecec 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+cl-uffi (1.4.8-1) unstable; urgency=low
+
+  * New upstream
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Tue, 13 Apr 2004 14:13:04 -0600
+
 cl-uffi (1.4.7-1) unstable; urgency=low
 
   * Fix fast-native-to-string on 16-bit wide char Allegro

diff --git a/src/package.lisp b/src/package.lisp
index 54af538ab25ed8c781247cd464b6f0c0b06cee8b..05f7e4f5d6802e1687f63fc494a7c2d1573c4a6b 100644 (file)
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -62,6 +62,7 @@
    #:convert-to-foreign-string
    #:allocate-foreign-string
    #:with-foreign-string
+   #:foreign-string-length
    
    ;; function call
    #:def-function

diff --git a/src/strings.lisp b/src/strings.lisp
index e4d67013a80a1db25ac52324fdf0ffe4993542bb..0585d43ada673ff958cd16b92c0edff088343214 100644 (file)
--- a/src/strings.lisp
+++ b/src/strings.lisp
@@ -223,6 +223,15 @@ that LW/CMU automatically converts strings from c-calls."
   `(new-ptr ,size)
   )
 
+(defun foreign-string-length (foreign-string)
+  #+allegro `(ff:foreign-strlen ,ptr)
+  #-allegro
+  `(loop with size = 0
+    until (char= (deref-array ,ptr '(:array :unsigned-char) size) #\Null)
+    do (incf size)
+    finally return size))
+
+
 (defmacro with-foreign-string ((foreign-string lisp-string) &body body)
   (let ((result (gensym)))
     `(let* ((,foreign-string (convert-to-foreign-string ,lisp-string))