src/utils/cdk/zlibstubs.c

   1 /***********************************************************************/
   2 /*                                                                     */
   3 /*                      The CamlZip library                            */
   4 /*                                                                     */
   5 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
   6 /*                                                                     */
   7 /*  Copyright 2001 Institut National de Recherche en Informatique et   */
   8 /*  en Automatique.  All rights reserved.  This file is distributed    */
   9 /*  under the terms of the GNU Lesser General Public License, with     */
  10 /*  the special exception on linking described in file LICENSE.        */
  11 /*                                                                     */
  12 /***********************************************************************/
  13
  14 /* $Id$ */
  15
  16 /* Stub code to interface with Zlib */
  17 #include "../../../config/config.h" /* for HAVE_ZLIBVERSION */
  18
  19 #include <stdint.h>
  20 #include <zlib.h>
  21
  22 #include <caml/mlvalues.h>
  23 #include <caml/alloc.h>
  24 #include <caml/callback.h>
  25 #include <caml/fail.h>
  26 #include <caml/memory.h>
  27 #include <caml/custom.h>
  28
  29 #define ZStream_val(v) (*((z_streamp *)Data_custom_val(v)))
  30
  31 static const value * camlzip_error_exn = NULL;
  32
  33 static void camlzip_error(char * fn, value vzs)
  34 {
  35   char * msg;
  36   value s1 = Val_unit, s2 = Val_unit, bucket = Val_unit;
  37
  38   msg = ZStream_val(vzs)->msg;
  39   if (msg == NULL) msg = "";
  40   if (camlzip_error_exn == NULL) {
  41     camlzip_error_exn = caml_named_value("Zlib.Error");
  42     if (camlzip_error_exn == NULL)
  43       caml_invalid_argument("Exception Zlib.Error not initialized");
  44   }
  45   Begin_roots3(s1, s2, bucket);
  46     s1 = caml_copy_string(fn);
  47     s2 = caml_copy_string(msg);
  48     bucket = caml_alloc_small(3, 0);
  49     Field(bucket, 0) = *camlzip_error_exn;
  50     Field(bucket, 1) = s1;
  51     Field(bucket, 2) = s2;
  52   End_roots();
  53   caml_raise(bucket);
  54 }
  55
  56 void camlzip_free_stream(value vzs)
  57 {
  58   caml_stat_free(ZStream_val(vzs));
  59   ZStream_val(vzs) = NULL;
  60 }
  61
  62 static struct custom_operations camlzip_stream_ops = {
  63   "camlzip_stream_ops", &camlzip_free_stream, NULL, NULL, NULL, NULL
  64 };
  65
  66 static value camlzip_new_stream(void)
  67 {
  68   value res = caml_alloc_custom(&camlzip_stream_ops, sizeof(z_streamp), 0, 1);
  69
  70   ZStream_val(res) = caml_stat_alloc(sizeof(z_stream));
  71   ZStream_val(res)->zalloc = NULL;
  72   ZStream_val(res)->zfree = NULL;
  73   ZStream_val(res)->opaque = NULL;
  74   ZStream_val(res)->next_in = NULL;
  75   ZStream_val(res)->next_out = NULL;
  76   return res;
  77 }
  78
  79 value camlzip_deflateInit(value vlevel, value expect_header)
  80 {
  81   value vzs = camlzip_new_stream();
  82   if (deflateInit2(ZStream_val(vzs),
  83                    Int_val(vlevel),
  84                    Z_DEFLATED,
  85                    Bool_val(expect_header) ? MAX_WBITS : -MAX_WBITS,
  86                    8,
  87                    Z_DEFAULT_STRATEGY) != Z_OK)
  88     camlzip_error("Zlib.deflateInit", vzs);
  89   return vzs;
  90 }
  91
  92 static int camlzip_flush_table[] =
  93 { Z_NO_FLUSH, Z_SYNC_FLUSH, Z_FULL_FLUSH, Z_FINISH };
  94
  95 value camlzip_deflate(value vzs, value srcbuf, value srcpos, value srclen,
  96                       value dstbuf, value dstpos, value dstlen,
  97                       value vflush)
  98 {
  99   z_stream * zs = ZStream_val(vzs);
 100   int retcode;
 101   long used_in, used_out;
 102   value res;
 103
 104   zs->next_in = &Byte_u(srcbuf, Long_val(srcpos));
 105   zs->avail_in = Long_val(srclen);
 106   zs->next_out = &Byte_u(dstbuf, Long_val(dstpos));
 107   zs->avail_out = Long_val(dstlen);
 108   retcode = deflate(zs, camlzip_flush_table[Int_val(vflush)]);
 109   if (retcode < 0 && retcode != Z_BUF_ERROR) camlzip_error("Zlib.deflate", vzs);
 110   used_in = Long_val(srclen) - zs->avail_in;
 111   used_out = Long_val(dstlen) - zs->avail_out;
 112   zs->next_in = NULL;         /* not required, but cleaner */
 113   zs->next_out = NULL;        /* (avoid dangling pointers into Caml heap) */
 114   res = caml_alloc_small(3, 0);
 115   Field(res, 0) = Val_bool(retcode == Z_STREAM_END);
 116   Field(res, 1) = Val_int(used_in);
 117   Field(res, 2) = Val_int(used_out);
 118   return res;
 119 }
 120
 121 value camlzip_deflate_bytecode(value * arg, int nargs)
 122 {
 123   return camlzip_deflate(arg[0], arg[1], arg[2], arg[3],
 124                          arg[4], arg[5], arg[6], arg[7]);
 125 }
 126
 127 value camlzip_deflateEnd(value vzs)
 128 {
 129   if (deflateEnd(ZStream_val(vzs)) != Z_OK)
 130     camlzip_error("Zlib.deflateEnd", vzs);
 131   return Val_unit;
 132 }
 133
 134 value camlzip_inflateInit(value expect_header)
 135 {
 136   value vzs = camlzip_new_stream();
 137   if (inflateInit2(ZStream_val(vzs),
 138                    Bool_val(expect_header) ? MAX_WBITS : -MAX_WBITS) != Z_OK)
 139     camlzip_error("Zlib.inflateInit", vzs);
 140   return vzs;
 141 }
 142
 143 value camlzip_inflate(value vzs, value srcbuf, value srcpos, value srclen,
 144                       value dstbuf, value dstpos, value dstlen,
 145                       value vflush)
 146 {
 147   z_stream * zs = ZStream_val(vzs);
 148   int retcode;
 149   long used_in, used_out;
 150   value res;
 151
 152   zs->next_in = &Byte_u(srcbuf, Long_val(srcpos));
 153   zs->avail_in = Long_val(srclen);
 154   zs->next_out = &Byte_u(dstbuf, Long_val(dstpos));
 155   zs->avail_out = Long_val(dstlen);
 156   retcode = inflate(zs, camlzip_flush_table[Int_val(vflush)]);
 157   if ((retcode < 0 && retcode != Z_BUF_ERROR) || retcode == Z_NEED_DICT)
 158     camlzip_error("Zlib.inflate", vzs);
 159   used_in = Long_val(srclen) - zs->avail_in;
 160   used_out = Long_val(dstlen) - zs->avail_out;
 161   zs->next_in = NULL;           /* not required, but cleaner */
 162   zs->next_out = NULL;          /* (avoid dangling pointers into Caml heap) */
 163   res = caml_alloc_small(3, 0);
 164   Field(res, 0) = Val_bool(retcode == Z_STREAM_END);
 165   Field(res, 1) = Val_int(used_in);
 166   Field(res, 2) = Val_int(used_out);
 167   return res;
 168 }
 169
 170 value camlzip_inflate_bytecode(value * arg, int nargs)
 171 {
 172   return camlzip_inflate(arg[0], arg[1], arg[2], arg[3],
 173                          arg[4], arg[5], arg[6], arg[7]);
 174 }
 175
 176 value camlzip_inflateEnd(value vzs)
 177 {
 178   if (inflateEnd(ZStream_val(vzs)) != Z_OK)
 179     camlzip_error("Zlib.inflateEnd", vzs);
 180   return Val_unit;
 181 }
 182
 183 value camlzip_update_crc32(value crc, value buf, value pos, value len)
 184 {
 185   return caml_copy_int32(crc32((uint32_t) Int32_val(crc),
 186                           &Byte_u(buf, Long_val(pos)),
 187                           Long_val(len)));
 188 }
 189
 190 int camlzip_zlibversion(void)
 191 {
 192   CAMLparam0 ();
 193   CAMLlocal1 (v);
 194 #ifdef HAVE_ZLIBVERSION
 195   v = copy_string (zlibVersion());
 196   CAMLreturn (v);
 197 #else
 198   failwith("zlibVersion not found");
 199 #endif
 200 }