|
52 | 52 | #include <caml/signals.h>
|
53 | 53 | #include <caml/fail.h>
|
54 | 54 | #include <caml/bigarray.h>
|
| 55 | +#include <caml/custom.h> |
55 | 56 |
|
56 | 57 | #include <libpq-fe.h>
|
57 | 58 | #include <libpq/libpq-fs.h>
|
@@ -373,11 +374,14 @@ noalloc_conn_info_intnat(PQserverVersion)
|
373 | 374 |
|
374 | 375 | /* Command Execution Functions */
|
375 | 376 |
|
376 |
| -#define get_res(v) ((PGresult *) Field(v, 1)) |
377 |
| -#define set_res(v, res) (Field(v, 1) = (value) res) |
| 377 | +struct pg_ocaml_result { PGresult *res; np_callback *cb; }; |
378 | 378 |
|
379 |
| -#define get_res_cb(v) ((np_callback *) Field(v, 2)) |
380 |
| -#define set_res_cb(v, cb) (Field(v, 2) = (value) cb) |
| 379 | +#define PG_ocaml_result_val(v) ((struct pg_ocaml_result *) Data_custom_val(v)) |
| 380 | +#define get_res(v) PG_ocaml_result_val(v)->res |
| 381 | +#define set_res(v, result) PG_ocaml_result_val(v)->res = result |
| 382 | + |
| 383 | +#define get_res_cb(v) PG_ocaml_result_val(v)->cb |
| 384 | +#define set_res_cb(v, callback) PG_ocaml_result_val(v)->cb = callback |
381 | 385 |
|
382 | 386 | #define res_info(fun, ret) \
|
383 | 387 | CAMLprim value fun##_stub(value v_res) \
|
@@ -488,9 +492,20 @@ CAMLprim value PQres_isnull(value v_res)
|
488 | 492 | return Val_bool(get_res(v_res) ? 0 : 1);
|
489 | 493 | }
|
490 | 494 |
|
| 495 | +static struct custom_operations result_ops = { |
| 496 | + "pg_ocaml_result", |
| 497 | + free_result, |
| 498 | + custom_compare_default, |
| 499 | + custom_hash_default, |
| 500 | + custom_serialize_default, |
| 501 | + custom_deserialize_default, |
| 502 | + custom_compare_ext_default |
| 503 | +}; |
| 504 | + |
491 | 505 | static inline value alloc_result(PGresult *res, np_callback *cb)
|
492 | 506 | {
|
493 |
| - value v_res = caml_alloc_final(3, free_result, 1, 500); |
| 507 | + value v_res = |
| 508 | + caml_alloc_custom(&result_ops, sizeof(struct pg_ocaml_result), 1, 100000); |
494 | 509 | set_res(v_res, res);
|
495 | 510 | set_res_cb(v_res, cb);
|
496 | 511 | np_incr_refcount(cb);
|
|
0 commit comments