fix memory management to use managed memory instead of naked pointer (#…

…96)
dmtrKovalenko · Jun 15, 2024 · 05447f4 · 05447f4
1 parent c795417
commit 05447f4
Show file tree

Hide file tree

Showing 9 changed files with 43 additions and 83 deletions.
diff --git a/io/jpg/Jpg.ml b/io/jpg/Jpg.ml
@@ -3,12 +3,11 @@ open Bigarray
 type data = (int32, int32_elt, c_layout) Array1.t
 
 module IO = struct
-  type buffer
-  type t = { data : data; buffer : buffer }
+  type t = { data : data }
 
   let loadImage filename : t Odiff.ImageIO.img =
-    let width, height, data, buffer = ReadJpg.read_jpeg_image filename in
-    { width; height; image = { data; buffer } }
+    let width, height, data = ReadJpg.read_jpeg_image filename in
+    { width; height; image = { data } }
 
   let readDirectPixel ~x ~y (img : t Odiff.ImageIO.img) =
     Array1.unsafe_get img.image.data ((y * img.width) + x)
@@ -19,10 +18,9 @@ module IO = struct
   let saveImage (img : t Odiff.ImageIO.img) filename =
     WritePng.write_png_bigarray filename img.image.data img.width img.height
 
-  let freeImage (img : t Odiff.ImageIO.img) =
-    ReadJpg.cleanup_jpg img.image.buffer
+  let freeImage (img : t Odiff.ImageIO.img) = ()
 
   let makeSameAsLayout (img : t Odiff.ImageIO.img) =
     let data = Array1.create int32 c_layout (Array1.dim img.image.data) in
-    { img with image = { data; buffer = img.image.buffer } }
+    { img with image = { data } }
 end
diff --git a/io/jpg/ReadJpg.c b/io/jpg/ReadJpg.c
@@ -29,9 +29,11 @@ read_jpeg_file_to_tuple(value file)
       caml_failwith("opening input file failed!");
   }
   if (fseek(fp, 0, SEEK_END) < 0 || ((size = ftell(fp)) < 0) || fseek(fp, 0, SEEK_SET) < 0) {
+      fclose(fp);
       caml_failwith("determining input file size failed");
   }
   if (size == 0) {
+      fclose(fp);
       caml_failwith("Input file contains no data");
   }
 
@@ -46,10 +48,12 @@ read_jpeg_file_to_tuple(value file)
   JDIMENSION stride = width * channels;
   JSAMPARRAY temp_buffer = (*cinfo.mem->alloc_sarray)((j_common_ptr) &cinfo, JPOOL_IMAGE, stride, 1);
 
-  int buffer_size = width * height;
-  uint8_t *image_buffer = (uint8_t*)malloc(buffer_size * 4);
+  int buffer_size = width * height * 4;
+  intnat dims[1] = {buffer_size};
+  ba = caml_ba_alloc(CAML_BA_UINT8 | CAML_BA_C_LAYOUT | CAML_BA_MANAGED, 1, NULL, dims);
+  uint8_t *image_buffer = (uint8_t *)Caml_ba_data_val(ba);
 
-  while (cinfo.output_scanline < cinfo.output_height) {
+  while (cinfo.output_scanline < height) {
     jpeg_read_scanlines(&cinfo, temp_buffer, 1);
 
     unsigned int k = (cinfo.output_scanline - 1) * 4 * width;
@@ -65,25 +69,13 @@ read_jpeg_file_to_tuple(value file)
   }
 
   jpeg_finish_decompress(&cinfo);
+  jpeg_destroy_decompress(&cinfo);
+  fclose(fp);
 
-  res = caml_alloc(4, 0);
-  ba = caml_ba_alloc_dims(CAML_BA_INT32 | CAML_BA_C_LAYOUT, 1, image_buffer, buffer_size);
-
+  res = caml_alloc_tuple(3);
   Store_field(res, 0, Val_int(width));
   Store_field(res, 1, Val_int(height));
   Store_field(res, 2, ba);
-  Store_field(res, 3, Val_bp(image_buffer));
-
-  jpeg_destroy_decompress(&cinfo);
-  fclose(fp);
 
   CAMLreturn(res);
 }
-
-CAMLprim value
-cleanup_jpg(value buffer)
-{
-  CAMLparam1(buffer);
-  free(Bp_val(buffer));
-  CAMLreturn(Val_unit);
-}
diff --git a/io/jpg/ReadJpg.ml b/io/jpg/ReadJpg.ml
@@ -1,8 +1,4 @@
 external read_jpeg_image :
   string ->
-  int
-  * int
-  * (int32, Bigarray.int32_elt, Bigarray.c_layout) Bigarray.Array1.t
-  * 'a = "read_jpeg_file_to_tuple"
-
-external cleanup_jpg : 'a -> unit = "cleanup_jpg" [@@noalloc]
+  int * int * (int32, Bigarray.int32_elt, Bigarray.c_layout) Bigarray.Array1.t
+  = "read_jpeg_file_to_tuple"
diff --git a/io/png/Png.ml b/io/png/Png.ml
@@ -15,7 +15,7 @@ module IO : Odiff.ImageIO.ImageIO = struct
     Array1.unsafe_set image ((y * img.width) + x) color
 
   let loadImage filename : t Odiff.ImageIO.img =
-    let width, height, data, _buffer = ReadPng.read_png_image filename in
+    let width, height, data = ReadPng.read_png_image filename in
     { width; height; image = data }
 
   let saveImage (img : t Odiff.ImageIO.img) filename =

diff --git a/io/png/ReadPng.c b/io/png/ReadPng.c
@@ -15,7 +15,6 @@ CAMLprim value read_png_file(value file) {
   int result = 0;
   FILE *png;
   spng_ctx *ctx = NULL;
-  unsigned char *out = NULL;
   const char *filename = String_val(file);
 
   png = fopen(filename, "rb");
@@ -24,11 +23,9 @@ CAMLprim value read_png_file(value file) {
   }
 
   ctx = spng_ctx_new(0);
-
   if (ctx == NULL) {
+    fclose(png);    
     caml_failwith("spng_ctx_new() failed");
-    spng_ctx_free(ctx);
-    free(out);
   }
 
   /* Ignore and don't calculate chunk CRC's */
@@ -46,40 +43,37 @@ CAMLprim value read_png_file(value file) {
   result = spng_get_ihdr(ctx, &ihdr);
 
   if (result) {
-    caml_failwith("spng_get_ihdr() error!");
     spng_ctx_free(ctx);
-    free(out);
+    fclose(png);
+    caml_failwith("spng_get_ihdr() error!");
   }
 
   size_t out_size;
   result = spng_decoded_image_size(ctx, SPNG_FMT_RGBA8, &out_size);
   if (result) {
     spng_ctx_free(ctx);
+    fclose(png);
+    caml_failwith(spng_strerror(result));
   };
 
-  out = malloc(out_size);
-  if (out == NULL) {
-    spng_ctx_free(ctx);
-    free(out);
-  };
+  ba = caml_ba_alloc(CAML_BA_UINT8 | CAML_BA_C_LAYOUT | CAML_BA_MANAGED, 1, NULL, &out_size);
+  unsigned char *out = (unsigned char *)Caml_ba_data_val(ba);
 
   result =
       spng_decode_image(ctx, out, out_size, SPNG_FMT_RGBA8, SPNG_DECODE_TRNS);
   if (result) {
     spng_ctx_free(ctx);
-    free(out);
+    fclose(png);
     caml_failwith(spng_strerror(result));
   }
 
-  res = caml_alloc(4, 0);
-  ba = caml_ba_alloc_dims(CAML_BA_INT32 | CAML_BA_C_LAYOUT, 1, out, out_size);
+  spng_ctx_free(ctx);
+  fclose(png);
 
+  res = caml_alloc_tuple(3);
   Store_field(res, 0, Val_int(ihdr.width));
   Store_field(res, 1, Val_int(ihdr.height));
   Store_field(res, 2, ba);
-  Store_field(res, 3, Val_bp(out));
-
-  spng_ctx_free(ctx);
 
   CAMLreturn(res);
 }
diff --git a/io/png/ReadPng.ml b/io/png/ReadPng.ml
@@ -1,6 +1,4 @@
 external read_png_image :
   string ->
-  int
-  * int
-  * (int32, Bigarray.int32_elt, Bigarray.c_layout) Bigarray.Array1.t
-  * 'a = "read_png_file"
+  int * int * (int32, Bigarray.int32_elt, Bigarray.c_layout) Bigarray.Array1.t
+  = "read_png_file"
diff --git a/io/tiff/ReadTiff.c b/io/tiff/ReadTiff.c
@@ -15,7 +15,6 @@ CAMLprim value read_tiff_file_to_tuple(value file) {
   CAMLlocal2(res, ba);
 
   const char *filename = String_val(file);
-  uint32_t *buffer = NULL;
   int width;
   int height;
 
@@ -29,35 +28,23 @@ CAMLprim value read_tiff_file_to_tuple(value file) {
   TIFFGetField(image, TIFFTAG_IMAGELENGTH, &height);
 
   int buffer_size = width * height;
-  buffer = (uint32_t *)malloc(buffer_size * 4);
 
-  if (!buffer) {
-    TIFFClose(image);
-    caml_failwith("allocating TIFF buffer failed");
-  }
+  intnat dims[1] = {buffer_size};
+  ba = caml_ba_alloc(CAML_BA_INT32 | CAML_BA_C_LAYOUT | CAML_BA_MANAGED, 1, NULL, dims);
 
+  uint32_t *buffer = (uint32_t *)Caml_ba_data_val(ba);
   if (!(TIFFReadRGBAImageOriented(image, width, height, buffer,
                                   ORIENTATION_TOPLEFT, 0))) {
     TIFFClose(image);
     caml_failwith("reading input file failed");
   }
 
-  res = caml_alloc(4, 0);
-  ba = caml_ba_alloc_dims(CAML_BA_INT32 | CAML_BA_C_LAYOUT, 1, buffer,
-                          buffer_size);
+  TIFFClose(image);
 
+  res = caml_alloc_tuple(3);
   Store_field(res, 0, Val_int(width));
   Store_field(res, 1, Val_int(height));
   Store_field(res, 2, ba);
-  Store_field(res, 3, Val_bp(buffer));
-
-  TIFFClose(image);
 
   CAMLreturn(res);
 }
-
-CAMLprim value cleanup_tiff(value buffer) {
-  CAMLparam1(buffer);
-  free(Bp_val(buffer));
-  CAMLreturn(Val_unit);
-}
diff --git a/io/tiff/ReadTiff.ml b/io/tiff/ReadTiff.ml
@@ -1,8 +1,4 @@
 external load :
   string ->
-  int
-  * int
-  * (int32, Bigarray.int32_elt, Bigarray.c_layout) Bigarray.Array1.t
-  * 'a = "read_tiff_file_to_tuple"
-
-external cleanup_tiff : 'a -> unit = "cleanup_tiff" [@@noalloc]
+  int * int * (int32, Bigarray.int32_elt, Bigarray.c_layout) Bigarray.Array1.t
+  = "read_tiff_file_to_tuple"
diff --git a/io/tiff/Tiff.ml b/io/tiff/Tiff.ml
@@ -4,11 +4,11 @@ type data = (int32, int32_elt, c_layout) Array1.t
 
 module IO : Odiff.ImageIO.ImageIO = struct
   type buffer
-  type t = { data : data; buffer : buffer }
+  type t = { data : data }
 
   let loadImage filename : t Odiff.ImageIO.img =
-    let width, height, data, buffer = ReadTiff.load filename in
-    { width; height; image = { data; buffer } }
+    let width, height, data = ReadTiff.load filename in
+    { width; height; image = { data } }
 
   let readDirectPixel ~(x : int) ~(y : int) (img : t Odiff.ImageIO.img) =
     Array1.unsafe_get img.image.data ((y * img.width) + x)
@@ -19,10 +19,9 @@ module IO : Odiff.ImageIO.ImageIO = struct
   let saveImage (img : t Odiff.ImageIO.img) filename =
     WritePng.write_png_bigarray filename img.image.data img.width img.height
 
-  let freeImage (img : t Odiff.ImageIO.img) =
-    ReadTiff.cleanup_tiff img.image.buffer
+  let freeImage (img : t Odiff.ImageIO.img) = ()
 
   let makeSameAsLayout (img : t Odiff.ImageIO.img) =
     let data = Array1.create int32 c_layout (Array1.dim img.image.data) in
-    { img with image = { data; buffer = img.image.buffer } }
+    { img with image = { data } }
 end