perl.cmo: perl.cmi
perl.cmx: perl.cmi
-examples/google.cmo: perl.cmi wrappers/pl_Net_Google.cmo
-examples/google.cmx: perl.cmx wrappers/pl_Net_Google.cmx
-examples/loadpage.cmo: perl.cmi wrappers/pl_HTML_Element.cmo \
+examples/google.cmo: wrappers/pl_Net_Google.cmo
+examples/google.cmx: wrappers/pl_Net_Google.cmx
+examples/loadpage.cmo: wrappers/pl_HTML_Element.cmo \
wrappers/pl_HTML_TreeBuilder.cmo wrappers/pl_HTTP_Request.cmo \
wrappers/pl_LWP_UserAgent.cmo
-examples/loadpage.cmx: perl.cmx wrappers/pl_HTML_Element.cmx \
+examples/loadpage.cmx: wrappers/pl_HTML_Element.cmx \
wrappers/pl_HTML_TreeBuilder.cmx wrappers/pl_HTTP_Request.cmx \
wrappers/pl_LWP_UserAgent.cmx
-examples/parsedate.cmo: perl.cmi wrappers/pl_Date_Format.cmo \
+examples/parsedate.cmo: wrappers/pl_Date_Format.cmo \
wrappers/pl_Date_Parse.cmo
-examples/parsedate.cmx: perl.cmx wrappers/pl_Date_Format.cmx \
+examples/parsedate.cmx: wrappers/pl_Date_Format.cmx \
wrappers/pl_Date_Parse.cmx
examples/test.cmo: perl.cmi
examples/test.cmx: perl.cmx
# perl4caml configuration -*- Makefile -*-
-# $Id: Makefile.config,v 1.12 2003-11-19 16:28:22 rich Exp $
+# $Id: Makefile.config,v 1.13 2003-12-11 17:41:52 rich Exp $
# PERLINCDIR
# Directory containing the Perl include files, eg. <EXTERN.h>.
# PACKAGE and VERSION
PACKAGE := perl4caml
-VERSION := 0.3.7
+VERSION := 0.3.9
(* Example program which uses Net::Google to query Google.
* You will need to have a Google API key in ~/.googlekey for this to work.
* Copyright (C) 2003 Merjis Ltd.
- * $Id: google.ml,v 1.3 2003-10-16 11:03:52 rich Exp $
+ * $Id: google.ml,v 1.4 2003-12-11 17:41:52 rich Exp $
*)
open Printf
printf "* %s\n <URL:%s>\n\n" response#title response#url
) search#results;
- (* Destroy the Perl interpreter. *)
- Perl.destroy (Perl.current_interpreter ());
-
(* Perform a full collection - good way to find GC/allocation bugs. *)
Gc.full_major ()
(* Example program which uses LWP::UserAgent and HTML::TreeBuilder to
* download an HTTP page and parse it.
* Copyright (C) 2003 Merjis Ltd.
- * $Id: loadpage.ml,v 1.4 2003-10-16 11:03:52 rich Exp $
+ * $Id: loadpage.ml,v 1.5 2003-12-11 17:41:52 rich Exp $
*)
open Printf
in
print tree;
- (* Destroy the Perl interpreter. *)
- Perl.destroy (Perl.current_interpreter ());
-
(* Perform a full collection - good way to find GC/allocation bugs. *)
Gc.full_major ()
(* Example program which uses Date::Parse.
* Copyright (C) 2003 Merjis Ltd.
- * $Id: parsedate.ml,v 1.1 2003-11-19 16:28:22 rich Exp $
+ * $Id: parsedate.ml,v 1.2 2003-12-11 17:41:52 rich Exp $
*)
open Printf
) strings
);
- (* Destroy the Perl interpreter. *)
- Perl.destroy (Perl.current_interpreter ());
-
(* Perform a full collection - good way to find GC/allocation bugs. *)
Gc.full_major ()
(* Simple test of the API.
* Copyright (C) 2003 Merjis Ltd.
- * $Id: test.ml,v 1.5 2003-10-16 11:03:52 rich Exp $
+ * $Id: test.ml,v 1.6 2003-12-11 17:41:52 rich Exp $
*)
open Printf
let sv = Perl.call_method obj "get_foo" [] in
printf "TestClass.foo is %d\n" (Perl.int_of_sv sv); flush stdout;
- (* Destroy the interpreter. *)
- Perl.destroy (Perl.current_interpreter ());
-
(* Perform a full collection - good way to find GC/allocation bugs. *)
Gc.full_major ()
(* Interface to Perl from OCaml.
* Copyright (C) 2003 Merjis Ltd.
- * $Id: perl.ml,v 1.10 2003-10-26 12:57:11 rich Exp $
+ * $Id: perl.ml,v 1.11 2003-12-11 17:41:52 rich Exp $
*)
-type t
-
type sv
type av
type hv
exception Perl_failure of string
-external create : ?args:string array -> unit -> t
- = "perl4caml_create"
-
(* Initialization. This must happen first, otherwise other parts of the
* program will segfault because of a missing interpreter.
*)
let () =
Callback.register_exception "perl4caml_perl_failure" (Perl_failure "");
c_init (); (* Initialise C code. *)
- (* Create the default interpreter. *)
- create ~args:[| ""; "-w"; "-e"; "0" |] ();
()
-external current_interpreter : unit -> t
- = "perl4caml_current_interpreter"
-
-external destroy : t -> unit
- = "perl4caml_destroy"
-
-external set_context : t -> unit
- = "perl4caml_set_context"
-
external int_of_sv : sv -> int = "perl4caml_int_of_sv"
external sv_of_int : int -> sv = "perl4caml_sv_of_int"
external float_of_sv : sv -> float = "perl4caml_float_of_sv"
*
* Copyright (C) 2003 Merjis Ltd.
*
- * $Id: perl.mli,v 1.10 2003-10-26 11:22:38 rich Exp $
+ * $Id: perl.mli,v 1.11 2003-12-11 17:41:52 rich Exp $
*)
-type t
-(** Perl interpreter (abstract type). *)
-
type sv
(** Perl scalar value. *)
exception Perl_failure of string
(** [die] in Perl code is translated automatically into this exception. *)
-val current_interpreter : unit -> t
-(** The [Perl] module has a notion of the "current" interpreter. Throws
- * [Not_found] if there is no current interpreter.
- *
- * When a program starts up, if it has been linked with [perl_init.cmo]
- * (which is should be), an interpreter is created for you. Normally
- * this should be all you need to know about interpreters, unless you
- * want to be really good and call
- * [Perl.destroy (Perl.current_interpreter ())] at the end of your
- * program to do proper cleanup.
- *
- * You can also, under certain circumstances, create other interpreters,
- * although this is experiemental and definitely not recommended.
- *
- * If Perl was compiled with [-Dusemultiplicity] then you can create
- * mutliple interpreters at the same time and switch between them by
- * calling {!Perl.set_context}.
- *
- * Otherwise you may destroy the current interpreter and create another
- * one (provided that at no time you have two "live" interpreters),
- * by calling {!Perl.destroy} followed by {!Perl.create}.
-*)
-
-val destroy : t -> unit
-(** Destroy the Perl interpreter, performing any necessary cleanup.
- *
- * You should call [Perl.destroy (Perl.current_interpreter ())] at
- * the end of your program, otherwise Perl won't properly clean up
- * (running [END] blocks, destroying objects and the like).
- *
- * Note that a Perl interpreter is created for you by default when you
- * use perl4caml.
- *
- * The current interpreter can be found by calling
- * {!Perl.current_interpreter}.
- *)
-
-val create : ?args:string array -> unit -> t
-(** Create a new Perl interpreter. (Note that a Perl interpreter is created
- * for you by default so you don't need to call this).
- *
- * The optional [?args] parameter is the command line passed to the
- * interpreter, and controls things like whether warnings are enabled
- * ([-w]) and which file(s) are parsed. The first element in the
- * array is the executable name (you can just set this to [""]).
- *
- * Perl won't allow you to create multiple interpreters at the same time
- * unless Perl itself was compiled with [-Dusemultiplicity]. However you
- * can create, then destroy, then create another and so on.
- *
- * The newly created interpreter is set as the "current interpreter".
- *)
-
-val set_context : t -> unit
-(** IF Perl was compiled with [-Dusemultiplicity] and IF you are using
- * multiple interpreters at the same time, then you must call this to
- * set the implied "current" interpreter.
- *
- * Most users will never need to call this function.
- *)
-
val int_of_sv : sv -> int
(** Convert a Perl [SV] into an integer. Note that OCaml [int]s aren't
* large enough to store the full 32 (or 64) bits from a Perl integer,
/* Interface to Perl from OCaml.
* Copyright (C) 2003 Merjis Ltd.
- * $Id: perl_c.c,v 1.12 2003-11-19 16:28:22 rich Exp $
+ * $Id: perl_c.c,v 1.13 2003-12-11 17:41:52 rich Exp $
*/
#include <stdio.h>
#include <caml/alloc.h>
#include <caml/callback.h>
+#include <caml/custom.h>
#include <caml/fail.h>
#include <caml/memory.h>
#include <caml/mlvalues.h>
/* Wrap up an arbitrary void pointer in an opaque OCaml object. */
static value Val_voidptr (void *ptr);
+/* Wrap up an SV, AV or HV in a custom OCaml object which will decrement
+ * the reference count on finalization.
+ */
+static value Val_xv (SV *sv);
+
/* Get the concrete value from an optional field. */
static value unoption (value option, value deflt);
/* Unwrap an arbitrary void pointer from an opaque OCaml object. */
#define Voidptr_val(type,rv) ((type *) Field ((rv), 0))
+/* Unwrap a custom block. */
+#define Xv_val(rv) (*((void **)Data_custom_val(rv)))
+
/* Hide Perl types in opaque OCaml objects. */
#define Val_perl(pl) (Val_voidptr ((pl)))
#define Perl_val(plv) (Voidptr_val (PerlInterpreter, (plv)))
-#define Val_sv(sv) (Val_voidptr ((sv)))
-#define Sv_val(svv) (Voidptr_val (SV, (svv)))
-#define Val_av(av) (Val_voidptr ((av)))
-#define Av_val(avv) (Voidptr_val (AV, (avv)))
-#define Val_hv(hv) (Val_voidptr ((hv)))
-#define Hv_val(hvv) (Voidptr_val (HV, (hvv)))
-
-CAMLprim value
-perl4caml_init (value unit)
-{
- CAMLparam1 (unit);
- PERL_SYS_INIT3 (NULL, NULL, NULL);
- CAMLreturn (Val_unit);
-}
-
-CAMLprim value
-perl4caml_current_interpreter (value unit)
-{
- CAMLparam1 (unit);
- if (my_perl == 0) raise_not_found ();
- CAMLreturn (Val_perl (my_perl));
-}
+#define Val_sv(sv) (Val_xv ((sv)))
+#define Sv_val(svv) ((SV *) Xv_val (svv))
+#define Val_av(av) (Val_xv ((SV *)(av)))
+#define Av_val(avv) ((AV *) Xv_val (avv))
+#define Val_hv(hv) (Val_xv ((SV *)(hv)))
+#define Hv_val(hvv) ((HV *) Xv_val (hvv))
static void
xs_init (pTHX)
}
CAMLprim value
-perl4caml_create (value optargs, value unit)
+perl4caml_init (value unit)
{
- CAMLparam2 (optargs, unit);
- CAMLlocal1 (args);
- int argc, i;
- char **argv;
- static char *no_args[] = { "", "-w", "-e", "0" };
-
- /* Arguments given? */
- if (optargs == Val_int (0)) /* "None" */
- {
- argc = 4;
- argv = no_args;
- }
- else /* "Some args" where args is a string array. */
- {
- args = Field (optargs, 0);
- argc = Wosize_val (args);
- argv = alloca (argc * sizeof (char *));
- for (i = 0; i < argc; ++i) argv[i] = String_val (Field (args, i));
- }
+ CAMLparam1 (unit);
+ int argc = 4;
+ static char *argv[] = { "", "-w", "-e", "0" };
+ PERL_SYS_INIT3 (NULL, NULL, NULL);
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_run (my_perl);*/
- CAMLreturn (Val_perl (my_perl));
-}
-
-CAMLprim value
-perl4caml_destroy (value plv)
-{
- CAMLparam1 (plv);
- PerlInterpreter *pl = Perl_val (plv);
-
- perl_destruct (pl);
- perl_free (pl);
-
- /* Current interpreter? */
- if (my_perl == pl) my_perl = 0;
-
- CAMLreturn (Val_unit);
-}
-
-CAMLprim value
-perl4caml_set_context (value plv)
-{
- CAMLparam1 (plv);
- PerlInterpreter *pl = Perl_val (plv);
-
- PERL_SET_CONTEXT (pl);
- my_perl = pl;
-
CAMLreturn (Val_unit);
}
*/
list = Val_int (0);
for (i = 0; i < count; ++i) {
+ SV *sv;
+
cons = alloc (2, 0);
Field (cons, 1) = list;
list = cons;
- Field (cons, 0) = Val_sv (newSVsv (POPs));
+ sv = newSVsv (POPs);
+ Field (cons, 0) = Val_sv (sv);
}
/* Restore the stack. */
*/
list = Val_int (0);
for (i = 0; i < count; ++i) {
+ SV *sv;
+
cons = alloc (2, 0);
Field (cons, 1) = list;
list = cons;
- Field (cons, 0) = Val_sv (newSVsv (POPs));
+ sv = newSVsv (POPs);
+ Field (cons, 0) = Val_sv (sv);
}
/* Restore the stack. */
static value
Val_voidptr (void *ptr)
{
- value rv = alloc (1, Abstract_tag); /* XXX Is this correct? */
+ CAMLparam0 ();
+ CAMLlocal1 (rv);
+ rv = alloc (1, Abstract_tag);
Field(rv, 0) = (value) ptr;
- return rv;
+ CAMLreturn (rv);
+}
+
+static void
+xv_finalize (value v)
+{
+ SvREFCNT_dec ((SV *) Xv_val (v));
+}
+
+static struct custom_operations xv_custom_operations = {
+ "xv_custom_operations",
+ xv_finalize,
+ custom_compare_default,
+ custom_hash_default,
+ custom_serialize_default,
+ custom_deserialize_default
+};
+
+static value
+Val_xv (SV *sv)
+{
+ CAMLparam0 ();
+ CAMLlocal1 (rv);
+ rv = alloc_custom (&xv_custom_operations, sizeof (void *), 0, 1);
+ Xv_val (rv) = sv;
+ CAMLreturn (rv);
}
static value
git.annexia.org / perl4caml.git / commitdiff