src/library.c

   1 /*
   2 Copyright (C) 2004, The Perl 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 a C function to access parrot's bytecode library functions.
  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 <assert.h>
  24 #include "library.str"
  25
  26 /*
  27
  28 =item C<void parrot_init_library_paths(Interp *)>
  29
  30 Create an array of StringArrays with library searchpaths and shared
  31 extension used for loading various files at runtime. The created
  32 structures looks like this:
  33
  34   lib_paths = [
  35     [ "runtime/parrot/include", ... ],   # paths for .include 'file'
  36     [ "runtime/parrot/library", ... ],   # paths for load_bytecode
  37     [ "runtime/parrot/dynext", ... ],    # paths for loadlib
  38     [ ".so", ... ]                       # list of shared extensions
  39   ]
  40
  41 If the platform defines
  42
  43   #define PARROT_PLATFORM_LIB_PATH_INIT_HOOK the_init_hook
  44
  45 if will be called as a function with this prototype:
  46
  47   void the_init_hook(Interp*, PMC *lib_paths);
  48
  49 Platform code may add, delete, or replace search path entries as needed. See
  50 also F<include/parrot/library.h> for C<enum_lib_paths>.
  51
  52 =cut
  53
  54 */
  55
  56 void
  57 parrot_init_library_paths(Interp *interpreter)
  58 {
  59     PMC *iglobals, *lib_paths, *paths;
  60     STRING *entry;
  61
  62     iglobals = interpreter->iglobals;
  63     /* create the lib_paths array */
  64     lib_paths = pmc_new(interpreter, enum_class_FixedPMCArray);
  65     VTABLE_set_integer_native(interpreter, lib_paths, PARROT_LIB_PATH_SIZE);
  66     VTABLE_set_pmc_keyed_int(interpreter, iglobals,
  67             IGLOBALS_LIB_PATHS, lib_paths);
  68     /* each is an array of strings */
  69     /* define include paths */
  70     paths = pmc_new(interpreter, enum_class_ResizableStringArray);
  71     VTABLE_set_pmc_keyed_int(interpreter, lib_paths,
  72             PARROT_LIB_PATH_INCLUDE, paths);
  73     entry = CONST_STRING(interpreter, "runtime/parrot/include/");
  74     VTABLE_push_string(interpreter, paths, entry);
  75     entry = CONST_STRING(interpreter, "runtime/parrot/");
  76     VTABLE_push_string(interpreter, paths, entry);
  77     entry = CONST_STRING(interpreter, "./");
  78     VTABLE_push_string(interpreter, paths, entry);
  79     entry = CONST_STRING(interpreter, "lib/parrot/include/");
  80     VTABLE_push_string(interpreter, paths, entry);
  81     entry = CONST_STRING(interpreter, "lib/parrot/");
  82     VTABLE_push_string(interpreter, paths, entry);
  83
  84     /* define library paths */
  85     paths = pmc_new(interpreter, enum_class_ResizableStringArray);
  86     VTABLE_set_pmc_keyed_int(interpreter, lib_paths,
  87             PARROT_LIB_PATH_LIBRARY, paths);
  88     entry = CONST_STRING(interpreter, "runtime/parrot/library/");
  89     VTABLE_push_string(interpreter, paths, entry);
  90     entry = CONST_STRING(interpreter, "runtime/parrot/");
  91     VTABLE_push_string(interpreter, paths, entry);
  92     entry = CONST_STRING(interpreter, "./");
  93     VTABLE_push_string(interpreter, paths, entry);
  94     entry = CONST_STRING(interpreter, "lib/parrot/library/");
  95     VTABLE_push_string(interpreter, paths, entry);
  96     entry = CONST_STRING(interpreter, "lib/parrot/");
  97     VTABLE_push_string(interpreter, paths, entry);
  98
  99     /* define dynext paths */
 100     paths = pmc_new(interpreter, enum_class_ResizableStringArray);
 101     VTABLE_set_pmc_keyed_int(interpreter, lib_paths,
 102             PARROT_LIB_PATH_DYNEXT, paths);
 103     entry = CONST_STRING(interpreter, "runtime/parrot/dynext/");
 104     VTABLE_push_string(interpreter, paths, entry);
 105     entry = CONST_STRING(interpreter, "");
 106     VTABLE_push_string(interpreter, paths, entry);
 107     entry = CONST_STRING(interpreter, "lib/parrot/dynext/");
 108     VTABLE_push_string(interpreter, paths, entry);
 109
 110     /* shared exts */
 111     paths = pmc_new(interpreter, enum_class_ResizableStringArray);
 112     VTABLE_set_pmc_keyed_int(interpreter, lib_paths,
 113             PARROT_LIB_DYN_EXTS, paths);
 114     /* no CONST_STRING here - the c2str.pl preprocessor needs "real strs" */
 115     entry = const_string(interpreter, PARROT_LOAD_EXT);
 116     VTABLE_push_string(interpreter, paths, entry);
 117     /* OS/X has .dylib and .bundle */
 118     if (strcmp(PARROT_LOAD_EXT, PARROT_SHARE_EXT)) {
 119         entry = const_string(interpreter, PARROT_SHARE_EXT);
 120         VTABLE_push_string(interpreter, paths, entry);
 121     }
 122
 123 #ifdef PARROT_PLATFORM_LIB_PATH_INIT_HOOK
 124     PARROT_PLATFORM_LIB_PATH_INIT_HOOK(interpreter, lib_paths);
 125 #endif
 126 }
 127
 128 static PMC*
 129 get_search_paths(Interp *interpreter, enum_lib_paths which)
 130 {
 131     PMC *iglobals, *lib_paths;
 132
 133     iglobals = interpreter->iglobals;
 134     lib_paths = VTABLE_get_pmc_keyed_int(interpreter, iglobals,
 135             IGLOBALS_LIB_PATHS);
 136     return VTABLE_get_pmc_keyed_int(interpreter, lib_paths, which);
 137 }
 138
 139 static int
 140 is_abs_path(Interp* interpreter, STRING *file)
 141 {
 142     char *file_name;
 143
 144     file_name = file->strstart;
 145     if (file->strlen <= 1)
 146         return 0;
 147     assert(file->encoding == Parrot_fixed_8_encoding_ptr ||
 148             file->encoding == Parrot_utf8_encoding_ptr);
 149 #ifdef WIN32
 150     if (file_name[0] == '\\' || file_name[0] == '/' ||
 151             (isalpha(file_name[0]) && file->strlen > 2 &&
 152              (strncmp(file_name+1, ":\\", 2) == 0 ||
 153               strncmp(file_name+1, ":/",  2) == 0)))
 154 #else
 155         if (file_name[0] == '/')     /* XXX  ../foo, ./bar */
 156 #endif
 157         {
 158             return 1;
 159         }
 160     return 0;
 161 }
 162
 163 /*
 164
 165 =item C<char* Parrot_locate_runtime_file(Interp *, const char *file_name,
 166         enum_runtime_ft type)>
 167
 168 Locate the full path for C<file_name> and the given file type(s). If
 169 successful, returns a C-string allocated with C<string_to_cstring> or
 170 NULL otherwise.
 171
 172 =item C<STRING* Parrot_locate_runtime_file_str(Interp *, STRING  *file_name,
 173         enum_runtime_ft type)>
 174
 175 Like above but use and return STRINGs. If successful, the returned STRING
 176 is 0-terminated so that C<result-E<gt>strstart> is usable as B<const char*>
 177 c-string for C library functions like fopen(3).
 178 This is the prefered API function.
 179
 180 The C<enum_runtime_ft type> is one or more of the types defined in
 181 F<include/parrot/library.h>.
 182
 183 =cut
 184
 185 */
 186
 187 STRING*
 188 Parrot_locate_runtime_file_str(Interp *interpreter, STRING *file,
 189         enum_runtime_ft type)
 190 {
 191     STRING *prefix, *path, *full_name, *slash, *nul;
 192     INTVAL i, n;
 193     PMC *paths;
 194
 195     /* if this is an absolute path return it as is */
 196     if (is_abs_path(interpreter, file))
 197         return file;
 198
 199     if (type & PARROT_RUNTIME_FT_DYNEXT)
 200         paths = get_search_paths(interpreter, PARROT_LIB_PATH_DYNEXT);
 201     else if (type & (PARROT_RUNTIME_FT_PBC | PARROT_RUNTIME_FT_SOURCE))
 202         paths = get_search_paths(interpreter, PARROT_LIB_PATH_LIBRARY);
 203     else
 204         paths = get_search_paths(interpreter, PARROT_LIB_PATH_INCLUDE);
 205
 206 #ifdef WIN32
 207     slash = CONST_STRING(interpreter, "\\");
 208 #else
 209     slash = CONST_STRING(interpreter, "/");
 210 #endif
 211
 212     nul = string_from_const_cstring(interpreter, "\0", 1);
 213     Parrot_get_runtime_prefix(interpreter, &prefix);
 214     n = VTABLE_elements(interpreter, paths);
 215     for (i = 0; i < n; ++i) {
 216         path = VTABLE_get_string_keyed_int(interpreter, paths, i);
 217         if (string_length(interpreter, prefix) &&
 218            !is_abs_path(interpreter,path)) {
 219             full_name = string_concat(interpreter, prefix, slash, 0);
 220             full_name = string_append(interpreter, full_name, path);
 221         }
 222         else
 223             full_name = string_copy(interpreter, path);
 224
 225         /* make sure this path has a trailing slash before appending the file */
 226         if (   string_index(interpreter, full_name, full_name->strlen - 1)
 227             != string_index(interpreter, slash, 0))
 228             full_name = string_append(interpreter, full_name, slash);
 229
 230         full_name = string_append(interpreter, full_name, file);
 231         /* TODO create a string API that just does that
 232          *      a lot of ICU lib functions also need 0-terminated strings
 233          *      the goal is just to have for sure an invisible 0 at end
 234          */
 235         full_name = string_append(interpreter, full_name, nul);
 236         full_name->bufused--;
 237         full_name->strlen--;
 238 #ifdef WIN32
 239         {
 240             char *p;
 241             assert(full_name->encoding == Parrot_fixed_8_encoding_ptr ||
 242                    full_name->encoding == Parrot_utf8_encoding_ptr);
 243             while ( (p = strchr(full_name->strstart, '/')) )
 244                 *p = '\\';
 245         }
 246 #endif
 247         if (Parrot_stat_info_intval(interpreter, full_name, STAT_EXISTS)) {
 248             return full_name;
 249         }
 250     }
 251     /* finally try as is */
 252     full_name = string_append(interpreter, file, nul);
 253     full_name->bufused--;
 254     full_name->strlen--;
 255 #ifdef WIN32
 256     {
 257         char *p;
 258         assert(full_name->encoding == Parrot_fixed_8_encoding_ptr ||
 259                 full_name->encoding == Parrot_utf8_encoding_ptr);
 260         while ( (p = strchr(full_name->strstart, '/')) )
 261             *p = '\\';
 262     }
 263 #endif
 264     if (Parrot_stat_info_intval(interpreter, full_name, STAT_EXISTS)) {
 265         return full_name;
 266     }
 267     return NULL;
 268 }
 269
 270 char*
 271 Parrot_locate_runtime_file(Interp *interpreter, const char *file_name,
 272         enum_runtime_ft type)
 273 {
 274     STRING *file = string_from_cstring(interpreter, file_name, 0);
 275     STRING *result = Parrot_locate_runtime_file_str(interpreter,
 276             file, type);
 277     /*
 278      * XXX valgrind shows e.g.
 279      *     invalid read of size 8 inside a string of length 69
 280      *     at position 64
 281      *     it seems that dlopen accesses words beyond the string end
 282      *
 283      *     see also the log at #37814
 284      */
 285     return string_to_cstring(interpreter, result);
 286 }
 287 /*
 288
 289 =item C<const char* Parrot_get_runtime_prefix(Interp *, STRING **prefix_str)>
 290
 291 If C<prefix_str> is not NULL, set it to the prefix, else
 292 return a malloced c-string for the runtime prefix.
 293
 294 =cut
 295
 296 */
 297
 298 const char*
 299 Parrot_get_runtime_prefix(Interp *interpreter, STRING **prefix_str)
 300 {
 301     STRING *s, *key;
 302     PMC *config_hash;
 303     int free_it;
 304     char *env;
 305
 306     env = Parrot_getenv("PARROT_RUNTIME", &free_it);
 307     if (env) {
 308         if (prefix_str) {
 309             *prefix_str = string_from_cstring(interpreter, env, 0);
 310             if (free_it)
 311                 free(env);
 312             return NULL;
 313         }
 314         if (!free_it)
 315             env = strdup(env);
 316         return env;
 317     }
 318
 319     config_hash = VTABLE_get_pmc_keyed_int(interpreter, interpreter->iglobals,
 320             (INTVAL) IGLOBALS_CONFIG_HASH);
 321     key = CONST_STRING(interpreter, "prefix");
 322     if (!VTABLE_elements(interpreter, config_hash)) {
 323         const char *pwd = ".";
 324         char *ret;
 325
 326         if (prefix_str) {
 327             *prefix_str = const_string(interpreter, pwd);
 328             return NULL;
 329         }
 330         ret = mem_sys_allocate(3);
 331         strcpy(ret, pwd);
 332         return ret;
 333     }
 334     s = VTABLE_get_string_keyed_str(interpreter, config_hash, key);
 335     if (prefix_str) {
 336         *prefix_str = s;
 337         return NULL;
 338     }
 339     return string_to_cstring(interpreter, s);
 340 }
 341
 342 /*
 343
 344 =item C<void Parrot_autoload_class(Interp *, STRING *class)>
 345
 346 Try to load a library that holds the PMC class.
 347
 348 XXX Check if this is still needed with HLL type mappings.
 349
 350 =cut
 351
 352 */
 353 void
 354 Parrot_autoload_class(Interp *interpreter, STRING *class)
 355 {
 356     static const struct {
 357         const char *prefix;
 358         const char *lib;
 359     } mappings[] = {
 360         { "Py", "python_group" },
 361         { "Tcl", "tcl_group" }
 362     };
 363     size_t i;
 364     char *cclass;
 365
 366     cclass = string_to_cstring(interpreter, class);
 367     for (i = 0; i < sizeof(mappings)/sizeof(mappings[0]); ++i) {
 368         if (!memcmp(mappings[i].prefix, cclass, strlen(mappings[i].prefix))) {
 369             STRING *slib = const_string(interpreter, mappings[i].lib);
 370             Parrot_load_lib(interpreter, slib, NULL);
 371             break;
 372         }
 373     }
 374     string_cstring_free(cclass);
 375
 376 }
 377
 378 /*
 379
 380 =item C<STRING *
 381 parrot_split_path_ext(Interp*, STRING *in, STRING **wo_ext, STRING **ext)>
 382
 383 Split the pathstring C<in> into <path><filestem><ext>. Return the
 384 C<filestem> of the pathstring. Set C<wo_ext> to the part without
 385 extension and C<ext> to the extension or NULL.
 386
 387 =cut
 388
 389 */
 390
 391 STRING *
 392 parrot_split_path_ext(Interp* interpreter, STRING *in,
 393         STRING **wo_ext, STRING **ext)
 394 {
 395     STRING *slash1, *slash2, *dot, *stem;
 396     INTVAL pos_sl, pos_dot, len;
 397     slash1 = CONST_STRING(interpreter, "/");
 398     slash2 = CONST_STRING(interpreter, "\\");
 399     dot    = CONST_STRING(interpreter, ".");
 400     len = string_length(interpreter, in);
 401     pos_sl = CHARSET_RINDEX(interpreter, in, slash1, len);
 402     if (pos_sl == -1)
 403         pos_sl = CHARSET_RINDEX(interpreter, in, slash2, len);
 404     pos_dot = CHARSET_RINDEX(interpreter, in, dot, len);
 405
 406     /* XXX directory parrot-0.4.1 or such */
 407     if (pos_dot != -1 && isdigit( ((char*)in->strstart)[pos_dot+1]))
 408         pos_dot = -1;
 409
 410     ++pos_dot;
 411     ++pos_sl;
 412     if (pos_sl && pos_dot ) {
 413         stem = string_substr(interpreter, in, pos_sl, pos_dot - pos_sl - 1,
 414                 NULL, 0);
 415         *wo_ext = string_substr(interpreter, in, 0, pos_dot - 1, NULL, 0);
 416         *ext = string_substr(interpreter, in, pos_dot, len - pos_dot, NULL, 0);
 417     }
 418     else if (pos_dot) {
 419         stem = string_substr(interpreter, in, 0, pos_dot - 1, NULL, 0);
 420         *wo_ext = stem;
 421         *ext = string_substr(interpreter, in, pos_dot, len - pos_dot, NULL, 0);
 422     }
 423     else if (pos_sl) {
 424         stem = string_substr(interpreter, in, pos_sl, len - pos_sl, NULL, 0);
 425         *wo_ext = string_copy(interpreter, in);
 426         *ext = 0;
 427     }
 428     else {
 429         stem = string_copy(interpreter, in);
 430         *wo_ext = stem;
 431         *ext = NULL;
 432     }
 433     return stem;
 434 }
 435 /*
 436
 437 =back
 438
 439 =head1 SEE ALSO
 440
 441 F<include/parrot/library.h>
 442
 443 =cut
 444
 445 */
 446
 447
 448 /*
 449  * Local variables:
 450  *   c-file-style: "parrot"
 451  * End:
 452  * vim: expandtab shiftwidth=4:
 453  */