src/dynext.c

   1 /*
   2 Copyright (C) 2001-2010, 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 Sets a property C<name> with value C<what> on the C<ParrotLibrary> C<lib_pmc>.
 149
 150 =cut
 151
 152 */
 153
 154 static void
 155 set_cstring_prop(PARROT_INTERP, ARGMOD(PMC *lib_pmc), ARGIN(const char *what),
 156         ARGIN(STRING *name))
 157 {
 158     ASSERT_ARGS(set_cstring_prop)
 159     STRING * const key  = Parrot_str_new_constant(interp, what);
 160     PMC    * const prop = Parrot_pmc_new_constant(interp, enum_class_String);
 161
 162     VTABLE_set_string_native(interp, prop, name);
 163     VTABLE_setprop(interp, lib_pmc, key, prop);
 164 }
 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 Stores 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
 200 =item C<static PMC* is_loaded(PARROT_INTERP, STRING *path)>
 201
 202 Returns a C<ParrotLibrary> PMC with the given filename path, if it exists.
 203 Otherwise returns PMCNULL.
 204
 205 =cut
 206
 207 */
 208
 209 PARROT_WARN_UNUSED_RESULT
 210 PARROT_CAN_RETURN_NULL
 211 static PMC*
 212 is_loaded(PARROT_INTERP, ARGIN(STRING *path))
 213 {
 214     ASSERT_ARGS(is_loaded)
 215     PMC * const iglobals = interp->iglobals;
 216     PMC * const dyn_libs = VTABLE_get_pmc_keyed_int(interp, iglobals,
 217             IGLOBALS_DYN_LIBS);
 218     return VTABLE_get_pmc_keyed_str(interp, dyn_libs, path);
 219 }
 220
 221
 222 /*
 223
 224 =item C<static void * dlopen_string(PARROT_INTERP, Parrot_dlopen_flags flags,
 225 STRING *path)>
 226
 227 Calls C<Parrot_dlopen> with the path argument converted to a 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
 250 =item C<static STRING * get_path(PARROT_INTERP, STRING *lib, Parrot_dlopen_flags
 251 flags, void **handle, STRING *wo_ext, STRING *ext)>
 252
 253 Returns path and handle of a dynamic lib, setting lib_name to just the filestem
 254 (i.e. without path or extension) as a freshly-allocated C string.
 255
 256 =cut
 257
 258 */
 259
 260 PARROT_WARN_UNUSED_RESULT
 261 PARROT_CAN_RETURN_NULL
 262 static STRING *
 263 get_path(PARROT_INTERP, ARGMOD_NULLOK(STRING *lib), Parrot_dlopen_flags flags,
 264         ARGOUT(void **handle), ARGIN(STRING *wo_ext),
 265         ARGIN_NULLOK(STRING *ext))
 266 {
 267     ASSERT_ARGS(get_path)
 268     PMC * const iglobals  = interp->iglobals;
 269     PMC * const lib_paths = VTABLE_get_pmc_keyed_int(interp, iglobals,
 270                                                      IGLOBALS_LIB_PATHS);
 271     PMC * const share_ext = VTABLE_get_pmc_keyed_int(interp, lib_paths,
 272                                                      PARROT_LIB_DYN_EXTS);
 273
 274     STRING *path, *full_name;
 275
 276     if (! lib) {
 277         *handle = Parrot_dlopen((char *)NULL, flags);
 278         if (*handle)
 279             return CONST_STRING(interp, "");
 280         else {
 281             const char *err = Parrot_dlerror();
 282             Parrot_warn(interp, PARROT_WARNINGS_DYNEXT_FLAG,
 283                         "Couldn't dlopen(NULL): %s\n",
 284                         err ? err : "unknown reason");
 285             /* clear the error memory */
 286             (void)Parrot_dlerror();
 287             return NULL;
 288         }
 289     }
 290
 291     /* first, try to add an extension to the file if it has none */
 292     if (! ext) {
 293         const INTVAL n = VTABLE_elements(interp, share_ext);
 294         INTVAL       i;
 295
 296         for (i = 0; i < n; ++i) {
 297             ext       = VTABLE_get_string_keyed_int(interp, share_ext, i);
 298             full_name = Parrot_str_concat(interp, wo_ext, ext);
 299             path      = Parrot_locate_runtime_file_str(interp, full_name,
 300                             PARROT_RUNTIME_FT_DYNEXT);
 301
 302             if (path) {
 303                 *handle = dlopen_string(interp, flags, path);
 304
 305                 if (*handle)
 306                     return path;
 307                 else {
 308                     const char *err = Parrot_dlerror();
 309                     Parrot_warn(interp, PARROT_WARNINGS_DYNEXT_FLAG,
 310                                 "Couldn't load '%Ss': %s\n",
 311                             full_name, err ? err : "unknown reason");
 312                     /* clear the error memory */
 313                     (void)Parrot_dlerror();
 314                     return NULL;
 315                 }
 316             }
 317
 318             /* File not found with extension and prefix; try file.extension */
 319             *handle = dlopen_string(interp, flags, full_name);
 320             if (*handle)
 321                 return full_name;
 322         }
 323     }
 324
 325     /*
 326      * finally, try the given file name as is. We still use
 327      * Parrot_locate_runtime_file so that (a) relative pathnames are searched in
 328      * the standard locations, and (b) the angle of the slashes are adjusted as
 329      * required for non-Unix systems.
 330      */
 331
 332     full_name = Parrot_locate_runtime_file_str(interp, lib,
 333                     PARROT_RUNTIME_FT_DYNEXT);
 334
 335     if (full_name) {
 336         *handle = dlopen_string(interp, flags, full_name);
 337
 338         if (*handle)
 339             return full_name;
 340     }
 341
 342     /*
 343      * and on windows strip a leading "lib"
 344      * [shouldn't this happen in Parrot_locate_runtime_file instead?]
 345      */
 346 #ifdef WIN32
 347     if (!STRING_IS_EMPTY(lib) && memcmp(lib->strstart, "lib", 3) == 0) {
 348         *handle = Parrot_dlopen((char *)lib->strstart + 3, 0);
 349
 350         if (*handle)
 351             return Parrot_str_substr(interp, lib, 3, lib->strlen - 3);
 352     }
 353 #endif
 354
 355     /* And on cygwin replace a leading "lib" by "cyg". */
 356 #ifdef __CYGWIN__
 357     if (!STRING_IS_EMPTY(lib) && memcmp(lib->strstart, "lib", 3) == 0) {
 358         path = Parrot_str_concat(interp, CONST_STRING(interp, "cyg"),
 359             Parrot_str_substr(interp, lib, 3, lib->strlen - 3));
 360
 361         *handle = dlopen_string(interp, flags, path);
 362
 363         if (*handle)
 364             return path;
 365     }
 366 #endif
 367
 368     if (STRING_IS_EMPTY(lib)) {
 369         *handle = dlopen_string(interp, flags, lib);
 370         if (*handle)
 371             return lib;
 372     }
 373     /* And after-finally,  let the OS use his own search */
 374     {
 375         const char *err = Parrot_dlerror();
 376         Parrot_warn(interp, PARROT_WARNINGS_DYNEXT_FLAG,
 377                     "Couldn't load '%Ss': %s\n",
 378                     lib, err ? err : "unknown reason");
 379
 380         /* clear the error memory */
 381         (void)Parrot_dlerror();
 382         return NULL;
 383     }
 384 }
 385
 386
 387 /*
 388
 389 =item C<PMC * Parrot_init_lib(PARROT_INTERP, dynext_load_func load_func,
 390 dynext_init_func init_func)>
 391
 392 Initializes a new library. First, calls C<load_func> to load the library
 393 (if C<load_func> is provided) and then calls C<init_func>. Returns a
 394 ParrotLibrary PMC object that represents the initialized library.
 395
 396 =cut
 397
 398 */
 399
 400 PARROT_EXPORT
 401 PARROT_CANNOT_RETURN_NULL
 402 PMC *
 403 Parrot_init_lib(PARROT_INTERP,
 404         NULLOK(dynext_load_func load_func),
 405         NULLOK(dynext_init_func init_func))
 406 {
 407     ASSERT_ARGS(Parrot_init_lib)
 408     PMC *lib_pmc = NULL;
 409
 410     if (load_func)
 411         lib_pmc = (*load_func)(interp);
 412
 413     /* seems to be a native/NCI lib */
 414     if (!load_func || !lib_pmc)
 415         lib_pmc = Parrot_pmc_new_constant(interp, enum_class_ParrotLibrary);
 416
 417     /*  Call init, if it exists */
 418     if (init_func)
 419         (init_func)(interp, lib_pmc);
 420
 421     return lib_pmc;
 422 }
 423
 424
 425 /*
 426
 427 =item C<void * Parrot_dlsym_str(PARROT_INTERP, void *handle, STRING *symbol)>
 428
 429 Loads a symbol named C<symbol> from the shared library represented by
 430 C<handle>.
 431
 432 =cut
 433
 434 */
 435
 436 PARROT_EXPORT
 437 PARROT_CAN_RETURN_NULL
 438 void *
 439 Parrot_dlsym_str(PARROT_INTERP,
 440         ARGIN_NULLOK(void *handle), ARGIN_NULLOK(STRING *symbol))
 441 {
 442     ASSERT_ARGS(Parrot_dlsym_str)
 443
 444     if (STRING_IS_NULL(symbol))
 445         return NULL;
 446
 447     else {
 448         char *const symbol_cs = Parrot_str_to_cstring(interp, symbol);
 449         void       *ptr       = Parrot_dlsym(handle, symbol_cs);
 450         Parrot_str_free_cstring(symbol_cs);
 451         return ptr;
 452     }
 453 }
 454
 455
 456 /*
 457
 458 =item C<static PMC * run_init_lib(PARROT_INTERP, void *handle, STRING *lib_name,
 459 STRING *wo_ext)>
 460
 461 Loads and initializes a new library and returns a ParrotLibrary PMC.  Takes the
 462 name of a library C<lib_name>, that is loaded with handle C<handle>.  Calls the
 463 necessary initialization routines, if any.
 464
 465 =cut
 466
 467 */
 468
 469 PARROT_CANNOT_RETURN_NULL
 470 static PMC *
 471 run_init_lib(PARROT_INTERP, ARGIN(void *handle),
 472         ARGIN_NULLOK(STRING *lib_name), ARGIN(STRING *wo_ext))
 473 {
 474     ASSERT_ARGS(run_init_lib)
 475     STRING *type;
 476     PMC *(*load_func)(PARROT_INTERP);
 477     void (*init_func)(PARROT_INTERP, PMC *);
 478     PMC *lib_pmc;
 479
 480     UINTVAL regs_used[]     = { 2, 2, 2, 2 }; /* Arbitrary values */
 481     const int parrot_hll_id = 0;
 482     PMC * context = Parrot_push_context(interp, regs_used);
 483     Parrot_pcc_set_HLL(interp, context, parrot_hll_id);
 484     Parrot_pcc_set_namespace(interp, context,
 485             Parrot_get_HLL_namespace(interp, parrot_hll_id));
 486
 487     if (lib_name) {
 488         STRING * const load_name       = Parrot_sprintf_c(interp,
 489                                         "Parrot_lib_%Ss_load", lib_name);
 490         STRING * const init_func_name  = Parrot_sprintf_c(interp,
 491                                         "Parrot_lib_%Ss_init", lib_name);
 492
 493         /* get load_func */
 494         void * dlsymfunc = Parrot_dlsym_str(interp, handle, load_name);
 495         load_func = (PMC * (*)(PARROT_INTERP)) D2FPTR(dlsymfunc);
 496
 497         /* get init_func */
 498         dlsymfunc = Parrot_dlsym_str(interp, handle, init_func_name);
 499         init_func = (void (*)(PARROT_INTERP, PMC *)) D2FPTR(dlsymfunc);
 500     }
 501     else {
 502         load_func = NULL;
 503         init_func = NULL;
 504     }
 505
 506     lib_pmc = Parrot_init_lib(interp, load_func, init_func);
 507     VTABLE_set_pointer(interp, lib_pmc, handle);
 508
 509     if (!load_func)
 510         type = CONST_STRING(interp, "NCI");
 511     else {
 512         if (((Parrot_ParrotLibrary_attributes *)PMC_data(lib_pmc))->oplib_init)
 513             type = CONST_STRING(interp, "Ops");
 514         else
 515             type = CONST_STRING(interp, "PMC");
 516     }
 517
 518     /* remember lib_pmc in iglobals */
 519     store_lib_pmc(interp, lib_pmc, wo_ext, type, lib_name);
 520
 521     Parrot_pop_context(interp);
 522
 523     return lib_pmc;
 524 }
 525
 526
 527 /*
 528
 529 =item C<static STRING * clone_string_into(Interp *d, Interp *s, PMC *value)>
 530
 531 Extracts a STRING value from PMC C<value> in interpreter C<s>. Copies that
 532 string into the pool of interpreter C<d> using the default encoding.
 533
 534 =cut
 535
 536 */
 537
 538 PARROT_WARN_UNUSED_RESULT
 539 PARROT_CANNOT_RETURN_NULL
 540 static STRING *
 541 clone_string_into(ARGMOD(Interp *d), ARGIN(Interp *s), ARGIN(PMC *value))
 542 {
 543     ASSERT_ARGS(clone_string_into)
 544     STRING * const  orig    = VTABLE_get_string(s, value);
 545     char   * const  raw_str = Parrot_str_to_cstring(s, orig);
 546     STRING * const  ret     =
 547         Parrot_str_new_init(d, raw_str, strlen(raw_str),
 548             Parrot_default_encoding_ptr,
 549             PObj_constant_FLAG);
 550     Parrot_str_free_cstring(raw_str);
 551     return ret;
 552 }
 553
 554
 555 /*
 556
 557 =item C<static PMC * make_string_pmc(PARROT_INTERP, STRING *string)>
 558
 559 Converts a STRING C<string> into a String PMC.
 560
 561 =cut
 562
 563 */
 564
 565 PARROT_WARN_UNUSED_RESULT
 566 PARROT_CANNOT_RETURN_NULL
 567 static PMC *
 568 make_string_pmc(PARROT_INTERP, ARGIN(STRING *string))
 569 {
 570     ASSERT_ARGS(make_string_pmc)
 571     PMC * const ret = Parrot_pmc_new_constant(interp, enum_class_String);
 572     VTABLE_set_string_native(interp, ret, string);
 573
 574     return ret;
 575 }
 576
 577
 578 /*
 579
 580 =item C<PMC * Parrot_clone_lib_into(Interp *d, Interp *s, PMC *lib_pmc)>
 581
 582 Clones a ParrotLibrary PMC C<lib_pmc> from interpreter C<s> into interpreter
 583 C<d>.
 584
 585 =cut
 586
 587 */
 588
 589 PARROT_EXPORT
 590 PARROT_WARN_UNUSED_RESULT
 591 PARROT_CANNOT_RETURN_NULL
 592 PMC *
 593 Parrot_clone_lib_into(ARGMOD(Interp *d), ARGMOD(Interp *s), ARGIN(PMC *lib_pmc))
 594 {
 595     ASSERT_ARGS(Parrot_clone_lib_into)
 596     STRING * const filename = CONST_STRING(s, "_filename");
 597     STRING * const libname  = CONST_STRING(s, "_lib_name");
 598     STRING * const type_str = CONST_STRING(s, "_type");
 599     STRING * const ops      = CONST_STRING(s, "Ops");
 600
 601     STRING * const wo_ext = clone_string_into(d, s,
 602         VTABLE_getprop(s, lib_pmc, filename));
 603     STRING * const lib_name = clone_string_into(d, s,
 604         VTABLE_getprop(s, lib_pmc, libname));
 605     void * const handle = VTABLE_get_pointer(s, lib_pmc);
 606     STRING * const type =
 607         VTABLE_get_string(s, VTABLE_getprop(s, lib_pmc, type_str));
 608
 609     if (Parrot_str_equal(s, type, ops)) {
 610         /* we can't clone oplibs in the normal way, since they're actually
 611          * shared between interpreters dynop_register modifies the (statically
 612          * allocated) op_lib_t structure from core_ops.c, for example.
 613          * Anyways, if we hope to share bytecode at runtime, we need to have
 614          * them have identical opcodes anyways.
 615          */
 616          PMC * const new_lib_pmc = Parrot_pmc_new_constant(d,
 617                                         enum_class_ParrotLibrary);
 618
 619         PMC_data(new_lib_pmc) = handle;
 620         VTABLE_setprop(d, new_lib_pmc, CONST_STRING(s, "_filename"), make_string_pmc(d, wo_ext));
 621         VTABLE_setprop(d, new_lib_pmc, CONST_STRING(s, "_lib_name"), make_string_pmc(d, lib_name));
 622         VTABLE_setprop(d, new_lib_pmc, CONST_STRING(s, "_type"), make_string_pmc(d, ops));
 623
 624         /* fixup d->all_op_libs, if necessary */
 625         if (d->n_libs != s->n_libs) {
 626             INTVAL i;
 627             if (d->all_op_libs)
 628                 d->all_op_libs
 629                     = (op_lib_t **)mem_internal_realloc(d->all_op_libs,
 630                         sizeof (op_lib_t *) * s->n_libs);
 631             else
 632                 d->all_op_libs
 633                     = (op_lib_t **)mem_internal_allocate(sizeof (op_lib_t *) *
 634                         s->n_libs);
 635             for (i = d->n_libs; i < s->n_libs; ++i)
 636                 d->all_op_libs[i] = s->all_op_libs[i];
 637             d->n_libs = s->n_libs;
 638         }
 639
 640         return new_lib_pmc;
 641     }
 642
 643     return run_init_lib(d, handle, lib_name, wo_ext);
 644 }
 645
 646
 647 /*
 648
 649 =item C<PMC * Parrot_load_lib(PARROT_INTERP, STRING *lib, PMC *parameters)>
 650
 651 Dynamic library loader.
 652
 653 C<parameters>, if not null, points to something which controls library
 654 loading and initialization.  Currently just its integer value is used,
 655 interpreted as C<Parrot_dlopen_flags>.
 656
 657 Calls C<Parrot_lib_%s_load()> which performs the registration of the lib
 658 once C<Parrot_lib_%s_init()> gets called (if exists) to perform thread
 659 specific setup. In both functions C<%s> is the name of the library.
 660
 661 If Parrot_lib_%s_load() succeeds, it should either return a
 662 ParrotLibrary PMC, which is then used as the handle for this library
 663 or NULL, in which case parrot creates a handle for the library.
 664
 665 If either Parrot_lib_%s_load() or Parrot_lib_%s_init() detects an error
 666 condition, an exception should be thrown.
 667
 668 TODO: fetch Parrot_lib load/init handler exceptions
 669
 670 =cut
 671
 672 */
 673
 674 PARROT_EXPORT
 675 PARROT_WARN_UNUSED_RESULT
 676 PARROT_CANNOT_RETURN_NULL
 677 PMC *
 678 Parrot_load_lib(PARROT_INTERP, ARGIN_NULLOK(STRING *lib), ARGIN_NULLOK(PMC *parameters))
 679 {
 680     ASSERT_ARGS(Parrot_load_lib)
 681     void   *handle;
 682     PMC    *lib_pmc;
 683     STRING *path;
 684     STRING *lib_name, *wo_ext, *ext;    /* library stem without path
 685                                          * or extension.  */
 686     int flags = 0;
 687     /* Find the pure library name, without path or extension.  */
 688     /*
 689      * TODO move the class_count_mutex here
 690      *
 691      * LOCK()
 692      */
 693     if (lib)
 694         lib_name = parrot_split_path_ext(interp, lib, &wo_ext, &ext);
 695     else {
 696         wo_ext   = CONST_STRING(interp, "");
 697         lib_name = NULL;
 698         ext      = NULL;
 699     }
 700
 701     lib_pmc = is_loaded(interp, wo_ext);
 702
 703     /* UNLOCK() */
 704     if (!PMC_IS_NULL(lib_pmc))
 705         return lib_pmc;
 706
 707     if (!PMC_IS_NULL(parameters))
 708         flags = VTABLE_get_integer(interp, parameters);
 709
 710     path = get_path(interp, lib, (Parrot_dlopen_flags)flags, &handle, wo_ext, ext);
 711
 712     /*
 713      * XXX Parrot_ex_throw_from_c_args? return PMCNULL?
 714      * PMC Undef seems convenient, because it can be queried with get_bool()
 715      */
 716     if (!path || !handle)
 717         return Parrot_pmc_new(interp, enum_class_Undef);
 718
 719     return run_init_lib(interp, handle, lib_name, wo_ext);
 720 }
 721
 722
 723 /*
 724
 725 =back
 726
 727 =head1 SEE ALSO
 728
 729 F<include/parrot/dynext.h> and F<src/pmc/parrotlibrary.pmc>.
 730
 731 =cut
 732
 733 */
 734
 735
 736 /*
 737  * Local variables:
 738  *   c-file-style: "parrot"
 739  * End:
 740  * vim: expandtab shiftwidth=4:
 741  */