src/library.c

   1 /*
   2 Copyright (C) 2004-2009, Parrot Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/library.c - Interface to Parrot's bytecode library
   8
   9 =head1 DESCRIPTION
  10
  11 This file contains C functions to access Parrot's bytecode library functions,
  12 for include files (via C<.include>), library files (via C<load_bytecode>), and
  13 dynext files (via C<loadlib>).
  14
  15 =head2 Functions
  16
  17 =over 4
  18
  19 =cut
  20
  21 */
  22
  23 #include "parrot/parrot.h"
  24 #include "parrot/dynext.h"
  25 #include "library.str"
  26
  27 /* HEADERIZER HFILE: include/parrot/library.h */
  28
  29 /* HEADERIZER BEGIN: static */
  30 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  31
  32 static void cnv_to_win32_filesep(ARGMOD(STRING *path))
  33         __attribute__nonnull__(1)
  34         FUNC_MODIFIES(*path);
  35
  36 PARROT_WARN_UNUSED_RESULT
  37 PARROT_CANNOT_RETURN_NULL
  38 static PMC* get_search_paths(PARROT_INTERP, enum_lib_paths which)
  39         __attribute__nonnull__(1);
  40
  41 PARROT_PURE_FUNCTION
  42 static int is_abs_path(ARGIN(const STRING *file))
  43         __attribute__nonnull__(1);
  44
  45 PARROT_WARN_UNUSED_RESULT
  46 PARROT_CANNOT_RETURN_NULL
  47 static STRING* path_append(PARROT_INTERP,
  48     ARGMOD(STRING *l_path),
  49     ARGMOD(STRING *r_path))
  50         __attribute__nonnull__(1)
  51         __attribute__nonnull__(2)
  52         __attribute__nonnull__(3)
  53         FUNC_MODIFIES(*l_path)
  54         FUNC_MODIFIES(*r_path);
  55
  56 PARROT_WARN_UNUSED_RESULT
  57 PARROT_CANNOT_RETURN_NULL
  58 static STRING* path_concat(PARROT_INTERP,
  59     ARGMOD(STRING *l_path),
  60     ARGMOD(STRING *r_path))
  61         __attribute__nonnull__(1)
  62         __attribute__nonnull__(2)
  63         __attribute__nonnull__(3)
  64         FUNC_MODIFIES(*l_path)
  65         FUNC_MODIFIES(*r_path);
  66
  67 PARROT_WARN_UNUSED_RESULT
  68 PARROT_CANNOT_RETURN_NULL
  69 static STRING* path_finalize(PARROT_INTERP, ARGMOD(STRING *path))
  70         __attribute__nonnull__(1)
  71         __attribute__nonnull__(2)
  72         FUNC_MODIFIES(*path);
  73
  74 PARROT_WARN_UNUSED_RESULT
  75 PARROT_CANNOT_RETURN_NULL
  76 static STRING* path_guarantee_trailing_separator(PARROT_INTERP,
  77     ARGMOD(STRING *path))
  78         __attribute__nonnull__(1)
  79         __attribute__nonnull__(2)
  80         FUNC_MODIFIES(*path);
  81
  82 PARROT_WARN_UNUSED_RESULT
  83 PARROT_CAN_RETURN_NULL
  84 static STRING* try_bytecode_extensions(PARROT_INTERP, ARGMOD(STRING* path))
  85         __attribute__nonnull__(1)
  86         __attribute__nonnull__(2)
  87         FUNC_MODIFIES(* path);
  88
  89 PARROT_WARN_UNUSED_RESULT
  90 PARROT_CAN_RETURN_NULL
  91 static STRING* try_load_path(PARROT_INTERP, ARGMOD(STRING* path))
  92         __attribute__nonnull__(1)
  93         __attribute__nonnull__(2)
  94         FUNC_MODIFIES(* path);
  95
  96 #define ASSERT_ARGS_cnv_to_win32_filesep __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
  97        PARROT_ASSERT_ARG(path))
  98 #define ASSERT_ARGS_get_search_paths __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
  99        PARROT_ASSERT_ARG(interp))
 100 #define ASSERT_ARGS_is_abs_path __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 101        PARROT_ASSERT_ARG(file))
 102 #define ASSERT_ARGS_path_append __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 103        PARROT_ASSERT_ARG(interp) \
 104     , PARROT_ASSERT_ARG(l_path) \
 105     , PARROT_ASSERT_ARG(r_path))
 106 #define ASSERT_ARGS_path_concat __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 107        PARROT_ASSERT_ARG(interp) \
 108     , PARROT_ASSERT_ARG(l_path) \
 109     , PARROT_ASSERT_ARG(r_path))
 110 #define ASSERT_ARGS_path_finalize __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 111        PARROT_ASSERT_ARG(interp) \
 112     , PARROT_ASSERT_ARG(path))
 113 #define ASSERT_ARGS_path_guarantee_trailing_separator \
 114      __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 115        PARROT_ASSERT_ARG(interp) \
 116     , PARROT_ASSERT_ARG(path))
 117 #define ASSERT_ARGS_try_bytecode_extensions __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 118        PARROT_ASSERT_ARG(interp) \
 119     , PARROT_ASSERT_ARG(path))
 120 #define ASSERT_ARGS_try_load_path __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 121        PARROT_ASSERT_ARG(interp) \
 122     , PARROT_ASSERT_ARG(path))
 123 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
 124 /* HEADERIZER END: static */
 125
 126
 127 /*
 128
 129 =item C<void parrot_init_library_paths(PARROT_INTERP)>
 130
 131 Create an array of StringArrays with library searchpaths and shared
 132 extension used for loading various files at runtime. The created
 133 structures looks like this:
 134
 135   lib_paths = [
 136     [ "runtime/parrot/include", ... ],   # paths for .include 'file'
 137     [ "runtime/parrot/library", ... ],   # paths for load_bytecode
 138     [ "runtime/parrot/dynext", ... ],    # paths for loadlib
 139     [ "languages", ... ],                # paths for languages
 140     [ ".so", ... ]                       # list of shared extensions
 141   ]
 142
 143 If the platform defines
 144
 145   #define PARROT_PLATFORM_LIB_PATH_INIT_HOOK the_init_hook
 146
 147 it will be called as a function with this prototype:
 148
 149   void the_init_hook(PARROT_INTERP, PMC *lib_paths);
 150
 151 Platform code may add, delete, or replace search path entries as needed. See
 152 also F<include/parrot/library.h> for C<enum_lib_paths>.
 153
 154 =cut
 155
 156 */
 157
 158 void
 159 parrot_init_library_paths(PARROT_INTERP)
 160 {
 161     ASSERT_ARGS(parrot_init_library_paths)
 162     PMC    *paths;
 163     STRING *entry;
 164     STRING *versionlib      = NULL;
 165     STRING *builddir        = NULL;
 166     PMC * const iglobals    = interp->iglobals;
 167     PMC * const config_hash = VTABLE_get_pmc_keyed_int(interp, iglobals,
 168                                 (INTVAL)IGLOBALS_CONFIG_HASH);
 169
 170     /* create the lib_paths array */
 171     PMC * const lib_paths   = Parrot_pmc_new_init_int(interp,
 172             enum_class_FixedPMCArray, PARROT_LIB_PATH_SIZE);
 173     VTABLE_set_pmc_keyed_int(interp, iglobals,
 174             IGLOBALS_LIB_PATHS, lib_paths);
 175
 176     if (VTABLE_elements(interp, config_hash)) {
 177         STRING * const libkey      = CONST_STRING(interp, "libdir");
 178         STRING * const verkey      = CONST_STRING(interp, "versiondir");
 179         STRING * const builddirkey = CONST_STRING(interp, "build_dir");
 180         STRING * const installed   = CONST_STRING(interp, "installed");
 181
 182         versionlib = VTABLE_get_string_keyed_str(interp, config_hash, libkey);
 183         entry      = VTABLE_get_string_keyed_str(interp, config_hash, verkey);
 184         versionlib = Parrot_str_concat(interp, versionlib, entry);
 185
 186         if (!VTABLE_get_integer_keyed_str(interp, config_hash, installed))
 187             builddir = VTABLE_get_string_keyed_str(interp,
 188                                 config_hash, builddirkey);
 189     }
 190
 191     /* each is an array of strings */
 192     /* define include paths */
 193     paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
 194     VTABLE_set_pmc_keyed_int(interp, lib_paths,
 195             PARROT_LIB_PATH_INCLUDE, paths);
 196     { /* EXPERIMENTAL: add include path from environment */
 197         const char *envvar = Parrot_getenv(interp,
 198                                            Parrot_str_new_constant(interp, "PARROT_INCLUDE"));
 199         if (envvar != NULL  && envvar[0]) {
 200             entry = Parrot_str_new(interp, envvar, 0);
 201             VTABLE_push_string(interp, paths, entry);
 202         }
 203     }
 204     if (!STRING_IS_NULL(builddir)) {
 205         entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/"));
 206         VTABLE_push_string(interp, paths, entry);
 207         entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/include/"));
 208         VTABLE_push_string(interp, paths, entry);
 209     }
 210     entry = CONST_STRING(interp, "./");
 211     VTABLE_push_string(interp, paths, entry);
 212     if (!STRING_IS_NULL(versionlib)) {
 213         entry = Parrot_str_concat(interp, versionlib, CONST_STRING(interp, "/include/"));
 214         VTABLE_push_string(interp, paths, entry);
 215     }
 216
 217     /* define library paths */
 218     paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
 219     VTABLE_set_pmc_keyed_int(interp, lib_paths,
 220             PARROT_LIB_PATH_LIBRARY, paths);
 221     { /* EXPERIMENTAL: add library path from environment */
 222         const char *envvar = Parrot_getenv(interp,
 223                                            Parrot_str_new_constant(interp, "PARROT_LIBRARY"));
 224         if (envvar != NULL && envvar[0]) {
 225             entry = Parrot_str_new(interp, envvar, 0);
 226             VTABLE_push_string(interp, paths, entry);
 227         }
 228     }
 229     if (!STRING_IS_NULL(builddir)) {
 230         entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/library/"));
 231         VTABLE_push_string(interp, paths, entry);
 232     }
 233     entry = CONST_STRING(interp, "./");
 234     VTABLE_push_string(interp, paths, entry);
 235     if (!STRING_IS_NULL(versionlib)) {
 236         entry = Parrot_str_concat(interp, versionlib, CONST_STRING(interp, "/library/"));
 237         VTABLE_push_string(interp, paths, entry);
 238     }
 239
 240     /* define languages paths */
 241     paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
 242     VTABLE_set_pmc_keyed_int(interp, lib_paths,
 243             PARROT_LIB_PATH_LANG, paths);
 244     if (!STRING_IS_NULL(builddir)) {
 245         entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/languages/"));
 246         VTABLE_push_string(interp, paths, entry);
 247     }
 248     entry = CONST_STRING(interp, "./");
 249     VTABLE_push_string(interp, paths, entry);
 250     if (!STRING_IS_NULL(versionlib)) {
 251         entry = Parrot_str_concat(interp, versionlib, CONST_STRING(interp, "/languages/"));
 252         VTABLE_push_string(interp, paths, entry);
 253     }
 254
 255     /* define dynext paths */
 256     paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
 257     VTABLE_set_pmc_keyed_int(interp, lib_paths,
 258             PARROT_LIB_PATH_DYNEXT, paths);
 259     if (!STRING_IS_NULL(builddir)) {
 260         entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/dynext/"));
 261         VTABLE_push_string(interp, paths, entry);
 262     }
 263     entry = CONST_STRING(interp, "dynext/");
 264     VTABLE_push_string(interp, paths, entry);
 265     if (!STRING_IS_NULL(versionlib)) {
 266         entry = Parrot_str_concat(interp, versionlib, CONST_STRING(interp, "/dynext/"));
 267         VTABLE_push_string(interp, paths, entry);
 268     }
 269
 270     /* shared exts */
 271     paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
 272     VTABLE_set_pmc_keyed_int(interp, lib_paths,
 273             PARROT_LIB_DYN_EXTS, paths);
 274     /* no CONST_STRING here - the c2str.pl preprocessor needs "real strs" */
 275     entry = Parrot_str_new_constant(interp, PARROT_LOAD_EXT);
 276     VTABLE_push_string(interp, paths, entry);
 277     /* OS/X has .dylib and .bundle */
 278     if (!STREQ(PARROT_LOAD_EXT, PARROT_SHARE_EXT)) {
 279         entry = Parrot_str_new_constant(interp, PARROT_SHARE_EXT);
 280         VTABLE_push_string(interp, paths, entry);
 281     }
 282
 283 #ifdef PARROT_PLATFORM_LIB_PATH_INIT_HOOK
 284     PARROT_PLATFORM_LIB_PATH_INIT_HOOK(interp, lib_paths);
 285 #endif
 286 }
 287
 288 /*
 289
 290 =item C<static PMC* get_search_paths(PARROT_INTERP, enum_lib_paths which)>
 291
 292 Return lib_paths as array of StringArrays with library searchpaths and shared
 293 extension used for loading various files at runtime.
 294 The structure looks like this:
 295
 296   lib_paths = [
 297     [ "runtime/parrot/include", ... ],   # paths for .include 'file'
 298     [ "runtime/parrot/library", ... ],   # paths for load_bytecode
 299     [ "runtime/parrot/dynext", ... ],    # paths for loadlib
 300     [ "languages", ... ],                # paths for languages
 301     [ ".so", ... ]                       # list of shared extensions
 302   ]
 303
 304 =cut
 305
 306 */
 307
 308 PARROT_WARN_UNUSED_RESULT
 309 PARROT_CANNOT_RETURN_NULL
 310 static PMC*
 311 get_search_paths(PARROT_INTERP, enum_lib_paths which)
 312 {
 313     ASSERT_ARGS(get_search_paths)
 314     PMC * const iglobals = interp->iglobals;
 315     PMC * const lib_paths = VTABLE_get_pmc_keyed_int(interp, iglobals,
 316             IGLOBALS_LIB_PATHS);
 317     return VTABLE_get_pmc_keyed_int(interp, lib_paths, which);
 318 }
 319
 320 static const char path_separator = '/';
 321
 322 #ifdef WIN32
 323
 324 static const char win32_path_separator = '\\';
 325
 326 #endif
 327
 328 /*
 329
 330 =item C<static int is_abs_path(const STRING *file)>
 331
 332 Determines whether a file name given by a fixed-8 or utf8 C<STRING> is an
 333 absolute file name. Returns C<1> if the filename is absolute, returns C<0>
 334 otherwise.
 335
 336 =cut
 337
 338 */
 339
 340 PARROT_PURE_FUNCTION
 341 static int
 342 is_abs_path(ARGIN(const STRING *file))
 343 {
 344     ASSERT_ARGS(is_abs_path)
 345     const char * const file_name = (const char *)file->strstart;
 346     if (file->strlen <= 1)
 347         return 0;
 348     PARROT_ASSERT(STRING_max_bytes_per_codepoint(file) == 1 ||
 349             file->encoding == Parrot_utf8_encoding_ptr);
 350
 351     /* XXX  ../foo, ./bar */
 352     if (file_name[0] == path_separator
 353 #ifdef WIN32
 354             || (file_name[0] == win32_path_separator ||
 355             (isalpha((unsigned char)file_name[0]) && file->strlen > 2 &&
 356              (strncmp(file_name+1, ":\\", 2) == 0 ||
 357               strncmp(file_name+1, ":/",  2) == 0)))
 358 #endif
 359             /* no space before closing paren */)
 360         {
 361             return 1;
 362         }
 363     return 0;
 364 }
 365
 366
 367 #ifdef WIN32
 368
 369 /*
 370
 371 =item C<static void cnv_to_win32_filesep(STRING *path)>
 372
 373 Converts a path with forward slashes to one with backward slashes.
 374
 375 =cut
 376
 377 */
 378
 379 static void
 380 cnv_to_win32_filesep(ARGMOD(STRING *path))
 381 {
 382     ASSERT_ARGS(cnv_to_win32_filesep)
 383     char *cnv = path->strstart;
 384
 385     while ((cnv = strchr(cnv, path_separator)) != NULL)
 386         *cnv = win32_path_separator;
 387 }
 388
 389 #endif
 390
 391 /*
 392
 393 =item C<static STRING* path_finalize(PARROT_INTERP, STRING *path)>
 394
 395 Ensures the given STRING C<path> has a C-style NULL character at the end. The
 396 length of the string is not increased to account for this NULL, however. In
 397 WIN32 systems, the path separator is switched from the unix-style "/" to the
 398 Windows-style "\".
 399
 400 =cut
 401
 402 */
 403
 404 PARROT_WARN_UNUSED_RESULT
 405 PARROT_CANNOT_RETURN_NULL
 406 static STRING*
 407 path_finalize(PARROT_INTERP, ARGMOD(STRING *path))
 408 {
 409     ASSERT_ARGS(path_finalize)
 410
 411     /* TODO create a string API that just does that
 412      *      a lot of ICU lib functions also need 0-terminated strings
 413      *      the goal is just to have for sure an invisible 0 at end
 414      */
 415
 416     STRING * const nul = string_chr(interp, '\0');
 417
 418     path = Parrot_str_concat(interp, path, nul);
 419     --path->bufused;
 420     --path->strlen;
 421
 422 #ifdef WIN32
 423     cnv_to_win32_filesep(path);
 424 #endif
 425
 426     return path;
 427 }
 428
 429 /*
 430
 431 =item C<static STRING* path_guarantee_trailing_separator(PARROT_INTERP, STRING
 432 *path)>
 433
 434 unary path argument. the path string will have a
 435 trailing path-separator appended if it is not
 436 there already.
 437
 438 =cut
 439
 440 */
 441
 442 PARROT_WARN_UNUSED_RESULT
 443 PARROT_CANNOT_RETURN_NULL
 444 static STRING*
 445 path_guarantee_trailing_separator(PARROT_INTERP, ARGMOD(STRING *path))
 446 {
 447     ASSERT_ARGS(path_guarantee_trailing_separator)
 448     STRING * const path_separator_string = string_chr(interp, path_separator);
 449
 450     /* make sure the path has a trailing slash before appending the file */
 451     if (Parrot_str_indexed(interp, path , path->strlen - 1)
 452          != Parrot_str_indexed(interp, path_separator_string, 0))
 453         path = Parrot_str_concat(interp, path , path_separator_string);
 454
 455     return path;
 456 }
 457
 458 /*
 459
 460 =item C<static STRING* path_append(PARROT_INTERP, STRING *l_path, STRING
 461 *r_path)>
 462
 463 binary path arguments, the left arg is modified.
 464 a trailing separator is guaranteed for the left
 465 argument and the right argument is appended
 466
 467 =cut
 468
 469 */
 470
 471 PARROT_WARN_UNUSED_RESULT
 472 PARROT_CANNOT_RETURN_NULL
 473 static STRING*
 474 path_append(PARROT_INTERP, ARGMOD(STRING *l_path), ARGMOD(STRING *r_path))
 475 {
 476     ASSERT_ARGS(path_append)
 477     l_path = path_guarantee_trailing_separator(interp, l_path);
 478     l_path = Parrot_str_concat(interp, l_path, r_path);
 479
 480     return l_path;
 481 }
 482
 483 /*
 484
 485 =item C<static STRING* path_concat(PARROT_INTERP, STRING *l_path, STRING
 486 *r_path)>
 487
 488 binary path arguments. A new string is created
 489 that is the concatenation of the two path components
 490 with a path-separator.
 491
 492 =cut
 493
 494 */
 495
 496 PARROT_WARN_UNUSED_RESULT
 497 PARROT_CANNOT_RETURN_NULL
 498 static STRING*
 499 path_concat(PARROT_INTERP, ARGMOD(STRING *l_path), ARGMOD(STRING *r_path))
 500 {
 501     ASSERT_ARGS(path_concat)
 502     STRING* join;
 503
 504     join = path_guarantee_trailing_separator(interp, l_path);
 505     join = Parrot_str_concat(interp, join, r_path);
 506
 507     return join;
 508 }
 509
 510 /*
 511
 512 =item C<static STRING* try_load_path(PARROT_INTERP, STRING* path)>
 513
 514 Attempts to load a file with name C<path>. If the file is successfully located,
 515 the finalized name of the file is returned as a STRING. Otherwise, returns
 516 NULL.
 517
 518 =cut
 519
 520 */
 521
 522 PARROT_WARN_UNUSED_RESULT
 523 PARROT_CAN_RETURN_NULL
 524 static STRING*
 525 try_load_path(PARROT_INTERP, ARGMOD(STRING* path))
 526 {
 527     ASSERT_ARGS(try_load_path)
 528     STRING * const final = path_finalize(interp, path);
 529
 530     if (Parrot_stat_info_intval(interp, final, STAT_EXISTS)) {
 531         return final;
 532     }
 533
 534     return NULL;
 535 }
 536
 537 /*
 538
 539 =item C<static STRING* try_bytecode_extensions(PARROT_INTERP, STRING* path)>
 540
 541 Guess extensions, so that the user can drop the extensions
 542 leaving it up to the build process/install whether or not
 543 a .pbc, .pasm or a .pir file is used.
 544
 545 =cut
 546
 547 */
 548
 549 PARROT_WARN_UNUSED_RESULT
 550 PARROT_CAN_RETURN_NULL
 551 static STRING*
 552 try_bytecode_extensions(PARROT_INTERP, ARGMOD(STRING* path))
 553 {
 554     ASSERT_ARGS(try_bytecode_extensions)
 555     STRING *test_path, *result;
 556     STRING * const bytecode_extension = CONST_STRING(interp, ".pbc");
 557     STRING * const pir_extension      = CONST_STRING(interp, ".pir");
 558     STRING * const pasm_extension     = CONST_STRING(interp, ".pasm");
 559
 560     test_path = path;
 561
 562     /* First try the path as given. */
 563     result = try_load_path(interp, test_path);
 564     if (result)
 565         return result;
 566
 567     /*
 568       If the original requested file doesn't exist, try it with a
 569       different extension. A requested PIR or PASM file will check for a
 570       corresponding bytecode file. A requested bytecode file will check
 571       first for a corresponding PIR file, then for a PASM file.
 572     */
 573
 574     if (!STRING_IS_NULL(test_path)) {
 575         if (Parrot_str_byte_length(interp, test_path) > 4) {
 576             STRING *orig_ext = Parrot_str_substr(interp, test_path, -4, 4);
 577             /* First try substituting .pbc for the .pir extension */
 578             if (Parrot_str_equal(interp, orig_ext, pir_extension)) {
 579                 STRING * const without_ext = Parrot_str_chopn(interp, test_path, 4);
 580                 test_path = Parrot_str_concat(interp, without_ext, bytecode_extension);
 581                 result = try_load_path(interp, test_path);
 582                 if (result)
 583                     return result;
 584             }
 585             /* Next try substituting .pir, then .pasm for the .pbc extension */
 586             else if (Parrot_str_equal(interp, orig_ext, bytecode_extension)) {
 587                 STRING * const without_ext = Parrot_str_chopn(interp, test_path, 4);
 588                 test_path = Parrot_str_concat(interp, without_ext, pir_extension);
 589                 result = try_load_path(interp, test_path);
 590                 if (result)
 591                     return result;
 592
 593                 test_path = Parrot_str_concat(interp, without_ext, pasm_extension);
 594                 result = try_load_path(interp, test_path);
 595                 if (result)
 596                     return result;
 597             }
 598
 599         }
 600
 601         /* Finally, try substituting .pbc for the .pasm extension. */
 602         if (Parrot_str_byte_length(interp, test_path) > 5) {
 603             STRING * const orig_ext = Parrot_str_substr(interp, test_path, -5, 5);
 604             if (Parrot_str_equal(interp, orig_ext, pasm_extension)) {
 605                 STRING * const without_ext = Parrot_str_chopn(interp, test_path, 5);
 606                 test_path = Parrot_str_concat(interp, without_ext, bytecode_extension);
 607                 result = try_load_path(interp, test_path);
 608                 if (result)
 609                     return result;
 610             }
 611         }
 612     }
 613
 614     return NULL;
 615 }
 616
 617 /*
 618
 619 =item C<void Parrot_lib_add_path(PARROT_INTERP, STRING *path_str, enum_lib_paths
 620 which)>
 621
 622 Add a path to the library searchpath of the given type (passing in a STRING).
 623
 624 =cut
 625
 626 */
 627
 628 PARROT_EXPORT
 629 void
 630 Parrot_lib_add_path(PARROT_INTERP,
 631         ARGIN(STRING *path_str),
 632         enum_lib_paths which)
 633 {
 634     ASSERT_ARGS(Parrot_lib_add_path)
 635     PMC * const iglobals = interp->iglobals;
 636     PMC * const lib_paths = VTABLE_get_pmc_keyed_int(interp, iglobals,
 637         IGLOBALS_LIB_PATHS);
 638     PMC * const paths = VTABLE_get_pmc_keyed_int(interp, lib_paths, which);
 639     VTABLE_unshift_string(interp, paths, path_str);
 640 }
 641
 642 /*
 643
 644 =item C<void Parrot_lib_add_path_from_cstring(PARROT_INTERP, const char *path,
 645 enum_lib_paths which)>
 646
 647 Add a path to the library searchpath of the given type (passing in a C string).
 648
 649 =cut
 650
 651 */
 652
 653 PARROT_EXPORT
 654 void
 655 Parrot_lib_add_path_from_cstring(PARROT_INTERP,
 656         ARGIN(const char *path),
 657         enum_lib_paths which)
 658 {
 659     ASSERT_ARGS(Parrot_lib_add_path_from_cstring)
 660     STRING * const path_str = Parrot_str_new(interp, path, 0);
 661     Parrot_lib_add_path(interp, path_str, which);
 662 }
 663
 664 /*
 665
 666 =item C<STRING* Parrot_locate_runtime_file_str(PARROT_INTERP, STRING *file,
 667 enum_runtime_ft type)>
 668
 669 Locate the full path for C<file_name> and the given file type(s).
 670
 671 The C<enum_runtime_ft type> is one or more of the types defined in
 672 F<include/parrot/library.h>.
 673
 674 =cut
 675
 676 */
 677
 678 PARROT_EXPORT
 679 PARROT_WARN_UNUSED_RESULT
 680 PARROT_CAN_RETURN_NULL
 681 STRING*
 682 Parrot_locate_runtime_file_str(PARROT_INTERP, ARGMOD(STRING *file),
 683         enum_runtime_ft type)
 684 {
 685     ASSERT_ARGS(Parrot_locate_runtime_file_str)
 686     STRING *prefix;
 687     STRING *full_name;
 688     PMC    *paths;
 689     INTVAL  i, n;
 690
 691     /* if this is an absolute path return it as is */
 692     if (is_abs_path(file))
 693         return file;
 694
 695     if (type & PARROT_RUNTIME_FT_LANG)
 696         paths = get_search_paths(interp, PARROT_LIB_PATH_LANG);
 697     else if (type & PARROT_RUNTIME_FT_DYNEXT)
 698         paths = get_search_paths(interp, PARROT_LIB_PATH_DYNEXT);
 699     else if (type & (PARROT_RUNTIME_FT_PBC | PARROT_RUNTIME_FT_SOURCE))
 700         paths = get_search_paths(interp, PARROT_LIB_PATH_LIBRARY);
 701     else
 702         paths = get_search_paths(interp, PARROT_LIB_PATH_INCLUDE);
 703
 704     prefix = Parrot_get_runtime_path(interp);
 705     n = VTABLE_elements(interp, paths);
 706
 707     for (i = 0; i < n; ++i) {
 708         STRING * const path = VTABLE_get_string_keyed_int(interp, paths, i);
 709         STRING *found_name;
 710
 711         full_name = path_append(interp, path, file);
 712
 713         found_name =
 714             (type & PARROT_RUNTIME_FT_DYNEXT)
 715                 ? try_load_path(interp, full_name)
 716                 : try_bytecode_extensions(interp, full_name);
 717
 718         if (found_name)
 719             return found_name;
 720
 721         if (Parrot_str_byte_length(interp, prefix) && !is_abs_path(path)) {
 722             full_name = path_concat(interp, prefix, full_name);
 723
 724             found_name =
 725                 (type & PARROT_RUNTIME_FT_DYNEXT)
 726                     ? try_load_path(interp, full_name)
 727                     : try_bytecode_extensions(interp, full_name);
 728
 729             if (found_name)
 730                 return found_name;
 731         }
 732     }
 733
 734     full_name =
 735         (type & PARROT_RUNTIME_FT_DYNEXT)
 736             ? try_load_path(interp, file)
 737             : try_bytecode_extensions(interp, file);
 738
 739     return full_name;
 740 }
 741
 742 /*
 743
 744 =item C<char* Parrot_locate_runtime_file(PARROT_INTERP, const char *file_name,
 745 enum_runtime_ft type)>
 746
 747 Locate the full path for C<file_name> and the given file type(s). If
 748 successful, returns a C-string allocated with C<Parrot_str_to_cstring> or
 749 NULL otherwise.  Remember to free the string with C<Parrot_str_free_cstring()>.
 750
 751 If successful, the returned STRING is 0-terminated so that
 752 C<result-E<gt>strstart> is usable as B<const char*> c-string for C library
 753 functions like fopen(3).  This is the preferred API function.
 754
 755 The C<enum_runtime_ft type> is one or more of the types defined in
 756 F<include/parrot/library.h>.
 757
 758 =cut
 759
 760 */
 761
 762
 763 PARROT_EXPORT
 764 PARROT_WARN_UNUSED_RESULT
 765 PARROT_CAN_RETURN_NULL
 766 PARROT_MALLOC
 767 char*
 768 Parrot_locate_runtime_file(PARROT_INTERP, ARGIN(const char *file_name),
 769         enum_runtime_ft type)
 770 {
 771     ASSERT_ARGS(Parrot_locate_runtime_file)
 772     STRING * const file   = Parrot_str_new(interp, file_name, 0);
 773     STRING * const result = Parrot_locate_runtime_file_str(interp, file, type);
 774     /*
 775      * XXX valgrind shows e.g.
 776      *     invalid read of size 8 inside a string of length 69
 777      *     at position 64
 778      *     it seems that dlopen accesses words beyond the string end
 779      *
 780      *     see also the log at #37814
 781      */
 782     return result ? Parrot_str_to_cstring(interp, result) : NULL;
 783 }
 784
 785 /*
 786
 787 =item C<STRING * Parrot_get_runtime_path(PARROT_INTERP)>
 788
 789 Return a string for the runtime prefix.
 790
 791 =cut
 792
 793 */
 794
 795 PARROT_EXPORT
 796 PARROT_CANNOT_RETURN_NULL
 797 STRING *
 798 Parrot_get_runtime_path(PARROT_INTERP)
 799 {
 800     ASSERT_ARGS(Parrot_get_runtime_path)
 801     char * const env = Parrot_getenv(interp, CONST_STRING(interp, "PARROT_RUNTIME"));
 802     STRING *result;
 803
 804     if (env)
 805     {
 806         result = Parrot_str_new(interp, env, 0);
 807     }
 808     else {
 809         PMC    * const config_hash =
 810             VTABLE_get_pmc_keyed_int(interp, interp->iglobals, (INTVAL) IGLOBALS_CONFIG_HASH);
 811
 812         if (VTABLE_elements(interp, config_hash)) {
 813             STRING * const key = CONST_STRING(interp, "prefix");
 814             result = VTABLE_get_string_keyed_str(interp, config_hash, key);
 815         }
 816         else
 817             result = CONST_STRING(interp, ".");
 818     }
 819     return result;
 820 }
 821
 822 /*
 823
 824 =item C<STRING * parrot_split_path_ext(PARROT_INTERP, STRING *in, STRING
 825 **wo_ext, STRING **ext)>
 826
 827 Split the pathstring C<in> into <path><filestem><ext>. Return the
 828 C<filestem> of the pathstring. Set C<wo_ext> to the part without
 829 extension and C<ext> to the extension or NULL.
 830
 831 =cut
 832
 833 */
 834
 835 PARROT_IGNORABLE_RESULT
 836 PARROT_CANNOT_RETURN_NULL
 837 STRING *
 838 parrot_split_path_ext(PARROT_INTERP, ARGMOD(STRING *in),
 839         ARGOUT(STRING **wo_ext), ARGOUT(STRING **ext))
 840 {
 841     ASSERT_ARGS(parrot_split_path_ext)
 842
 843     /* This is a quick fix for TT #65
 844      * TODO: redo it with the string reimplementation
 845      */
 846     STRING * const slash1 = Parrot_str_new_init(interp, "/", 1,
 847             in->encoding, PObj_external_FLAG|PObj_constant_FLAG);
 848     STRING * const slash2 = Parrot_str_new_init(interp, "\\", 1,
 849             in->encoding, PObj_external_FLAG|PObj_constant_FLAG);
 850     STRING * const dot    = Parrot_str_new_init(interp, ".", 1,
 851             in->encoding, PObj_external_FLAG|PObj_constant_FLAG);
 852
 853     const INTVAL len = Parrot_str_byte_length(interp, in);
 854     STRING *stem;
 855     INTVAL pos_sl, pos_dot;
 856
 857     pos_sl = STRING_rindex(interp, in, slash1, len);
 858     if (pos_sl == -1)
 859         pos_sl = STRING_rindex(interp, in, slash2, len);
 860     pos_dot = STRING_rindex(interp, in, dot, len);
 861
 862     /* ignore dot in directory name */
 863     if (pos_dot != -1 && pos_dot < pos_sl)
 864         pos_dot = -1;
 865
 866     ++pos_dot;
 867     ++pos_sl;
 868     if (pos_sl && pos_dot) {
 869         stem = Parrot_str_substr(interp, in, pos_sl, pos_dot - pos_sl - 1);
 870         *wo_ext = Parrot_str_substr(interp, in, 0, pos_dot - 1);
 871         *ext = Parrot_str_substr(interp, in, pos_dot, len - pos_dot);
 872     }
 873     else if (pos_dot) {
 874         stem = Parrot_str_substr(interp, in, 0, pos_dot - 1);
 875         *wo_ext = stem;
 876         *ext = Parrot_str_substr(interp, in, pos_dot, len - pos_dot);
 877     }
 878     else if (pos_sl) {
 879         stem = Parrot_str_substr(interp, in, pos_sl, len - pos_sl);
 880         *wo_ext = in;
 881         *ext = NULL;
 882     }
 883     else {
 884         stem = in;
 885         *wo_ext = stem;
 886         *ext = NULL;
 887     }
 888     return stem;
 889 }
 890
 891 /*
 892
 893 =back
 894
 895 =head1 SEE ALSO
 896
 897 F<include/parrot/library.h>
 898
 899 =cut
 900
 901 */
 902
 903
 904 /*
 905  * Local variables:
 906  *   c-file-style: "parrot"
 907  * End:
 908  * vim: expandtab shiftwidth=4:
 909  */