INTVAL
Parrot_Run_OS_Command(PARROT_INTERP, STRING *command)
{
DWORD status = 0;
STARTUPINFO si;
PROCESS_INFORMATION pi;
char* const cmd = (char *)mem_sys_allocate(command->strlen + 4);
char* const shell = Parrot_getenv(interp, Parrot_str_new(interp, "ComSpec", strlen("ComSpec")));
char* const cmdin = Parrot_str_to_cstring(interp, command);
strcpy(cmd, "/c ");
strcat(cmd, cmdin);
Parrot_str_free_cstring(cmdin);
memset(&si, 0, sizeof (si));
si.cb = sizeof (si);
memset(&pi, 0, sizeof (pi));
/* Start the child process. */
if (!CreateProcess(shell, cmd, NULL, NULL, TRUE, 0, NULL, NULL, &si, &pi))
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_NOSPAWN,
"Can't spawn child process");
WaitForSingleObject(pi.hProcess, INFINITE);
if (!GetExitCodeProcess(pi.hProcess, &status)) {
Parrot_warn(interp, PARROT_WARNINGS_PLATFORM_FLAG,
"Process completed: Failed to get exit code.");
}
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
Parrot_str_free_cstring(shell);
mem_sys_free(cmd);
/* Return exit code left shifted by 8 for POSIX emulation. */
return status << 8;
}
=item C<static int is_env_var_set(PARROT_INTERP, STRING* var)>
Checks whether the specified environment variable is set.
=cut
*/
PARROT_WARN_UNUSED_RESULT
static int
is_env_var_set(PARROT_INTERP, ARGIN(STRING* var))
{
ASSERT_ARGS(is_env_var_set)
int retval;
STRING * const value = Parrot_getenv(interp, var);
if (STRING_IS_NULL(value))
retval = 0;
else if (STRING_IS_EMPTY(value))
retval = 0;
else
retval = !STRING_equal(interp, value, CONST_STRING(interp, "0"));
return retval;
}
/*
=item C<Parrot_Interp Parrot_new(Parrot_Interp parent)>
Returns a new Parrot interpreter.
void
parrot_init_library_paths(PARROT_INTERP)
{
ASSERT_ARGS(parrot_init_library_paths)
PMC *paths;
STRING *entry;
STRING *versionlib = NULL;
STRING *builddir = NULL;
PMC * const iglobals = interp->iglobals;
PMC * const config_hash = VTABLE_get_pmc_keyed_int(interp, iglobals,
(INTVAL)IGLOBALS_CONFIG_HASH);
/* create the lib_paths array */
PMC * const lib_paths = Parrot_pmc_new_init_int(interp,
enum_class_FixedPMCArray, PARROT_LIB_PATH_SIZE);
VTABLE_set_pmc_keyed_int(interp, iglobals,
IGLOBALS_LIB_PATHS, lib_paths);
if (VTABLE_elements(interp, config_hash)) {
STRING * const libkey = CONST_STRING(interp, "libdir");
STRING * const verkey = CONST_STRING(interp, "versiondir");
STRING * const builddirkey = CONST_STRING(interp, "build_dir");
STRING * const installed = CONST_STRING(interp, "installed");
versionlib = VTABLE_get_string_keyed_str(interp, config_hash, libkey);
entry = VTABLE_get_string_keyed_str(interp, config_hash, verkey);
versionlib = Parrot_str_concat(interp, versionlib, entry);
if (!VTABLE_get_integer_keyed_str(interp, config_hash, installed))
builddir = VTABLE_get_string_keyed_str(interp,
config_hash, builddirkey);
}
/* each is an array of strings */
/* define include paths */
paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
VTABLE_set_pmc_keyed_int(interp, lib_paths,
PARROT_LIB_PATH_INCLUDE, paths);
{ /* EXPERIMENTAL: add include path from environment */
const char *envvar = Parrot_getenv(interp,
Parrot_str_new_constant(interp, "PARROT_INCLUDE"));
if (envvar != NULL && envvar[0]) {
entry = Parrot_str_new(interp, envvar, 0);
VTABLE_push_string(interp, paths, entry);
}
}
if (!STRING_IS_NULL(builddir)) {
entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/"));
VTABLE_push_string(interp, paths, entry);
entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/include/"));
VTABLE_push_string(interp, paths, entry);
}
entry = CONST_STRING(interp, "./");
VTABLE_push_string(interp, paths, entry);
if (!STRING_IS_NULL(versionlib)) {
entry = Parrot_str_concat(interp, versionlib, CONST_STRING(interp, "/include/"));
VTABLE_push_string(interp, paths, entry);
}
/* define library paths */
paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
VTABLE_set_pmc_keyed_int(interp, lib_paths,
PARROT_LIB_PATH_LIBRARY, paths);
{ /* EXPERIMENTAL: add library path from environment */
const char *envvar = Parrot_getenv(interp,
Parrot_str_new_constant(interp, "PARROT_LIBRARY"));
if (envvar != NULL && envvar[0]) {
entry = Parrot_str_new(interp, envvar, 0);
VTABLE_push_string(interp, paths, entry);
}
}
if (!STRING_IS_NULL(builddir)) {
entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/library/"));
VTABLE_push_string(interp, paths, entry);
}
entry = CONST_STRING(interp, "./");
VTABLE_push_string(interp, paths, entry);
if (!STRING_IS_NULL(versionlib)) {
entry = Parrot_str_concat(interp, versionlib, CONST_STRING(interp, "/library/"));
VTABLE_push_string(interp, paths, entry);
}
/* define languages paths */
paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
VTABLE_set_pmc_keyed_int(interp, lib_paths,
PARROT_LIB_PATH_LANG, paths);
if (!STRING_IS_NULL(builddir)) {
entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/languages/"));
VTABLE_push_string(interp, paths, entry);
}
entry = CONST_STRING(interp, "./");
VTABLE_push_string(interp, paths, entry);
if (!STRING_IS_NULL(versionlib)) {
entry = Parrot_str_concat(interp, versionlib, CONST_STRING(interp, "/languages/"));
VTABLE_push_string(interp, paths, entry);
}
/* define dynext paths */
paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
VTABLE_set_pmc_keyed_int(interp, lib_paths,
PARROT_LIB_PATH_DYNEXT, paths);
if (!STRING_IS_NULL(builddir)) {
entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/dynext/"));
VTABLE_push_string(interp, paths, entry);
}
entry = CONST_STRING(interp, "dynext/");
VTABLE_push_string(interp, paths, entry);
if (!STRING_IS_NULL(versionlib)) {
entry = Parrot_str_concat(interp, versionlib, CONST_STRING(interp, "/dynext/"));
VTABLE_push_string(interp, paths, entry);
}
/* shared exts */
paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
VTABLE_set_pmc_keyed_int(interp, lib_paths,
PARROT_LIB_DYN_EXTS, paths);
/* no CONST_STRING here - the c2str.pl preprocessor needs "real strs" */
entry = Parrot_str_new_constant(interp, PARROT_LOAD_EXT);
VTABLE_push_string(interp, paths, entry);
/* OS/X has .dylib and .bundle */
if (!STREQ(PARROT_LOAD_EXT, PARROT_SHARE_EXT)) {
entry = Parrot_str_new_constant(interp, PARROT_SHARE_EXT);
VTABLE_push_string(interp, paths, entry);
}
#ifdef PARROT_PLATFORM_LIB_PATH_INIT_HOOK
PARROT_PLATFORM_LIB_PATH_INIT_HOOK(interp, lib_paths);
#endif
}
void
parrot_init_library_paths(PARROT_INTERP)
{
ASSERT_ARGS(parrot_init_library_paths)
PMC *paths;
STRING *entry;
PMC * const iglobals = interp->iglobals;
/* create the lib_paths array */
PMC * const lib_paths = Parrot_pmc_new_init_int(interp,
enum_class_FixedPMCArray, PARROT_LIB_PATH_SIZE);
VTABLE_set_pmc_keyed_int(interp, iglobals,
IGLOBALS_LIB_PATHS, lib_paths);
/* each is an array of strings */
/* define include paths */
paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
VTABLE_set_pmc_keyed_int(interp, lib_paths,
PARROT_LIB_PATH_INCLUDE, paths);
{ /* EXPERIMENTAL: add include path from environment */
STRING *envvar = Parrot_getenv(interp, CONST_STRING(interp, "PARROT_INCLUDE"));
Parrot_warn_experimental(interp, "PARROT_INCLUDE environment variable is experimental");
if (!STRING_IS_NULL(envvar) && !STRING_IS_EMPTY(envvar))
VTABLE_push_string(interp, paths, envvar);
}
entry = CONST_STRING(interp, "./");
VTABLE_push_string(interp, paths, entry);
/* define library paths */
paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
VTABLE_set_pmc_keyed_int(interp, lib_paths,
PARROT_LIB_PATH_LIBRARY, paths);
{ /* EXPERIMENTAL: add library path from environment */
STRING *envvar = Parrot_getenv(interp, CONST_STRING(interp, "PARROT_LIBRARY"));
Parrot_warn_experimental(interp, "PARROT_LIBRARY environment variable is experimental");
if (!STRING_IS_NULL(envvar) && !STRING_IS_EMPTY(envvar))
VTABLE_push_string(interp, paths, envvar);
}
entry = CONST_STRING(interp, "./");
VTABLE_push_string(interp, paths, entry);
/* define languages paths */
paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
VTABLE_set_pmc_keyed_int(interp, lib_paths,
PARROT_LIB_PATH_LANG, paths);
entry = CONST_STRING(interp, "./");
VTABLE_push_string(interp, paths, entry);
/* define dynext paths */
paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
VTABLE_set_pmc_keyed_int(interp, lib_paths,
PARROT_LIB_PATH_DYNEXT, paths);
entry = CONST_STRING(interp, "dynext/");
VTABLE_push_string(interp, paths, entry);
/* shared exts */
paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
VTABLE_set_pmc_keyed_int(interp, lib_paths,
PARROT_LIB_DYN_EXTS, paths);
/* no CONST_STRING here - the c2str.pl preprocessor needs "real strs" */
entry = Parrot_str_new_constant(interp, PARROT_LOAD_EXT);
VTABLE_push_string(interp, paths, entry);
/* OS/X has .dylib and .bundle */
if (!STREQ(PARROT_LOAD_EXT, PARROT_SHARE_EXT)) {
entry = Parrot_str_new_constant(interp, PARROT_SHARE_EXT);
VTABLE_push_string(interp, paths, entry);
}
#ifdef PARROT_PLATFORM_LIB_PATH_INIT_HOOK
PARROT_PLATFORM_LIB_PATH_INIT_HOOK(interp, lib_paths);
#endif
}
=item C<static int is_env_var_set(PARROT_INTERP, STRING* var)>
Checks whether the specified environment variable is set.
=cut
*/
PARROT_WARN_UNUSED_RESULT
static int
is_env_var_set(PARROT_INTERP, ARGIN(STRING* var))
{
ASSERT_ARGS(is_env_var_set)
int retval;
char* const value = Parrot_getenv(interp, var);
if (value == NULL)
retval = 0;
else if (*value == '\0')
retval = 0;
else
retval = !STREQ(value, "0");
return retval;
}
/*
=item C<Parrot_Interp make_interpreter(Interp *parent, INTVAL flags)>
Create the Parrot interpreter. Allocate memory and clear the registers.
char *profile_filename_cstr, *output_cstr, *env_filename_cstr;
/* initialize the runcore struct */
runcore->runops = (Parrot_runcore_runops_fn_t) runops_profiling_core;
runcore->destroy = (Parrot_runcore_destroy_fn_t) destroy_profiling_core;
runcore->prev_ctx = NULL;
runcore->profiling_flags = 0;
runcore->runloop_count = 0;
runcore->time_size = 32;
runcore->line_cache = parrot_new_pointer_hash(interp);
runcore->time = mem_gc_allocate_n_typed(interp, runcore->time_size,
UHUGEINTVAL);
/* figure out what format the output should be in */
output_cstr = Parrot_getenv(interp, CONST_STRING(interp, "PARROT_PROFILING_OUTPUT"));
if (output_cstr) {
STRING *profile_format_str = Parrot_str_new(interp, output_cstr, 0);
if (STRING_equal(interp, profile_format_str, CONST_STRING(interp, "pprof"))) {
runcore->output_fn = record_values_ascii_pprof;
}
else if (STRING_equal(interp, profile_format_str, CONST_STRING(interp, "none"))) {
runcore->output_fn = record_values_none;
}
else {
fprintf(stderr, "'%s' is not a valid profiling output format.\n", output_cstr);
fprintf(stderr, "Valid values are pprof and none. The default is pprof.\n");
exit(1);
}
