Coverage report: /home/ellis/comp/core/ffi/zstd/pkg.lisp

KindCoveredAll%
expression146 2.2
branch00nil
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; ffi/zstd/pkg.lisp --- ZSTD FFI
2
 
3
 ;; Zstd compression support for Lisp
4
 
5
 ;;; Commentary:
6
 
7
 ;; Initially I was thinking of this as an SB-CONTRIB module which links up
8
 ;; with whatever C runtime functions exposed by the built-in SBCL compression
9
 ;; support. However, there isn't actually much going on in the runtime and
10
 ;; it's not publicly exposed at all. The SBCL/Zstd surface-area is restrained
11
 ;; to FASL read/write streams and not of much use outside it.
12
 
13
 ;; So, we'll be applying the same from-scratch strategy we've become
14
 ;; accustomed to, exposing as much of the C API as possible and building up
15
 ;; our abstractions.
16
 
17
 ;; The low-level abstractions are in this package - ZSTD.
18
 
19
 ;; For the high-level abstractions see IO/FLATE and IO/ZSTD in the IO package.
20
 
21
 ;; The following programs have compile-time support for linking Zstd:
22
 
23
 ;; SBCL
24
 ;; QEMU
25
 ;; RocksDB 
26
 
27
 #| from zstd.h:
28
 Introduction                            ; ; ; ; ; ;
29
                                         ; ; ; ; ; ;
30
 zstd, short for Zstandard, is a fast lossless compression algorithm, targeting ; ; ; ; ; ;
31
 real-time compression scenarios at zlib-level and better compression ratios. ; ; ; ; ; ;
32
 The zstd compression library provides in-memory compression and decompression ; ; ; ; ; ;
33
 functions.                              ; ; ; ; ; ;
34
                                         ; ; ; ; ; ;
35
 The library supports regular compression levels from 1 up to ZSTD_maxCLevel(), ; ; ; ; ; ;
36
 which is currently 22. Levels >= 20, labeled `--ultra`, should be used with ; ; ; ; ; ;
37
 caution, as they require more memory. The library also offers negative ; ; ; ; ; ;
38
 compression levels, which extend the range of speed vs. ratio preferences. ; ; ; ; ; ;
39
 The lower the level, the faster the speed (at the cost of compression). ; ; ; ; ; ;
40
                                         ; ; ; ; ; ;
41
 Compression can be done in:             ; ; ; ; ; ;
42
 - a single step (described as Simple API) ; ; ; ; ; ;
43
 - a single step, reusing a context (described as Explicit context) ; ; ; ; ; ;
44
 - unbounded multiple steps (described as Streaming compression) ; ; ; ; ; ;
45
                                         ; ; ; ; ; ;
46
 The compression ratio achievable on small data can be highly improved using ; ; ; ; ; ;
47
 a dictionary. Dictionary compression can be performed in: ; ; ; ; ; ;
48
 - a single step (described as Simple dictionary API) ; ; ; ; ; ;
49
 - a single step, reusing a dictionary (described as Bulk-processing ; ; ; ; ; ;
50
 dictionary API)                         ; ; ; ; ; ;
51
                                         ; ; ; ; ; ;
52
 Advanced experimental functions can be accessed using ; ; ; ; ; ;
53
 `#define ZSTD_STATIC_LINKING_ONLY` before including zstd.h. ; ; ; ; ; ;
54
                                         ; ; ; ; ; ;
55
 Advanced experimental APIs should never be used with a dynamically-linked ; ; ; ; ; ;
56
 library. They are not "stable"; their definitions or signatures may change in ; ; ; ; ; ;
57
 the future. Only static linking is allowed. ; ; ; ; ; ;
58
 |#
59
 
60
 ;;; Code:
61
 (defpackage :zstd
62
   (:use :cl :std :sb-alien)
63
   (:nicknames :zstd)
64
   (:export :zstd-alien-error :with-zstd-cstream :with-zstd-dstream
65
    :zstd-versionnumber :zstd-cstreaminsize :zstd-cstreamoutsize :zstd-inbuffer
66
    :zstd-iserror :zstd-defaultclevel :zstd-compress :zstd-decompress
67
    :zstd-cstream :zstd-dstream :zstd-compressstream :zstd-decompressstream
68
    :zstd-compressstream2 :zstd-outbuffer :zstd-geterrorname :zstd-geterrorcode
69
    :zstdc :zstdd
70
    :zstd-alien-error :zstd-dstream-error :zstd-cstream-error
71
    :with-zstd-streams
72
    :with-zstd-buffers
73
    :with-zstd-outbuffer
74
    :with-zstd-inbuffer
75
    :with-zstd-cdict
76
    :with-zstd-ddict
77
    :load-zstd :load-zstd-alien))
78
 
79
 (in-package :zstd)
80
 (define-alien-loader zstd "/usr/local/lib/")
81
 (define-alien-loader zstd-alien "/usr/local/lib/")
82
 
83
 ;;; Types
84
 (deftype zstd-error-code ()
85
   `(integer 0 120))
86
 
87
 (deftype zstd-strategy-designator ()
88
   `(or (integer ,(zstd-minclevel) ,(zstd-maxclevel))
89
        (member :fast :dfast :greedy :lazy
90
                :lazy2 :btlazy2 :btopt :btultra
91
                :btultra2)))
92
 
93
 (deftype zstd-compression-parameter ()
94
   `(integer 100 1024))
95
 (deftype zstd-decompression-parameter ()
96
   `(integer 100 1024))
97
 
98
 (deftype zstd-reset-directive ()
99
   `(or (integer 1 3) (member :session-only :parameters :session-and-parameters)))
100
 (deftype zstd-end-directive ()
101
   `(or (integer 0 2) (member :continue :flus :end)))
102
 
103
 ;;; Errors
104
 (define-condition zstd-alien-condition () ()
105
   (:documentation "Superclass of all conditions triggered by the ZSTD FFI."))
106
 
107
 (deferror zstd-alien-error (error)
108
     ((code :initarg :code :accessor zstd-error-code))
109
     (:documentation "Error signaled from Zstd Alien."))
110
     
111
 ;; found in zstd_errors.h
112
 (define-alien-enum (zstd-errorcode int)
113
                    :no-error 0
114
                    :generic 1
115
                    :prefix-unknown 10
116
                    :version-unsupported 12
117
                    :frameparameter-unsupported 14
118
                    :frameparameter-windowtoolarge 16
119
                    :corruption-detected 20
120
                    :checksum-wrong 22
121
                    :literals-headerwrong 24
122
                    :dictionary-corrupted 30
123
                    :dictionary-wrong 32
124
                    :dictionarycreation-failed 34
125
                    :parameter-unsupported 40
126
                    :parameter-combination-unsupported 41
127
                    :parameter-outofbound 42
128
                    :tablelog-toolarge 44
129
                    :maxsymbolvalue-toolarge 46
130
                    :maxsymbolvalue-toosmall 48
131
                    :stabilitycondition-notrespected 50
132
                    :stage-wrong 60
133
                    :init-missing 62
134
                    :memory-allocation 64
135
                    :workspace-toosmall 66
136
                    :dstsize-toosmall 70
137
                    :srcsize-wrong 72
138
                    :dstbuffer-null 74
139
                    :noforwardprogress-destfull 80
140
                    :noforwardprogress-inputempty 82
141
                    ;; unstable
142
                    :frameindex-toolarge 100
143
                    :seekableio 102
144
                    :dstbuffer-wrong 104
145
                    :srcbuffer-wrong 105
146
                    :sequenceproducer-failed 106
147
                    :externalsequences-invalid 107
148
                    :maxcode 120)
149
 
150
 ;;; Utils
151
 (defar "ZSTD_versionNumber" unsigned)
152
 (defar "ZSTD_versionString" c-string)
153
 (defar "ZSTD_compressBound" size-t (src-size size-t))
154
 (defar "ZSTD_isError" unsigned (code size-t))
155
 (defar "ZSTD_getErrorName" c-string (code size-t))
156
 ;; zstd_errors.h - does this work?
157
 (defar "ZSTD_getErrorCode" int (function-result size-t))
158
 (defar "ZSTD_getErrorString" c-string (code int))
159
 
160
 (defar "ZSTD_minCLevel" int)
161
 (defar "ZSTD_maxCLevel" int)
162
 (defar "ZSTD_defaultCLevel" int)
163
 
164
 (defar "ZSTD_findFrameCompressedSize" size-t
165
   (src (* t))
166
   (src-size size-t))
167
 
168
 (defar "ZSTD_getFrameContentSize" unsigned-long-long
169
   (src (* t))
170
   (src-size size-t))
171
 
172
 (defar "ZSTD_decompressBound" unsigned-long-long
173
   (src (* t))
174
   (src-size size-t))
175
 
176
 ;;; Explicit Context API
177
 (define-alien-type zstd-cctx (struct zstd-cctx-s))
178
 
179
 (defar "ZSTD_createCCtx" (* zstd-cctx))
180
 (defar "ZSTD_freeCCtx" void (cctx (* zstd-cctx)))
181
 (defar "ZSTD_compressCCtx" size-t
182
   (cctx (* zstd-cctx))
183
   (dst (* t)) (dst-capacity size-t)
184
   (src (* t)) (src-size size-t)
185
   (compression-level int))
186
 
187
 (define-alien-type zstd-dctx (struct zstd-dctx-s))
188
 
189
 (defar "ZSTD_createDCtx" (* zstd-dctx))
190
 (defar "ZSTD_freeDCtx" void (dctx (* zstd-dctx)))
191
 (defar "ZSTD_decompressDCtx" size-t
192
   (dctx (* zstd-dctx))
193
   (dst (* t)) (dst-capacity size-t)
194
   (src (* t)) (src-size size-t))
195
 ;;; Advanced API
196
 (define-alien-enum (zstd-strategy int)
197
                    :fast 1
198
                    :dfast 2
199
                    :greedy 3
200
                    :lazy 4
201
                    :lazy2 5
202
                    :btlazy2 6
203
                    :btopt 7
204
                    :btultra 8
205
                    :btultra2 9)
206
 
207
 (define-alien-enum (zstd-cparameter int)
208
                    :compression-level 100
209
                    :window-log 101
210
                    :hash-log 102
211
                    :chain-log 103
212
                    :search-log 104
213
                    :min-match 105
214
                    :target-length 106
215
                    :strategy 107
216
                    :target-c-block-size 130
217
                    :enable-long-distance-matching 160
218
                    :ldm-hash-log 161
219
                    :ldm-min-match 162
220
                    :ldm-bucket-size-log 163
221
                    :ldm-hash-rate-log 164
222
                    :content-size-flag 200
223
                    :checksum-flag 201
224
                    :dict-id-flag 202
225
                    :nb-workers 400
226
                    :job-size 401
227
                    :overlap-log 402
228
                    :expiremental1 500
229
                    :expiremental2 10
230
                    :expiremental3 1000
231
                    :expiremental4 1001
232
                    :expiremental5 1002
233
                    ;; :expiremental6 1003 ;; is now target-c-block-size
234
                    :expiremental7 1004
235
                    :expiremental8 1005
236
                    :expiremental9 1006
237
                    :expiremental10 1007
238
                    :expiremental11 1008
239
                    :expiremental12 1009
240
                    :expiremental13 1010
241
                    :expiremental14 1011
242
                    :expiremental15 1012
243
                    :expiremental16 1013
244
                    :expiremental17 1014
245
                    :expiremental18 1015
246
                    :expiremental19 1016)
247
 
248
 (define-alien-enum (zstd-reset-directive int)
249
                    :session-only 1
250
                    :parameters 2
251
                    :session-and-parameters 3)
252
 
253
 (define-alien-enum (zstd-dparameter int)
254
                    :window-log-max 100
255
                    :experimental1 1000
256
                    :experimental2 1001
257
                    :experimental3 1002
258
                    :experimental4 1003                   
259
                    :experimental5 1004
260
                    :experimental6 1005)