X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=perl_c.c;h=1737bc0d565949792a10d6e86497e50f7193d925;hb=186f65548798769d55c2581b55b41ce1bbd6fe90;hp=20d4299f818ffd1ecec669b4ded127dfbb318ce9;hpb=7e4c9fd14a6ece5941cadec586daaf4ab8f02d39;p=perl4caml.git diff --git a/perl_c.c b/perl_c.c index 20d4299..1737bc0 100644 --- a/perl_c.c +++ b/perl_c.c @@ -1,6 +1,6 @@ /* Interface to Perl from OCaml. * Copyright (C) 2003 Merjis Ltd. - * $Id: perl_c.c,v 1.15 2004-03-03 12:39:20 rich Exp $ + * $Id: perl_c.c,v 1.20 2005-01-28 23:09:32 rich Exp $ */ #include @@ -9,6 +9,8 @@ #include #include +#define CAML_NAME_SPACE 1 + #include #include #include @@ -16,15 +18,6 @@ #include #include -/* XXX This was required to avoid an error on my machine when loading the Perl - * headers. Not clear why this is missing. - */ -#define off64_t __off64_t - -/* XXX This is required by Perl >= 5.8.2. */ -#define __USE_GNU -#include - #include #include @@ -81,13 +74,13 @@ perl4caml_init (value unit) { CAMLparam1 (unit); int argc = 4; - static char *argv[] = { "", "-w", "-e", "0" }; + static char *argv[] = { "", "-w", "-e", "0", NULL }; - PERL_SYS_INIT3 (NULL, NULL, NULL); + PERL_SYS_INIT (&argc, &argv); my_perl = perl_alloc (); perl_construct (my_perl); PL_exit_flags |= PERL_EXIT_DESTRUCT_END; - perl_parse (my_perl, xs_init, argc, argv, NULL); + perl_parse (my_perl, xs_init, argc, argv, (char **) NULL); /*perl_run (my_perl);*/ CAMLreturn (Val_unit); @@ -114,7 +107,7 @@ perl4caml_float_of_sv (value svv) CAMLparam1 (svv); SV *sv = Sv_val (svv); CAMLlocal1 (f); - f = copy_double (SvNV (sv)); + f = caml_copy_double (SvNV (sv)); CAMLreturn (f); } @@ -135,7 +128,7 @@ perl4caml_string_of_sv (value svv) CAMLlocal1 (strv); str = SvPV (sv, len); /* XXX This won't work if the string contains NUL. */ - strv = copy_string (str); + strv = caml_copy_string (str); CAMLreturn (strv); } @@ -143,7 +136,7 @@ CAMLprim value perl4caml_sv_of_string (value strv) { CAMLparam1 (strv); - CAMLreturn (Val_sv (newSVpv (String_val (strv), string_length (strv)))); + CAMLreturn (Val_sv (newSVpv (String_val (strv), caml_string_length (strv)))); } CAMLprim value @@ -158,7 +151,17 @@ CAMLprim value perl4caml_sv_undef (value unit) { CAMLparam1 (unit); - CAMLreturn (Val_sv (newSV (0))); + /*CAMLreturn (Val_sv (newSV (0)));*/ + CAMLreturn (Val_sv (&PL_sv_undef)); +} + +CAMLprim value +perl4caml_sv_is_undef (value svv) +{ + CAMLparam1 (svv); + SV *sv = Sv_val (svv); + CAMLreturn (!SvPOK (sv) && !SvIOK (sv) && SvTYPE (sv) == SVt_NULL + ? Val_true : Val_false); } CAMLprim value @@ -197,6 +200,30 @@ perl4caml_sv_type (value svv) } CAMLprim value +perl4caml_address_of_sv (value svv) +{ + CAMLparam1 (svv); + SV *sv = Sv_val (svv); + CAMLreturn (caml_copy_nativeint ((long) sv)); +} + +CAMLprim value +perl4caml_address_of_av (value avv) +{ + CAMLparam1 (avv); + AV *av = Av_val (avv); + CAMLreturn (caml_copy_nativeint ((long) av)); +} + +CAMLprim value +perl4caml_address_of_hv (value hvv) +{ + CAMLparam1 (hvv); + HV *hv = Hv_val (hvv); + CAMLreturn (caml_copy_nativeint ((long) hv)); +} + +CAMLprim value perl4caml_scalarref (value svv) { CAMLparam1 (svv); @@ -233,8 +260,8 @@ perl4caml_deref (value svv) CAMLlocal1 (rsvv); SV *sv = Sv_val (svv); - if (SvROK (sv)) - invalid_argument ("deref: SV is not a reference"); + if (!SvROK (sv)) + caml_invalid_argument ("deref: SV is not a reference"); switch (SvTYPE (SvRV (sv))) { case SVt_IV: case SVt_NV: @@ -243,9 +270,14 @@ perl4caml_deref (value svv) case SVt_PVMG: break; default: - invalid_argument ("deref: SV is not a reference to a scalar"); + caml_invalid_argument ("deref: SV is not a reference to a scalar"); } - rsvv = Val_sv (SvRV (sv)); + sv = SvRV (sv); + /* Increment the reference count because we're creating another + * value pointing at the referenced SV. + */ + sv = SvREFCNT_inc (sv); + rsvv = Val_sv (sv); CAMLreturn (rsvv); } @@ -256,15 +288,20 @@ perl4caml_deref_array (value svv) CAMLlocal1 (ravv); SV *sv = Sv_val (svv); - if (SvROK (sv)) - invalid_argument ("deref_array: SV is not a reference"); + if (!SvROK (sv)) + caml_invalid_argument ("deref_array: SV is not a reference"); switch (SvTYPE (SvRV (sv))) { case SVt_PVAV: break; default: - invalid_argument ("deref_array: SV is not a reference to an array"); + caml_invalid_argument ("deref_array: SV is not a reference to an array"); } - ravv = Val_av ((AV *) SvRV (sv)); + sv = SvRV (sv); + /* Increment the reference count because we're creating another + * value pointing at the referenced AV. + */ + sv = SvREFCNT_inc (sv); + ravv = Val_av ((AV *) sv); CAMLreturn (ravv); } @@ -275,15 +312,20 @@ perl4caml_deref_hash (value svv) CAMLlocal1 (rhvv); SV *sv = Sv_val (svv); - if (SvROK (sv)) - invalid_argument ("deref_hash: SV is not a reference"); + if (!SvROK (sv)) + caml_invalid_argument ("deref_hash: SV is not a reference"); switch (SvTYPE (SvRV (sv))) { case SVt_PVHV: break; default: - invalid_argument ("deref_hash: SV is not a reference to a hash"); + caml_invalid_argument ("deref_hash: SV is not a reference to a hash"); } - rhvv = Val_hv ((HV *) SvRV (sv)); + sv = SvRV (sv); + /* Increment the reference count because we're creating another + * value pointing at the referenced HV. + */ + sv = SvREFCNT_inc (sv); + rhvv = Val_hv ((HV *) sv); CAMLreturn (rhvv); } @@ -343,6 +385,10 @@ perl4caml_av_pop (value avv) CAMLparam1 (avv); AV *av = Av_val (avv); SV *sv = av_pop (av); + /* Increment the reference count because we're creating another + * value pointing at the referenced AV. + */ + sv = SvREFCNT_inc (sv); CAMLreturn (Val_sv (sv)); } @@ -365,6 +411,10 @@ perl4caml_av_shift (value avv) CAMLparam1 (avv); AV *av = Av_val (avv); SV *sv = av_shift (av); + /* Increment the reference count because we're creating another + * value pointing at the referenced AV. + */ + sv = SvREFCNT_inc (sv); CAMLreturn (Val_sv (sv)); } @@ -394,7 +444,11 @@ perl4caml_av_get (value avv, value i) CAMLparam2 (avv, i); AV *av = Av_val (avv); SV **svp = av_fetch (av, Int_val (i), 0); - if (svp == 0) invalid_argument ("av_get: index out of bounds"); + if (svp == 0) caml_invalid_argument ("av_get: index out of bounds"); + /* Increment the reference count because we're creating another + * value pointing at the referenced AV. + */ + *svp = SvREFCNT_inc (*svp); CAMLreturn (Val_sv (*svp)); } @@ -440,7 +494,7 @@ perl4caml_hv_set (value hvv, value key, value svv) HV *hv = Hv_val (hvv); SV *sv = Sv_val (svv); SvREFCNT_inc (sv); - if (hv_store (hv, String_val (key), string_length (key), sv, 0) == 0) + if (hv_store (hv, String_val (key), caml_string_length (key), sv, 0) == 0) SvREFCNT_dec (sv); CAMLreturn (Val_unit); } @@ -450,8 +504,12 @@ perl4caml_hv_get (value hvv, value key) { CAMLparam2 (hvv, key); HV *hv = Hv_val (hvv); - SV **svp = hv_fetch (hv, String_val (key), string_length (key), 0); - if (svp == 0) raise_not_found (); + SV **svp = hv_fetch (hv, String_val (key), caml_string_length (key), 0); + if (svp == 0) caml_raise_not_found (); + /* Increment the reference count because we're creating another + * value pointing at the referenced SV. + */ + SvREFCNT_inc (*svp); CAMLreturn (Val_sv (*svp)); } @@ -460,7 +518,7 @@ perl4caml_hv_exists (value hvv, value key) { CAMLparam2 (hvv, key); HV *hv = Hv_val (hvv); - bool r = hv_exists (hv, String_val (key), string_length (key)); + bool r = hv_exists (hv, String_val (key), caml_string_length (key)); CAMLreturn (r ? Val_true : Val_false); } @@ -469,7 +527,7 @@ perl4caml_hv_delete (value hvv, value key) { CAMLparam2 (hvv, key); HV *hv = Hv_val (hvv); - hv_delete (hv, String_val (key), string_length (key), G_DISCARD); + hv_delete (hv, String_val (key), caml_string_length (key), G_DISCARD); CAMLreturn (Val_unit); } @@ -500,7 +558,12 @@ perl4caml_get_sv (value optcreate, value name) create = unoption (optcreate, Val_false); sv = get_sv (String_val (name), create == Val_true ? TRUE : FALSE); - if (sv == NULL) raise_not_found (); + if (sv == NULL) caml_raise_not_found (); + + /* Increment the reference count because we're creating another + * value pointing at the referenced SV. + */ + SvREFCNT_inc (sv); CAMLreturn (Val_sv (sv)); } @@ -514,7 +577,12 @@ perl4caml_get_av (value optcreate, value name) create = unoption (optcreate, Val_false); av = get_av (String_val (name), create == Val_true ? TRUE : FALSE); - if (av == NULL) raise_not_found (); + if (av == NULL) caml_raise_not_found (); + + /* Increment the reference count because we're creating another + * value pointing at the AV. + */ + SvREFCNT_inc (av); CAMLreturn (Val_av (av)); } @@ -528,7 +596,12 @@ perl4caml_get_hv (value optcreate, value name) create = unoption (optcreate, Val_false); hv = get_hv (String_val (name), create == Val_true ? TRUE : FALSE); - if (hv == NULL) raise_not_found (); + if (hv == NULL) caml_raise_not_found (); + + /* Increment the reference count because we're creating another + * value pointing at the HV. + */ + SvREFCNT_inc (hv); CAMLreturn (Val_hv (hv)); } @@ -544,9 +617,9 @@ check_perl_failure () STRLEN n_a; const char *err = SvPV (errsv, n_a); - errv = copy_string (err); + errv = caml_copy_string (err); - raise_with_arg (*caml_named_value ("perl4caml_perl_failure"), errv); + caml_raise_with_arg (*caml_named_value ("perl4caml_perl_failure"), errv); } } @@ -663,7 +736,7 @@ perl4caml_call_array (value optsv, value optfnname, value arglist) for (i = 0; i < count; ++i) { SV *sv; - cons = alloc (2, 0); + cons = caml_alloc (2, 0); Field (cons, 1) = list; list = cons; sv = newSVsv (POPs); @@ -840,7 +913,7 @@ perl4caml_call_method_array (value ref, value name, value arglist) for (i = 0; i < count; ++i) { SV *sv; - cons = alloc (2, 0); + cons = caml_alloc (2, 0); Field (cons, 1) = list; list = cons; sv = newSVsv (POPs); @@ -984,7 +1057,7 @@ perl4caml_call_class_method_array (value classname, value name, value arglist) */ list = Val_int (0); for (i = 0; i < count; ++i) { - cons = alloc (2, 0); + cons = caml_alloc (2, 0); Field (cons, 1) = list; list = cons; Field (cons, 0) = Val_sv (newSVsv (POPs)); @@ -1048,7 +1121,7 @@ Val_voidptr (void *ptr) { CAMLparam0 (); CAMLlocal1 (rv); - rv = alloc (1, Abstract_tag); + rv = caml_alloc (1, Abstract_tag); Field(rv, 0) = (value) ptr; CAMLreturn (rv); } @@ -1058,6 +1131,7 @@ Val_voidptr (void *ptr) static void xv_finalize (value v) { + /*fprintf (stderr, "about to decrement %p\n", Xv_val (v));*/ SvREFCNT_dec ((SV *) Xv_val (v)); } @@ -1075,7 +1149,7 @@ Val_xv (SV *sv) { CAMLparam0 (); CAMLlocal1 (rv); - rv = alloc_custom (&xv_custom_operations, sizeof (void *), 0, 1); + rv = caml_alloc_custom (&xv_custom_operations, sizeof (void *), 0, 1); Xv_val (rv) = sv; CAMLreturn (rv); }