r3546: *** empty log message ***
authorKevin M. Rosenberg <kevin@rosenberg.net>
Tue, 3 Dec 2002 06:58:39 +0000 (06:58 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Tue, 3 Dec 2002 06:58:39 +0000 (06:58 +0000)
examples/Makefile
examples/arrays.lisp
examples/compress.lisp
examples/union.lisp
src/objects.lisp
tests/Makefile
tests/arrays.lisp
tests/compress.lisp
tests/union.lisp

index f49a13fdc2368be508298f130c7bca083511af4f..530655a22d27b89d12e2ec5e884b20e41502b6a4 100644 (file)
@@ -5,7 +5,7 @@
 #  Programer:    Kevin M. Rosenberg
 #  Date Started: Mar 2002
 #
-#  CVS Id:   $Id: Makefile,v 1.17 2002/11/29 11:10:08 kevin Exp $
+#  CVS Id:   $Id: Makefile,v 1.18 2002/12/03 06:58:39 kevin Exp $
 #
 # This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 #
@@ -37,10 +37,7 @@ linux: $(source) Makefile
 mac:
        cc -dynamic -c $(source) -o $(object)
        ld -bundle /usr/lib/bundle1.o -flat_namespace -undefined suppress -o $(base).dylib $(object)
-
-mac-bundle:
-       cc -dynamic -c $(source) -o $(object)
-       ld -bundle /usr/lib/bundle1.o -flat_namespace -undefined suppress -o $(base).bundle $(object)
+       ld -bundle /usr/lib/bundle1.o -flat_namespace -undefined suppress /usr/lib/libz.dylib -o z.dylib
 
 solaris:
        cc -KPIC -c $(source) -o $(object)
index 75ff5a7a69c91f6d47fbbde782a2c80c27e26eeb..1bc438f623cb6ba2aa853bf03a50d95a58b95dcc 100644 (file)
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id: arrays.lisp,v 1.1 2002/09/30 10:02:36 kevin Exp $
+;;;; $Id: arrays.lisp,v 1.2 2002/12/03 06:58:39 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -21,6 +21,8 @@
 (uffi:def-constant +column-length+ 10)
 (uffi:def-constant +row-length+ 10)
 
+(uffi:def-foreign-type long-ptr '(* :long))
+
 (defun test-array-1d ()
   "Tests vector"
   (let ((a (uffi:allocate-foreign-object :long +column-length+)))
@@ -33,7 +35,7 @@
 
 (defun test-array-2d ()
   "Tests 2d array"
-  (let ((a (uffi:allocate-foreign-object '(* :long) +row-length+)))
+  (let ((a (uffi:allocate-foreign-object 'long-ptr +row-length+)))
     (dotimes (r +row-length+)
       (declare (fixnum r))
       (setf (uffi:deref-array a '(:array (* :long)) r)
index 75d79c4d02ed95ee3c73341f2671db9254bd1743..e5140aea57b6d4b60988d5dd2cb670b7175142cc 100644 (file)
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: compress.lisp,v 1.1 2002/09/30 10:02:36 kevin Exp $
+;;;; $Id: compress.lisp,v 1.2 2002/12/03 06:58:39 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
 
 (in-package :cl-user)
 
-(unless (uffi:load-foreign-library
-        (uffi:find-foreign-library
-         "libz"
-         '("/usr/local/lib/" "/usr/lib/" "/zlib/")
-         :types '("so" "a" "dylib"))
-        :module "zlib" 
-        :supporting-libraries '("c"))
-  (warn "Unable to load zlib"))
-
+(eval-when (:load-toplevel :execute)
+  (unless (uffi:load-foreign-library
+          #-(or macosx darwin)
+          (uffi:find-foreign-library
+           "libz"
+           '("/usr/local/lib/" "/usr/lib/" "/zlib/")
+           :types '("so" "a"))
+          #+(or macosx darwin)
+          (uffi:find-foreign-library "z"
+                                     `(,(pathname-directory *load-pathname*)))
+          :module "zlib" 
+          :supporting-libraries '("c"))
+    (warn "Unable to load zlib")))
+  
 (uffi:def-function ("compress" c-compress)
     ((dest (* :unsigned-char))
      (destlen (* :long))
index 856ac4935787987d2db3a2ea561de1e81fd3ecd9..5b22be2cdfa0e03615363c26327ab69bd874f5a6 100644 (file)
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id: union.lisp,v 1.1 2002/09/30 10:02:36 kevin Exp $
+;;;; $Id: union.lisp,v 1.2 2002/12/03 06:58:39 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
   (let ((u (uffi:allocate-foreign-object 'tunion1)))
     (setf (uffi:get-slot-value u 'tunion1 'uint)
       ;; little endian
-      #-(or sparc sparc-v9 powerpc ppc)
+      #-(or sparc sparc-v9 powerpc ppc little-endian)
       (+ (* 1 (char-code #\A))
         (* 256 (char-code #\B))
         (* 65536 (char-code #\C))
-        (* 16777216 128))
+        (* 16777216 255))
       ;; big endian
-      #+(or sparc sparc-v9 powerpc ppc)
+      #+(or sparc sparc-v9 powerpc ppc big-endian)
       (+ (* 16777216 (char-code #\A))
         (* 65536 (char-code #\B))
         (* 256 (char-code #\C))
-        (* 1 128)))
+        (* 1 255)))
     (format *standard-output* "~&Should be #\A: ~S" 
            (uffi:ensure-char-character 
             (uffi:get-slot-value u 'tunion1 'char)))
-    (format *standard-output* "~&Should be negative number: ~D" 
-           (uffi:get-slot-value u 'tunion1 'int))
+;;    (format *standard-output* "~&Should be negative number: ~D" 
+;;         (uffi:get-slot-value u 'tunion1 'int))
     (format *standard-output* "~&Should be positive number: ~D"
            (uffi:get-slot-value u 'tunion1 'uint))
     (uffi:free-foreign-object u))
               :test #'eql
               :fail-info "Error with union character")
     #-(or sparc sparc-v9 mcl)
-    (util.test:test (> 0 (uffi:get-slot-value u 'tunion1 'int))
-              t
-              :fail-info
-              "Error with negative int in union")
+;;    (util.test:test (> 0 (uffi:get-slot-value u 'tunion1 'int))
+;;            t
+;;            :fail-info
+;;            "Error with negative int in union")
     (util.test:test (plusp (uffi:get-slot-value u 'tunion1 'uint))
               t
               :fail-info
index 8c6d2aca11f1c936b3d970438aed7057ef3561d3..0265259037bd09e79e7f41c26f51ae889e212a7a 100644 (file)
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: objects.lisp,v 1.7 2002/12/02 13:21:43 kevin Exp $
+;;;; $Id: objects.lisp,v 1.8 2002/12/03 06:58:39 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -58,7 +58,7 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated."
        #+lispworks
        `(fli:allocate-foreign-object :type ',(convert-from-uffi-type type :allocate) :nelems ,size)
        #+allegro
-       `(ff:allocate-fobject '(:array ,(convert-from-uffi-type (eval type) :allocate) ,(eval size)) :c)
+       `(ff:allocate-fobject (list :array (quote ,(convert-from-uffi-type type :allocate)) ,size) :c)
        #+mcl
        `(new-ptr (* ,size ,(size-of-foreign-type (convert-from-uffi-type type :allocation))))
        )))
index f49a13fdc2368be508298f130c7bca083511af4f..530655a22d27b89d12e2ec5e884b20e41502b6a4 100644 (file)
@@ -5,7 +5,7 @@
 #  Programer:    Kevin M. Rosenberg
 #  Date Started: Mar 2002
 #
-#  CVS Id:   $Id: Makefile,v 1.17 2002/11/29 11:10:08 kevin Exp $
+#  CVS Id:   $Id: Makefile,v 1.18 2002/12/03 06:58:39 kevin Exp $
 #
 # This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 #
@@ -37,10 +37,7 @@ linux: $(source) Makefile
 mac:
        cc -dynamic -c $(source) -o $(object)
        ld -bundle /usr/lib/bundle1.o -flat_namespace -undefined suppress -o $(base).dylib $(object)
-
-mac-bundle:
-       cc -dynamic -c $(source) -o $(object)
-       ld -bundle /usr/lib/bundle1.o -flat_namespace -undefined suppress -o $(base).bundle $(object)
+       ld -bundle /usr/lib/bundle1.o -flat_namespace -undefined suppress /usr/lib/libz.dylib -o z.dylib
 
 solaris:
        cc -KPIC -c $(source) -o $(object)
index 75ff5a7a69c91f6d47fbbde782a2c80c27e26eeb..1bc438f623cb6ba2aa853bf03a50d95a58b95dcc 100644 (file)
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id: arrays.lisp,v 1.1 2002/09/30 10:02:36 kevin Exp $
+;;;; $Id: arrays.lisp,v 1.2 2002/12/03 06:58:39 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -21,6 +21,8 @@
 (uffi:def-constant +column-length+ 10)
 (uffi:def-constant +row-length+ 10)
 
+(uffi:def-foreign-type long-ptr '(* :long))
+
 (defun test-array-1d ()
   "Tests vector"
   (let ((a (uffi:allocate-foreign-object :long +column-length+)))
@@ -33,7 +35,7 @@
 
 (defun test-array-2d ()
   "Tests 2d array"
-  (let ((a (uffi:allocate-foreign-object '(* :long) +row-length+)))
+  (let ((a (uffi:allocate-foreign-object 'long-ptr +row-length+)))
     (dotimes (r +row-length+)
       (declare (fixnum r))
       (setf (uffi:deref-array a '(:array (* :long)) r)
index 75d79c4d02ed95ee3c73341f2671db9254bd1743..e5140aea57b6d4b60988d5dd2cb670b7175142cc 100644 (file)
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: compress.lisp,v 1.1 2002/09/30 10:02:36 kevin Exp $
+;;;; $Id: compress.lisp,v 1.2 2002/12/03 06:58:39 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
 
 (in-package :cl-user)
 
-(unless (uffi:load-foreign-library
-        (uffi:find-foreign-library
-         "libz"
-         '("/usr/local/lib/" "/usr/lib/" "/zlib/")
-         :types '("so" "a" "dylib"))
-        :module "zlib" 
-        :supporting-libraries '("c"))
-  (warn "Unable to load zlib"))
-
+(eval-when (:load-toplevel :execute)
+  (unless (uffi:load-foreign-library
+          #-(or macosx darwin)
+          (uffi:find-foreign-library
+           "libz"
+           '("/usr/local/lib/" "/usr/lib/" "/zlib/")
+           :types '("so" "a"))
+          #+(or macosx darwin)
+          (uffi:find-foreign-library "z"
+                                     `(,(pathname-directory *load-pathname*)))
+          :module "zlib" 
+          :supporting-libraries '("c"))
+    (warn "Unable to load zlib")))
+  
 (uffi:def-function ("compress" c-compress)
     ((dest (* :unsigned-char))
      (destlen (* :long))
index 856ac4935787987d2db3a2ea561de1e81fd3ecd9..5b22be2cdfa0e03615363c26327ab69bd874f5a6 100644 (file)
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id: union.lisp,v 1.1 2002/09/30 10:02:36 kevin Exp $
+;;;; $Id: union.lisp,v 1.2 2002/12/03 06:58:39 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
   (let ((u (uffi:allocate-foreign-object 'tunion1)))
     (setf (uffi:get-slot-value u 'tunion1 'uint)
       ;; little endian
-      #-(or sparc sparc-v9 powerpc ppc)
+      #-(or sparc sparc-v9 powerpc ppc little-endian)
       (+ (* 1 (char-code #\A))
         (* 256 (char-code #\B))
         (* 65536 (char-code #\C))
-        (* 16777216 128))
+        (* 16777216 255))
       ;; big endian
-      #+(or sparc sparc-v9 powerpc ppc)
+      #+(or sparc sparc-v9 powerpc ppc big-endian)
       (+ (* 16777216 (char-code #\A))
         (* 65536 (char-code #\B))
         (* 256 (char-code #\C))
-        (* 1 128)))
+        (* 1 255)))
     (format *standard-output* "~&Should be #\A: ~S" 
            (uffi:ensure-char-character 
             (uffi:get-slot-value u 'tunion1 'char)))
-    (format *standard-output* "~&Should be negative number: ~D" 
-           (uffi:get-slot-value u 'tunion1 'int))
+;;    (format *standard-output* "~&Should be negative number: ~D" 
+;;         (uffi:get-slot-value u 'tunion1 'int))
     (format *standard-output* "~&Should be positive number: ~D"
            (uffi:get-slot-value u 'tunion1 'uint))
     (uffi:free-foreign-object u))
               :test #'eql
               :fail-info "Error with union character")
     #-(or sparc sparc-v9 mcl)
-    (util.test:test (> 0 (uffi:get-slot-value u 'tunion1 'int))
-              t
-              :fail-info
-              "Error with negative int in union")
+;;    (util.test:test (> 0 (uffi:get-slot-value u 'tunion1 'int))
+;;            t
+;;            :fail-info
+;;            "Error with negative int in union")
     (util.test:test (plusp (uffi:get-slot-value u 'tunion1 'uint))
               t
               :fail-info