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