X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=perl_c.c;h=57cf65039076e492031b3cb84fd315f50cc83b35;hb=9e88eacb7d2a8883900fba0c8abedc26c7510d98;hp=bf7858035e9fd02d55681ba8d478c6b287e549fd;hpb=918648a5563d9ae8e4079fdf7d364387b02b1b34;p=perl4caml.git diff --git a/perl_c.c b/perl_c.c index bf78580..57cf650 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.5 2003-10-14 16:05:21 rich Exp $ + * $Id: perl_c.c,v 1.6 2003-10-15 16:51:12 rich Exp $ */ #include @@ -43,31 +43,29 @@ static value unoption (value option, value deflt); #define Val_av(av) (Val_voidptr ((av))) #define Av_val(avv) (Voidptr_val (AV, (avv))) -static void -xs_init (pTHX) +CAMLprim value +perl4caml_init (value unit) { - char *file = __FILE__; - EXTERN_C void boot_DynaLoader (pTHX_ CV* cv); - - newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); + CAMLparam1 (unit); + PERL_SYS_INIT3 (NULL, NULL, NULL); + return Val_unit; } CAMLprim value -perl4caml_init (value unit) +perl4caml_current_interpreter (value unit) { - static char *argv[] = { "", "-w", "-e", "0" }; - int argc = sizeof argv / sizeof argv[0]; - - PERL_SYS_INIT3 (NULL, NULL, NULL); + CAMLparam1 (unit); + if (my_perl == 0) raise_not_found (); + return Val_perl (my_perl); +} - /* Create a default interpreter. */ - 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);*/ +static void +xs_init (pTHX) +{ + char *file = __FILE__; + EXTERN_C void boot_DynaLoader (pTHX_ CV* cv); - return Val_unit; + newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); } CAMLprim value @@ -77,12 +75,12 @@ perl4caml_create (value optargs, value unit) CAMLlocal1 (args); int argc, i; char **argv; - static char *no_args[] = { "", "-e", "0" }; + static char *no_args[] = { "", "-w", "-e", "0" }; /* Arguments given? */ if (optargs == Val_int (0)) /* "None" */ { - argc = 3; + argc = 4; argv = no_args; } else /* "Some args" where args is a string array. */ @@ -103,17 +101,16 @@ perl4caml_create (value optargs, value unit) } CAMLprim value -perl4caml_destroy (value unit) +perl4caml_destroy (value plv) { - CAMLparam1 (unit); + CAMLparam1 (plv); + PerlInterpreter *pl = Perl_val (plv); - perl_destruct (my_perl); - perl_free (my_perl); + perl_destruct (pl); + perl_free (pl); - /* Force a segfault if someone tries to use a Perl function without - * creating another interpreter first. - */ - my_perl = 0; + /* Current interpreter? */ + if (my_perl == pl) my_perl = 0; CAMLreturn (Val_unit); }