1 /* Interface to Perl from OCaml.
2 Copyright (C) 2003 Merjis Ltd.
4 This library is free software; you can redistribute it and/or
5 modify it under the terms of the GNU Library General Public
6 License as published by the Free Software Foundation; either
7 version 2 of the License, or (at your option) any later version.
9 This library is distributed in the hope that it will be useful,
10 but WITHOUT ANY WARRANTY; without even the implied warranty of
11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 Library General Public License for more details.
14 You should have received a copy of the GNU General Public License
15 along with this library; see the file COPYING. If not, write to
16 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
17 Boston, MA 02111-1307, USA.
19 $Id: perl_c.c,v 1.25 2008-03-01 13:02:21 rich Exp $
28 #define CAML_NAME_SPACE 1
30 #include <caml/alloc.h>
31 #include <caml/callback.h>
32 #include <caml/custom.h>
33 #include <caml/fail.h>
34 #include <caml/memory.h>
35 #include <caml/mlvalues.h>
40 /* Perl requires the interpreter to be called literally 'my_perl'! */
41 static PerlInterpreter *my_perl;
43 /* Get the concrete value from an optional field. */
44 static value unoption (value option, value deflt);
46 /* Wrap up an arbitrary void pointer in an opaque OCaml object. */
47 static value Val_voidptr (void *ptr);
49 /* Unwrap an arbitrary void pointer from an opaque OCaml object. */
50 #define Voidptr_val(type,rv) ((type *) Field ((rv), 0))
52 #if PERL4CAML_REFCOUNTING_EXPERIMENTAL
54 /* Unwrap a custom block. */
55 #define Xv_val(rv) (*((void **)Data_custom_val(rv)))
57 /* Wrap up an SV, AV or HV in a custom OCaml object which will decrement
58 * the reference count on finalization.
60 static value Val_xv (SV *sv);
64 #define Xv_val(rv) Voidptr_val (SV, (rv))
65 #define Val_xv(sv) Val_voidptr ((sv))
69 /* Hide Perl types in opaque OCaml objects. */
70 #define Val_perl(pl) (Val_voidptr ((pl)))
71 #define Perl_val(plv) (Voidptr_val (PerlInterpreter, (plv)))
72 #define Val_sv(sv) (Val_xv ((sv)))
73 #define Sv_val(svv) ((SV *) Xv_val (svv))
74 #define Val_av(av) (Val_xv ((SV *)(av)))
75 #define Av_val(avv) ((AV *) Xv_val (avv))
76 #define Val_hv(hv) (Val_xv ((SV *)(hv)))
77 #define Hv_val(hvv) ((HV *) Xv_val (hvv))
78 #define Val_he(he) (Val_voidptr ((he)))
79 #define He_val(hev) (Voidptr_val (HE, (hev)))
84 char *file = __FILE__;
85 EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
87 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
91 perl4caml_init (value unit)
95 static char *argv[] = { "", "-w", "-e", "0", NULL };
97 PERL_SYS_INIT (&argc, &argv);
98 my_perl = perl_alloc ();
99 perl_construct (my_perl);
100 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
101 perl_parse (my_perl, xs_init, argc, argv, (char **) NULL);
102 /*perl_run (my_perl);*/
104 CAMLreturn (Val_unit);
108 perl4caml_int_of_sv (value svv)
111 SV *sv = Sv_val (svv);
112 CAMLreturn (Val_int (SvIV (sv)));
116 perl4caml_sv_of_int (value iv)
119 CAMLreturn (Val_sv (newSViv (Int_val (iv))));
123 perl4caml_float_of_sv (value svv)
126 SV *sv = Sv_val (svv);
128 f = caml_copy_double (SvNV (sv));
133 perl4caml_sv_of_float (value fv)
136 CAMLreturn (Val_sv (newSVnv (Double_val (fv))));
140 perl4caml_string_of_sv (value svv)
143 SV *sv = Sv_val (svv);
147 str = SvPV (sv, len);
148 strv = caml_alloc_string (len);
149 memcpy (String_val (strv), str, len);
154 perl4caml_sv_of_string (value strv)
157 CAMLreturn (Val_sv (newSVpv (String_val (strv), caml_string_length (strv))));
161 perl4caml_sv_is_true (value svv)
164 SV *sv = Sv_val (svv);
165 CAMLreturn (SvTRUE (sv) ? Val_true : Val_false);
169 perl4caml_sv_undef (value unit)
172 /*CAMLreturn (Val_sv (newSV (0)));*/
173 CAMLreturn (Val_sv (&PL_sv_undef));
177 perl4caml_sv_is_undef (value svv)
180 SV *sv = Sv_val (svv);
181 CAMLreturn (!SvPOK (sv) && !SvIOK (sv) && SvTYPE (sv) == SVt_NULL
182 ? Val_true : Val_false);
186 perl4caml_sv_yes (value unit)
189 CAMLreturn (Val_sv (&PL_sv_yes));
193 perl4caml_sv_no (value unit)
196 CAMLreturn (Val_sv (&PL_sv_no));
202 #if PERL_VERSION >= 11
203 if (SvROK(sv)) return 4;
207 case SVt_IV: return 1;
208 case SVt_NV: return 2;
209 case SVt_PV: return 3;
210 #if PERL_VERSION < 11
211 case SVt_RV: return 4;
213 case SVt_PVAV: return 5;
214 case SVt_PVHV: return 6;
215 case SVt_PVCV: return 7;
216 case SVt_PVGV: return 8;
217 case SVt_PVMG: return 9;
223 perl4caml_sv_type (value svv)
226 SV *sv = Sv_val (svv);
228 CAMLreturn (Val_int (sv_type (sv)));
232 perl4caml_address_of_sv (value svv)
235 SV *sv = Sv_val (svv);
236 CAMLreturn (caml_copy_nativeint ((long) sv));
240 perl4caml_address_of_av (value avv)
243 AV *av = Av_val (avv);
244 CAMLreturn (caml_copy_nativeint ((long) av));
248 perl4caml_address_of_hv (value hvv)
251 HV *hv = Hv_val (hvv);
252 CAMLreturn (caml_copy_nativeint ((long) hv));
256 perl4caml_scalarref (value svv)
260 SV *sv = Sv_val (svv);
261 rsvv = Val_sv (newRV_inc (sv));
266 perl4caml_arrayref (value avv)
270 AV *av = Av_val (avv);
271 rsvv = Val_sv (newRV_inc ((SV *) av));
276 perl4caml_hashref (value hvv)
280 HV *hv = Hv_val (hvv);
281 rsvv = Val_sv (newRV_inc ((SV *) hv));
286 perl4caml_reftype (value svv)
289 SV *sv = Sv_val (svv);
292 caml_invalid_argument ("reftype: SV is not a reference");
294 CAMLreturn (Val_int (sv_type (SvRV (sv))));
298 perl4caml_deref (value svv)
302 SV *sv = Sv_val (svv);
305 caml_invalid_argument ("deref: SV is not a reference");
306 switch (SvTYPE (SvRV (sv))) {
310 #if PERL_VERSION < 11
316 caml_invalid_argument ("deref: SV is not a reference to a scalar");
319 /* Increment the reference count because we're creating another
320 * value pointing at the referenced SV.
322 sv = SvREFCNT_inc (sv);
328 perl4caml_deref_array (value svv)
332 SV *sv = Sv_val (svv);
335 caml_invalid_argument ("deref_array: SV is not a reference");
336 switch (SvTYPE (SvRV (sv))) {
340 caml_invalid_argument ("deref_array: SV is not a reference to an array");
343 /* Increment the reference count because we're creating another
344 * value pointing at the referenced AV.
346 sv = SvREFCNT_inc (sv);
347 ravv = Val_av ((AV *) sv);
352 perl4caml_deref_hash (value svv)
356 SV *sv = Sv_val (svv);
359 caml_invalid_argument ("deref_hash: SV is not a reference");
360 switch (SvTYPE (SvRV (sv))) {
364 caml_invalid_argument ("deref_hash: SV is not a reference to a hash");
367 /* Increment the reference count because we're creating another
368 * value pointing at the referenced HV.
370 sv = SvREFCNT_inc (sv);
371 rhvv = Val_hv ((HV *) sv);
376 perl4caml_av_empty (value unit)
380 CAMLreturn (Val_av (av));
383 /* We don't know in advance how long the list will be, which makes this
387 perl4caml_av_of_sv_list (value svlistv)
389 CAMLparam1 (svlistv);
391 SV *sv, **svlist = 0;
392 int alloc = 0, size = 0;
395 for (; svlistv != Val_int (0); svlistv = Field (svlistv, 1))
397 svv = Field (svlistv, 0);
400 alloc = alloc == 0 ? 1 : alloc * 2;
401 svlist = realloc (svlist, alloc * sizeof (SV *));
406 av = av_make (size, svlist);
408 if (alloc > 0) free (svlist); /* Free memory allocated to SV list. */
410 CAMLreturn (Val_av (av));
413 /* XXX av_map would be faster if we also had sv_list_of_av. */
416 perl4caml_av_push (value avv, value svv)
418 CAMLparam2 (avv, svv);
419 AV *av = Av_val (avv);
420 SV *sv = Sv_val (svv);
422 CAMLreturn (Val_unit);
426 perl4caml_av_pop (value avv)
429 AV *av = Av_val (avv);
430 SV *sv = av_pop (av);
431 /* Increment the reference count because we're creating another
432 * value pointing at the referenced AV.
434 sv = SvREFCNT_inc (sv);
435 CAMLreturn (Val_sv (sv));
439 perl4caml_av_unshift (value avv, value svv)
441 CAMLparam2 (avv, svv);
442 AV *av = Av_val (avv);
443 SV *sv = Sv_val (svv);
446 if (av_store (av, 0, sv) == 0)
448 CAMLreturn (Val_unit);
452 perl4caml_av_shift (value avv)
455 AV *av = Av_val (avv);
456 SV *sv = av_shift (av);
457 /* Increment the reference count because we're creating another
458 * value pointing at the referenced AV.
460 sv = SvREFCNT_inc (sv);
461 CAMLreturn (Val_sv (sv));
465 perl4caml_av_length (value avv)
468 AV *av = Av_val (avv);
469 CAMLreturn (Val_int (av_len (av) + 1));
473 perl4caml_av_set (value avv, value i, value svv)
475 CAMLparam3 (avv, i, svv);
476 AV *av = Av_val (avv);
477 SV *sv = Sv_val (svv);
479 if (av_store (av, Int_val (i), sv) == 0)
481 CAMLreturn (Val_unit);
485 perl4caml_av_get (value avv, value i)
488 AV *av = Av_val (avv);
489 SV **svp = av_fetch (av, Int_val (i), 0);
490 if (svp == 0) caml_invalid_argument ("av_get: index out of bounds");
491 /* Increment the reference count because we're creating another
492 * value pointing at the referenced AV.
494 *svp = SvREFCNT_inc (*svp);
495 CAMLreturn (Val_sv (*svp));
499 perl4caml_av_clear (value avv)
502 AV *av = Av_val (avv);
504 CAMLreturn (Val_unit);
508 perl4caml_av_undef (value avv)
511 AV *av = Av_val (avv);
513 CAMLreturn (Val_unit);
517 perl4caml_av_extend (value avv, value i)
520 AV *av = Av_val (avv);
521 av_extend (av, Int_val (i));
522 CAMLreturn (Val_unit);
526 perl4caml_hv_empty (value unit)
530 CAMLreturn (Val_hv (hv));
534 perl4caml_hv_set (value hvv, value key, value svv)
536 CAMLparam3 (hvv, key, svv);
537 HV *hv = Hv_val (hvv);
538 SV *sv = Sv_val (svv);
540 if (hv_store (hv, String_val (key), caml_string_length (key), sv, 0) == 0)
542 CAMLreturn (Val_unit);
546 perl4caml_hv_get (value hvv, value key)
548 CAMLparam2 (hvv, key);
549 HV *hv = Hv_val (hvv);
550 SV **svp = hv_fetch (hv, String_val (key), caml_string_length (key), 0);
551 if (svp == 0) caml_raise_not_found ();
552 /* Increment the reference count because we're creating another
553 * value pointing at the referenced SV.
556 CAMLreturn (Val_sv (*svp));
560 perl4caml_hv_exists (value hvv, value key)
562 CAMLparam2 (hvv, key);
563 HV *hv = Hv_val (hvv);
564 bool r = hv_exists (hv, String_val (key), caml_string_length (key));
565 CAMLreturn (r ? Val_true : Val_false);
569 perl4caml_hv_delete (value hvv, value key)
571 CAMLparam2 (hvv, key);
572 HV *hv = Hv_val (hvv);
573 hv_delete (hv, String_val (key), caml_string_length (key), G_DISCARD);
574 CAMLreturn (Val_unit);
578 perl4caml_hv_clear (value hvv)
581 HV *hv = Hv_val (hvv);
583 CAMLreturn (Val_unit);
587 perl4caml_hv_undef (value hvv)
590 HV *hv = Hv_val (hvv);
592 CAMLreturn (Val_unit);
596 perl4caml_hv_iterinit (value hvv)
599 HV *hv = Hv_val (hvv);
600 int i = hv_iterinit (hv);
601 CAMLreturn (caml_copy_int32 (i));
605 perl4caml_hv_iternext (value hvv)
609 HV *hv = Hv_val (hvv);
610 HE *he = hv_iternext (hv);
611 if (he == NULL) caml_raise_not_found ();
617 perl4caml_hv_iterkey (value hev)
621 HE *he = He_val (hev);
623 char *str = hv_iterkey (he, &len);
624 strv = caml_alloc_string (len);
625 memcpy (String_val (strv), str, len);
630 perl4caml_hv_iterval (value hvv, value hev)
632 CAMLparam2 (hvv, hev);
634 HV *hv = Hv_val (hvv);
635 HE *he = He_val (hev);
636 SV *sv = hv_iterval (hv, he);
643 perl4caml_hv_iternextsv (value hvv)
646 CAMLlocal3 (strv, svv, rv);
647 HV *hv = Hv_val (hvv);
649 SV *sv = hv_iternextsv (hv, &str, &len);
650 if (sv == NULL) caml_raise_not_found ();
653 strv = caml_alloc_string (len);
654 memcpy (String_val (strv), str, len);
655 /* Construct a tuple (strv, svv). */
656 rv = caml_alloc_tuple (2);
657 Field (rv, 0) = strv;
663 perl4caml_get_sv (value optcreate, value name)
665 CAMLparam2 (optcreate, name);
669 create = unoption (optcreate, Val_false);
670 sv = get_sv (String_val (name), create == Val_true ? TRUE : FALSE);
671 if (sv == NULL) caml_raise_not_found ();
673 /* Increment the reference count because we're creating another
674 * value pointing at the referenced SV.
678 CAMLreturn (Val_sv (sv));
682 perl4caml_get_av (value optcreate, value name)
684 CAMLparam2 (optcreate, name);
688 create = unoption (optcreate, Val_false);
689 av = get_av (String_val (name), create == Val_true ? TRUE : FALSE);
690 if (av == NULL) caml_raise_not_found ();
692 /* Increment the reference count because we're creating another
693 * value pointing at the AV.
697 CAMLreturn (Val_av (av));
701 perl4caml_get_hv (value optcreate, value name)
703 CAMLparam2 (optcreate, name);
707 create = unoption (optcreate, Val_false);
708 hv = get_hv (String_val (name), create == Val_true ? TRUE : FALSE);
709 if (hv == NULL) caml_raise_not_found ();
711 /* Increment the reference count because we're creating another
712 * value pointing at the HV.
716 CAMLreturn (Val_hv (hv));
720 check_perl_failure ()
722 SV *errsv = get_sv ("@", TRUE);
724 if (SvTRUE (errsv)) /* Equivalent of $@ in Perl. */
728 const char *err = SvPV (errsv, n_a);
730 errv = caml_copy_string (err);
732 caml_raise_with_arg (*caml_named_value ("perl4caml_perl_failure"), errv);
737 perl4caml_call (value optsv, value optfnname, value arglist)
739 CAMLparam3 (optsv, optfnname, arglist);
743 CAMLlocal3 (errv, svv, fnname);
748 /* Push the parameter list. */
751 /* Iteration over the linked list. */
752 for (; arglist != Val_int (0); arglist = Field (arglist, 1))
754 svv = Field (arglist, 0);
756 XPUSHs (sv_2mortal (newSVsv (sv)));
761 if (optsv != Val_int (0))
763 svv = unoption (optsv, Val_false);
765 count = call_sv (sv, G_EVAL|G_SCALAR);
767 else if (optfnname != Val_int (0))
769 fnname = unoption (optfnname, Val_false);
770 count = call_pv (String_val (fnname), G_EVAL|G_SCALAR);
775 "Perl.call: must supply either 'sv' or 'fn' parameters.");
781 assert (count == 1); /* Pretty sure it should never be anything else. */
783 /* Pop return value off the stack. Note that the return value on the
784 * stack is mortal, so we need to take a copy.
791 check_perl_failure ();
798 perl4caml_call_array (value optsv, value optfnname, value arglist)
800 CAMLparam3 (optsv, optfnname, arglist);
804 CAMLlocal5 (errv, svv, fnname, list, cons);
809 /* Push the parameter list. */
812 /* Iteration over the linked list. */
813 for (; arglist != Val_int (0); arglist = Field (arglist, 1))
815 svv = Field (arglist, 0);
817 XPUSHs (sv_2mortal (newSVsv (sv)));
822 if (optsv != Val_int (0))
824 svv = unoption (optsv, Val_false);
826 count = call_sv (sv, G_EVAL|G_ARRAY);
828 else if (optfnname != Val_int (0))
830 fnname = unoption (optfnname, Val_false);
831 count = call_pv (String_val (fnname), G_EVAL|G_ARRAY);
836 "Perl.call_array: must supply either 'sv' or 'fn' parameters.");
842 /* Pop all the return values off the stack into a list. Values on the
843 * stack are mortal, so we must copy them.
846 for (i = 0; i < count; ++i) {
849 cons = caml_alloc (2, 0);
850 Field (cons, 1) = list;
853 Field (cons, 0) = Val_sv (sv);
856 /* Restore the stack. */
861 check_perl_failure ();
867 perl4caml_call_void (value optsv, value optfnname, value arglist)
869 CAMLparam3 (optsv, optfnname, arglist);
873 CAMLlocal3 (errv, svv, fnname);
878 /* Push the parameter list. */
881 /* Iteration over the linked list. */
882 for (; arglist != Val_int (0); arglist = Field (arglist, 1))
884 svv = Field (arglist, 0);
886 XPUSHs (sv_2mortal (newSVsv (sv)));
891 if (optsv != Val_int (0))
893 svv = unoption (optsv, Val_false);
895 count = call_sv (sv, G_EVAL|G_VOID);
897 else if (optfnname != Val_int (0))
899 fnname = unoption (optfnname, Val_false);
900 count = call_pv (String_val (fnname), G_EVAL|G_VOID|G_DISCARD);
905 "Perl.call_void: must supply either 'sv' or 'fn' parameters.");
913 /* Restore the stack. */
918 check_perl_failure ();
920 CAMLreturn (Val_unit);
924 perl4caml_eval (value expr)
929 CAMLlocal2 (errv, svv);
931 sv = eval_pv (String_val (expr), G_SCALAR);
933 check_perl_failure ();
940 perl4caml_call_method (value ref, value name, value arglist)
942 CAMLparam3 (ref, name, arglist);
946 CAMLlocal2 (errv, svv);
951 /* Push the parameter list. */
955 XPUSHs (sv_2mortal (newSVsv (sv)));
957 /* Iteration over the linked list. */
958 for (; arglist != Val_int (0); arglist = Field (arglist, 1))
960 svv = Field (arglist, 0);
962 XPUSHs (sv_2mortal (newSVsv (sv)));
967 count = call_method (String_val (name), G_EVAL|G_SCALAR);
971 assert (count == 1); /* Pretty sure it should never be anything else. */
973 /* Pop return value off the stack. Note that the return value on the
974 * stack is mortal, so we need to take a copy.
981 check_perl_failure ();
988 perl4caml_call_method_array (value ref, value name, value arglist)
990 CAMLparam3 (ref, name, arglist);
994 CAMLlocal4 (errv, svv, list, cons);
999 /* Push the parameter list. */
1003 XPUSHs (sv_2mortal (newSVsv (sv)));
1005 /* Iteration over the linked list. */
1006 for (; arglist != Val_int (0); arglist = Field (arglist, 1))
1008 svv = Field (arglist, 0);
1010 XPUSHs (sv_2mortal (newSVsv (sv)));
1015 count = call_method (String_val (name), G_EVAL|G_ARRAY);
1019 /* Pop all return values off the stack. Note that the return values on the
1020 * stack are mortal, so we need to take a copy.
1023 for (i = 0; i < count; ++i) {
1026 cons = caml_alloc (2, 0);
1027 Field (cons, 1) = list;
1029 sv = newSVsv (POPs);
1030 Field (cons, 0) = Val_sv (sv);
1033 /* Restore the stack. */
1038 check_perl_failure ();
1044 perl4caml_call_method_void (value ref, value name, value arglist)
1046 CAMLparam3 (ref, name, arglist);
1050 CAMLlocal2 (errv, svv);
1055 /* Push the parameter list. */
1059 XPUSHs (sv_2mortal (newSVsv (sv)));
1061 /* Iteration over the linked list. */
1062 for (; arglist != Val_int (0); arglist = Field (arglist, 1))
1064 svv = Field (arglist, 0);
1066 XPUSHs (sv_2mortal (newSVsv (sv)));
1071 count = call_method (String_val (name), G_EVAL|G_VOID|G_DISCARD);
1075 assert (count == 0);
1077 /* Restore the stack. */
1082 check_perl_failure ();
1084 CAMLreturn (Val_unit);
1088 perl4caml_call_class_method (value classname, value name, value arglist)
1090 CAMLparam3 (classname, name, arglist);
1094 CAMLlocal2 (errv, svv);
1099 /* Push the parameter list. */
1102 XPUSHs (sv_2mortal (newSVpv (String_val (classname), 0)));
1104 /* Iteration over the linked list. */
1105 for (; arglist != Val_int (0); arglist = Field (arglist, 1))
1107 svv = Field (arglist, 0);
1109 XPUSHs (sv_2mortal (newSVsv (sv)));
1114 count = call_method (String_val (name), G_EVAL|G_SCALAR);
1118 assert (count == 1); /* Pretty sure it should never be anything else. */
1120 /* Pop return value off the stack. Note that the return value on the
1121 * stack is mortal, so we need to take a copy.
1123 sv = newSVsv (POPs);
1128 check_perl_failure ();
1135 perl4caml_call_class_method_array (value classname, value name, value arglist)
1137 CAMLparam3 (classname, name, arglist);
1141 CAMLlocal4 (errv, svv, list, cons);
1146 /* Push the parameter list. */
1149 XPUSHs (sv_2mortal (newSVpv (String_val (classname), 0)));
1151 /* Iteration over the linked list. */
1152 for (; arglist != Val_int (0); arglist = Field (arglist, 1))
1154 svv = Field (arglist, 0);
1156 XPUSHs (sv_2mortal (newSVsv (sv)));
1161 count = call_method (String_val (name), G_EVAL|G_ARRAY);
1165 /* Pop all return values off the stack. Note that the return values on the
1166 * stack are mortal, so we need to take a copy.
1169 for (i = 0; i < count; ++i) {
1170 cons = caml_alloc (2, 0);
1171 Field (cons, 1) = list;
1173 Field (cons, 0) = Val_sv (newSVsv (POPs));
1176 /* Restore the stack. */
1181 check_perl_failure ();
1187 perl4caml_call_class_method_void (value classname, value name, value arglist)
1189 CAMLparam3 (classname, name, arglist);
1193 CAMLlocal2 (errv, svv);
1198 /* Push the parameter list. */
1201 XPUSHs (sv_2mortal (newSVpv (String_val (classname), 0)));
1203 /* Iteration over the linked list. */
1204 for (; arglist != Val_int (0); arglist = Field (arglist, 1))
1206 svv = Field (arglist, 0);
1208 XPUSHs (sv_2mortal (newSVsv (sv)));
1213 count = call_method (String_val (name), G_EVAL|G_VOID|G_DISCARD);
1217 assert (count == 0);
1219 /* Restore the stack. */
1224 check_perl_failure ();
1226 CAMLreturn (Val_unit);
1230 Val_voidptr (void *ptr)
1234 rv = caml_alloc (1, Abstract_tag);
1235 Field(rv, 0) = (value) ptr;
1239 #if PERL4CAML_REFCOUNTING_EXPERIMENTAL
1242 xv_finalize (value v)
1244 /*fprintf (stderr, "about to decrement %p\n", Xv_val (v));*/
1245 SvREFCNT_dec ((SV *) Xv_val (v));
1248 static struct custom_operations xv_custom_operations = {
1249 "xv_custom_operations",
1251 custom_compare_default,
1252 custom_hash_default,
1253 custom_serialize_default,
1254 custom_deserialize_default
1262 rv = caml_alloc_custom (&xv_custom_operations, sizeof (void *), 0, 1);
1267 #endif /* PERL4CAML_REFCOUNTING_EXPERIMENTAL */
1270 unoption (value option, value deflt)
1272 if (option == Val_int (0)) /* "None" */
1274 else /* "Some 'a" */
1275 return Field (option, 0);