Coverage report: /home/ellis/comp/core/lib/io/zstd.lisp

Kind	Covered	All	%
expression	30	410	7.3
branch	1	6	16.7

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;; zstd.lisp --- Zstd IO API

2

3

;; High-level Zstd API

4

5

;;; Code:

6

(in-package :io/zstd)

7

8

;;; Conditions

9

(eval-always (deferror zstd-error (io-error flate-error) () (:auto t)))

10

11

(deferror zstd-input-error (zstd-error) () (:auto t))

12

(deferror zstd-output-error (zstd-error) () (:auto t))

13

14

(deferror zstd-checksum-error (zstd-error) () (:auto t))

15

(deferror zstd-dictionary-error (zstd-error) () (:auto t))

16

17

;;; Objects

18

(defclass zstd-compressing-stream (compressing-stream)

19

((%level :initform *compression-level* :accessor compression-level)

20

(%input :initform (allocate-zstd-inbuffer) :reader input)

21

(%output :initform (allocate-zstd-outbuffer) :reader output)

22

(%stream :initform (zstd-createcstream)

23

:type (alien (* zstd-cstream))

24

:reader cstream)))

25

26

(defmethod make-compressing-stream ((self (eql :zstd)) stream &rest args)

27

(declare (ignore self))

28

(make-instance 'zstd-compressing-stream :compressor (apply 'make-instance 'zstd-compressor args)))

29

30

(defmethod input-size ((self zstd-compressing-stream))

31

(zstd-inbuffer-size (input self)))

32

33

(defmethod (setf input-size) (new (self zstd-compressing-stream))

34

(setf (zstd-inbuffer-size (input self)) new))

35

36

(defmethod output-size ((self zstd-compressing-stream))

37

(zstd-outbuffer-size (output self)))

38

39

(defmethod (setf output-size) (new (self zstd-compressing-stream))

40

(setf (zstd-outbuffer-size (output self)) new))

41

42

(defmethod input-buffer ((self zstd-compressing-stream))

43

(zstd-inbuffer-src (input self)))

44

45

(defmethod (setf input-buffer) ((new vector) (self zstd-compressing-stream))

46

(setf (zstd-inbuffer-src (input self)) (octets-to-alien new)))

47

48

(defmethod (setf input-buffer) (new (self zstd-compressing-stream))

49

(setf (zstd-inbuffer-src (input self)) new))

50

51

(defmethod output-buffer ((self zstd-compressing-stream))

52

(zstd-outbuffer-dst (output self)))

53

54

(defmethod (setf output-buffer) (new (self zstd-compressing-stream))

55

(setf (zstd-outbuffer-dst (output self)) new))

56

57

(defmethod (setf output-buffer) ((new vector) (self zstd-compressing-stream))

58

(setf (zstd-outbuffer-dst (output self)) (octets-to-alien new)))

59

60

(defmethod input-position ((self zstd-compressing-stream))

61

(zstd-inbuffer-pos (input self)))

62

63

(defmethod (setf input-position) (new (self zstd-compressing-stream))

64

(setf (zstd-inbuffer-pos (input self)) new))

65

66

(defmethod output-position ((self zstd-compressing-stream))

67

(zstd-outbuffer-pos (output self)))

68

69

(defmethod (setf output-position) (new (self zstd-compressing-stream))

70

(setf (zstd-outbuffer-pos (output self)) new))

71

72

(defmethod initialize-instance :after ((self zstd-compressing-stream)

73

&key (input-size (zstd-cstreaminsize))

74

                                             (output-size (zstd-cstreamoutsize)))

75

(setf (input-size self) input-size

76

(output-size self) output-size)

77

(zstd-initcstream (cstream self) (compression-level self)))

78

79

(defmethod stream-force-output ((stream zstd-compressing-stream))

80

(zstd::zstd-flushstream (cstream stream) (output stream)))

81

82

(defmethod stream-finish-output ((stream zstd-compressing-stream))

83

(zstd::zstd-endstream (cstream stream) (output stream)))

84

85

(defmethod stream-write-sequence ((stream zstd-compressing-stream) seq &optional start end))

86

87

(defmethod close ((stream zstd-compressing-stream) &key &allow-other-keys)

88

;; (sb-alien:free-alien (input stream))

89

;; (sb-alien:free-alien (output stream))

90

;; (zstd-freecstream (cstream stream))

91

)

92

93

(defclass zstd-decompressing-stream (decompressing-stream)

94

((%input :initform (allocate-zstd-inbuffer) :reader input :type (alien zstd-inbuffer))

95

(%output :initform (allocate-zstd-outbuffer) :reader output :type (alien zstd-outbuffer))

96

(%stream :initform (zstd-createdstream)

97

:type (alien (* zstd-dstream))

98

:reader dstream)))

99

100

(defmethod make-decompressing-stream ((self (eql :zstd)) stream &rest args)

101

(make-instance 'zstd-decompressing-stream :decompressor (apply 'make-instance 'zstd-decompressor args)))

102

103

(defmethod input-size ((self zstd-decompressing-stream))

104

(zstd-inbuffer-size (input self)))

105

106

(defmethod (setf input-size) (new (self zstd-decompressing-stream))

107

(setf (zstd-inbuffer-size (input self)) new))

108

109

(defmethod output-size ((self zstd-decompressing-stream))

110

(zstd-outbuffer-size (output self)))

111

112

(defmethod (setf output-size) (new (self zstd-decompressing-stream))

113

(setf (zstd-outbuffer-size (output self)) new))

114

115

(defmethod input-buffer ((self zstd-decompressing-stream))

116

(zstd-inbuffer-src (input self)))

117

118

(defmethod (setf input-buffer) (new (self zstd-decompressing-stream))

119

(setf (zstd-inbuffer-src (input self)) new))

120

121

(defmethod output-buffer ((self zstd-decompressing-stream))

122

(zstd-outbuffer-dst (output self)))

123

124

(defmethod (setf output-buffer) (new (self zstd-decompressing-stream))

125

(setf (zstd-outbuffer-dst (output self)) new))

126

127

(defmethod input-position ((self zstd-decompressing-stream))

128

(zstd-inbuffer-pos (input self)))

129

130

(defmethod (setf input-position) (new (self zstd-decompressing-stream))

131

(setf (zstd-inbuffer-pos (input self)) new))

132

133

(defmethod output-position ((self zstd-decompressing-stream))

134

(zstd-outbuffer-pos (output self)))

135

136

(defmethod (setf output-position) (new (self zstd-decompressing-stream))

137

(setf (zstd-outbuffer-pos (output self)) new))

138

139

(defmacro with-zstd-stream (stream (zst in out) &body body)

140

`(let ((,zst (slot-value ,stream '%stream))

141

(,in (input ,stream))

142

(,out (output ,stream)))

143

,@body))

144

145

(defmethod initialize-instance :after ((self zstd-decompressing-stream)

146

&key (input-size (zstd-dstreaminsize))

147

                                             (output-size (zstd-dstreamoutsize)))

148

(setf (input-size self) input-size

149

(output-size self) output-size)

150

;; returns recommended

151

(print (zstd-initdstream (dstream self))))

152

153

(defmethod close ((stream zstd-decompressing-stream) &key &allow-other-keys)

154

;; (sb-alien:free-alien (input stream))

155

;; (sb-alien:free-alien (output stream))

156

(zstd-freedstream (dstream stream)))

157

158

(defmethod sb-gray:stream-read-sequence ((self zstd-decompressing-stream) (seq vector) &optional start end)

159

(declare (ignore start end))

160

(with-vector-sap (sp seq)

161

(with-zstd-stream self (z i o)

162

(setf

163

(zstd-outbuffer-dst o) sp

164

(zstd-outbuffer-size o) (output-size self))

165

(zstd-decompressstream z o i))))

166

167

(defclass zstd-compressor (compressor) ()

168

(:default-initargs

169

:stream (make-instance 'zstd-compressing-stream)))

170

171

(defmethod cstream ((self zstd-compressor))

172

(cstream (stream-of self)))

173

174

(defmethod input ((self zstd-compressor))

175

(input (stream-of self)))

176

177

(defmethod output ((self zstd-compressor))

178

(output (stream-of self)))

179

180

(defmethod input-size ((self zstd-compressor))

181

(input-size (stream-of self)))

182

183

(defmethod output-size ((self zstd-compressor))

184

(output-size (stream-of self)))

185

186

(defmethod (setf output-size) (new (self zstd-compressor))

187

(setf (output-size (stream-of self)) new))

188

189

(defmethod output-buffer ((self zstd-compressor))

190

(output-buffer (stream-of self)))

191

192

(defmethod (setf output-buffer) (new (self zstd-compressor))

193

(setf (output-buffer (stream-of self)) new))

194

195

(defmethod (setf output-buffer) ((new vector) (self zstd-compressor))

196

(memcpy (zstd-outbuffer-dst (output self)) (octets-to-alien new) (length new)))

197

198

(defmethod input-buffer ((self zstd-compressor))

199

(input-buffer (stream-of self)))

200

201

(defmethod (setf input-buffer) (new (self zstd-compressor))

202

(setf (input-buffer (stream-of self)) new))

203

204

(defmethod (setf input-buffer) ((new vector) (self zstd-compressor))

205

(memcpy (zstd-inbuffer-src (input self)) (octets-to-alien new) (length new)))

206

207

(defmethod input-position ((self zstd-compressor))

208

(input-position (stream-of self)))

209

210

(defmethod (setf input-position) (new (self zstd-compressor))

211

(setf (input-position (stream-of self)) new))

212

213

(defmethod output-position ((self zstd-compressor))

214

(output-position (stream-of self)))

215

216

(defmethod (setf output-position) (new (self zstd-compressor))

217

(setf (output-position (stream-of self)) new))

218

219

(defmethod compression-level ((self zstd-compressor))

220

(compression-level (stream-of self)))

221

222

(defmethod compress-with ((self zstd-compressor) (obj vector) &key (end-op :continue) &allow-other-keys)

223

(with-zstd-stream (stream-of self) (z i o)

224

(setf

225

(zstd-inbuffer-src i)

226

(octets-to-alien obj)

227

(zstd-outbuffer-dst o)

228

(make-alien sb-alien:unsigned-char (output-size self)))

229

(let ((code (zstd-compressstream2 z o i (zstd-enddirective end-op))))

230

(if (or (zerop code) (zerop (zstd::zstd-iserror code)))

231

code

232

(zstd-error (zstd::zstd-geterrorstring (zstd::zstd-geterrorcode code)))))))

233

234

(defmethod stream-force-output ((stream zstd-compressor))

235

(force-output (stream-of stream)))

236

237

(defmethod stream-finish-output ((stream zstd-compressor))

238

(stream-finish-output (stream-of stream)))

239

240

(defclass zstd-decompressor (decompressor)

241

()

242

(:default-initargs

243

:stream (make-instance 'zstd-decompressing-stream)))

244

245

(defmethod dstream ((self zstd-decompressor))

246

(dstream (stream-of self)))

247

248

(defmethod input ((self zstd-decompressor))

249

(input (stream-of self)))

250

251

(defmethod output ((self zstd-decompressor))

252

(output (stream-of self)))

253

254

(defmethod input-buffer ((self zstd-decompressor))

255

(input-buffer (stream-of self)))

256

257

(defmethod (setf input-buffer) (new (self zstd-decompressor))

258

(setf (input-buffer (stream-of self)) new))

259

260

(defmethod (setf input-buffer) ((new vector) (self zstd-decompressor))

261

(memcpy (zstd-inbuffer-src (input self)) (octets-to-alien new) (length new)))

262

263

(defmethod output-buffer ((self zstd-decompressor))

264

(output-buffer (stream-of self)))

265

266

(defmethod (setf output-buffer) (new (self zstd-decompressor))

267

(setf (output-buffer (stream-of self)) new))

268

269

(defmethod (setf output-buffer) ((new vector) (self zstd-decompressor))

270

(memcpy (zstd-outbuffer-dst (output self)) (octets-to-alien new) (length new)))

271

272

(defmethod input-size ((self zstd-decompressor))

273

(input-size (stream-of self)))

274

275

(defmethod output-size ((self zstd-decompressor))

276

(output-size (stream-of self)))

277

278

(defmethod input-position ((self zstd-decompressor))

279

(input-position (stream-of self)))

280

281

(defmethod (setf input-position) (new (self zstd-decompressor))

282

(setf (input-position (stream-of self)) new))

283

284

(defmethod output-position ((self zstd-decompressor))

285

(output-position (stream-of self)))

286

287

(defmethod (setf output-position) (new (self zstd-decompressor))

288

(setf (output-position (stream-of self)) new))

289

290

(defmethod decompress-with ((self zstd-decompressor) (obj vector) &key &allow-other-keys)

291

(with-zstd-stream (stream-of self) (z i o)

292

(setf

293

(zstd-inbuffer-src i)

294

(octets-to-alien obj)

295

(zstd-outbuffer-dst o)

296

(make-alien sb-alien:unsigned-char (input-size self)))

297

(let ((code (zstd-decompressstream z o i)))

298

(if (or (zerop code) (zerop (zstd::zstd-iserror code)))

299

code

300

(zstd-error (zstd::zstd-geterrorstring (zstd::zstd-geterrorcode code)))))))

301

302

;; (defmethod stream-force-output ((stream zstd-decompressor))

303

;; (force-output (stream-of stream)))

304

305

(defmethod stream-finish-output ((stream zstd-decompressor))

306

(stream-finish-output (stream-of stream)))

307

308

;; (defmethod stream-force-output ((stream zstd-decompressing-stream))

309

;; (zstd::zstd-flushstream (dstream stream) (output stream)))

310

311

(defmethod stream-finish-output ((stream zstd-compressing-stream))

312

(zstd::zstd-freedstream (dstream stream)))

313

314

;; (zstd::zstd-decompressbound

315

316

;;; Simple API

317

(defmacro with-zstd-output ((sym &optional buffer (level #.zstd:+zstd-clevel-default+)) &body body)

318

`(handler-case

319

(let ((,sym ,(or buffer

320

(make-array #.io/flate:*compression-buffer-size*

321

:element-type 'std:octet

322

:fill-pointer 0))))

323

,@body

324

(zstd:zstdc ,sym ,level))

325

(error (c) (zstd-output-error c))))

326

327

(defmacro with-zstd-input ((sym buffer &optional size) &body body)

328

`(handler-case

329

(let ((,sym (zstd:zstdd ,buffer ,(or size `(length ,buffer)))))

330

,@(when (null body) `(,sym))

331

,@body)

332

(error (c) (zstd-input-error c))))

333

334

 (defmacro with-zstd-buffer ((sym buffer &key size (level #.zstd:+zstd-clevel-default+) (direction :input)) &body body)

335

(ecase direction

336

(:input `(with-zstd-input (,sym ,buffer ,size) ,@body))

337

(:output `(with-zstd-output (,sym ,buffer ,level) ,@body))))