2 Copyright (C) 2001-2008, Parrot Foundation.
7 src/dynext.c - Dynamic extensions to Parrot
11 Functions for loading and initializing dynamic link libraries.
21 #include "parrot/parrot.h"
22 #include "parrot/dynext.h"
24 #include "pmc/pmc_parrotlibrary.h"
25 #include "pmc/pmc_callcontext.h"
27 /* HEADERIZER HFILE: include/parrot/dynext.h */
29 /* HEADERIZER BEGIN: static */
30 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
32 PARROT_WARN_UNUSED_RESULT
33 PARROT_CANNOT_RETURN_NULL
34 static STRING
* clone_string_into(
38 __attribute__nonnull__(1)
39 __attribute__nonnull__(2)
40 __attribute__nonnull__(3)
43 PARROT_WARN_UNUSED_RESULT
44 PARROT_CAN_RETURN_NULL
45 static void * dlopen_string(PARROT_INTERP
,
46 Parrot_dlopen_flags flags
,
48 __attribute__nonnull__(1)
49 __attribute__nonnull__(3);
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)
63 FUNC_MODIFIES(*handle
);
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);
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);
77 PARROT_CANNOT_RETURN_NULL
78 static PMC
* run_init_lib(PARROT_INTERP
,
80 ARGIN_NULLOK(STRING
*lib_name
),
81 ARGIN(STRING
*wo_ext
))
82 __attribute__nonnull__(1)
83 __attribute__nonnull__(2)
84 __attribute__nonnull__(4);
86 static void set_cstring_prop(PARROT_INTERP
,
88 ARGIN(const char *what
),
90 __attribute__nonnull__(1)
91 __attribute__nonnull__(2)
92 __attribute__nonnull__(3)
93 __attribute__nonnull__(4)
94 FUNC_MODIFIES(*lib_pmc
);
96 static void store_lib_pmc(PARROT_INTERP
,
100 ARGIN_NULLOK(STRING
*lib_name
))
101 __attribute__nonnull__(1)
102 __attribute__nonnull__(2)
103 __attribute__nonnull__(3)
104 __attribute__nonnull__(4);
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 */
140 /* _PARROTLIB is now the default */
141 /*#define _PARROTLIB not working: "make testr" */
145 =item C<static void set_cstring_prop(PARROT_INTERP, PMC *lib_pmc, const char
146 *what, STRING *name)>
148 Set a property C<name> with value C<what> on the C<ParrotLibrary>
156 set_cstring_prop(PARROT_INTERP
, ARGMOD(PMC
*lib_pmc
), ARGIN(const char *what
),
159 ASSERT_ARGS(set_cstring_prop
)
160 STRING
* const key
= Parrot_str_new_constant(interp
, what
);
161 PMC
* const prop
= Parrot_pmc_new_constant(interp
, enum_class_String
);
163 VTABLE_set_string_native(interp
, prop
, name
);
164 VTABLE_setprop(interp
, lib_pmc
, key
, prop
);
169 =item C<static void store_lib_pmc(PARROT_INTERP, PMC *lib_pmc, STRING *path,
170 STRING *type, STRING *lib_name)>
172 Store a C<ParrotLibrary> PMC in the interpreter's C<iglobals>.
179 store_lib_pmc(PARROT_INTERP
, ARGIN(PMC
*lib_pmc
), ARGIN(STRING
*path
),
180 ARGIN(STRING
*type
), ARGIN_NULLOK(STRING
*lib_name
))
182 ASSERT_ARGS(store_lib_pmc
)
183 PMC
* const iglobals
= interp
->iglobals
;
184 PMC
* const dyn_libs
= VTABLE_get_pmc_keyed_int(interp
, iglobals
,
187 /* remember path/file in props */
188 set_cstring_prop(interp
, lib_pmc
, "_filename", path
);
189 set_cstring_prop(interp
, lib_pmc
, "_type", type
);
192 set_cstring_prop(interp
, lib_pmc
, "_lib_name", lib_name
);
194 VTABLE_set_pmc_keyed_str(interp
, dyn_libs
, path
, lib_pmc
);
199 =item C<static PMC* is_loaded(PARROT_INTERP, STRING *path)>
201 Check if a C<ParrotLibrary> PMC with the filename path exists.
202 If it does, return it. Otherwise, return NULL.
208 PARROT_WARN_UNUSED_RESULT
209 PARROT_CAN_RETURN_NULL
211 is_loaded(PARROT_INTERP
, ARGIN(STRING
*path
))
213 ASSERT_ARGS(is_loaded
)
214 PMC
* const iglobals
= interp
->iglobals
;
215 PMC
* const dyn_libs
= VTABLE_get_pmc_keyed_int(interp
, iglobals
,
217 if (!VTABLE_exists_keyed_str(interp
, dyn_libs
, path
))
219 return VTABLE_get_pmc_keyed_str(interp
, dyn_libs
, path
);
224 =item C<static void * dlopen_string(PARROT_INTERP, Parrot_dlopen_flags flags,
227 Call Parrot_dlopen with the Parrot String argument converted to C string. The
228 flags argument will be converted into native form and used if applicable.
234 PARROT_WARN_UNUSED_RESULT
235 PARROT_CAN_RETURN_NULL
237 dlopen_string(PARROT_INTERP
, Parrot_dlopen_flags flags
, ARGIN(STRING
*path
))
239 ASSERT_ARGS(dlopen_string
)
241 char * const pathstr
= Parrot_str_to_cstring(interp
, path
);
242 void * handle
= Parrot_dlopen(pathstr
, flags
);
243 Parrot_str_free_cstring(pathstr
);
249 =item C<static STRING * get_path(PARROT_INTERP, STRING *lib, Parrot_dlopen_flags
250 flags, void **handle, STRING *wo_ext, STRING *ext)>
252 Return path and handle of a dynamic lib, setting lib_name to just the filestem
253 (i.e. without path or extension) as a freshly-allocated C string.
259 PARROT_WARN_UNUSED_RESULT
260 PARROT_CAN_RETURN_NULL
262 get_path(PARROT_INTERP
, ARGMOD_NULLOK(STRING
*lib
), Parrot_dlopen_flags flags
,
263 ARGOUT(void **handle
), ARGIN(STRING
*wo_ext
),
264 ARGIN_NULLOK(STRING
*ext
))
266 ASSERT_ARGS(get_path
)
267 STRING
*path
, *full_name
;
268 const char *err
= NULL
; /* buffer returned from Parrot_dlerror */
270 PMC
* const iglobals
= interp
->iglobals
;
271 PMC
* const lib_paths
= VTABLE_get_pmc_keyed_int(interp
, iglobals
,
273 PMC
* const share_ext
= VTABLE_get_pmc_keyed_int(interp
, lib_paths
,
274 PARROT_LIB_DYN_EXTS
);
277 *handle
= Parrot_dlopen((char *)NULL
, flags
);
279 return string_from_literal(interp
, "");
281 err
= Parrot_dlerror();
282 Parrot_warn(interp
, PARROT_WARNINGS_DYNEXT_FLAG
,
283 "Couldn't dlopen(NULL): %s\n",
284 err
? err
: "unknown reason");
289 * first, try to add an extension to the file if it has none.
292 const INTVAL n
= VTABLE_elements(interp
, share_ext
);
295 for (i
= 0; i
< n
; ++i
) {
296 ext
= VTABLE_get_string_keyed_int(interp
, share_ext
, i
);
297 full_name
= Parrot_str_concat(interp
, wo_ext
, ext
, 0);
298 path
= Parrot_locate_runtime_file_str(interp
, full_name
,
299 PARROT_RUNTIME_FT_DYNEXT
);
301 *handle
= dlopen_string(interp
, flags
, path
);
305 err
= Parrot_dlerror();
306 Parrot_warn(interp
, PARROT_WARNINGS_DYNEXT_FLAG
,
307 "Couldn't load '%Ss': %s\n",
308 full_name
, err
? err
: "unknown reason");
313 * File with extension and prefix was not found,
314 * so try file.extension w/o prefix
316 *handle
= dlopen_string(interp
, flags
, full_name
);
323 * finally, try the given file name as is. We still use
324 * Parrot_locate_runtime_file so that (a) relative pathnames are searched in
325 * the standard locations, and (b) the angle of the slashes are adjusted as
326 * required for non-Unix systems.
328 full_name
= Parrot_locate_runtime_file_str(interp
, lib
,
329 PARROT_RUNTIME_FT_DYNEXT
);
331 *handle
= dlopen_string(interp
, flags
, full_name
);
337 * and on windows strip a leading "lib"
338 * [shouldn't this happen in Parrot_locate_runtime_file instead?]
341 if (!STRING_IS_EMPTY(lib
) && memcmp(lib
->strstart
, "lib", 3) == 0) {
342 *handle
= Parrot_dlopen((char *)lib
->strstart
+ 3, 0);
344 path
= Parrot_str_substr(interp
, lib
, 3, lib
->strlen
- 3, NULL
, 0);
350 /* And on cygwin replace a leading "lib" by "cyg". */
352 if (!STRING_IS_EMPTY(lib
) && memcmp(lib
->strstart
, "lib", 3) == 0) {
353 path
= Parrot_str_append(interp
, CONST_STRING(interp
, "cyg"),
354 Parrot_str_substr(interp
, lib
, 3, lib
->strlen
- 3, NULL
, 0));
356 *handle
= dlopen_string(interp
, flags
, path
);
363 /* And after-finally, let the OS use his own search */
364 if (!STRING_IS_EMPTY(lib
)) {
365 *handle
= dlopen_string(interp
, flags
, lib
);
370 err
= Parrot_dlerror();
371 Parrot_warn(interp
, PARROT_WARNINGS_DYNEXT_FLAG
,
372 "Couldn't load '%Ss': %s\n",
373 lib
, err
? err
: "unknown reason");
379 =item C<PMC * Parrot_init_lib(PARROT_INTERP, PMC *(*load_func(PARROT_INTERP)),
380 void (*init_func(PARROT_INTERP, PMC *)))>
382 Initializes a new library. First, calls C<load_func> to load the library
383 (if C<load_func> is provided) and then calls C<init_func>. Returns a
384 ParrotLibrary PMC object that represents the initialized library.
391 PARROT_CANNOT_RETURN_NULL
393 Parrot_init_lib(PARROT_INTERP
,
394 ARGIN_NULLOK(PMC
*(*load_func
)(PARROT_INTERP
)),
395 ARGIN_NULLOK(void (*init_func
)(PARROT_INTERP
, ARGIN_NULLOK(PMC
*))))
397 ASSERT_ARGS(Parrot_init_lib
)
401 lib_pmc
= (*load_func
)(interp
);
403 /* seems to be a native/NCI lib */
404 if (!load_func
|| !lib_pmc
)
405 lib_pmc
= Parrot_pmc_new_constant(interp
, enum_class_ParrotLibrary
);
407 /* Call init, if it exists */
409 (init_func
)(interp
, lib_pmc
);
416 =item C<static PMC * run_init_lib(PARROT_INTERP, void *handle, STRING *lib_name,
419 Loads and Initializes a new library and returns a ParrotLibrary PMC.
420 Takes the name of a library C<libname>, that is loaded with handle C<handle>.
421 Calls the necessary initialization routines, if any.
427 PARROT_CANNOT_RETURN_NULL
429 run_init_lib(PARROT_INTERP
, ARGIN(void *handle
),
430 ARGIN_NULLOK(STRING
*lib_name
), ARGIN(STRING
*wo_ext
))
432 ASSERT_ARGS(run_init_lib
)
434 PMC
*(*load_func
)(PARROT_INTERP
);
435 void (*init_func
)(PARROT_INTERP
, PMC
*);
438 UINTVAL regs_used
[] = { 2, 2, 2, 2 }; /* Arbitrary values */
439 const int parrot_hll_id
= 0;
440 PMC
* context
= Parrot_push_context(interp
, regs_used
);
441 Parrot_pcc_set_HLL(interp
, context
, parrot_hll_id
);
442 Parrot_pcc_set_namespace(interp
, context
,
443 Parrot_get_HLL_namespace(interp
, parrot_hll_id
));
446 * work around gcc 3.3.3 and other problem with dynpmcs
447 * something during library loading doesn't stand a GC run
449 Parrot_block_GC_mark(interp
);
452 STRING
* const load_name
= Parrot_sprintf_c(interp
,
453 "Parrot_lib_%Ss_load", lib_name
);
454 STRING
* const init_func_name
= Parrot_sprintf_c(interp
,
455 "Parrot_lib_%Ss_init", lib_name
);
456 char * const cload_func_name
= Parrot_str_to_cstring(interp
, load_name
);
457 char * const cinit_func_name
= Parrot_str_to_cstring(interp
, init_func_name
);
460 void * dlsymfunc
= Parrot_dlsym(handle
, cload_func_name
);
461 load_func
= (PMC
* (*)(PARROT_INTERP
)) D2FPTR(dlsymfunc
);
462 Parrot_str_free_cstring(cload_func_name
);
465 dlsymfunc
= Parrot_dlsym(handle
, cinit_func_name
);
466 init_func
= (void (*)(PARROT_INTERP
, PMC
*)) D2FPTR(dlsymfunc
);
467 Parrot_str_free_cstring(cinit_func_name
);
474 lib_pmc
= Parrot_init_lib(interp
, load_func
, init_func
);
475 VTABLE_set_pointer(interp
, lib_pmc
, handle
);
478 type
= CONST_STRING(interp
, "NCI");
480 if (((Parrot_ParrotLibrary_attributes
*)PMC_data(lib_pmc
))->oplib_init
)
481 type
= CONST_STRING(interp
, "Ops");
483 type
= CONST_STRING(interp
, "PMC");
486 /* remember lib_pmc in iglobals */
487 store_lib_pmc(interp
, lib_pmc
, wo_ext
, type
, lib_name
);
490 Parrot_unblock_GC_mark(interp
);
492 Parrot_pop_context(interp
);
499 =item C<static STRING * clone_string_into(Interp *d, Interp *s, PMC *value)>
501 Extracts a STRING value from PMC C<value> in interpreter C<s>. Copies that
502 string into the pool of interpreter C<d> using the default encoding
509 PARROT_WARN_UNUSED_RESULT
510 PARROT_CANNOT_RETURN_NULL
512 clone_string_into(ARGMOD(Interp
*d
), ARGIN(Interp
*s
), ARGIN(PMC
*value
))
514 ASSERT_ARGS(clone_string_into
)
515 STRING
* const orig
= VTABLE_get_string(s
, value
);
516 char * const raw_str
= Parrot_str_to_cstring(s
, orig
);
518 Parrot_str_new_init(d
, raw_str
, strlen(raw_str
),
519 PARROT_DEFAULT_ENCODING
, PARROT_DEFAULT_CHARSET
,
521 Parrot_str_free_cstring(raw_str
);
527 =item C<static PMC * make_string_pmc(PARROT_INTERP, STRING *string)>
529 Converts a STRING C<string> into a String PMC.
535 PARROT_WARN_UNUSED_RESULT
536 PARROT_CANNOT_RETURN_NULL
538 make_string_pmc(PARROT_INTERP
, ARGIN(STRING
*string
))
540 ASSERT_ARGS(make_string_pmc
)
541 PMC
* const ret
= Parrot_pmc_new_constant(interp
, enum_class_String
);
542 VTABLE_set_string_native(interp
, ret
, string
);
549 =item C<PMC * Parrot_clone_lib_into(Interp *d, Interp *s, PMC *lib_pmc)>
551 Clones a ParrotLibrary PMC C<lib_pmc> from interpreter C<s> into interpreter
559 PARROT_WARN_UNUSED_RESULT
560 PARROT_CANNOT_RETURN_NULL
562 Parrot_clone_lib_into(ARGMOD(Interp
*d
), ARGMOD(Interp
*s
), ARGIN(PMC
*lib_pmc
))
564 ASSERT_ARGS(Parrot_clone_lib_into
)
565 STRING
* const filename
= CONST_STRING(s
, "_filename");
566 STRING
* const libname
= CONST_STRING(s
, "_lib_name");
567 STRING
* const type_str
= CONST_STRING(s
, "_type");
568 STRING
* const ops
= CONST_STRING(s
, "Ops");
570 STRING
* const wo_ext
= clone_string_into(d
, s
,
571 VTABLE_getprop(s
, lib_pmc
, filename
));
572 STRING
* const lib_name
= clone_string_into(d
, s
,
573 VTABLE_getprop(s
, lib_pmc
, libname
));
574 void * const handle
= VTABLE_get_pointer(s
, lib_pmc
);
575 STRING
* const type
=
576 VTABLE_get_string(s
, VTABLE_getprop(s
, lib_pmc
, type_str
));
578 if (Parrot_str_equal(s
, type
, ops
)) {
579 /* we can't clone oplibs in the normal way, since they're actually
580 * shared between interpreters dynop_register modifies the (statically
581 * allocated) op_lib_t structure from core_ops.c, for example.
582 * Anyways, if we hope to share bytecode at runtime, we need to have
583 * them have identical opcodes anyways.
585 PMC
* const new_lib_pmc
= Parrot_pmc_new_constant(d
, enum_class_ParrotLibrary
);
587 PMC_data(new_lib_pmc
) = handle
;
588 VTABLE_setprop(d
, new_lib_pmc
, CONST_STRING(s
, "_filename"), make_string_pmc(d
, wo_ext
));
589 VTABLE_setprop(d
, new_lib_pmc
, CONST_STRING(s
, "_lib_name"), make_string_pmc(d
, lib_name
));
590 VTABLE_setprop(d
, new_lib_pmc
, CONST_STRING(s
, "_type"), make_string_pmc(d
, ops
));
592 /* fixup d->all_op_libs, if necessary */
593 if (d
->n_libs
!= s
->n_libs
) {
596 d
->all_op_libs
= (op_lib_t
**)mem_internal_realloc(d
->all_op_libs
,
597 sizeof (op_lib_t
*) * s
->n_libs
);
599 d
->all_op_libs
= (op_lib_t
**)mem_internal_allocate(sizeof (op_lib_t
*) *
601 for (i
= d
->n_libs
; i
< s
->n_libs
; ++i
)
602 d
->all_op_libs
[i
] = s
->all_op_libs
[i
];
603 d
->n_libs
= s
->n_libs
;
609 return run_init_lib(d
, handle
, lib_name
, wo_ext
);
615 =item C<PMC * Parrot_load_lib(PARROT_INTERP, STRING *lib, PMC *parameters)>
617 Dynamic library loader.
619 C<parameters>, if not null, points to something which controls library
620 loading and initialization. Currently just its integer value is used,
621 interpreted as C<Parrot_dlopen_flags>.
623 Calls C<Parrot_lib_%s_load()> which performs the registration of the lib
624 once C<Parrot_lib_%s_init()> gets called (if exists) to perform thread
625 specific setup. In both functions C<%s> is the name of the library.
627 If Parrot_lib_%s_load() succeeds, it should either return a
628 ParrotLibrary PMC, which is then used as the handle for this library
629 or NULL, in which case parrot creates a handle for the library.
631 If either Parrot_lib_%s_load() or Parrot_lib_%s_init() detects an error
632 condition, an exception should be thrown.
634 TODO: fetch Parrot_lib load/init handler exceptions
641 PARROT_WARN_UNUSED_RESULT
642 PARROT_CANNOT_RETURN_NULL
644 Parrot_load_lib(PARROT_INTERP
, ARGIN_NULLOK(STRING
*lib
), PMC
*parameters
)
646 ASSERT_ARGS(Parrot_load_lib
)
650 STRING
*lib_name
, *wo_ext
, *ext
; /* library stem without path
653 /* Find the pure library name, without path or extension. */
655 * TODO move the class_count_mutex here
660 lib_name
= parrot_split_path_ext(interp
, lib
, &wo_ext
, &ext
);
663 wo_ext
= string_from_literal(interp
, "");
668 lib_pmc
= is_loaded(interp
, wo_ext
);
669 if (!PMC_IS_NULL(lib_pmc
)) {
674 if (!PMC_IS_NULL(parameters
)) {
675 flags
= VTABLE_get_integer(interp
, parameters
);
678 path
= get_path(interp
, lib
, (Parrot_dlopen_flags
)flags
, &handle
, wo_ext
, ext
);
679 if (!path
|| !handle
) {
681 * XXX Parrot_ex_throw_from_c_args? return PMCNULL?
682 * PMC Undef seems convenient, because it can be queried with get_bool()
684 return Parrot_pmc_new(interp
, enum_class_Undef
);
687 return run_init_lib(interp
, handle
, lib_name
, wo_ext
);
696 F<include/parrot/dynext.h> and F<src/pmc/parrotlibrary.pmc>.
700 Initial rev by leo 2003.08.06.
709 * c-file-style: "parrot"
711 * vim: expandtab shiftwidth=4: