# Programer: Kevin M. Rosenberg, M.D.
# Date Started: Mar 2002
#
-# CVS Id: $Id: Makefile,v 1.51 2002/10/01 17:05:29 kevin Exp $
+# CVS Id: $Id$
#
# This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
#
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Mar 2002
;;;;
-;;;; $Id: allocation.lisp,v 1.2 2003/04/29 19:51:20 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
# Programer: Kevin M. Rosenberg
# Date Started: Mar 2002
#
-# CVS Id: $Id: Makefile,v 1.29 2002/08/02 14:39:44 kevin Exp $
+# CVS Id: $Id$
#
# This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
#
# Programer: Kevin M. Rosenberg
# Date Started: Mar 2002
#
-# CVS Id: $Id: Makefile,v 1.18 2002/12/03 06:58:39 kevin Exp $
+# CVS Id: $Id$
#
# This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
#
;; Place, Suite 330, Boston, MA 02111-1307 USA
;;
;;;; from the original ACL 6.1 sources:
-;; $Id: acl-compat-tester.lisp,v 1.1 2002/09/30 10:02:36 kevin Exp $
+;; $Id$
(defpackage :util.test
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Mar 2002
;;;;
-;;;; $Id: arrays.lisp,v 1.2 2002/12/03 06:58:39 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Mar 2002
;;;;
-;;;; $Id: atoifl.lisp,v 1.1 2002/09/30 10:02:36 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
* Programer: Kevin M. Rosenberg
* Date Started: Mar 2002
*
- * CVS Id: $Id: c-test-fns.c,v 1.5 2002/03/21 10:06:52 kevin Exp $
+ * CVS Id: $Id$
*
* This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
*
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Mar 2002
;;;;
-;;;; $Id: c-test-fns.lisp,v 1.4 2002/11/18 04:53:31 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-\r
-;;;; *************************************************************************\r
-;;;; FILE IDENTIFICATION\r
-;;;;\r
-;;;; Name: compress.cl\r
-;;;; Purpose: UFFI Example file for zlib compression\r
-;;;; Programmer: Kevin M. Rosenberg\r
-;;;; Date Started: Feb 2002\r
-;;;;\r
-;;;; $Id: compress.lisp,v 1.4 2003/03/10 17:37:05 kevin Exp $\r
-;;;;\r
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg\r
-;;;;\r
-;;;; UFFI users are granted the rights to distribute and use this software\r
-;;;; as governed by the terms of the Lisp Lesser GNU Public License\r
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.\r
-;;;; *************************************************************************\r
-\r
-(in-package :cl-user)\r
-\r
-(eval-when (:load-toplevel :execute)\r
- (unless (uffi:load-foreign-library\r
- #-(or macosx darwin)\r
- (uffi:find-foreign-library\r
- "libz"\r
- '("/usr/local/lib/" "/usr/lib/" "/zlib/")\r
- :types '("so" "a"))\r
- #+(or macosx darwin)\r
- (uffi:find-foreign-library "z"\r
- `(,(pathname-directory *load-pathname*)))\r
- :module "zlib" \r
- :supporting-libraries '("c"))\r
- (warn "Unable to load zlib")))\r
- \r
-(uffi:def-function ("compress" c-compress)\r
- ((dest (* :unsigned-char))\r
- (destlen (* :long))\r
- (source :cstring)\r
- (source-len :long))\r
- :returning :int\r
- :module "zlib")\r
- \r
-(defun compress (source)\r
- "Returns two values: array of bytes containing the compressed data\r
- and the numbe of compressed bytes"\r
- (let* ((sourcelen (length source))\r
- (destsize (+ 12 (ceiling (* sourcelen 1.01))))\r
- (dest (uffi:allocate-foreign-string destsize :unsigned t))\r
- (destlen (uffi:allocate-foreign-object :long)))\r
- (setf (uffi:deref-pointer destlen :long) destsize)\r
- (uffi:with-cstring (source-native source)\r
- (let ((result (c-compress dest destlen source-native sourcelen))\r
- (newdestlen (uffi:deref-pointer destlen :long)))\r
- (unwind-protect\r
- (if (zerop result)\r
- (values (uffi:convert-from-foreign-string \r
- dest\r
- :length newdestlen\r
- :null-terminated-p nil)\r
- newdestlen)\r
- (error "zlib error, code ~D" result))\r
- (progn\r
- (uffi:free-foreign-object destlen)\r
- (uffi:free-foreign-object dest)))))))\r
-\r
-(uffi:def-function ("uncompress" c-uncompress)\r
- ((dest (* :unsigned-char))\r
- (destlen (* :long))\r
- (source :cstring)\r
- (source-len :long))\r
- :returning :int\r
- :module "zlib")\r
-\r
-(defun uncompress (source)\r
- (let* ((sourcelen (length source))\r
- (destsize 200000) ;adjust as needed\r
- (dest (uffi:allocate-foreign-string destsize :unsigned t))\r
- (destlen (uffi:allocate-foreign-object :long)))\r
- (setf (uffi:deref-pointer destlen :long) destsize)\r
- (uffi:with-cstring (source-native source)\r
- (let ((result (c-uncompress dest destlen source-native sourcelen))\r
- (newdestlen (uffi:deref-pointer destlen :long)))\r
- (unwind-protect\r
- (if (zerop result)\r
- (uffi:convert-from-foreign-string \r
- dest\r
- :length newdestlen\r
- :null-terminated-p nil)\r
- (error "zlib error, code ~D" result))\r
- (progn\r
- (uffi:free-foreign-object destlen)\r
- (uffi:free-foreign-object dest)))))))\r
-\r
-#+examples-uffi\r
-(progn\r
- (flet ((print-results (str)\r
- (multiple-value-bind (compressed len) (compress str)\r
- (let ((*print-length* nil))\r
- (format t "~&(compress ~S) => " str)\r
- (format t "~S~%" (map 'list #'char-code compressed))))))\r
- (print-results "")\r
- (print-results "test")\r
- (print-results "test2")))\r
-\r
-#+test-uffi\r
-(progn\r
- (flet ((test-compress (str)\r
- (multiple-value-bind (compressed len) (compress str)\r
- (multiple-value-bind (uncompressed len2) (uncompress compressed)\r
- (util.test:test str uncompressed :test #'string=\r
- :fail-info "Error uncompressing a compressed string")))))\r
- (test-compress "")\r
- (test-compress "test")\r
- (test-compress "test2")))\r
-\r
-;; Results of the above on my system:\r
-;; (compress "") => 789c300001,8\r
-;; (compress "test") => 789c2b492d2e1045d1c1,12\r
-;; (compress "test2") => 789c2b492d2e31206501f3,13\r
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: compress.cl
+;;;; Purpose: UFFI Example file for zlib compression
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id$
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; UFFI users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+(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))
+ (source :cstring)
+ (source-len :long))
+ :returning :int
+ :module "zlib")
+
+(defun compress (source)
+ "Returns two values: array of bytes containing the compressed data
+ and the numbe of compressed bytes"
+ (let* ((sourcelen (length source))
+ (destsize (+ 12 (ceiling (* sourcelen 1.01))))
+ (dest (uffi:allocate-foreign-string destsize :unsigned t))
+ (destlen (uffi:allocate-foreign-object :long)))
+ (setf (uffi:deref-pointer destlen :long) destsize)
+ (uffi:with-cstring (source-native source)
+ (let ((result (c-compress dest destlen source-native sourcelen))
+ (newdestlen (uffi:deref-pointer destlen :long)))
+ (unwind-protect
+ (if (zerop result)
+ (values (uffi:convert-from-foreign-string
+ dest
+ :length newdestlen
+ :null-terminated-p nil)
+ newdestlen)
+ (error "zlib error, code ~D" result))
+ (progn
+ (uffi:free-foreign-object destlen)
+ (uffi:free-foreign-object dest)))))))
+
+(uffi:def-function ("uncompress" c-uncompress)
+ ((dest (* :unsigned-char))
+ (destlen (* :long))
+ (source :cstring)
+ (source-len :long))
+ :returning :int
+ :module "zlib")
+
+(defun uncompress (source)
+ (let* ((sourcelen (length source))
+ (destsize 200000) ;adjust as needed
+ (dest (uffi:allocate-foreign-string destsize :unsigned t))
+ (destlen (uffi:allocate-foreign-object :long)))
+ (setf (uffi:deref-pointer destlen :long) destsize)
+ (uffi:with-cstring (source-native source)
+ (let ((result (c-uncompress dest destlen source-native sourcelen))
+ (newdestlen (uffi:deref-pointer destlen :long)))
+ (unwind-protect
+ (if (zerop result)
+ (uffi:convert-from-foreign-string
+ dest
+ :length newdestlen
+ :null-terminated-p nil)
+ (error "zlib error, code ~D" result))
+ (progn
+ (uffi:free-foreign-object destlen)
+ (uffi:free-foreign-object dest)))))))
+
+#+examples-uffi
+(progn
+ (flet ((print-results (str)
+ (multiple-value-bind (compressed len) (compress str)
+ (let ((*print-length* nil))
+ (format t "~&(compress ~S) => " str)
+ (format t "~S~%" (map 'list #'char-code compressed))))))
+ (print-results "")
+ (print-results "test")
+ (print-results "test2")))
+
+#+test-uffi
+(progn
+ (flet ((test-compress (str)
+ (multiple-value-bind (compressed len) (compress str)
+ (multiple-value-bind (uncompressed len2) (uncompress compressed)
+ (util.test:test str uncompressed :test #'string=
+ :fail-info "Error uncompressing a compressed string")))))
+ (test-compress "")
+ (test-compress "test")
+ (test-compress "test2")))
+
+;; Results of the above on my system:
+;; (compress "") => 789c300001,8
+;; (compress "test") => 789c2b492d2e1045d1c1,12
+;; (compress "test2") => 789c2b492d2e31206501f3,13
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Jul 2002
;;;;
-;;;; $Id: file-socket.lisp,v 1.1 2002/09/30 10:02:36 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: getenv.lisp,v 1.1 2002/09/30 10:02:36 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: gethostname.lisp,v 1.3 2002/12/02 13:21:43 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Mar 2002
;;;;
-;;;; $Id: getshells.lisp,v 1.1 2002/09/30 10:02:36 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: gettime.lisp,v 1.1 2002/09/30 10:02:36 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: run-examples.lisp,v 1.1 2002/09/30 10:02:36 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: strtol.lisp,v 1.1 2002/09/30 10:02:36 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: test-examples.lisp,v 1.1 2002/09/30 10:02:36 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Mar 2002
;;;;
-;;;; $Id: union.lisp,v 1.3 2002/12/09 16:30:20 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: aggregates.lisp,v 1.9 2003/08/26 13:29:31 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; Programmer: "Joe Marshall" <prunesquallor@attbi.com>
;;;; Date Started: Feb 2002
;;;;
-`;;;; $Id: getenv-ccl.lisp,v 1.1 2002/10/01 17:05:29 kevin Exp $
+`;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: functions.lisp,v 1.8 2003/06/06 21:59:18 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: libraries.lisp,v 1.13 2003/08/27 20:02:59 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: objects.lisp,v 1.20 2003/08/23 01:05:53 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Sep 2002
;;;;
-;;;; $Id: os.lisp,v 1.5 2003/06/06 21:59:18 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg.
;;;; Much of this code was taken from other open source project and copyright
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: primitives.lisp,v 1.12 2003/08/15 02:34:34 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; Programmer: Kevin M. Rosenberg/John Desoi
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: readmacros-mcl.lisp,v 1.4 2003/06/06 21:59:18 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: strings.lisp,v 1.10 2003/07/18 21:33:26 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
# Programer: Kevin M. Rosenberg
# Date Started: Mar 2002
#
-# CVS Id: $Id: Makefile,v 1.24 2003/09/01 02:45:39 kevin Exp $
+# CVS Id: $Id$
#
# This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
#
;;;; Author: Kevin M. Rosenberg
;;;; Date Started: Mar 2002
;;;;
-;;;; $Id: arrays.lisp,v 1.5 2003/08/13 18:53:42 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Mar 2002
;;;;
-;;;; $Id: atoifl.lisp,v 1.3 2003/08/13 18:53:42 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
;;;;
;;;; Programmer: Kevin M. Rosenberg / Edi Weitz
;;;; Date Started: Aug 2003
;;;;
-;;;; $Id: casts.lisp,v 1.2 2003/08/14 21:40:13 kevin Exp $
+;;;; $Id$
;;;;
;;;; *************************************************************************
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-\r
-;;;; *************************************************************************\r
-;;;; FILE IDENTIFICATION\r
-;;;;\r
-;;;; Name: compress.lisp\r
-;;;; Purpose: UFFI Example file for zlib compression\r
-;;;; Author: Kevin M. Rosenberg\r
-;;;; Date Started: Feb 2002\r
-;;;;\r
-;;;; $Id: compress.lisp,v 1.12 2003/08/13 18:53:42 kevin Exp $\r
-;;;;\r
-;;;; This file, part of UFFI, is Copyright (c) 2002-2003 by Kevin M. Rosenberg\r
-;;;;\r
-;;;; *************************************************************************\r
-\r
-(in-package #:uffi-tests)\r
-\r
-(uffi:def-function ("compress" c-compress)\r
- ((dest (* :unsigned-char))\r
- (destlen (* :long))\r
- (source :cstring)\r
- (source-len :long))\r
- :returning :int\r
- :module "zlib")\r
- \r
-(defun compress (source)\r
- "Returns two values: array of bytes containing the compressed data\r
- and the numbe of compressed bytes"\r
- (let* ((sourcelen (length source))\r
- (destsize (+ 12 (ceiling (* sourcelen 1.01))))\r
- (dest (uffi:allocate-foreign-string destsize :unsigned t))\r
- (destlen (uffi:allocate-foreign-object :long)))\r
- (setf (uffi:deref-pointer destlen :long) destsize)\r
- (uffi:with-cstring (source-native source)\r
- (let ((result (c-compress dest destlen source-native sourcelen))\r
- (newdestlen (uffi:deref-pointer destlen :long)))\r
- (unwind-protect\r
- (if (zerop result)\r
- (values (uffi:convert-from-foreign-string \r
- dest\r
- :length newdestlen\r
- :null-terminated-p nil)\r
- newdestlen)\r
- (error "zlib error, code ~D" result))\r
- (progn\r
- (uffi:free-foreign-object destlen)\r
- (uffi:free-foreign-object dest)))))))\r
-\r
-(uffi:def-function ("uncompress" c-uncompress)\r
- ((dest (* :unsigned-char))\r
- (destlen (* :long))\r
- (source :cstring)\r
- (source-len :long))\r
- :returning :int\r
- :module "zlib")\r
-\r
-(defun uncompress (source)\r
- (let* ((sourcelen (length source))\r
- (destsize 200000) ;adjust as needed\r
- (dest (uffi:allocate-foreign-string destsize :unsigned t))\r
- (destlen (uffi:allocate-foreign-object :long)))\r
- (setf (uffi:deref-pointer destlen :long) destsize)\r
- (uffi:with-cstring (source-native source)\r
- (let ((result (c-uncompress dest destlen source-native sourcelen))\r
- (newdestlen (uffi:deref-pointer destlen :long)))\r
- (unwind-protect\r
- (if (zerop result)\r
- (uffi:convert-from-foreign-string \r
- dest\r
- :length newdestlen\r
- :null-terminated-p nil)\r
- (error "zlib error, code ~D" result))\r
- (progn\r
- (uffi:free-foreign-object destlen)\r
- (uffi:free-foreign-object dest)))))))\r
-\r
-(deftest compress.1 (map 'list #'char-code (compress ""))\r
- (120 156 3 0 0 0 0 1))\r
-(deftest compress.2 (map 'list #'char-code (compress "test"))\r
- (120 156 43 73 45 46 1 0 4 93 1 193))\r
-(deftest compress.3 (map 'list #'char-code (compress "test2"))\r
- (120 156 43 73 45 46 49 2 0 6 80 1 243))\r
-\r
-(defun compress-uncompress (str)\r
- (multiple-value-bind (compressed len) (compress str)\r
- (declare (ignore len))\r
- (multiple-value-bind (uncompressed len2) (uncompress compressed)\r
- (declare (ignore len2))\r
- uncompressed)))\r
-\r
-\r
-(deftest uncompress.1 "" "")\r
-(deftest uncompress.2 "test" "test")\r
-(deftest uncompress.3 "test2" "test2")\r
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: compress.lisp
+;;;; Purpose: UFFI Example file for zlib compression
+;;;; Author: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id$
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package #:uffi-tests)
+
+(uffi:def-function ("compress" c-compress)
+ ((dest (* :unsigned-char))
+ (destlen (* :long))
+ (source :cstring)
+ (source-len :long))
+ :returning :int
+ :module "zlib")
+
+(defun compress (source)
+ "Returns two values: array of bytes containing the compressed data
+ and the numbe of compressed bytes"
+ (let* ((sourcelen (length source))
+ (destsize (+ 12 (ceiling (* sourcelen 1.01))))
+ (dest (uffi:allocate-foreign-string destsize :unsigned t))
+ (destlen (uffi:allocate-foreign-object :long)))
+ (setf (uffi:deref-pointer destlen :long) destsize)
+ (uffi:with-cstring (source-native source)
+ (let ((result (c-compress dest destlen source-native sourcelen))
+ (newdestlen (uffi:deref-pointer destlen :long)))
+ (unwind-protect
+ (if (zerop result)
+ (values (uffi:convert-from-foreign-string
+ dest
+ :length newdestlen
+ :null-terminated-p nil)
+ newdestlen)
+ (error "zlib error, code ~D" result))
+ (progn
+ (uffi:free-foreign-object destlen)
+ (uffi:free-foreign-object dest)))))))
+
+(uffi:def-function ("uncompress" c-uncompress)
+ ((dest (* :unsigned-char))
+ (destlen (* :long))
+ (source :cstring)
+ (source-len :long))
+ :returning :int
+ :module "zlib")
+
+(defun uncompress (source)
+ (let* ((sourcelen (length source))
+ (destsize 200000) ;adjust as needed
+ (dest (uffi:allocate-foreign-string destsize :unsigned t))
+ (destlen (uffi:allocate-foreign-object :long)))
+ (setf (uffi:deref-pointer destlen :long) destsize)
+ (uffi:with-cstring (source-native source)
+ (let ((result (c-uncompress dest destlen source-native sourcelen))
+ (newdestlen (uffi:deref-pointer destlen :long)))
+ (unwind-protect
+ (if (zerop result)
+ (uffi:convert-from-foreign-string
+ dest
+ :length newdestlen
+ :null-terminated-p nil)
+ (error "zlib error, code ~D" result))
+ (progn
+ (uffi:free-foreign-object destlen)
+ (uffi:free-foreign-object dest)))))))
+
+(deftest compress.1 (map 'list #'char-code (compress ""))
+ (120 156 3 0 0 0 0 1))
+(deftest compress.2 (map 'list #'char-code (compress "test"))
+ (120 156 43 73 45 46 1 0 4 93 1 193))
+(deftest compress.3 (map 'list #'char-code (compress "test2"))
+ (120 156 43 73 45 46 49 2 0 6 80 1 243))
+
+(defun compress-uncompress (str)
+ (multiple-value-bind (compressed len) (compress str)
+ (declare (ignore len))
+ (multiple-value-bind (uncompressed len2) (uncompress compressed)
+ (declare (ignore len2))
+ uncompressed)))
+
+
+(deftest uncompress.1 "" "")
+(deftest uncompress.2 "test" "test")
+(deftest uncompress.3 "test2" "test2")
;;;; Author: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: foreign-loader.lisp,v 1.7 2003/08/27 19:58:25 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; Authors: Kevin M. Rosenberg and Edi Weitz
;;;; Date Started: Aug 2003
;;;;
-;;;; $Id: foreign-var.lisp,v 1.4 2003/08/15 02:50:24 kevin Exp $
+;;;; $Id$
;;;;
;;;; *************************************************************************
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: getenv.lisp,v 1.4 2003/08/13 18:53:42 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: gethostname.lisp,v 1.6 2003/08/13 18:53:42 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
;;;;
;;;; Author: Kevin M. Rosenberg
;;;; Date Started: Apr 2003
;;;;
-;;;; $Id: package.lisp,v 1.2 2003/04/29 12:57:10 kevin Exp $
+;;;; $Id$
;;;; *************************************************************************
(defpackage #:uffi-tests
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Aug 2003
;;;;
-;;;; $Id: pointers.lisp,v 1.1 2003/08/14 19:35:05 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2003 by Kevin M. Rosenberg
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: strtol.lisp,v 1.3 2003/08/13 18:53:42 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: structs.lisp,v 1.2 2003/08/14 19:35:05 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
;;;;
;;;; Author: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: time.lisp,v 1.3 2003/08/23 12:36:59 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
* Programer: Kevin M. Rosenberg
* Date Started: Mar 2002
*
- * CVS Id: $Id: uffi-c-test-lib.c,v 1.4 2003/08/15 02:34:34 kevin Exp $
+ * CVS Id: $Id$
*
* This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
*
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Mar 2002
;;;;
-;;;; $Id: uffi-c-test-lib.lisp,v 1.3 2003/08/13 18:53:42 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Mar 2002
;;;;
-;;;; $Id: union.lisp,v 1.5 2003/08/13 18:53:42 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
;;;;
;;;; Author: Kevin M. Rosenberg
;;;; Date Started: Apr 2003
;;;;
-;;;; $Id: uffi-tests.asd,v 1.10 2003/08/14 21:40:13 kevin Exp $
+;;;; $Id$
;;;; *************************************************************************
(defpackage #:uffi-tests-system
;;;; Author: Kevin M. Rosenberg
;;;; Date Started: Aug 2002
;;;;
-;;;; $Id: uffi.asd,v 1.28 2003/08/14 19:35:05 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;