value camlzip_inflateEnd(value vzs)
{
if (inflateEnd(ZStream_val(vzs)) != Z_OK)
camlzip_error("Zlib.inflateEnd", vzs);
free(ZStream_val(vzs));
return Val_unit;
}
static value camlzip_new_stream(void)
{
value res = caml_alloc((sizeof(z_stream) + sizeof(value) - 1) / sizeof(value),
Abstract_tag);
ZStream_val(res)->zalloc = NULL;
ZStream_val(res)->zfree = NULL;
ZStream_val(res)->opaque = NULL;
ZStream_val(res)->next_in = NULL;
ZStream_val(res)->next_out = NULL;
return res;
}
value camlzip_deflate(value vzs, value srcbuf, value srcpos, value srclen,
value dstbuf, value dstpos, value dstlen,
value vflush)
{
z_stream * zs = ZStream_val(vzs);
int retcode;
long used_in, used_out;
value res;
zs->next_in = &Byte_u(srcbuf, Long_val(srcpos));
zs->avail_in = Long_val(srclen);
zs->next_out = &Byte_u(dstbuf, Long_val(dstpos));
zs->avail_out = Long_val(dstlen);
retcode = deflate(zs, camlzip_flush_table[Int_val(vflush)]);
if (retcode < 0) camlzip_error("Zlib.deflate", vzs);
used_in = Long_val(srclen) - zs->avail_in;
used_out = Long_val(dstlen) - zs->avail_out;
zs->next_in = NULL; /* not required, but cleaner */
zs->next_out = NULL; /* (avoid dangling pointers into Caml heap) */
res = caml_alloc_small(3, 0);
Field(res, 0) = Val_bool(retcode == Z_STREAM_END);
Field(res, 1) = Val_int(used_in);
Field(res, 2) = Val_int(used_out);
return res;
}
CAMLprim
value caml_zlib_inflateEnd(value vzs)
{
if (inflateEnd(ZStream_val(vzs)) != Z_OK)
caml_zlib_error("Zlib.inflateEnd", vzs);
return Val_unit;
}
value camlzip_inflateInit(value expect_header)
{
value vzs = camlzip_new_stream();
if (inflateInit2(ZStream_val(vzs),
Bool_val(expect_header) ? MAX_WBITS : -MAX_WBITS) != Z_OK)
camlzip_error("Zlib.inflateInit", vzs);
return vzs;
}
value camlzip_deflateInit(value vlevel, value expect_header)
{
value vzs = camlzip_new_stream();
if (deflateInit2(ZStream_val(vzs),
Int_val(vlevel),
Z_DEFLATED,
Bool_val(expect_header) ? MAX_WBITS : -MAX_WBITS,
8,
Z_DEFAULT_STRATEGY) != Z_OK)
camlzip_error("Zlib.deflateInit", vzs);
return vzs;
}
static void camlzip_error(char * fn, value vzs)
{
char * msg;
value s1 = Val_unit, s2 = Val_unit, bucket = Val_unit;
msg = ZStream_val(vzs)->msg;
if (msg == NULL) msg = "";
if (camlzip_error_exn == NULL) {
camlzip_error_exn = caml_named_value("Zlib.Error");
if (camlzip_error_exn == NULL)
caml_invalid_argument("Exception Zlib.Error not initialized");
}
Begin_roots3(s1, s2, bucket);
s1 = caml_copy_string(fn);
s2 = caml_copy_string(msg);
bucket = caml_alloc_small(3, 0);
Field(bucket, 0) = *camlzip_error_exn;
Field(bucket, 1) = s1;
Field(bucket, 2) = s2;
End_roots();
caml_raise(bucket);
}
static void caml_zlib_error(char * fn, value vzs)
{
char * msg;
value s1 = Val_unit, s2 = Val_unit, tuple = Val_unit, bucket = Val_unit;
msg = ZStream_val(vzs)->msg;
if (msg == NULL) msg = "";
if (caml_zlib_error_exn == NULL) {
caml_zlib_error_exn = caml_named_value("Cryptokit.Error");
if (caml_zlib_error_exn == NULL)
invalid_argument("Exception Cryptokit.Error not initialized");
}
Begin_roots4(s1, s2, tuple, bucket);
s1 = copy_string(fn);
s2 = copy_string(msg);
tuple = alloc_small(2, 0);
Field(tuple, 0) = s1;
Field(tuple, 1) = s2;
bucket = alloc_small(2, 0);
Field(bucket, 0) = *caml_zlib_error_exn;
Field(bucket, 1) = tuple;
End_roots();
mlraise(bucket);
}
value camlzip_deflateEnd(value vzs)
{
if (deflateEnd(ZStream_val(vzs)) != Z_OK)
camlzip_error("Zlib.deflateEnd", vzs);
return Val_unit;
}
