# 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
#
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)
;;;; 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
;;;;
(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+)))
(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)
;;;; 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))
;;;; 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
;;;; 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
;;;;
#+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))))
)))
# 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
#
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)
;;;; 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
;;;;
(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+)))
(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)
;;;; 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))
;;;; 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