1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: UFFI Example file for zlib compression
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Feb 2002
12 ;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
14 ;;;; *************************************************************************
18 (eval-when (:load-toplevel :execute)
19 (unless (uffi:load-foreign-library
21 (uffi:find-foreign-library
23 '("/usr/local/lib/" "/usr/lib/" "/zlib/")
26 (uffi:find-foreign-library "z"
27 `(,(pathname-directory *load-pathname*)))
29 :supporting-libraries '("c"))
30 (warn "Unable to load zlib")))
32 (uffi:def-function ("compress" c-compress)
33 ((dest (* :unsigned-char))
40 (defun compress (source)
41 "Returns two values: array of bytes containing the compressed data
42 and the numbe of compressed bytes"
43 (let* ((sourcelen (length source))
44 (destsize (+ 12 (ceiling (* sourcelen 1.01))))
45 (dest (uffi:allocate-foreign-string destsize :unsigned t))
46 (destlen (uffi:allocate-foreign-object :long)))
47 (setf (uffi:deref-pointer destlen :long) destsize)
48 (uffi:with-cstring (source-native source)
49 (let ((result (c-compress dest destlen source-native sourcelen))
50 (newdestlen (uffi:deref-pointer destlen :long)))
53 (values (uffi:convert-from-foreign-string
56 :null-terminated-p nil)
58 (error "zlib error, code ~D" result))
60 (uffi:free-foreign-object destlen)
61 (uffi:free-foreign-object dest)))))))
63 (uffi:def-function ("uncompress" c-uncompress)
64 ((dest (* :unsigned-char))
71 (defun uncompress (source)
72 (let* ((sourcelen (length source))
73 (destsize 200000) ;adjust as needed
74 (dest (uffi:allocate-foreign-string destsize :unsigned t))
75 (destlen (uffi:allocate-foreign-object :long)))
76 (setf (uffi:deref-pointer destlen :long) destsize)
77 (uffi:with-cstring (source-native source)
78 (let ((result (c-uncompress dest destlen source-native sourcelen))
79 (newdestlen (uffi:deref-pointer destlen :long)))
82 (uffi:convert-from-foreign-string
85 :null-terminated-p nil)
86 (error "zlib error, code ~D" result))
88 (uffi:free-foreign-object destlen)
89 (uffi:free-foreign-object dest)))))))
93 (flet ((print-results (str)
94 (multiple-value-bind (compressed len) (compress str)
95 (let ((*print-length* nil))
96 (format t "~&(compress ~S) => " str)
97 (format t "~S~%" (map 'list #'char-code compressed))))))
99 (print-results "test")
100 (print-results "test2")))
104 (flet ((test-compress (str)
105 (multiple-value-bind (compressed len) (compress str)
106 (multiple-value-bind (uncompressed len2) (uncompress compressed)
107 (util.test:test str uncompressed :test #'string=
108 :fail-info "Error uncompressing a compressed string")))))
110 (test-compress "test")
111 (test-compress "test2")))
113 ;; Results of the above on my system:
114 ;; (compress "") => 789c300001,8
115 ;; (compress "test") => 789c2b492d2e1045d1c1,12
116 ;; (compress "test2") => 789c2b492d2e31206501f3,13