src/dynext.c

   1 /*
   2 Copyright (C) 2001-2008, The Perl Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/dynext.c - Dynamic extensions to Parrot
   8
   9 =head1 DESCRIPTION
  10
  11 =head2 Functions
  12
  13 =over 4
  14
  15 =cut
  16
  17 */
  18
  19 #include "parrot/parrot.h"
  20 #include "parrot/dynext.h"
  21 #include "dynext.str"
  22
  23 /* HEADERIZER HFILE: include/parrot/dynext.h */
  24
  25 /* HEADERIZER BEGIN: static */
  26 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  27
  28 PARROT_WARN_UNUSED_RESULT
  29 PARROT_CANNOT_RETURN_NULL
  30 static STRING * clone_string_into(
  31     ARGMOD(Interp *d),
  32     ARGIN(Interp *s),
  33     ARGIN(PMC *value))
  34         __attribute__nonnull__(1)
  35         __attribute__nonnull__(2)
  36         __attribute__nonnull__(3)
  37         FUNC_MODIFIES(*d);
  38
  39 PARROT_WARN_UNUSED_RESULT
  40 PARROT_CAN_RETURN_NULL
  41 static STRING * get_path(PARROT_INTERP,
  42     ARGMOD(STRING *lib),
  43     ARGOUT(void **handle),
  44     ARGIN(STRING *wo_ext),
  45     ARGIN_NULLOK(STRING *ext))
  46         __attribute__nonnull__(1)
  47         __attribute__nonnull__(2)
  48         __attribute__nonnull__(3)
  49         __attribute__nonnull__(4)
  50         FUNC_MODIFIES(*lib)
  51         FUNC_MODIFIES(*handle);
  52
  53 PARROT_WARN_UNUSED_RESULT
  54 PARROT_CAN_RETURN_NULL
  55 static PMC* is_loaded(PARROT_INTERP, ARGIN(STRING *path))
  56         __attribute__nonnull__(1)
  57         __attribute__nonnull__(2);
  58
  59 PARROT_WARN_UNUSED_RESULT
  60 PARROT_CANNOT_RETURN_NULL
  61 static PMC * make_string_pmc(PARROT_INTERP, ARGIN(STRING *string))
  62         __attribute__nonnull__(1)
  63         __attribute__nonnull__(2);
  64
  65 PARROT_CANNOT_RETURN_NULL
  66 static PMC * run_init_lib(PARROT_INTERP,
  67     ARGIN(void *handle),
  68     ARGIN(STRING *lib_name),
  69     ARGIN(STRING *wo_ext))
  70         __attribute__nonnull__(1)
  71         __attribute__nonnull__(2)
  72         __attribute__nonnull__(3)
  73         __attribute__nonnull__(4);
  74
  75 static void set_cstring_prop(PARROT_INTERP,
  76     ARGMOD(PMC *lib_pmc),
  77     ARGIN(const char *what),
  78     ARGIN(STRING *name))
  79         __attribute__nonnull__(1)
  80         __attribute__nonnull__(2)
  81         __attribute__nonnull__(3)
  82         __attribute__nonnull__(4)
  83         FUNC_MODIFIES(*lib_pmc);
  84
  85 static void store_lib_pmc(PARROT_INTERP,
  86     ARGIN(PMC *lib_pmc),
  87     ARGIN(STRING *path),
  88     ARGIN(STRING *type),
  89     ARGIN(STRING *lib_name))
  90         __attribute__nonnull__(1)
  91         __attribute__nonnull__(2)
  92         __attribute__nonnull__(3)
  93         __attribute__nonnull__(4)
  94         __attribute__nonnull__(5);
  95
  96 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  97 /* HEADERIZER END: static */
  98
  99 /* _PARROTLIB is now the default */
 100 /*#define _PARROTLIB not working: "make testr" */
 101
 102 /*
 103
 104 =item C<static void set_cstring_prop>
 105
 106 Set a property C<name> with value C<what> on the C<ParrotLibrary>
 107 C<lib_pmc>.
 108
 109 =cut
 110
 111 */
 112
 113 static void
 114 set_cstring_prop(PARROT_INTERP, ARGMOD(PMC *lib_pmc), ARGIN(const char *what),
 115         ARGIN(STRING *name))
 116 {
 117     STRING * const key  = const_string(interp, what);
 118     PMC    * const prop = constant_pmc_new(interp, enum_class_String);
 119
 120     VTABLE_set_string_native(interp, prop, name);
 121     VTABLE_setprop(interp, lib_pmc, key, prop);
 122 }
 123
 124 /*
 125
 126 =item C<static void store_lib_pmc>
 127
 128 Store a C<ParrotLibrary> PMC in the interpreter's C<iglobals>.
 129
 130 =cut
 131
 132 */
 133
 134 static void
 135 store_lib_pmc(PARROT_INTERP, ARGIN(PMC *lib_pmc), ARGIN(STRING *path),
 136         ARGIN(STRING *type), ARGIN(STRING *lib_name))
 137 {
 138     PMC * const iglobals = interp->iglobals;
 139     PMC * const dyn_libs = VTABLE_get_pmc_keyed_int(interp, iglobals,
 140             IGLOBALS_DYN_LIBS);
 141
 142     /* remember path/file in props */
 143     set_cstring_prop(interp, lib_pmc, "_filename", path);  /* XXX */
 144     set_cstring_prop(interp, lib_pmc, "_type", type);
 145
 146     if (lib_name)
 147         set_cstring_prop(interp, lib_pmc, "_lib_name", lib_name);
 148
 149     VTABLE_set_pmc_keyed_str(interp, dyn_libs, path, lib_pmc);
 150 }
 151
 152 /*
 153
 154 =item C<static PMC* is_loaded>
 155
 156 Check if a C<ParrotLibrary> PMC with the filename path exists.
 157 If it does, return it. Otherwise, return NULL.
 158
 159 =cut
 160
 161 */
 162
 163 PARROT_WARN_UNUSED_RESULT
 164 PARROT_CAN_RETURN_NULL
 165 static PMC*
 166 is_loaded(PARROT_INTERP, ARGIN(STRING *path))
 167 {
 168     PMC * const iglobals = interp->iglobals;
 169     PMC * const dyn_libs = VTABLE_get_pmc_keyed_int(interp, iglobals,
 170             IGLOBALS_DYN_LIBS);
 171     if (!VTABLE_exists_keyed_str(interp, dyn_libs, path))
 172         return PMCNULL;
 173     return VTABLE_get_pmc_keyed_str(interp, dyn_libs, path);
 174 }
 175
 176 /*
 177
 178 =item C<static STRING * get_path>
 179
 180 Return path and handle of a dynamic lib, setting lib_name to just the filestem
 181 (i.e. without path or extension) as a freshly-allocated C string.
 182
 183 =cut
 184
 185 */
 186
 187 PARROT_WARN_UNUSED_RESULT
 188 PARROT_CAN_RETURN_NULL
 189 static STRING *
 190 get_path(PARROT_INTERP, ARGMOD(STRING *lib), ARGOUT(void **handle),
 191         ARGIN(STRING *wo_ext), ARGIN_NULLOK(STRING *ext))
 192 {
 193     STRING *path, *full_name;
 194     const char *err = NULL;    /* buffer returned from Parrot_dlerror */
 195
 196     PMC * const iglobals = interp->iglobals;
 197     PMC * const lib_paths = VTABLE_get_pmc_keyed_int(interp, iglobals,
 198                                                      IGLOBALS_LIB_PATHS);
 199     PMC * const share_ext = VTABLE_get_pmc_keyed_int(interp, lib_paths,
 200                                                      PARROT_LIB_DYN_EXTS);
 201
 202     if (lib == NULL) {
 203         *handle = Parrot_dlopen((char *)NULL);
 204         if (*handle) {
 205             return string_from_literal(interp, "");
 206         }
 207         err = Parrot_dlerror();
 208         Parrot_warn(interp, PARROT_WARNINGS_DYNEXT_FLAG,
 209                     "Couldn't dlopen(NULL): %s\n",
 210                     err ? err : "unknown reason");
 211         return NULL;
 212     }
 213
 214     /*
 215      * first, try to add an extension to the file if it has none.
 216      */
 217     if (! ext) {
 218         const INTVAL n = VTABLE_elements(interp, share_ext);
 219         INTVAL i;
 220
 221         for (i = 0; i < n; ++i) {
 222             ext = VTABLE_get_string_keyed_int(interp, share_ext, i);
 223             full_name = string_concat(interp, wo_ext, ext, 0);
 224             path = Parrot_locate_runtime_file_str(interp, full_name,
 225                     PARROT_RUNTIME_FT_DYNEXT);
 226             if (path) {
 227                 *handle = Parrot_dlopen(path->strstart);
 228                 if (*handle) {
 229                     return path;
 230                 }
 231                 err = Parrot_dlerror();
 232                 Parrot_warn(interp, PARROT_WARNINGS_DYNEXT_FLAG,
 233                             "Couldn't load '%Ss': %s\n",
 234                         full_name, err ? err : "unknown reason");
 235                 return NULL;
 236             }
 237
 238             /*
 239              * File with extension and prefix was not found,
 240              * so try file.extension w/o prefix
 241              */
 242             *handle = Parrot_dlopen(full_name->strstart);
 243             if (*handle) {
 244                 return full_name;
 245             }
 246         }
 247     }
 248     /*
 249      * finally, try the given file name as is. We still use
 250      * Parrot_locate_runtime_file so that (a) relative pathnames are searched in
 251      * the standard locations, and (b) the angle of the slashes are adjusted as
 252      * required for non-Unix systems.
 253      */
 254     full_name = Parrot_locate_runtime_file_str(interp, lib,
 255             PARROT_RUNTIME_FT_DYNEXT);
 256     if (full_name) {
 257         *handle = Parrot_dlopen((char *)full_name->strstart);
 258         if (*handle) {
 259             return full_name;
 260         }
 261     }
 262     /*
 263      * and on windows strip a leading "lib"
 264      * [shouldn't this happen in Parrot_locate_runtime_file instead?]
 265      */
 266 #ifdef WIN32
 267     if (!STRING_IS_EMPTY(lib) && memcmp(lib->strstart, "lib", 3) == 0) {
 268         *handle = Parrot_dlopen((char*)lib->strstart + 3);
 269         if (*handle) {
 270             path = string_substr(interp, lib, 3, lib->strlen - 3, NULL, 0);
 271             return path;
 272         }
 273     }
 274 #endif
 275
 276     /* And on cygwin replace a leading "lib" by "cyg". */
 277 #ifdef __CYGWIN__
 278     if (!STRING_IS_EMPTY(lib) && memcmp(lib->strstart, "lib", 3) == 0) {
 279         path = string_append(interp, CONST_STRING(interp, "cyg"),
 280             string_substr(interp, lib, 3, lib->strlen - 3, NULL, 0));
 281
 282         *handle           = Parrot_dlopen(path->strstart);
 283
 284         if (*handle)
 285             return path;
 286     }
 287 #endif
 288     err = Parrot_dlerror();
 289     Parrot_warn(interp, PARROT_WARNINGS_DYNEXT_FLAG,
 290                 "Couldn't load '%Ss': %s\n",
 291                 lib, err ? err : "unknown reason");
 292     return NULL;
 293 }
 294
 295 /*
 296
 297 =item C<PMC * Parrot_init_lib>
 298
 299 RT#48260: Not yet documented!!!
 300
 301 =cut
 302
 303 */
 304
 305 PARROT_API
 306 PARROT_CANNOT_RETURN_NULL
 307 PMC *
 308 Parrot_init_lib(PARROT_INTERP,
 309                 ARGIN_NULLOK(PMC *(*load_func)(PARROT_INTERP)),
 310                 ARGIN_NULLOK(void (*init_func)(PARROT_INTERP, ARGIN_NULLOK(PMC *))))
 311 {
 312     PMC *lib_pmc = NULL;
 313
 314     if (load_func)
 315         lib_pmc = (*load_func)(interp);
 316
 317     /* seems to be a native/NCI lib */
 318     if (!load_func || !lib_pmc)
 319         lib_pmc = constant_pmc_new(interp, enum_class_ParrotLibrary);
 320
 321     /*  Call init, if it exists */
 322     if (init_func)
 323         (init_func)(interp, lib_pmc);
 324
 325     return lib_pmc;
 326 }
 327
 328 /*
 329
 330 =item C<static PMC * run_init_lib>
 331
 332 RT#48260: Not yet documented!!!
 333
 334 =cut
 335
 336 */
 337
 338 PARROT_CANNOT_RETURN_NULL
 339 static PMC *
 340 run_init_lib(PARROT_INTERP, ARGIN(void *handle),
 341         ARGIN(STRING *lib_name), ARGIN(STRING *wo_ext))
 342 {
 343     STRING *type;
 344     PMC *(*load_func)(PARROT_INTERP);
 345     void (*init_func)(PARROT_INTERP, PMC *);
 346     char *cinit_func_name;
 347     PMC *lib_pmc;
 348
 349     /*
 350      * work around gcc 3.3.3 and other problem with dynpmcs
 351      * something during library loading doesn't stand a DOD run
 352      */
 353     Parrot_block_GC_mark(interp);
 354
 355     /* get load_func */
 356     if (lib_name) {
 357         STRING * const load_func_name = Parrot_sprintf_c(interp,
 358                                         "Parrot_lib_%Ss_load", lib_name);
 359         char * const cload_func_name = string_to_cstring(interp, load_func_name);
 360         STRING *init_func_name;
 361
 362         load_func    = (PMC * (*)(PARROT_INTERP))
 363             (Parrot_dlsym(handle, cload_func_name));
 364
 365         string_cstring_free(cload_func_name);
 366
 367         /* get init_func */
 368         init_func_name  = Parrot_sprintf_c(interp, "Parrot_lib_%Ss_init",
 369                                           lib_name);
 370         cinit_func_name = string_to_cstring(interp, init_func_name);
 371         init_func      = (void (*)(PARROT_INTERP, PMC *))(Parrot_dlsym(handle,
 372                     cinit_func_name));
 373         string_cstring_free(cinit_func_name);
 374     }
 375     else {
 376         load_func = NULL;
 377         init_func = NULL;
 378     }
 379
 380     lib_pmc = Parrot_init_lib(interp, load_func, init_func);
 381     VTABLE_set_pointer(interp, lib_pmc, handle);
 382
 383     if (!load_func)
 384         type = CONST_STRING(interp, "NCI");
 385     else {
 386         /* we could set a private flag in the PMC header too
 387          * but currently only ops files have struct_val set */
 388
 389         if (PMC_struct_val(lib_pmc))
 390             type = CONST_STRING(interp, "Ops");
 391         else
 392             type = CONST_STRING(interp, "PMC");
 393     }
 394
 395     /* remember lib_pmc in iglobals */
 396     store_lib_pmc(interp, lib_pmc, wo_ext, type, lib_name);
 397
 398     /* UNLOCK */
 399     Parrot_unblock_GC_mark(interp);
 400
 401     return lib_pmc;
 402 }
 403
 404 /*
 405
 406 =item C<static STRING * clone_string_into>
 407
 408 RT#48260: Not yet documented!!!
 409
 410 =cut
 411
 412 */
 413
 414 PARROT_WARN_UNUSED_RESULT
 415 PARROT_CANNOT_RETURN_NULL
 416 static STRING *
 417 clone_string_into(ARGMOD(Interp *d), ARGIN(Interp *s), ARGIN(PMC *value))
 418 {
 419     STRING * const orig = VTABLE_get_string(s, value);
 420     char * const raw_str = string_to_cstring(s, orig);
 421     STRING * const ret =
 422         string_make_direct(d, raw_str, strlen(raw_str),
 423             PARROT_DEFAULT_ENCODING, PARROT_DEFAULT_CHARSET,
 424             PObj_constant_FLAG);
 425     string_cstring_free(raw_str);
 426     return ret;
 427 }
 428
 429 /*
 430
 431 =item C<static PMC * make_string_pmc>
 432
 433 RT#48260: Not yet documented!!!
 434
 435 =cut
 436
 437 */
 438
 439 PARROT_WARN_UNUSED_RESULT
 440 PARROT_CANNOT_RETURN_NULL
 441 static PMC *
 442 make_string_pmc(PARROT_INTERP, ARGIN(STRING *string))
 443 {
 444     PMC * const ret = VTABLE_new_from_string(interp,
 445         interp->vtables[enum_class_String]->pmc_class,
 446         string, PObj_constant_FLAG);
 447     return ret;
 448 }
 449
 450 /*
 451
 452 =item C<PMC * Parrot_clone_lib_into>
 453
 454 RT#48260: Not yet documented!!!
 455
 456 =cut
 457
 458 */
 459
 460 PARROT_API
 461 PARROT_WARN_UNUSED_RESULT
 462 PARROT_CANNOT_RETURN_NULL
 463 PMC *
 464 Parrot_clone_lib_into(ARGMOD(Interp *d), ARGMOD(Interp *s), ARGIN(PMC *lib_pmc))
 465 {
 466     STRING * const wo_ext = clone_string_into(d, s,
 467         VTABLE_getprop(s, lib_pmc, CONST_STRING(s, "_filename")));
 468     STRING * const lib_name = clone_string_into(d, s,
 469         VTABLE_getprop(s, lib_pmc, CONST_STRING(s, "_lib_name")));
 470     void * const handle = PMC_data(lib_pmc);
 471     STRING * const type =
 472         VTABLE_get_string(s, VTABLE_getprop(s, lib_pmc, CONST_STRING(s, "_type")));
 473     STRING * const ops  = CONST_STRING(s, "Ops");
 474
 475     if (!string_equal(s, type, ops)) {
 476         /* we can't clone oplibs in the normal way, since they're actually
 477          * shared between interpreters dynop_register modifies the (statically
 478          * allocated) op_lib_t structure from core_ops.c, for example.
 479          * Anyways, if we hope to share bytecode at runtime, we need to have
 480          * them have identical opcodes anyways.
 481          */
 482         PMC * const new_lib_pmc = constant_pmc_new(d, enum_class_ParrotLibrary);
 483
 484         PMC_data(new_lib_pmc) = handle;
 485         VTABLE_setprop(d, new_lib_pmc, CONST_STRING(s, "_filename"), make_string_pmc(d, wo_ext));
 486         VTABLE_setprop(d, new_lib_pmc, CONST_STRING(s, "_lib_name"), make_string_pmc(d, lib_name));
 487         VTABLE_setprop(d, new_lib_pmc, CONST_STRING(s, "_type"), make_string_pmc(d, ops));
 488
 489         /* fixup d->all_op_libs, if necessary */
 490         if (d->n_libs != s->n_libs) {
 491             INTVAL i;
 492             if (d->all_op_libs)
 493                 d->all_op_libs = (op_lib_t **)mem_sys_realloc(d->all_op_libs,
 494                     sizeof (op_lib_t *) * s->n_libs);
 495             else
 496                 d->all_op_libs = (op_lib_t **)mem_sys_allocate(sizeof (op_lib_t *) *
 497                     s->n_libs);
 498             for (i = d->n_libs; i < s->n_libs; ++i)
 499                 d->all_op_libs[i] = s->all_op_libs[i];
 500             d->n_libs = s->n_libs;
 501         }
 502
 503         return new_lib_pmc;
 504     }
 505     else {
 506         return run_init_lib(d, handle, lib_name, wo_ext);
 507     }
 508 }
 509
 510 /*
 511
 512 =item C<PMC * Parrot_load_lib>
 513
 514 Dynamic library loader.
 515
 516 C<initializer> is currently unused.
 517
 518 Calls C<Parrot_lib_%s_load()> which performs the registration of the lib
 519 once C<Parrot_lib_%s_init()> gets called (if exists) to perform thread
 520 specific setup. In both functions C<%s> is the name of the library.
 521
 522 If Parrot_lib_%s_load() succeeds, it should either return a
 523 ParrotLibrary PMC, which is then used as the handle for this library
 524 or NULL, in which case parrot creates a handle for the library.
 525
 526 If either Parrot_lib_%s_load() or Parrot_lib_%s_init() detects an error
 527 condition, an exception should be thrown.
 528
 529 TODO: fetch Parrot_lib load/init handler exceptions
 530
 531 =cut
 532
 533 */
 534
 535 PARROT_API
 536 PARROT_WARN_UNUSED_RESULT
 537 PARROT_CANNOT_RETURN_NULL
 538 PMC *
 539 Parrot_load_lib(PARROT_INTERP, ARGIN_NULLOK(STRING *lib), SHIM(PMC *initializer))
 540 {
 541     void   *handle;
 542     PMC    *lib_pmc;
 543     STRING *path;
 544     STRING *lib_name, *wo_ext, *ext;    /* library stem without path
 545                                          * or extension.  */
 546     /* Find the pure library name, without path or extension.  */
 547     /*
 548      * TODO move the class_count_mutex here
 549      *
 550      * LOCK()
 551      */
 552     if (lib) {
 553         lib_name = parrot_split_path_ext(interp, lib, &wo_ext, &ext);
 554     }
 555     else {
 556         wo_ext   = string_from_literal(interp, "");
 557         lib_name = NULL;
 558         ext      = NULL;
 559     }
 560
 561     lib_pmc = is_loaded(interp, wo_ext);
 562     if (!PMC_IS_NULL(lib_pmc)) {
 563         /* UNLOCK() */
 564         return lib_pmc;
 565     }
 566
 567     path = get_path(interp, lib, &handle, wo_ext, ext);
 568     if (!path || !handle) {
 569         /*
 570          * XXX real_exception? return PMCNULL?
 571          * PMC Undef seems convenient, because it can be queried with get_bool()
 572          */
 573         return pmc_new(interp, enum_class_Undef);
 574     }
 575
 576     return run_init_lib(interp, handle, lib_name, wo_ext);
 577 }
 578
 579 /*
 580
 581 =back
 582
 583 =head1 SEE ALSO
 584
 585 F<include/parrot/dynext.h> and F<src/pmc/parrotlibrary.pmc>.
 586
 587 =head1 HISTORY
 588
 589 Initial rev by leo 2003.08.06.
 590
 591 =cut
 592
 593 */
 594
 595
 596 /*
 597  * Local variables:
 598  *   c-file-style: "parrot"
 599  * End:
 600  * vim: expandtab shiftwidth=4:
 601  */