1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
\r
2 ;;;; *************************************************************************
\r
3 ;;;; FILE IDENTIFICATION
\r
5 ;;;; Name: compress.cl
\r
6 ;;;; Purpose: UFFI Example file for zlib compression
\r
7 ;;;; Programmer: Kevin M. Rosenberg
\r
8 ;;;; Date Started: Feb 2002
\r
10 ;;;; $Id: compress.lisp,v 1.4 2003/03/10 17:37:05 kevin Exp $
\r
12 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
\r
14 ;;;; UFFI users are granted the rights to distribute and use this software
\r
15 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
\r
16 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
\r
17 ;;;; *************************************************************************
\r
19 (in-package :cl-user)
\r
21 (eval-when (:load-toplevel :execute)
\r
22 (unless (uffi:load-foreign-library
\r
23 #-(or macosx darwin)
\r
24 (uffi:find-foreign-library
\r
26 '("/usr/local/lib/" "/usr/lib/" "/zlib/")
\r
28 #+(or macosx darwin)
\r
29 (uffi:find-foreign-library "z"
\r
30 `(,(pathname-directory *load-pathname*)))
\r
32 :supporting-libraries '("c"))
\r
33 (warn "Unable to load zlib")))
\r
35 (uffi:def-function ("compress" c-compress)
\r
36 ((dest (* :unsigned-char))
\r
43 (defun compress (source)
\r
44 "Returns two values: array of bytes containing the compressed data
\r
45 and the numbe of compressed bytes"
\r
46 (let* ((sourcelen (length source))
\r
47 (destsize (+ 12 (ceiling (* sourcelen 1.01))))
\r
48 (dest (uffi:allocate-foreign-string destsize :unsigned t))
\r
49 (destlen (uffi:allocate-foreign-object :long)))
\r
50 (setf (uffi:deref-pointer destlen :long) destsize)
\r
51 (uffi:with-cstring (source-native source)
\r
52 (let ((result (c-compress dest destlen source-native sourcelen))
\r
53 (newdestlen (uffi:deref-pointer destlen :long)))
\r
56 (values (uffi:convert-from-foreign-string
\r
59 :null-terminated-p nil)
\r
61 (error "zlib error, code ~D" result))
\r
63 (uffi:free-foreign-object destlen)
\r
64 (uffi:free-foreign-object dest)))))))
\r
66 (uffi:def-function ("uncompress" c-uncompress)
\r
67 ((dest (* :unsigned-char))
\r
74 (defun uncompress (source)
\r
75 (let* ((sourcelen (length source))
\r
76 (destsize 200000) ;adjust as needed
\r
77 (dest (uffi:allocate-foreign-string destsize :unsigned t))
\r
78 (destlen (uffi:allocate-foreign-object :long)))
\r
79 (setf (uffi:deref-pointer destlen :long) destsize)
\r
80 (uffi:with-cstring (source-native source)
\r
81 (let ((result (c-uncompress dest destlen source-native sourcelen))
\r
82 (newdestlen (uffi:deref-pointer destlen :long)))
\r
85 (uffi:convert-from-foreign-string
\r
88 :null-terminated-p nil)
\r
89 (error "zlib error, code ~D" result))
\r
91 (uffi:free-foreign-object destlen)
\r
92 (uffi:free-foreign-object dest)))))))
\r
96 (flet ((print-results (str)
\r
97 (multiple-value-bind (compressed len) (compress str)
\r
98 (let ((*print-length* nil))
\r
99 (format t "~&(compress ~S) => " str)
\r
100 (format t "~S~%" (map 'list #'char-code compressed))))))
\r
102 (print-results "test")
\r
103 (print-results "test2")))
\r
107 (flet ((test-compress (str)
\r
108 (multiple-value-bind (compressed len) (compress str)
\r
109 (multiple-value-bind (uncompressed len2) (uncompress compressed)
\r
110 (util.test:test str uncompressed :test #'string=
\r
111 :fail-info "Error uncompressing a compressed string")))))
\r
113 (test-compress "test")
\r
114 (test-compress "test2")))
\r
116 ;; Results of the above on my system:
\r
117 ;; (compress "") => 789c300001,8
\r
118 ;; (compress "test") => 789c2b492d2e1045d1c1,12
\r
119 ;; (compress "test2") => 789c2b492d2e31206501f3,13
\r