perl_c.c

   1 /* Interface to Perl from OCaml.
   2  * Copyright (C) 2003 Merjis Ltd.
   3  * $Id: perl_c.c,v 1.3 2003-10-12 11:56:26 rich Exp $
   4  */
   5
   6 #include <stdio.h>
   7 #include <stdlib.h>
   8 #include <assert.h>
   9 #include <unistd.h>
  10 #include <alloca.h>
  11
  12 #include <caml/alloc.h>
  13 #include <caml/callback.h>
  14 #include <caml/fail.h>
  15 #include <caml/memory.h>
  16 #include <caml/mlvalues.h>
  17
  18 /* XXX This was required to avoid an error on my machine when loading the Perl
  19  * headers. Not clear why this is missing.
  20  */
  21 #define off64_t __off64_t
  22
  23 #include <EXTERN.h>
  24 #include <perl.h>
  25
  26 /* Perl requires the interpreter to be called literally 'my_perl'! */
  27 static PerlInterpreter *my_perl;
  28
  29 /* Wrap up an arbitrary void pointer in an opaque OCaml object. */
  30 static value Val_voidptr (void *ptr);
  31
  32 /* Get the concrete value from an optional field. */
  33 static value unoption (value option, value deflt);
  34
  35 /* Unwrap an arbitrary void pointer from an opaque OCaml object. */
  36 #define Voidptr_val(type,rv) ((type *) Field ((rv), 0))
  37
  38 /* Hide Perl types in opaque OCaml objects. */
  39 #define Val_perl(pl) (Val_voidptr ((pl)))
  40 #define Perl_val(plv) (Voidptr_val (PerlInterpreter, (plv)))
  41 #define Val_sv(sv) (Val_voidptr ((sv)))
  42 #define Sv_val(svv) (Voidptr_val (SV, (svv)))
  43
  44 CAMLprim value
  45 perl4caml_init (value unit)
  46 {
  47   PERL_SYS_INIT3 (NULL, NULL, NULL);
  48   return Val_unit;
  49 }
  50
  51 CAMLprim value
  52 perl4caml_create (value optargs, value unit)
  53 {
  54   CAMLparam2 (optargs, unit);
  55   CAMLlocal1 (args);
  56   int argc, i;
  57   char **argv;
  58   static char *no_args[] = { "", "-e", "0" };
  59
  60   /* Arguments given? */
  61   if (optargs == Val_int (0))   /* "None" */
  62     {
  63       argc = 3;
  64       argv = no_args;
  65     }
  66   else                          /* "Some args" where args is a string array. */
  67     {
  68       args = Field (optargs, 0);
  69       argc = Wosize_val (args);
  70       argv = alloca (argc * sizeof (char *));
  71       for (i = 0; i < argc; ++i) argv[i] = String_val (Field (args, i));
  72     }
  73
  74   my_perl = perl_alloc ();
  75   perl_construct (my_perl);
  76   PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
  77   perl_parse (my_perl, NULL, argc, argv, NULL);
  78   perl_run (my_perl);
  79
  80   CAMLreturn (Val_perl (my_perl));
  81 }
  82
  83 CAMLprim value
  84 perl4caml_destroy (value plv)
  85 {
  86   CAMLparam1 (plv);
  87   PerlInterpreter *pl = Perl_val (plv);
  88
  89   perl_destruct (pl);
  90   perl_free (pl);
  91
  92   CAMLreturn (Val_unit);
  93 }
  94
  95 CAMLprim value
  96 perl4caml_set_context (value plv)
  97 {
  98   CAMLparam1 (plv);
  99   PerlInterpreter *pl = Perl_val (plv);
 100
 101   PERL_SET_CONTEXT (pl);
 102   my_perl = pl;
 103
 104   CAMLreturn (Val_unit);
 105 }
 106
 107 CAMLprim value
 108 perl4caml_int_of_sv (value svv)
 109 {
 110   CAMLparam1 (svv);
 111   SV *sv = Sv_val (svv);
 112   CAMLreturn (Val_int (SvIV (sv)));
 113 }
 114
 115 CAMLprim value
 116 perl4caml_sv_of_int (value iv)
 117 {
 118   CAMLparam1 (iv);
 119   CAMLreturn (Val_sv (newSViv (Int_val (iv))));
 120 }
 121
 122 CAMLprim value
 123 perl4caml_float_of_sv (value svv)
 124 {
 125   CAMLparam1 (svv);
 126   SV *sv = Sv_val (svv);
 127   CAMLlocal1 (f);
 128   f = copy_double (SvNV (sv));
 129   CAMLreturn (f);
 130 }
 131
 132 CAMLprim value
 133 perl4caml_sv_of_float (value fv)
 134 {
 135   CAMLparam1 (fv);
 136   CAMLreturn (Val_sv (newSViv (Double_val (fv))));
 137 }
 138
 139 CAMLprim value
 140 perl4caml_string_of_sv (value svv)
 141 {
 142   CAMLparam1 (svv);
 143   SV *sv = Sv_val (svv);
 144   char *str;
 145   STRLEN len;
 146   CAMLlocal1 (strv);
 147   str = SvPV (sv, len);
 148   /* XXX This won't work if the string contains NUL. */
 149   strv = copy_string (str);
 150   CAMLreturn (strv);
 151 }
 152
 153 CAMLprim value
 154 perl4caml_sv_of_string (value strv)
 155 {
 156   CAMLparam1 (strv);
 157   CAMLreturn (Val_sv (newSVpv (String_val (strv), string_length (strv))));
 158 }
 159
 160 CAMLprim value
 161 perl4caml_sv_is_true (value svv)
 162 {
 163   CAMLparam1 (svv);
 164   SV *sv = Sv_val (svv);
 165   CAMLreturn (SvTRUE (sv) ? Val_true : Val_false);
 166 }
 167
 168 CAMLprim value
 169 perl4caml_sv_is_undef (value svv)
 170 {
 171   CAMLparam1 (svv);
 172   SV *sv = Sv_val (svv);
 173   CAMLreturn (sv == &PL_sv_undef ? Val_true : Val_false);
 174 }
 175
 176 CAMLprim value
 177 perl4caml_sv_get_undef (value unit)
 178 {
 179   CAMLparam1 (unit);
 180   CAMLreturn (Val_sv (&PL_sv_undef));
 181 }
 182
 183 CAMLprim value
 184 perl4caml_sv_get_yes (value unit)
 185 {
 186   CAMLparam1 (unit);
 187   CAMLreturn (Val_sv (&PL_sv_yes));
 188 }
 189
 190 CAMLprim value
 191 perl4caml_sv_get_no (value unit)
 192 {
 193   CAMLparam1 (unit);
 194   CAMLreturn (Val_sv (&PL_sv_no));
 195 }
 196
 197 CAMLprim value
 198 perl4caml_get_sv (value optcreate, value name)
 199 {
 200   CAMLparam2 (optcreate, name);
 201   CAMLlocal1 (create);
 202   SV *sv;
 203
 204   create = unoption (optcreate, Val_false);
 205   sv = get_sv (String_val (name), create == Val_true ? TRUE : FALSE);
 206   if (sv == NULL) raise_not_found ();
 207
 208   CAMLreturn (Val_sv (sv));
 209 }
 210
 211 CAMLprim value
 212 perl4caml_call (value optsv, value optfnname, value arglist)
 213 {
 214   CAMLparam3 (optsv, optfnname, arglist);
 215   dSP;
 216   int count;
 217   SV *sv;
 218   CAMLlocal3 (errv, svv, fnname);
 219
 220   ENTER;
 221   SAVETMPS;
 222
 223   /* Push the parameter list. */
 224   PUSHMARK (SP);
 225
 226   /* Iteration over the linked list. */
 227   for (; arglist != Val_int (0); arglist = Field (arglist, 1))
 228     {
 229       svv = Field (arglist, 0);
 230       sv = Sv_val (svv);
 231       XPUSHs (sv_2mortal (newSVsv (sv)));
 232     }
 233
 234   PUTBACK;
 235
 236   if (optsv != Val_int (0))
 237     {
 238       svv = unoption (optsv, Val_false);
 239       sv = Sv_val (svv);
 240       count = call_sv (sv, G_EVAL|G_SCALAR);
 241     }
 242   else if (optfnname != Val_int (0))
 243     {
 244       fnname = unoption (optfnname, Val_false);
 245       count = call_pv (String_val (fnname), G_EVAL|G_SCALAR);
 246     }
 247   else
 248     {
 249       fprintf (stderr,
 250                "Perl.call: must supply either 'sv' or 'fn' parameters.");
 251       abort ();
 252     }
 253
 254   SPAGAIN;
 255
 256   assert (count == 1); /* Pretty sure it should never be anything else. */
 257
 258   /* Pop return value off the stack. Note that the return value on the
 259    * stack is mortal, so we need to take a copy.
 260    */
 261   sv = newSVsv (POPs);
 262   PUTBACK;
 263   FREETMPS;
 264   LEAVE;
 265
 266   /* Died with an error?
 267    * XXX Actually this doesn't work for some reason.
 268    */
 269   if (SvTRUE (ERRSV))
 270     {
 271       STRLEN n_a;
 272       const char *err = SvPV (ERRSV, n_a); /* Equivalent of $@ in Perl. */
 273
 274       errv = copy_string (err);
 275
 276       raise_with_arg (*caml_named_value ("perl4caml_perl_failure"), errv);
 277     }
 278   else
 279     {
 280       svv = Val_sv (sv);
 281       CAMLreturn (svv);
 282     }
 283 }
 284
 285 CAMLprim value
 286 perl4caml_call_array (value optsv, value optfnname, value arglist)
 287 {
 288   CAMLparam3 (optsv, optfnname, arglist);
 289   dSP;
 290   int i, count;
 291   SV *sv;
 292   CAMLlocal5 (errv, svv, fnname, list, cons);
 293
 294   ENTER;
 295   SAVETMPS;
 296
 297   /* Push the parameter list. */
 298   PUSHMARK (SP);
 299
 300   /* Iteration over the linked list. */
 301   for (; arglist != Val_int (0); arglist = Field (arglist, 1))
 302     {
 303       svv = Field (arglist, 0);
 304       sv = Sv_val (svv);
 305       XPUSHs (sv_2mortal (newSVsv (sv)));
 306     }
 307
 308   PUTBACK;
 309
 310   if (optsv != Val_int (0))
 311     {
 312       svv = unoption (optsv, Val_false);
 313       sv = Sv_val (svv);
 314       count = call_sv (sv, G_EVAL|G_ARRAY);
 315     }
 316   else if (optfnname != Val_int (0))
 317     {
 318       fnname = unoption (optfnname, Val_false);
 319       count = call_pv (String_val (fnname), G_EVAL|G_ARRAY);
 320     }
 321   else
 322     {
 323       fprintf (stderr,
 324                "Perl.call_array: must supply either 'sv' or 'fn' parameters.");
 325       abort ();
 326     }
 327
 328   SPAGAIN;
 329
 330   /* Pop all the return values off the stack into a list. Values on the
 331    * stack are mortal, so we must copy them.
 332    */
 333   list = Val_int (0);
 334   for (i = 0; i < count; ++i) {
 335     cons = alloc (2, 0);
 336     Field (cons, 1) = list;
 337     list = cons;
 338     Field (cons, 0) = Val_sv (newSVsv (POPs));
 339   }
 340
 341   /* Restore the stack. */
 342   PUTBACK;
 343   FREETMPS;
 344   LEAVE;
 345
 346   /* Died with an error?
 347    * XXX Actually this doesn't work for some reason.
 348    */
 349   if (SvTRUE (ERRSV))
 350     {
 351       STRLEN n_a;
 352       const char *err = SvPV (ERRSV, n_a); /* Equivalent of $@ in Perl. */
 353
 354       errv = copy_string (err);
 355
 356       raise_with_arg (*caml_named_value ("perl4caml_perl_failure"), errv);
 357     }
 358   else
 359     CAMLreturn (list);
 360 }
 361
 362 CAMLprim value
 363 perl4caml_call_void (value optsv, value optfnname, value arglist)
 364 {
 365   CAMLparam3 (optsv, optfnname, arglist);
 366   dSP;
 367   int count;
 368   SV *sv;
 369   CAMLlocal3 (errv, svv, fnname);
 370
 371   ENTER;
 372   SAVETMPS;
 373
 374   /* Push the parameter list. */
 375   PUSHMARK (SP);
 376
 377   /* Iteration over the linked list. */
 378   for (; arglist != Val_int (0); arglist = Field (arglist, 1))
 379     {
 380       svv = Field (arglist, 0);
 381       sv = Sv_val (svv);
 382       XPUSHs (sv_2mortal (newSVsv (sv)));
 383     }
 384
 385   PUTBACK;
 386
 387   if (optsv != Val_int (0))
 388     {
 389       svv = unoption (optsv, Val_false);
 390       sv = Sv_val (svv);
 391       count = call_sv (sv, G_EVAL|G_VOID);
 392     }
 393   else if (optfnname != Val_int (0))
 394     {
 395       fnname = unoption (optfnname, Val_false);
 396       count = call_pv (String_val (fnname), G_EVAL|G_VOID);
 397     }
 398   else
 399     {
 400       fprintf (stderr,
 401                "Perl.call_void: must supply either 'sv' or 'fn' parameters.");
 402       abort ();
 403     }
 404
 405   SPAGAIN;
 406
 407   assert (count == 0); /* Pretty sure it should never be anything else. */
 408
 409   /* Restore the stack. */
 410   PUTBACK;
 411   FREETMPS;
 412   LEAVE;
 413
 414   /* Died with an error?
 415    * XXX Actually this doesn't work for some reason.
 416    */
 417   if (SvTRUE (ERRSV))
 418     {
 419       STRLEN n_a;
 420       const char *err = SvPV (ERRSV, n_a); /* Equivalent of $@ in Perl. */
 421
 422       errv = copy_string (err);
 423
 424       raise_with_arg (*caml_named_value ("perl4caml_perl_failure"), errv);
 425     }
 426   else
 427     CAMLreturn (Val_unit);
 428 }
 429
 430 CAMLprim value
 431 perl4caml_eval (value expr)
 432 {
 433   CAMLparam1 (expr);
 434   dSP;
 435   SV *sv;
 436   CAMLlocal2 (errv, svv);
 437
 438   ENTER;
 439   SAVETMPS;
 440
 441   PUSHMARK (SP);
 442   eval_pv (String_val (expr), G_SCALAR);
 443
 444   SPAGAIN;
 445   sv = newSVsv (POPs);
 446   PUTBACK;
 447   FREETMPS;
 448   LEAVE;
 449
 450   /* Died with an error?
 451    * XXX Actually this doesn't work for some reason.
 452    */
 453   if (SvTRUE (ERRSV))
 454     {
 455       STRLEN n_a;
 456       const char *err = SvPV (ERRSV, n_a); /* Equivalent of $@ in Perl. */
 457
 458       errv = copy_string (err);
 459
 460       raise_with_arg (*caml_named_value ("perl4caml_perl_failure"), errv);
 461     }
 462   else
 463     {
 464       svv = Val_sv (sv);
 465       CAMLreturn (svv);
 466     }
 467 }
 468
 469 CAMLprim value
 470 perl4caml_call_method (value ref, value name, value arglist)
 471 {
 472   CAMLparam3 (ref, name, arglist);
 473   dSP;
 474   int count;
 475   SV *sv;
 476   CAMLlocal2 (errv, svv);
 477
 478   ENTER;
 479   SAVETMPS;
 480
 481   /* Push the parameter list. */
 482   PUSHMARK (SP);
 483
 484   sv = Sv_val (ref);
 485   XPUSHs (sv_2mortal (newSVsv (sv)));
 486
 487   /* Iteration over the linked list. */
 488   for (; arglist != Val_int (0); arglist = Field (arglist, 1))
 489     {
 490       svv = Field (arglist, 0);
 491       sv = Sv_val (svv);
 492       XPUSHs (sv_2mortal (newSVsv (sv)));
 493     }
 494
 495   PUTBACK;
 496
 497   count = call_method (String_val (name), G_EVAL|G_SCALAR);
 498
 499   SPAGAIN;
 500
 501   assert (count == 1); /* Pretty sure it should never be anything else. */
 502
 503   /* Pop return value off the stack. Note that the return value on the
 504    * stack is mortal, so we need to take a copy.
 505    */
 506   sv = newSVsv (POPs);
 507   PUTBACK;
 508   FREETMPS;
 509   LEAVE;
 510
 511   /* Died with an error?
 512    * XXX Actually this doesn't work for some reason.
 513    */
 514   if (SvTRUE (ERRSV))
 515     {
 516       STRLEN n_a;
 517       const char *err = SvPV (ERRSV, n_a); /* Equivalent of $@ in Perl. */
 518
 519       errv = copy_string (err);
 520
 521       raise_with_arg (*caml_named_value ("perl4caml_perl_failure"), errv);
 522     }
 523   else
 524     {
 525       svv = Val_sv (sv);
 526       CAMLreturn (svv);
 527     }
 528 }
 529
 530 CAMLprim value
 531 perl4caml_call_method_array (value ref, value name, value arglist)
 532 {
 533   CAMLparam3 (ref, name, arglist);
 534   dSP;
 535   int count, i;
 536   SV *sv;
 537   CAMLlocal4 (errv, svv, list, cons);
 538
 539   ENTER;
 540   SAVETMPS;
 541
 542   /* Push the parameter list. */
 543   PUSHMARK (SP);
 544
 545   sv = Sv_val (ref);
 546   XPUSHs (sv_2mortal (newSVsv (sv)));
 547
 548   /* Iteration over the linked list. */
 549   for (; arglist != Val_int (0); arglist = Field (arglist, 1))
 550     {
 551       svv = Field (arglist, 0);
 552       sv = Sv_val (svv);
 553       XPUSHs (sv_2mortal (newSVsv (sv)));
 554     }
 555
 556   PUTBACK;
 557
 558   count = call_method (String_val (name), G_EVAL|G_ARRAY);
 559
 560   SPAGAIN;
 561
 562   /* Pop all return values off the stack. Note that the return values on the
 563    * stack are mortal, so we need to take a copy.
 564    */
 565   list = Val_int (0);
 566   for (i = 0; i < count; ++i) {
 567     cons = alloc (2, 0);
 568     Field (cons, 1) = list;
 569     list = cons;
 570     Field (cons, 0) = Val_sv (newSVsv (POPs));
 571   }
 572
 573   /* Restore the stack. */
 574   PUTBACK;
 575   FREETMPS;
 576   LEAVE;
 577
 578   /* Died with an error?
 579    * XXX Actually this doesn't work for some reason.
 580    */
 581   if (SvTRUE (ERRSV))
 582     {
 583       STRLEN n_a;
 584       const char *err = SvPV (ERRSV, n_a); /* Equivalent of $@ in Perl. */
 585
 586       errv = copy_string (err);
 587
 588       raise_with_arg (*caml_named_value ("perl4caml_perl_failure"), errv);
 589     }
 590   else
 591     CAMLreturn (list);
 592 }
 593
 594 CAMLprim value
 595 perl4caml_call_method_void (value ref, value name, value arglist)
 596 {
 597   CAMLparam3 (ref, name, arglist);
 598   dSP;
 599   int count;
 600   SV *sv;
 601   CAMLlocal2 (errv, svv);
 602
 603   ENTER;
 604   SAVETMPS;
 605
 606   /* Push the parameter list. */
 607   PUSHMARK (SP);
 608
 609   sv = Sv_val (ref);
 610   XPUSHs (sv_2mortal (newSVsv (sv)));
 611
 612   /* Iteration over the linked list. */
 613   for (; arglist != Val_int (0); arglist = Field (arglist, 1))
 614     {
 615       svv = Field (arglist, 0);
 616       sv = Sv_val (svv);
 617       XPUSHs (sv_2mortal (newSVsv (sv)));
 618     }
 619
 620   PUTBACK;
 621
 622   count = call_method (String_val (name), G_EVAL|G_VOID);
 623
 624   SPAGAIN;
 625
 626   assert (count == 0); /* Pretty sure it should never be anything else. */
 627
 628   /* Restore the stack. */
 629   PUTBACK;
 630   FREETMPS;
 631   LEAVE;
 632
 633   /* Died with an error?
 634    * XXX Actually this doesn't work for some reason.
 635    */
 636   if (SvTRUE (ERRSV))
 637     {
 638       STRLEN n_a;
 639       const char *err = SvPV (ERRSV, n_a); /* Equivalent of $@ in Perl. */
 640
 641       errv = copy_string (err);
 642
 643       raise_with_arg (*caml_named_value ("perl4caml_perl_failure"), errv);
 644     }
 645   else
 646     CAMLreturn (Val_unit);
 647 }
 648
 649 CAMLprim value
 650 perl4caml_call_class_method (value classname, value name, value arglist)
 651 {
 652   CAMLparam3 (classname, name, arglist);
 653   dSP;
 654   int count;
 655   SV *sv;
 656   CAMLlocal2 (errv, svv);
 657
 658   ENTER;
 659   SAVETMPS;
 660
 661   /* Push the parameter list. */
 662   PUSHMARK (SP);
 663
 664   XPUSHs (sv_2mortal (newSVpv (String_val (classname), 0)));
 665
 666   /* Iteration over the linked list. */
 667   for (; arglist != Val_int (0); arglist = Field (arglist, 1))
 668     {
 669       svv = Field (arglist, 0);
 670       sv = Sv_val (svv);
 671       XPUSHs (sv_2mortal (newSVsv (sv)));
 672     }
 673
 674   PUTBACK;
 675
 676   count = call_method (String_val (name), G_EVAL|G_SCALAR);
 677
 678   SPAGAIN;
 679
 680   assert (count == 1); /* Pretty sure it should never be anything else. */
 681
 682   /* Pop return value off the stack. Note that the return value on the
 683    * stack is mortal, so we need to take a copy.
 684    */
 685   sv = newSVsv (POPs);
 686   PUTBACK;
 687   FREETMPS;
 688   LEAVE;
 689
 690   /* Died with an error?
 691    * XXX Actually this doesn't work for some reason.
 692    */
 693   if (SvTRUE (ERRSV))
 694     {
 695       STRLEN n_a;
 696       const char *err = SvPV (ERRSV, n_a); /* Equivalent of $@ in Perl. */
 697
 698       errv = copy_string (err);
 699
 700       raise_with_arg (*caml_named_value ("perl4caml_perl_failure"), errv);
 701     }
 702   else
 703     {
 704       svv = Val_sv (sv);
 705       CAMLreturn (svv);
 706     }
 707 }
 708
 709 CAMLprim value
 710 perl4caml_call_class_method_array (value classname, value name, value arglist)
 711 {
 712   CAMLparam3 (classname, name, arglist);
 713   dSP;
 714   int count, i;
 715   SV *sv;
 716   CAMLlocal4 (errv, svv, list, cons);
 717
 718   ENTER;
 719   SAVETMPS;
 720
 721   /* Push the parameter list. */
 722   PUSHMARK (SP);
 723
 724   XPUSHs (sv_2mortal (newSVpv (String_val (classname), 0)));
 725
 726   /* Iteration over the linked list. */
 727   for (; arglist != Val_int (0); arglist = Field (arglist, 1))
 728     {
 729       svv = Field (arglist, 0);
 730       sv = Sv_val (svv);
 731       XPUSHs (sv_2mortal (newSVsv (sv)));
 732     }
 733
 734   PUTBACK;
 735
 736   count = call_method (String_val (name), G_EVAL|G_ARRAY);
 737
 738   SPAGAIN;
 739
 740   /* Pop all return values off the stack. Note that the return values on the
 741    * stack are mortal, so we need to take a copy.
 742    */
 743   list = Val_int (0);
 744   for (i = 0; i < count; ++i) {
 745     cons = alloc (2, 0);
 746     Field (cons, 1) = list;
 747     list = cons;
 748     Field (cons, 0) = Val_sv (newSVsv (POPs));
 749   }
 750
 751   /* Restore the stack. */
 752   PUTBACK;
 753   FREETMPS;
 754   LEAVE;
 755
 756   /* Died with an error?
 757    * XXX Actually this doesn't work for some reason.
 758    */
 759   if (SvTRUE (ERRSV))
 760     {
 761       STRLEN n_a;
 762       const char *err = SvPV (ERRSV, n_a); /* Equivalent of $@ in Perl. */
 763
 764       errv = copy_string (err);
 765
 766       raise_with_arg (*caml_named_value ("perl4caml_perl_failure"), errv);
 767     }
 768   else
 769     CAMLreturn (list);
 770 }
 771
 772 CAMLprim value
 773 perl4caml_call_class_method_void (value classname, value name, value arglist)
 774 {
 775   CAMLparam3 (classname, name, arglist);
 776   dSP;
 777   int count;
 778   SV *sv;
 779   CAMLlocal2 (errv, svv);
 780
 781   ENTER;
 782   SAVETMPS;
 783
 784   /* Push the parameter list. */
 785   PUSHMARK (SP);
 786
 787   XPUSHs (sv_2mortal (newSVpv (String_val (classname), 0)));
 788
 789   /* Iteration over the linked list. */
 790   for (; arglist != Val_int (0); arglist = Field (arglist, 1))
 791     {
 792       svv = Field (arglist, 0);
 793       sv = Sv_val (svv);
 794       XPUSHs (sv_2mortal (newSVsv (sv)));
 795     }
 796
 797   PUTBACK;
 798
 799   count = call_method (String_val (name), G_EVAL|G_VOID);
 800
 801   SPAGAIN;
 802
 803   assert (count == 0); /* Pretty sure it should never be anything else. */
 804
 805   /* Restore the stack. */
 806   PUTBACK;
 807   FREETMPS;
 808   LEAVE;
 809
 810   /* Died with an error?
 811    * XXX Actually this doesn't work for some reason.
 812    */
 813   if (SvTRUE (ERRSV))
 814     {
 815       STRLEN n_a;
 816       const char *err = SvPV (ERRSV, n_a); /* Equivalent of $@ in Perl. */
 817
 818       errv = copy_string (err);
 819
 820       raise_with_arg (*caml_named_value ("perl4caml_perl_failure"), errv);
 821     }
 822   else
 823     CAMLreturn (Val_unit);
 824 }
 825
 826 static value
 827 Val_voidptr (void *ptr)
 828 {
 829   value rv = alloc (1, Abstract_tag); /* XXX Is this correct? */
 830   Field(rv, 0) = (value) ptr;
 831   return rv;
 832 }
 833
 834 static value
 835 unoption (value option, value deflt)
 836 {
 837   if (option == Val_int (0))    /* "None" */
 838     return deflt;
 839   else                          /* "Some 'a" */
 840     return Field (option, 0);
 841 }