source: project/release/4/lzma/trunk/lzma.scm @ 15237

Last change on this file since 15237 was 15237, checked in by Alaric Snell-Pym, 10 years ago

C-Keen's first patch

File size: 1.3 KB
Line 
1(module lzma (compress decompress)
2
3(import scheme)
4(import chicken)
5(import foreign)
6(use lolevel)
7
8(foreign-declare "#include <lzmalib.h>")
9
10(foreign-declare "static int lzma_return_buffer_len;")
11
12(define-foreign-variable lzma-return-buffer-len int "lzma_return_buffer_len")
13(define _decompress (foreign-lambda* c-pointer ((blob inblob) (int inlen))
14   "C_return (lzma_decompress(inblob, inlen, &lzma_return_buffer_len));"))
15(define _compress (foreign-lambda* c-pointer ((blob inblob) (int inlen))
16   "C_return (lzma_compress(inblob, inlen, &lzma_return_buffer_len));"))
17(define _free (foreign-lambda void "lzma_free" c-pointer))
18
19(define (decompress inblob)
20   (let ((ptr (_decompress inblob (blob-size inblob))))
21      (if (null-pointer? ptr)
22         #f
23         (let ((outblob (make-blob lzma-return-buffer-len)))
24            (begin
25               (move-memory! ptr outblob lzma-return-buffer-len)
26               (_free ptr)
27               outblob)))))
28
29(define (compress inblob)
30   (let ((ptr (_compress inblob (blob-size inblob))))
31      (if (null-pointer? ptr)
32         #f
33         (let ((outblob (make-blob lzma-return-buffer-len)))
34            (begin
35               (move-memory! ptr outblob lzma-return-buffer-len)
36               (_free ptr)
37               outblob))))))
Note: See TracBrowser for help on using the repository browser.