src/dynext.c

   1 /*
   2 Copyright (C) 2001-2008, Parrot Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/dynext.c - Dynamic extensions to Parrot
   8
   9 =head1 DESCRIPTION
  10
  11 Functions for loading and initializing dynamic link libraries.
  12
  13 =head2 Functions
  14
  15 =over 4
  16
  17 =cut
  18
  19 */
  20
  21 #include "parrot/parrot.h"
  22 #include "parrot/dynext.h"
  23 #include "dynext.str"
  24 #include "pmc/pmc_parrotlibrary.h"
  25 #include "pmc/pmc_callcontext.h"
  26
  27 /* HEADERIZER HFILE: include/parrot/dynext.h */
  28
  29 /* HEADERIZER BEGIN: static */
  30 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  31
  32 PARROT_WARN_UNUSED_RESULT
  33 PARROT_CANNOT_RETURN_NULL
  34 static STRING * clone_string_into(
  35     ARGMOD(Interp *d),
  36     ARGIN(Interp *s),
  37     ARGIN(PMC *value))
  38         __attribute__nonnull__(1)
  39         __attribute__nonnull__(2)
  40         __attribute__nonnull__(3)
  41         FUNC_MODIFIES(*d);
  42
  43 PARROT_WARN_UNUSED_RESULT
  44 PARROT_CAN_RETURN_NULL
  45 static void * dlopen_string(PARROT_INTERP,
  46     Parrot_dlopen_flags flags,
  47     ARGIN(STRING *path))
  48         __attribute__nonnull__(1)
  49         __attribute__nonnull__(3);
  50
  51 PARROT_WARN_UNUSED_RESULT
  52 PARROT_CAN_RETURN_NULL
  53 static STRING * get_path(PARROT_INTERP,
  54     ARGMOD_NULLOK(STRING *lib),
  55     Parrot_dlopen_flags flags,
  56     ARGOUT(void **handle),
  57     ARGIN(STRING *wo_ext),
  58     ARGIN_NULLOK(STRING *ext))
  59         __attribute__nonnull__(1)
  60         __attribute__nonnull__(4)
  61         __attribute__nonnull__(5)
  62         FUNC_MODIFIES(*lib)
  63         FUNC_MODIFIES(*handle);
  64
  65 PARROT_WARN_UNUSED_RESULT
  66 PARROT_CAN_RETURN_NULL
  67 static PMC* is_loaded(PARROT_INTERP, ARGIN(STRING *path))
  68         __attribute__nonnull__(1)
  69         __attribute__nonnull__(2);
  70
  71 PARROT_WARN_UNUSED_RESULT
  72 PARROT_CANNOT_RETURN_NULL
  73 static PMC * make_string_pmc(PARROT_INTERP, ARGIN(STRING *string))
  74         __attribute__nonnull__(1)
  75         __attribute__nonnull__(2);
  76
  77 PARROT_CANNOT_RETURN_NULL
  78 static PMC * run_init_lib(PARROT_INTERP,
  79     ARGIN(void *handle),
  80     ARGIN_NULLOK(STRING *lib_name),
  81     ARGIN(STRING *wo_ext))
  82         __attribute__nonnull__(1)
  83         __attribute__nonnull__(2)
  84         __attribute__nonnull__(4);
  85
  86 static void set_cstring_prop(PARROT_INTERP,
  87     ARGMOD(PMC *lib_pmc),
  88     ARGIN(const char *what),
  89     ARGIN(STRING *name))
  90         __attribute__nonnull__(1)
  91         __attribute__nonnull__(2)
  92         __attribute__nonnull__(3)
  93         __attribute__nonnull__(4)
  94         FUNC_MODIFIES(*lib_pmc);
  95
  96 static void store_lib_pmc(PARROT_INTERP,
  97     ARGIN(PMC *lib_pmc),
  98     ARGIN(STRING *path),
  99     ARGIN(STRING *type),
 100     ARGIN_NULLOK(STRING *lib_name))
 101         __attribute__nonnull__(1)
 102         __attribute__nonnull__(2)
 103         __attribute__nonnull__(3)
 104         __attribute__nonnull__(4);
 105
 106 #define ASSERT_ARGS_clone_string_into __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 107        PARROT_ASSERT_ARG(d) \
 108     , PARROT_ASSERT_ARG(s) \
 109     , PARROT_ASSERT_ARG(value))
 110 #define ASSERT_ARGS_dlopen_string __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 111        PARROT_ASSERT_ARG(interp) \
 112     , PARROT_ASSERT_ARG(path))
 113 #define ASSERT_ARGS_get_path __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 114        PARROT_ASSERT_ARG(interp) \
 115     , PARROT_ASSERT_ARG(handle) \
 116     , PARROT_ASSERT_ARG(wo_ext))
 117 #define ASSERT_ARGS_is_loaded __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 118        PARROT_ASSERT_ARG(interp) \
 119     , PARROT_ASSERT_ARG(path))
 120 #define ASSERT_ARGS_make_string_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 121        PARROT_ASSERT_ARG(interp) \
 122     , PARROT_ASSERT_ARG(string))
 123 #define ASSERT_ARGS_run_init_lib __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 124        PARROT_ASSERT_ARG(interp) \
 125     , PARROT_ASSERT_ARG(handle) \
 126     , PARROT_ASSERT_ARG(wo_ext))
 127 #define ASSERT_ARGS_set_cstring_prop __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 128        PARROT_ASSERT_ARG(interp) \
 129     , PARROT_ASSERT_ARG(lib_pmc) \
 130     , PARROT_ASSERT_ARG(what) \
 131     , PARROT_ASSERT_ARG(name))
 132 #define ASSERT_ARGS_store_lib_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 133        PARROT_ASSERT_ARG(interp) \
 134     , PARROT_ASSERT_ARG(lib_pmc) \
 135     , PARROT_ASSERT_ARG(path) \
 136     , PARROT_ASSERT_ARG(type))
 137 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
 138 /* HEADERIZER END: static */
 139
 140 /* _PARROTLIB is now the default */
 141 /*#define _PARROTLIB not working: "make testr" */
 142
 143 /*
 144
 145 =item C<static void set_cstring_prop(PARROT_INTERP, PMC *lib_pmc, const char
 146 *what, STRING *name)>
 147
 148 Set a property C<name> with value C<what> on the C<ParrotLibrary>
 149 C<lib_pmc>.
 150
 151 =cut
 152
 153 */
 154
 155 static void
 156 set_cstring_prop(PARROT_INTERP, ARGMOD(PMC *lib_pmc), ARGIN(const char *what),
 157         ARGIN(STRING *name))
 158 {
 159     ASSERT_ARGS(set_cstring_prop)
 160     STRING * const key  = Parrot_str_new_constant(interp, what);
 161     PMC    * const prop = Parrot_pmc_new_constant(interp, enum_class_String);
 162
 163     VTABLE_set_string_native(interp, prop, name);
 164     VTABLE_setprop(interp, lib_pmc, key, prop);
 165 }
 166
 167 /*
 168
 169 =item C<static void store_lib_pmc(PARROT_INTERP, PMC *lib_pmc, STRING *path,
 170 STRING *type, STRING *lib_name)>
 171
 172 Store a C<ParrotLibrary> PMC in the interpreter's C<iglobals>.
 173
 174 =cut
 175
 176 */
 177
 178 static void
 179 store_lib_pmc(PARROT_INTERP, ARGIN(PMC *lib_pmc), ARGIN(STRING *path),
 180         ARGIN(STRING *type), ARGIN_NULLOK(STRING *lib_name))
 181 {
 182     ASSERT_ARGS(store_lib_pmc)
 183     PMC * const iglobals = interp->iglobals;
 184     PMC * const dyn_libs = VTABLE_get_pmc_keyed_int(interp, iglobals,
 185             IGLOBALS_DYN_LIBS);
 186
 187     /* remember path/file in props */
 188     set_cstring_prop(interp, lib_pmc, "_filename", path);
 189     set_cstring_prop(interp, lib_pmc, "_type", type);
 190
 191     if (lib_name)
 192         set_cstring_prop(interp, lib_pmc, "_lib_name", lib_name);
 193
 194     VTABLE_set_pmc_keyed_str(interp, dyn_libs, path, lib_pmc);
 195 }
 196
 197 /*
 198
 199 =item C<static PMC* is_loaded(PARROT_INTERP, STRING *path)>
 200
 201 Check if a C<ParrotLibrary> PMC with the filename path exists.
 202 If it does, return it. Otherwise, return NULL.
 203
 204 =cut
 205
 206 */
 207
 208 PARROT_WARN_UNUSED_RESULT
 209 PARROT_CAN_RETURN_NULL
 210 static PMC*
 211 is_loaded(PARROT_INTERP, ARGIN(STRING *path))
 212 {
 213     ASSERT_ARGS(is_loaded)
 214     PMC * const iglobals = interp->iglobals;
 215     PMC * const dyn_libs = VTABLE_get_pmc_keyed_int(interp, iglobals,
 216             IGLOBALS_DYN_LIBS);
 217     if (!VTABLE_exists_keyed_str(interp, dyn_libs, path))
 218         return PMCNULL;
 219     return VTABLE_get_pmc_keyed_str(interp, dyn_libs, path);
 220 }
 221
 222 /*
 223
 224 =item C<static void * dlopen_string(PARROT_INTERP, Parrot_dlopen_flags flags,
 225 STRING *path)>
 226
 227 Call Parrot_dlopen with the Parrot String argument converted to C string.  The
 228 flags argument will be converted into native form and used if applicable.
 229
 230 =cut
 231
 232 */
 233
 234 PARROT_WARN_UNUSED_RESULT
 235 PARROT_CAN_RETURN_NULL
 236 static void *
 237 dlopen_string(PARROT_INTERP, Parrot_dlopen_flags flags, ARGIN(STRING *path))
 238 {
 239     ASSERT_ARGS(dlopen_string)
 240
 241     char * const pathstr = Parrot_str_to_cstring(interp, path);
 242     void *       handle  = Parrot_dlopen(pathstr, flags);
 243     Parrot_str_free_cstring(pathstr);
 244     return handle;
 245 }
 246
 247 /*
 248
 249 =item C<static STRING * get_path(PARROT_INTERP, STRING *lib, Parrot_dlopen_flags
 250 flags, void **handle, STRING *wo_ext, STRING *ext)>
 251
 252 Return path and handle of a dynamic lib, setting lib_name to just the filestem
 253 (i.e. without path or extension) as a freshly-allocated C string.
 254
 255 =cut
 256
 257 */
 258
 259 PARROT_WARN_UNUSED_RESULT
 260 PARROT_CAN_RETURN_NULL
 261 static STRING *
 262 get_path(PARROT_INTERP, ARGMOD_NULLOK(STRING *lib), Parrot_dlopen_flags flags,
 263         ARGOUT(void **handle), ARGIN(STRING *wo_ext),
 264         ARGIN_NULLOK(STRING *ext))
 265 {
 266     ASSERT_ARGS(get_path)
 267     STRING *path, *full_name;
 268     const char *err = NULL;    /* buffer returned from Parrot_dlerror */
 269
 270     PMC * const iglobals = interp->iglobals;
 271     PMC * const lib_paths = VTABLE_get_pmc_keyed_int(interp, iglobals,
 272                                                      IGLOBALS_LIB_PATHS);
 273     PMC * const share_ext = VTABLE_get_pmc_keyed_int(interp, lib_paths,
 274                                                      PARROT_LIB_DYN_EXTS);
 275
 276     if (lib == NULL) {
 277         *handle = Parrot_dlopen((char *)NULL, flags);
 278         if (*handle) {
 279             return CONST_STRING(interp, "");
 280         }
 281         err = Parrot_dlerror();
 282         Parrot_warn(interp, PARROT_WARNINGS_DYNEXT_FLAG,
 283                     "Couldn't dlopen(NULL): %s\n",
 284                     err ? err : "unknown reason");
 285         return NULL;
 286     }
 287
 288     /*
 289      * first, try to add an extension to the file if it has none.
 290      */
 291     if (! ext) {
 292         const INTVAL n = VTABLE_elements(interp, share_ext);
 293         INTVAL i;
 294
 295         for (i = 0; i < n; ++i) {
 296             ext = VTABLE_get_string_keyed_int(interp, share_ext, i);
 297             full_name = Parrot_str_concat(interp, wo_ext, ext);
 298             path = Parrot_locate_runtime_file_str(interp, full_name,
 299                     PARROT_RUNTIME_FT_DYNEXT);
 300             if (path) {
 301                 *handle = dlopen_string(interp, flags, path);
 302                 if (*handle) {
 303                     return path;
 304                 }
 305                 err = Parrot_dlerror();
 306                 Parrot_warn(interp, PARROT_WARNINGS_DYNEXT_FLAG,
 307                             "Couldn't load '%Ss': %s\n",
 308                         full_name, err ? err : "unknown reason");
 309                 return NULL;
 310             }
 311
 312             /*
 313              * File with extension and prefix was not found,
 314              * so try file.extension w/o prefix
 315              */
 316             *handle = dlopen_string(interp, flags, full_name);
 317             if (*handle) {
 318                 return full_name;
 319             }
 320         }
 321     }
 322     /*
 323      * finally, try the given file name as is. We still use
 324      * Parrot_locate_runtime_file so that (a) relative pathnames are searched in
 325      * the standard locations, and (b) the angle of the slashes are adjusted as
 326      * required for non-Unix systems.
 327      */
 328     full_name = Parrot_locate_runtime_file_str(interp, lib,
 329             PARROT_RUNTIME_FT_DYNEXT);
 330     if (full_name) {
 331         *handle = dlopen_string(interp, flags, full_name);
 332         if (*handle) {
 333             return full_name;
 334         }
 335     }
 336     /*
 337      * and on windows strip a leading "lib"
 338      * [shouldn't this happen in Parrot_locate_runtime_file instead?]
 339      */
 340 #ifdef WIN32
 341     if (!STRING_IS_EMPTY(lib) && memcmp(lib->strstart, "lib", 3) == 0) {
 342         *handle = Parrot_dlopen((char *)lib->strstart + 3, 0);
 343         if (*handle) {
 344             path = Parrot_str_substr(interp, lib, 3, lib->strlen - 3);
 345             return path;
 346         }
 347     }
 348 #endif
 349
 350     /* And on cygwin replace a leading "lib" by "cyg". */
 351 #ifdef __CYGWIN__
 352     if (!STRING_IS_EMPTY(lib) && memcmp(lib->strstart, "lib", 3) == 0) {
 353         path = Parrot_str_concat(interp, CONST_STRING(interp, "cyg"),
 354             Parrot_str_substr(interp, lib, 3, lib->strlen - 3));
 355
 356         *handle = dlopen_string(interp, flags, path);
 357
 358         if (*handle)
 359             return path;
 360     }
 361 #endif
 362
 363     /* And after-finally,  let the OS use his own search */
 364     if (!STRING_IS_EMPTY(lib)) {
 365         *handle = dlopen_string(interp, flags, lib);
 366         if (*handle)
 367             return lib;
 368     }
 369
 370     err = Parrot_dlerror();
 371     Parrot_warn(interp, PARROT_WARNINGS_DYNEXT_FLAG,
 372                 "Couldn't load '%Ss': %s\n",
 373                 lib, err ? err : "unknown reason");
 374     return NULL;
 375 }
 376
 377 /*
 378
 379 =item C<PMC * Parrot_init_lib(PARROT_INTERP, dynext_load_func load_func,
 380 dynext_init_func init_func)>
 381
 382 Initializes a new library. First, calls C<load_func> to load the library
 383 (if C<load_func> is provided) and then calls C<init_func>. Returns a
 384 ParrotLibrary PMC object that represents the initialized library.
 385
 386 =cut
 387
 388 */
 389
 390 PARROT_EXPORT
 391 PARROT_CANNOT_RETURN_NULL
 392 PMC *
 393 Parrot_init_lib(PARROT_INTERP,
 394         NULLOK(dynext_load_func load_func),
 395         NULLOK(dynext_init_func init_func))
 396 {
 397     ASSERT_ARGS(Parrot_init_lib)
 398     PMC *lib_pmc = NULL;
 399
 400     if (load_func)
 401         lib_pmc = (*load_func)(interp);
 402
 403     /* seems to be a native/NCI lib */
 404     if (!load_func || !lib_pmc)
 405         lib_pmc = Parrot_pmc_new_constant(interp, enum_class_ParrotLibrary);
 406
 407     /*  Call init, if it exists */
 408     if (init_func)
 409         (init_func)(interp, lib_pmc);
 410
 411     return lib_pmc;
 412 }
 413
 414 /*
 415
 416 =item C<static PMC * run_init_lib(PARROT_INTERP, void *handle, STRING *lib_name,
 417 STRING *wo_ext)>
 418
 419 Loads and Initializes a new library and returns a ParrotLibrary PMC.
 420 Takes the name of a library C<libname>, that is loaded with handle C<handle>.
 421 Calls the necessary initialization routines, if any.
 422
 423 =cut
 424
 425 */
 426
 427 PARROT_CANNOT_RETURN_NULL
 428 static PMC *
 429 run_init_lib(PARROT_INTERP, ARGIN(void *handle),
 430         ARGIN_NULLOK(STRING *lib_name), ARGIN(STRING *wo_ext))
 431 {
 432     ASSERT_ARGS(run_init_lib)
 433     STRING *type;
 434     PMC *(*load_func)(PARROT_INTERP);
 435     void (*init_func)(PARROT_INTERP, PMC *);
 436     PMC *lib_pmc;
 437
 438     UINTVAL regs_used[]     = { 2, 2, 2, 2 }; /* Arbitrary values */
 439     const int parrot_hll_id = 0;
 440     PMC * context = Parrot_push_context(interp, regs_used);
 441     Parrot_pcc_set_HLL(interp, context, parrot_hll_id);
 442     Parrot_pcc_set_namespace(interp, context,
 443             Parrot_get_HLL_namespace(interp, parrot_hll_id));
 444
 445     /*
 446      * work around gcc 3.3.3 and other problem with dynpmcs
 447      * something during library loading doesn't stand a GC run
 448      */
 449     Parrot_block_GC_mark(interp);
 450
 451     if (lib_name) {
 452         STRING * const load_name       = Parrot_sprintf_c(interp,
 453                                         "Parrot_lib_%Ss_load", lib_name);
 454         STRING * const init_func_name  = Parrot_sprintf_c(interp,
 455                                         "Parrot_lib_%Ss_init", lib_name);
 456         char   * const cload_func_name = Parrot_str_to_cstring(interp, load_name);
 457         char   * const cinit_func_name = Parrot_str_to_cstring(interp, init_func_name);
 458
 459         /* get load_func */
 460         void * dlsymfunc = Parrot_dlsym(handle, cload_func_name);
 461         load_func = (PMC * (*)(PARROT_INTERP)) D2FPTR(dlsymfunc);
 462         Parrot_str_free_cstring(cload_func_name);
 463
 464         /* get init_func */
 465         dlsymfunc = Parrot_dlsym(handle, cinit_func_name);
 466         init_func = (void (*)(PARROT_INTERP, PMC *)) D2FPTR(dlsymfunc);
 467         Parrot_str_free_cstring(cinit_func_name);
 468     }
 469     else {
 470         load_func = NULL;
 471         init_func = NULL;
 472     }
 473
 474     lib_pmc = Parrot_init_lib(interp, load_func, init_func);
 475     VTABLE_set_pointer(interp, lib_pmc, handle);
 476
 477     if (!load_func)
 478         type = CONST_STRING(interp, "NCI");
 479     else {
 480         if (((Parrot_ParrotLibrary_attributes *)PMC_data(lib_pmc))->oplib_init)
 481             type = CONST_STRING(interp, "Ops");
 482         else
 483             type = CONST_STRING(interp, "PMC");
 484     }
 485
 486     /* remember lib_pmc in iglobals */
 487     store_lib_pmc(interp, lib_pmc, wo_ext, type, lib_name);
 488
 489     /* UNLOCK */
 490     Parrot_unblock_GC_mark(interp);
 491
 492     Parrot_pop_context(interp);
 493
 494     return lib_pmc;
 495 }
 496
 497 /*
 498
 499 =item C<static STRING * clone_string_into(Interp *d, Interp *s, PMC *value)>
 500
 501 Extracts a STRING value from PMC C<value> in interpreter C<s>. Copies that
 502 string into the pool of interpreter C<d> using the default encoding
 503 and charset.
 504
 505 =cut
 506
 507 */
 508
 509 PARROT_WARN_UNUSED_RESULT
 510 PARROT_CANNOT_RETURN_NULL
 511 static STRING *
 512 clone_string_into(ARGMOD(Interp *d), ARGIN(Interp *s), ARGIN(PMC *value))
 513 {
 514     ASSERT_ARGS(clone_string_into)
 515     STRING * const  orig   = VTABLE_get_string(s, value);
 516     char   * const raw_str = Parrot_str_to_cstring(s, orig);
 517     STRING * const   ret   =
 518         Parrot_str_new_init(d, raw_str, strlen(raw_str),
 519             PARROT_DEFAULT_ENCODING, PARROT_DEFAULT_CHARSET,
 520             PObj_constant_FLAG);
 521     Parrot_str_free_cstring(raw_str);
 522     return ret;
 523 }
 524
 525 /*
 526
 527 =item C<static PMC * make_string_pmc(PARROT_INTERP, STRING *string)>
 528
 529 Converts a STRING C<string> into a String PMC.
 530
 531 =cut
 532
 533 */
 534
 535 PARROT_WARN_UNUSED_RESULT
 536 PARROT_CANNOT_RETURN_NULL
 537 static PMC *
 538 make_string_pmc(PARROT_INTERP, ARGIN(STRING *string))
 539 {
 540     ASSERT_ARGS(make_string_pmc)
 541     PMC * const ret = Parrot_pmc_new_constant(interp, enum_class_String);
 542     VTABLE_set_string_native(interp, ret, string);
 543
 544     return ret;
 545 }
 546
 547 /*
 548
 549 =item C<PMC * Parrot_clone_lib_into(Interp *d, Interp *s, PMC *lib_pmc)>
 550
 551 Clones a ParrotLibrary PMC C<lib_pmc> from interpreter C<s> into interpreter
 552 C<d>.
 553
 554 =cut
 555
 556 */
 557
 558 PARROT_EXPORT
 559 PARROT_WARN_UNUSED_RESULT
 560 PARROT_CANNOT_RETURN_NULL
 561 PMC *
 562 Parrot_clone_lib_into(ARGMOD(Interp *d), ARGMOD(Interp *s), ARGIN(PMC *lib_pmc))
 563 {
 564     ASSERT_ARGS(Parrot_clone_lib_into)
 565     STRING * const filename = CONST_STRING(s, "_filename");
 566     STRING * const libname  = CONST_STRING(s, "_lib_name");
 567     STRING * const type_str = CONST_STRING(s, "_type");
 568     STRING * const ops      = CONST_STRING(s, "Ops");
 569
 570     STRING * const wo_ext = clone_string_into(d, s,
 571         VTABLE_getprop(s, lib_pmc, filename));
 572     STRING * const lib_name = clone_string_into(d, s,
 573         VTABLE_getprop(s, lib_pmc, libname));
 574     void * const handle = VTABLE_get_pointer(s, lib_pmc);
 575     STRING * const type =
 576         VTABLE_get_string(s, VTABLE_getprop(s, lib_pmc, type_str));
 577
 578     if (Parrot_str_equal(s, type, ops)) {
 579         /* we can't clone oplibs in the normal way, since they're actually
 580          * shared between interpreters dynop_register modifies the (statically
 581          * allocated) op_lib_t structure from core_ops.c, for example.
 582          * Anyways, if we hope to share bytecode at runtime, we need to have
 583          * them have identical opcodes anyways.
 584          */
 585         PMC * const new_lib_pmc = Parrot_pmc_new_constant(d, enum_class_ParrotLibrary);
 586
 587         PMC_data(new_lib_pmc) = handle;
 588         VTABLE_setprop(d, new_lib_pmc, CONST_STRING(s, "_filename"), make_string_pmc(d, wo_ext));
 589         VTABLE_setprop(d, new_lib_pmc, CONST_STRING(s, "_lib_name"), make_string_pmc(d, lib_name));
 590         VTABLE_setprop(d, new_lib_pmc, CONST_STRING(s, "_type"), make_string_pmc(d, ops));
 591
 592         /* fixup d->all_op_libs, if necessary */
 593         if (d->n_libs != s->n_libs) {
 594             INTVAL i;
 595             if (d->all_op_libs)
 596                 d->all_op_libs = (op_lib_t **)mem_internal_realloc(d->all_op_libs,
 597                     sizeof (op_lib_t *) * s->n_libs);
 598             else
 599                 d->all_op_libs = (op_lib_t **)mem_internal_allocate(sizeof (op_lib_t *) *
 600                     s->n_libs);
 601             for (i = d->n_libs; i < s->n_libs; ++i)
 602                 d->all_op_libs[i] = s->all_op_libs[i];
 603             d->n_libs = s->n_libs;
 604         }
 605
 606         return new_lib_pmc;
 607     }
 608     else {
 609         return run_init_lib(d, handle, lib_name, wo_ext);
 610     }
 611 }
 612
 613 /*
 614
 615 =item C<PMC * Parrot_load_lib(PARROT_INTERP, STRING *lib, PMC *parameters)>
 616
 617 Dynamic library loader.
 618
 619 C<parameters>, if not null, points to something which controls library
 620 loading and initialization.  Currently just its integer value is used,
 621 interpreted as C<Parrot_dlopen_flags>.
 622
 623 Calls C<Parrot_lib_%s_load()> which performs the registration of the lib
 624 once C<Parrot_lib_%s_init()> gets called (if exists) to perform thread
 625 specific setup. In both functions C<%s> is the name of the library.
 626
 627 If Parrot_lib_%s_load() succeeds, it should either return a
 628 ParrotLibrary PMC, which is then used as the handle for this library
 629 or NULL, in which case parrot creates a handle for the library.
 630
 631 If either Parrot_lib_%s_load() or Parrot_lib_%s_init() detects an error
 632 condition, an exception should be thrown.
 633
 634 TODO: fetch Parrot_lib load/init handler exceptions
 635
 636 =cut
 637
 638 */
 639
 640 PARROT_EXPORT
 641 PARROT_WARN_UNUSED_RESULT
 642 PARROT_CANNOT_RETURN_NULL
 643 PMC *
 644 Parrot_load_lib(PARROT_INTERP, ARGIN_NULLOK(STRING *lib), ARGIN_NULLOK(PMC *parameters))
 645 {
 646     ASSERT_ARGS(Parrot_load_lib)
 647     void   *handle;
 648     PMC    *lib_pmc;
 649     STRING *path;
 650     STRING *lib_name, *wo_ext, *ext;    /* library stem without path
 651                                          * or extension.  */
 652     int flags = 0;
 653     /* Find the pure library name, without path or extension.  */
 654     /*
 655      * TODO move the class_count_mutex here
 656      *
 657      * LOCK()
 658      */
 659     if (lib) {
 660         lib_name = parrot_split_path_ext(interp, lib, &wo_ext, &ext);
 661     }
 662     else {
 663         wo_ext   = CONST_STRING(interp, "");
 664         lib_name = NULL;
 665         ext      = NULL;
 666     }
 667
 668     lib_pmc = is_loaded(interp, wo_ext);
 669     if (!PMC_IS_NULL(lib_pmc)) {
 670         /* UNLOCK() */
 671         return lib_pmc;
 672     }
 673
 674     if (!PMC_IS_NULL(parameters)) {
 675         flags = VTABLE_get_integer(interp, parameters);
 676     }
 677
 678     path = get_path(interp, lib, (Parrot_dlopen_flags)flags, &handle, wo_ext, ext);
 679     if (!path || !handle) {
 680         /*
 681          * XXX Parrot_ex_throw_from_c_args? return PMCNULL?
 682          * PMC Undef seems convenient, because it can be queried with get_bool()
 683          */
 684         return Parrot_pmc_new(interp, enum_class_Undef);
 685     }
 686
 687     return run_init_lib(interp, handle, lib_name, wo_ext);
 688 }
 689
 690 /*
 691
 692 =back
 693
 694 =head1 SEE ALSO
 695
 696 F<include/parrot/dynext.h> and F<src/pmc/parrotlibrary.pmc>.
 697
 698 =cut
 699
 700 */
 701
 702
 703 /*
 704  * Local variables:
 705  *   c-file-style: "parrot"
 706  * End:
 707  * vim: expandtab shiftwidth=4:
 708  */