changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/ffi/zstd/stream.lisp

changeset 657: 937a6f354047
parent: 4dd7b6320efc
author: Richard Westhaver <ellis@rwest.io>
date: Wed, 18 Sep 2024 21:48:06 -0400
permissions: -rw-r--r--
description: zstd tests and macros 
     1 ;;; stream1.lisp --- Zstd Streaming v1 API
     2 
     3 ;; 
     4 
     5 ;;; Code:
     6 (in-package :zstd)
     7 
     8 (deferror zstd-dstream-error (zstd-alien-error) ())
     9 (deferror zstd-cstream-error (zstd-alien-error)
    10     ()
    11     (:report (lambda (c s)
    12                (format s "ZSTD CStream signalled error: ~A" (zstd-errorcode* (zstd-error-code c))))))
    13 
    14 (defun zstd-dstream-error (code)
    15   (error 'zstd-dstream-error :code code))
    16 
    17 (defun zstd-cstream-error (code)
    18   (error 'zstd-cstream-error :code code))
    19 
    20 (define-alien-type zstd-cstream zstd-cctx)
    21 
    22 (define-alien-routine "ZSTD_createCStream" (* zstd-cstream))
    23 (define-alien-routine "ZSTD_freeCStream" void (zcs (* zstd-cstream)))
    24 
    25 (define-alien-enum (zstd-enddirective int :default :error :test eq)
    26                    :e-continue 0
    27                    :e-flush 1
    28                    :e-end 2)
    29 
    30 (define-alien-variable "ZSTD_frameParameters" int)
    31 (define-alien-routine "ZSTD_compressStream2" size-t
    32   (cctx (* zstd-cctx))
    33   (output (* zstd-outbuffer))
    34   (input (* zstd-inbuffer))
    35   (end-op zstd-enddirective))
    36 
    37 (define-alien-routine "ZSTD_CStreamInSize" size-t)
    38 (define-alien-routine "ZSTD_CStreamOutSize" size-t)
    39 (define-alien-routine "ZSTD_initCStream" size-t (zcs (* zstd-cstream)) (compression-level int))
    40 
    41 (define-alien-routine "ZSTD_compressStream" size-t (zcs (* zstd-cstream)) (output (* zstd-outbuffer)) (input (* zstd-inbuffer)))
    42 (define-alien-routine "ZSTD_flushStream" size-t (zcs (* zstd-cstream)) (output (* zstd-outbuffer)))
    43 (define-alien-routine "ZSTD_endStream" size-t (zcs (* zstd-cstream)) (output (* zstd-outbuffer)))
    44 
    45 (define-alien-type zstd-dstream zstd-dctx)
    46 
    47 (define-alien-routine "ZSTD_createDStream" (* zstd-dstream))
    48 (define-alien-routine "ZSTD_freeDStream" void (zds (* zstd-dstream)))
    49 (define-alien-routine "ZSTD_initDStream" size-t (zds (* zstd-dstream)))
    50 
    51 (define-alien-routine "ZSTD_decompressStream" size-t
    52   (zds (* zstd-dstream))
    53   (output (* zstd-outbuffer))
    54   (input (* zstd-inbuffer)))
    55 
    56 (define-alien-routine "ZSTD_DStreamInSize" size-t)
    57 (define-alien-routine "ZSTD_DStreamOutSize" size-t)
    58 
    59 (defmacro with-zstd-inbuffer ((iv &key src size pos) &body body)
    60   `(with-alien ((,iv (* zstd-inbuffer) (allocate-zstd-inbuffer)))
    61      (unwind-protect
    62           (progn
    63             ,@(when src `((setf (zstd-inbuffer-src ,iv) ,src)))
    64             ,@(when size `((setf (zstd-inbuffer-size ,iv) ,size)))
    65             ,@(when pos `((setf (zstd-inbuffer-pos ,iv) ,pos)))
    66             ,@body)
    67        (free-alien ,iv))))
    68 
    69 (defmacro with-zstd-outbuffer ((ov &key dst size pos) &body body)
    70   `(with-alien ((,ov (* zstd-outbuffer) (allocate-zstd-outbuffer)))
    71      (unwind-protect
    72           (progn
    73             ,@(when dst `((setf (zstd-outbuffer-dst ,ov) ,dst)))
    74             ,@(when size `((setf (zstd-outbuffer-size ,ov) ,size)))
    75             ,@(when pos `((setf (zstd-outbuffer-pos ,ov) ,pos)))
    76             ,@body)
    77        (free-alien ,ov))))
    78   
    79 (defmacro with-zstd-buffers ((iv ov &key src src-size src-pos dst dst-size dst-pos) &body body)
    80   `(with-alien ((,iv (* zstd-inbuffer) (allocate-zstd-inbuffer))
    81                 (,ov (* zstd-outbuffer) (allocate-zstd-outbuffer)))
    82      (unwind-protect
    83           (progn
    84             ,@(when src `((setf (zstd-inbuffer-src ,iv) ,src)))
    85             ,@(when src-size `((setf (zstd-inbuffer-size ,iv) ,src-size)))
    86             ,@(when src-pos `((setf (zstd-inbuffer-pos ,iv) ,src-pos)))
    87             ,@(when dst `((setf (zstd-outbuffer-dst ,ov) ,dst)))
    88             ,@(when dst-size `((setf (zstd-outbuffer-size ,ov) ,dst-size)))
    89             ,@(when dst-pos `((setf (zstd-outbuffer-pos ,ov) ,dst-pos)))
    90             ,@body)
    91        (free-alien ,iv)
    92        (free-alien ,ov))))
    93        
    94 (defmacro with-zstd-cstream ((cv &key (init t) (close t) (level (zstd-defaultclevel)) ) &body body)
    95   `(with-alien ((,cv (* zstd-cstream) (zstd-createcstream)))
    96      (unwind-protect
    97           (progn
    98             ,@(when init `((let ((%cinit (zstd-initcstream ,cv ,level)))
    99                              (unless (zerop (zstd-iserror %cinit))
   100                                (zstd-cstream-error %cinit)))))
   101             ,@body)
   102        ,@(when close `((zstd-freecstream ,cv))))))
   103 
   104 (defmacro with-zstd-dstream ((dv &key (init t) (close t)) &body body)
   105   `(with-alien ((,dv (* zstd-dstream) (zstd-createdstream)))
   106      (unwind-protect
   107           (progn
   108             ,@(when init `((let ((%dinit (zstd-initdstream ,dv)))
   109                              (unless (zerop (zstd-iserror %dinit))
   110                                (zstd-dstream-error %dinit)))))
   111             ,@body)
   112        ,@(when close `((zstd-freedstream ,dv))))))
   113 
   114 (defmacro with-zstd-streams ((cv dv &key (init t) (close t) (level (zstd-defaultclevel))) &body body)
   115   `(with-alien ((,cv (* zstd-cstream) (zstd-createcstream))
   116                 (,dv (* zstd-dstream) (zstd-createdstream)))
   117      (unwind-protect
   118           (progn
   119             ,@(when init `((let ((%cinit (zstd-initcstream ,cv ,level))
   120                                  (%dinit (zstd-initdstream ,dv)))
   121                              ;; TODO 2024-09-18: 
   122                              (unless (zerop (zstd-iserror %cinit))
   123                                (zstd-cstream-error %cinit))
   124                              (unless (zerop (zstd-iserror %cinit))
   125                                (zstd-cstream-error %dinit)))))
   126             ,@body)
   127        ,@(when close `((zstd-freecstream ,cv)
   128                        (zstd-freedstream ,dv))))))