X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=perl_c.c;h=7970a815e338cf7186ddfe4937302f201c11aa0c;hb=95d760554441dac36fb77011c0c875490f873d68;hp=1737bc0d565949792a10d6e86497e50f7193d925;hpb=186f65548798769d55c2581b55b41ce1bbd6fe90;p=perl4caml.git

diff --git a/perl_c.c b/perl_c.c
index 1737bc0..7970a81 100644
--- a/perl_c.c
+++ b/perl_c.c
@@ -1,6 +1,22 @@
 /* Interface to Perl from OCaml.
- * Copyright (C) 2003 Merjis Ltd.
- * $Id: perl_c.c,v 1.20 2005-01-28 23:09:32 rich Exp $
+   Copyright (C) 2003 Merjis Ltd.
+
+   This library is free software; you can redistribute it and/or
+   modify it under the terms of the GNU Library General Public
+   License as published by the Free Software Foundation; either
+   version 2 of the License, or (at your option) any later version.
+
+   This library is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Library General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this library; see the file COPYING.  If not, write to
+   the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+   Boston, MA 02111-1307, USA.
+
+   $Id: perl_c.c,v 1.25 2008-03-01 13:02:21 rich Exp $
  */
 
 #include <stdio.h>
@@ -59,6 +75,8 @@ static value Val_xv (SV *sv);
 #define Av_val(avv) ((AV *) Xv_val (avv))
 #define Val_hv(hv) (Val_xv ((SV *)(hv)))
 #define Hv_val(hvv) ((HV *) Xv_val (hvv))
+#define Val_he(he) (Val_voidptr ((he)))
+#define He_val(hev) (Voidptr_val (HE, (hev)))
 
 static void
 xs_init (pTHX)
@@ -115,7 +133,7 @@ CAMLprim value
 perl4caml_sv_of_float (value fv)
 {
   CAMLparam1 (fv);
-  CAMLreturn (Val_sv (newSViv (Double_val (fv))));
+  CAMLreturn (Val_sv (newSVnv (Double_val (fv))));
 }
 
 CAMLprim value
@@ -127,8 +145,8 @@ perl4caml_string_of_sv (value svv)
   STRLEN len;
   CAMLlocal1 (strv);
   str = SvPV (sv, len);
-  /* XXX This won't work if the string contains NUL. */
-  strv = caml_copy_string (str);
+  strv = caml_alloc_string (len);
+  memcpy (String_val (strv), str, len);
   CAMLreturn (strv);
 }
 
@@ -178,25 +196,31 @@ perl4caml_sv_no (value unit)
   CAMLreturn (Val_sv (&PL_sv_no));
 }
 
+static int
+sv_type (SV *sv)
+{
+  switch (SvTYPE (sv))
+    {
+    case SVt_IV: return 1;
+    case SVt_NV: return 2;
+    case SVt_PV: return 3;
+    case SVt_RV: return 4;
+    case SVt_PVAV: return 5;
+    case SVt_PVHV: return 6;
+    case SVt_PVCV: return 7;
+    case SVt_PVGV: return 8;
+    case SVt_PVMG: return 9;
+    default: return 0;
+    }
+}
+
 CAMLprim value
 perl4caml_sv_type (value svv)
 {
   CAMLparam1 (svv);
   SV *sv = Sv_val (svv);
 
-  switch (SvTYPE (sv))
-    {
-    case SVt_IV: CAMLreturn (Val_int (1));
-    case SVt_NV: CAMLreturn (Val_int (2));
-    case SVt_PV: CAMLreturn (Val_int (3));
-    case SVt_RV: CAMLreturn (Val_int (4));
-    case SVt_PVAV: CAMLreturn (Val_int (5));
-    case SVt_PVHV: CAMLreturn (Val_int (6));
-    case SVt_PVCV: CAMLreturn (Val_int (7));
-    case SVt_PVGV: CAMLreturn (Val_int (8));
-    case SVt_PVMG: CAMLreturn (Val_int (9));
-    default: CAMLreturn (Val_int (0));
-    }
+  CAMLreturn (Val_int (sv_type (sv)));
 }
 
 CAMLprim value
@@ -254,6 +278,18 @@ perl4caml_hashref (value hvv)
 }
 
 CAMLprim value
+perl4caml_reftype (value svv)
+{
+  CAMLparam1 (svv);
+  SV *sv = Sv_val (svv);
+
+  if (!SvROK (sv))
+    caml_invalid_argument ("reftype: SV is not a reference");
+
+  CAMLreturn (Val_int (sv_type (SvRV (sv))));
+}
+
+CAMLprim value
 perl4caml_deref (value svv)
 {
   CAMLparam1 (svv);
@@ -550,6 +586,73 @@ perl4caml_hv_undef (value hvv)
 }
 
 CAMLprim value
+perl4caml_hv_iterinit (value hvv)
+{
+  CAMLparam1 (hvv);
+  HV *hv = Hv_val (hvv);
+  int i = hv_iterinit (hv);
+  CAMLreturn (caml_copy_int32 (i));
+}
+
+CAMLprim value
+perl4caml_hv_iternext (value hvv)
+{
+  CAMLparam1 (hvv);
+  CAMLlocal1 (hev);
+  HV *hv = Hv_val (hvv);
+  HE *he = hv_iternext (hv);
+  if (he == NULL) caml_raise_not_found ();
+  hev = Val_he (he);
+  CAMLreturn (hev);
+}
+
+CAMLprim value
+perl4caml_hv_iterkey (value hev)
+{
+  CAMLparam1 (hev);
+  CAMLlocal1 (strv);
+  HE *he = He_val (hev);
+  I32 len;
+  char *str = hv_iterkey (he, &len);
+  strv = caml_alloc_string (len);
+  memcpy (String_val (strv), str, len);
+  CAMLreturn (strv);
+}
+
+CAMLprim value
+perl4caml_hv_iterval (value hvv, value hev)
+{
+  CAMLparam2 (hvv, hev);
+  CAMLlocal1 (svv);
+  HV *hv = Hv_val (hvv);
+  HE *he = He_val (hev);
+  SV *sv = hv_iterval (hv, he);
+  SvREFCNT_inc (sv);
+  svv = Val_sv (sv);
+  CAMLreturn (svv);
+}
+
+CAMLprim value
+perl4caml_hv_iternextsv (value hvv)
+{
+  CAMLparam1 (hvv);
+  CAMLlocal3 (strv, svv, rv);
+  HV *hv = Hv_val (hvv);
+  char *str; I32 len;
+  SV *sv = hv_iternextsv (hv, &str, &len);
+  if (sv == NULL) caml_raise_not_found ();
+  SvREFCNT_inc (sv);
+  svv = Val_sv (sv);
+  strv = caml_alloc_string (len);
+  memcpy (String_val (strv), str, len);
+  /* Construct a tuple (strv, svv). */
+  rv = caml_alloc_tuple (2);
+  Field (rv, 0) = strv;
+  Field (rv, 1) = svv;
+  CAMLreturn (rv);
+}
+
+CAMLprim value
 perl4caml_get_sv (value optcreate, value name)
 {
   CAMLparam2 (optcreate, name);