caml_minilzo.c

#include "minilzo.h"
#include <caml/bigarray.h>
#include <stdio.h>

#ifndef __unused
#define __unused(x) x __attribute__((unused))
#endif

#define __unit() value __unused(unit)

int
caml_lzo_init(__unit ())
{
  return (lzo_init());
}
	
int
caml_lzo1x_decompress_safe(value vsrc, int src_len, value vdst, int dst_available)
{
  const unsigned char* src = Caml_ba_data_val (vsrc) ;
  unsigned char* dst = Caml_ba_data_val (vdst) ;
  size_t dst_len = dst_available ;

  (void) lzo1x_decompress_safe(src, src_len, dst, &dst_len, NULL) ; 

  return dst_len;
}

#define HEAP_ALLOC(var,size) \
    lzo_align_t __LZO_MMODEL var [ ((size) + (sizeof(lzo_align_t) - 1)) / sizeof(lzo_align_t) ]

static HEAP_ALLOC(wrkmem, LZO1X_1_MEM_COMPRESS);

int
caml_lzo1x_1_compress(value vsrc, int src_len, value vdst)
{
  const unsigned char* src = Caml_ba_data_val (vsrc) ;
  unsigned char* dst = Caml_ba_data_val (vdst) ;
  size_t dst_len ;

  (void) lzo1x_1_compress(src, src_len, dst, &dst_len, wrkmem) ;

  return dst_len;
}

dune

(library
 (name minilzo)
 (foreign_stubs
  (language c)
  (names caml_minilzo minilzo.pp))
  (flags (:standard -I .))
  (libraries bigstringaf))

lzop.ml

let () = Printexc.record_backtrace true

let minilzo_compress src len dst = Minilzo.lzo1x_1_compress src len dst
let minilzo_decompress src len dst =
  Minilzo.lzo1x_decompress_safe src len dst (Bigstringaf.length dst)

let wrkmem = Lzo.make_wrkmem ()

let compress filename =
  let ic = open_in filename in
  let len = in_channel_length ic in
  let res = Bytes.create len in
  really_input ic res 0 len ; close_in ic ;
  let raw = Bigstringaf.of_string (Bytes.unsafe_to_string res) ~off:0 ~len in
  let out = Bigstringaf.create De.io_buffer_size in
  let len = Lzo.compress raw out wrkmem in
  let out = Bigstringaf.sub raw ~off:0 ~len in
  for i = 0 to len - 1 do Format.printf "%c" (Bigstringaf.get out i) done ;
  Format.printf "%!"

let uncompress filename =
  let ic = open_in filename in
  let len = in_channel_length ic in
  let res = Bytes.create len in
  really_input ic res 0 len ; close_in ic ;
  let raw = Bigstringaf.of_string (Bytes.unsafe_to_string res) ~off:0 ~len in
  match Lzo.uncompress_with_buffer raw with
  | Ok res ->
    for i = 0 to String.length res - 1 do Format.printf "%c" res.[i] done ;
    Format.printf "%!"
  | Error err ->
    Format.eprintf "%s: %a\n%!" Sys.argv.(0) Lzo.pp_error err

let compress_with_minilzo filename =
  let ic = open_in filename in
  let len = in_channel_length ic in
  let res = Bytes.create len in
  really_input ic res 0 len ; close_in ic ;
  let raw = Bigstringaf.of_string (Bytes.unsafe_to_string res) ~off:0 ~len in
  let out = Bigstringaf.create De.io_buffer_size in
  let len = minilzo_compress raw len out in
  let out = Bigstringaf.sub out ~off:0 ~len in
  for i = 0 to len - 1 do Format.printf "%c" (Bigstringaf.get out i) done ;
  Format.printf "%!"

let uncompress_with_minilzo filename =
  let ic = open_in filename in
  let len = in_channel_length ic in
  let res = Bytes.create len in
  really_input ic res 0 len ; close_in ic ;
  let raw = Bigstringaf.of_string (Bytes.unsafe_to_string res) ~off:0 ~len in
  let out = Bigstringaf.create De.io_buffer_size in
  let len = minilzo_decompress raw len out in
  let out = Bigstringaf.sub out ~off:0 ~len in
  for i = 0 to len - 1 do Format.printf "%c" (Bigstringaf.get out i) done ;
  Format.printf "%!"

let () = match Sys.argv with
  | [| _; "-a"; filename |] -> uncompress filename
  | [| _; "-b"; filename |] -> compress filename
  | [| _; "-c"; filename |] -> compress_with_minilzo filename
  | [| _; "-d"; filename |] -> uncompress_with_minilzo filename
  | [| _; filename |] -> compress filename
  | _ -> Format.eprintf "%s [-c|-d] filename\n%!" Sys.argv.(0)

minilzo.ml

external lzo_init
  : unit -> (int[@untagged])
  = "none" "caml_lzo_init"
  [@@noalloc]

external lzo1x_decompress_safe
  : Bigstringaf.t -> (int[@untagged]) -> Bigstringaf.t -> (int[@untagged]) -> (int[@untagged])
  = "none" "caml_lzo1x_decompress_safe"
  [@@noalloc]

external lzo1x_1_compress
  : Bigstringaf.t -> (int[@untagged]) -> Bigstringaf.t -> (int[@untagged])
  = "none" "caml_lzo1x_1_compress"
  [@@noalloc]

let () = let _ = lzo_init () in ()