/***********************************************************************/ /* */ /* Objective Caml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 2001 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ /* under the terms of the GNU Library General Public License, with */ /* the special exception on linking described in file ../LICENSE. */ /* */ /***********************************************************************/ /* $Id$ */ /* Unix-specific stuff */ #include #include #include #include #include #include #include "config.h" #ifdef SUPPORT_DYNAMIC_LINKING #ifdef HAS_NSLINKMODULE #include #elif defined(__CYGWIN32__) #include "flexdll.h" #else #include #endif #endif #ifdef HAS_UNISTD #include #endif #ifdef HAS_DIRENT #include #else #include #endif #include "memory.h" #include "misc.h" #include "osdeps.h" #ifndef S_ISREG #define S_ISREG(mode) (((mode) & S_IFMT) == S_IFREG) #endif char * caml_decompose_path(struct ext_table * tbl, char * path) { char * p, * q; int n; if (path == NULL) return NULL; p = caml_stat_alloc(strlen(path) + 1); strcpy(p, path); q = p; while (1) { for (n = 0; q[n] != 0 && q[n] != ':'; n++) /*nothing*/; caml_ext_table_add(tbl, q); q = q + n; if (*q == 0) break; *q = 0; q += 1; } return p; } char * caml_search_in_path(struct ext_table * path, char * name) { char * p, * fullname; int i; struct stat st; for (p = name; *p != 0; p++) { if (*p == '/') goto not_found; } for (i = 0; i < path->size; i++) { fullname = caml_stat_alloc(strlen((char *)(path->contents[i])) + strlen(name) + 2); strcpy(fullname, (char *)(path->contents[i])); if (fullname[0] != 0) strcat(fullname, "/"); strcat(fullname, name); if (stat(fullname, &st) == 0 && S_ISREG(st.st_mode)) return fullname; caml_stat_free(fullname); } not_found: fullname = caml_stat_alloc(strlen(name) + 1); strcpy(fullname, name); return fullname; } #ifdef __CYGWIN32__ /* Cygwin needs special treatment because of the implicit ".exe" at the end of executable file names */ static int cygwin_file_exists(char * name) { int fd; /* Cannot use stat() here because it adds ".exe" implicitly */ fd = open(name, O_RDONLY); if (fd == -1) return 0; close(fd); return 1; } static char * cygwin_search_exe_in_path(struct ext_table * path, char * name) { char * p, * fullname; int i; for (p = name; *p != 0; p++) { if (*p == '/' || *p == '\\') goto not_found; } for (i = 0; i < path->size; i++) { fullname = caml_stat_alloc(strlen((char *)(path->contents[i])) + strlen(name) + 6); strcpy(fullname, (char *)(path->contents[i])); strcat(fullname, "/"); strcat(fullname, name); if (cygwin_file_exists(fullname)) return fullname; strcat(fullname, ".exe"); if (cygwin_file_exists(fullname)) return fullname; caml_stat_free(fullname); } not_found: fullname = caml_stat_alloc(strlen(name) + 5); strcpy(fullname, name); if (cygwin_file_exists(fullname)) return fullname; strcat(fullname, ".exe"); if (cygwin_file_exists(fullname)) return fullname; strcpy(fullname, name); return fullname; } #endif char * caml_search_exe_in_path(char * name) { struct ext_table path; char * tofree; char * res; caml_ext_table_init(&path, 8); tofree = caml_decompose_path(&path, getenv("PATH")); #ifndef __CYGWIN32__ res = caml_search_in_path(&path, name); #else res = cygwin_search_exe_in_path(&path, name); #endif caml_stat_free(tofree); caml_ext_table_free(&path, 0); return res; } char * caml_search_dll_in_path(struct ext_table * path, char * name) { char * dllname = caml_stat_alloc(strlen(name) + 4); char * res; strcpy(dllname, name); strcat(dllname, ".so"); res = caml_search_in_path(path, dllname); caml_stat_free(dllname); return res; } #ifdef SUPPORT_DYNAMIC_LINKING #ifdef HAS_NSLINKMODULE /* Use MacOSX bundles */ static char *dlerror_string = "No error"; /* Need to emulate dlopen behaviour by caching open libraries */ typedef struct bundle_entry { struct bundle_entry *next; char *name; void *handle; int count; } entry_t; entry_t bundle_list = {NULL,NULL,NULL,0}; entry_t *caml_lookup_bundle(const char *name) { entry_t *current = bundle_list.next, *last = &bundle_list; while (current !=NULL) { if (!strcmp(name,current->name)) return current; last = current; current = current->next; } current = (entry_t*) malloc(sizeof(entry_t)+strlen(name)+1); current->name = (char*)(current+1); strcpy(current->name, name); current->count = 0; current->next = NULL; last->next = current; return current; } void * caml_dlopen(char * libname, int for_execution) { NSObjectFileImage image; entry_t *bentry = caml_lookup_bundle(libname); NSObjectFileImageReturnCode retCode; void *result = NULL; if (bentry->count > 0) return bentry->handle; retCode = NSCreateObjectFileImageFromFile(libname, &image); switch (retCode) { case NSObjectFileImageSuccess: dlerror_string = NULL; result = (void*)NSLinkModule(image, libname, NSLINKMODULE_OPTION_BINDNOW | NSLINKMODULE_OPTION_RETURN_ON_ERROR); if (result != NULL) { bentry->count++; bentry->handle = result; } else NSDestroyObjectFileImage(image); break; case NSObjectFileImageAccess: dlerror_string = "cannot access this bundle"; break; case NSObjectFileImageArch: dlerror_string = "this bundle has wrong CPU architecture"; break; case NSObjectFileImageFormat: case NSObjectFileImageInappropriateFile: dlerror_string = "this file is not a proper bundle"; break; default: dlerror_string = "could not read object file"; break; } return result; } void caml_dlclose(void * handle) { entry_t *current = bundle_list.next; int close = 1; dlerror_string = NULL; while (current != NULL) { if (current->handle == handle) { current->count--; close = (current->count == 0); break; } current = current->next; } if (close) NSUnLinkModule((NSModule)handle, NSUNLINKMODULE_OPTION_NONE); } void * caml_dlsym(void * handle, char * name) { NSSymbol sym; char _name[1000] = "_"; strncat (_name, name, 998); dlerror_string = NULL; sym = NSLookupSymbolInModule((NSModule)handle, _name); if (sym != NULL) return NSAddressOfSymbol(sym); else return NULL; } void * caml_globalsym(char * name) { return NULL; } char * caml_dlerror(void) { NSLinkEditErrors c; int errnum; const char *fileName, *errorString; if (dlerror_string != NULL) return dlerror_string; NSLinkEditError(&c,&errnum,&fileName,&errorString); return (char *) errorString; } #elif defined(__CYGWIN32__) /* Use flexdll */ void * caml_dlopen(char * libname, int for_execution) { int flags = FLEXDLL_RTLD_GLOBAL; if (!for_execution) flags |= FLEXDLL_RTLD_NOEXEC; return flexdll_dlopen(libname, flags); } void caml_dlclose(void * handle) { flexdll_dlclose(handle); } void * caml_dlsym(void * handle, char * name) { return flexdll_dlsym(handle, name); } void * caml_globalsym(char * name) { return flexdll_dlsym(flexdll_dlopen(NULL,0), name); } char * caml_dlerror(void) { return flexdll_dlerror(); } #else /* Use normal dlopen */ #ifndef RTLD_GLOBAL #define RTLD_GLOBAL 0 #endif #ifndef RTLD_NODELETE #define RTLD_NODELETE 0 #endif void * caml_dlopen(char * libname, int for_execution) { return dlopen(libname, RTLD_NOW | RTLD_GLOBAL | RTLD_NODELETE); /* Could use RTLD_LAZY if for_execution == 0, but needs testing */ } void caml_dlclose(void * handle) { dlclose(handle); } void * caml_dlsym(void * handle, char * name) { #ifdef DL_NEEDS_UNDERSCORE char _name[1000] = "_"; strncat (_name, name, 998); name = _name; #endif return dlsym(handle, name); } void * caml_globalsym(char * name) { return caml_dlsym(dlopen(NULL,RTLD_GLOBAL), name); } char * caml_dlerror(void) { return dlerror(); } #endif #else void * caml_dlopen(char * libname, int for_execution) { return NULL; } void caml_dlclose(void * handle) { } void * caml_dlsym(void * handle, char * name) { return NULL; } void * caml_globalsym(char * name) { return NULL; } char * caml_dlerror(void) { return "dynamic loading not supported on this platform"; } #endif #ifdef USE_MMAP_INSTEAD_OF_MALLOC /* The code below supports the use of mmap() rather than malloc() for allocating the chunks composing the major heap. This code is needed on 64-bit Linux platforms, where the native malloc() implementation can return pointers several *exabytes* apart, (some coming from mmap(), other from sbrk()); this makes the page table *way* too large. */ #include char *caml_aligned_mmap (asize_t size, int modulo, void **block) { char *raw_mem; uintnat aligned_mem; Assert (modulo < Page_size); raw_mem = (char *) mmap(NULL, size + Page_size, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0); if (raw_mem == MAP_FAILED) return NULL; *block = raw_mem; raw_mem += modulo; /* Address to be aligned */ aligned_mem = (((uintnat) raw_mem / Page_size + 1) * Page_size); #ifdef DEBUG { uintnat *p; uintnat *p0 = (void *) *block, *p1 = (void *) (aligned_mem - modulo), *p2 = (void *) (aligned_mem - modulo + size), *p3 = (void *) ((char *) *block + size + Page_size); for (p = p0; p < p1; p++) *p = Debug_filler_align; for (p = p1; p < p2; p++) *p = Debug_uninit_align; for (p = p2; p < p3; p++) *p = Debug_filler_align; } #endif return (char *) (aligned_mem - modulo); } void caml_aligned_munmap (char * addr, asize_t size) { int retcode = munmap (addr, size + Page_size); Assert(retcode == 0); } #endif /* Add to [contents] the (short) names of the files contained in the directory named [dirname]. No entries are added for [.] and [..]. Return 0 on success, -1 on error; set errno in the case of error. */ int caml_read_directory(char * dirname, struct ext_table * contents) { DIR * d; #ifdef HAS_DIRENT struct dirent * e; #else struct direct * e; #endif char * p; d = opendir(dirname); if (d == NULL) return -1; while (1) { e = readdir(d); if (e == NULL) break; if (strcmp(e->d_name, ".") == 0 || strcmp(e->d_name, "..") == 0) continue; p = caml_stat_alloc(strlen(e->d_name) + 1); strcpy(p, e->d_name); caml_ext_table_add(contents, p); } closedir(d); return 0; } /* Recover executable name from /proc/self/exe if possible */ #ifdef __linux__ int caml_executable_name(char * name, int name_len) { int retcode; struct stat st; retcode = readlink("/proc/self/exe", name, name_len); if (retcode == -1 || retcode >= name_len) return -1; name[retcode] = 0; /* Make sure that the contents of /proc/self/exe is a regular file. (Old Linux kernels return an inode number instead.) */ if (stat(name, &st) != 0) return -1; if (! S_ISREG(st.st_mode)) return -1; return 0; } #endif