src/runtime/os-common.c

   1 /*
   2  * This software is part of the SBCL system. See the README file for
   3  * more information.
   4  *
   5  * This software is derived from the CMU CL system, which was
   6  * written at Carnegie Mellon University and released into the
   7  * public domain. The software is in the public domain and is
   8  * provided with absolutely no warranty. See the COPYING and CREDITS
   9  * files for more information.
  10  */
  11 # define _GNU_SOURCE /* needed for RTLD_DEFAULT from dlfcn.h */
  12 #include <stdio.h>
  13 #include <errno.h>
  14 #include <string.h>
  15
  16 #include "sbcl.h"
  17 #include "globals.h"
  18 #include "runtime.h"
  19 #include "genesis/config.h"
  20 #include "genesis/constants.h"
  21 #include "genesis/cons.h"
  22 #include "genesis/vector.h"
  23 #include "genesis/symbol.h"
  24 #include "genesis/static-symbols.h"
  25 #include "thread.h"
  26 #include "sbcl.h"
  27 #include "os.h"
  28 #include "arch.h"
  29 #include "interr.h"
  30 #if defined(LISP_FEATURE_OS_PROVIDES_DLOPEN) && !defined(LISP_FEATURE_WIN32)
  31 # include <dlfcn.h>
  32 #endif
  33
  34 /* Expose to Lisp the value of the preprocessor define. Don't touch! */
  35 int install_sig_memory_fault_handler = INSTALL_SIG_MEMORY_FAULT_HANDLER;
  36
  37 /* Except for os_zero, these routines are only called by Lisp code.
  38  * These routines may also be replaced by os-dependent versions
  39  * instead. See hpux-os.c for some useful restrictions on actual
  40  * usage. */
  41
  42 #ifdef LISP_FEATURE_CHENEYGC
  43 void
  44 os_zero(os_vm_address_t addr, os_vm_size_t length)
  45 {
  46     os_vm_address_t block_start;
  47     os_vm_size_t block_size;
  48
  49 #ifdef DEBUG
  50     fprintf(stderr,";;; os_zero: addr: 0x%08x, len: 0x%08x\n",addr,length);
  51 #endif
  52
  53     block_start = os_round_up_to_page(addr);
  54
  55     length -= block_start-addr;
  56     block_size = os_trunc_size_to_page(length);
  57
  58     if (block_start > addr)
  59         bzero((char *)addr, block_start-addr);
  60     if (block_size < length)
  61         bzero((char *)block_start+block_size, length-block_size);
  62
  63     if (block_size != 0) {
  64         /* Now deallocate and allocate the block so that it faults in
  65          * zero-filled. */
  66
  67         os_invalidate(block_start, block_size);
  68         addr = os_validate(NOT_MOVABLE, block_start, block_size);
  69
  70         if (addr == NULL || addr != block_start)
  71             lose("os_zero: block moved! 0x%08x ==> 0x%08x\n",
  72                  block_start,
  73                  addr);
  74     }
  75 }
  76 #endif
  77
  78 os_vm_address_t
  79 os_allocate(os_vm_size_t len)
  80 {
  81     return os_validate(MOVABLE, (os_vm_address_t)NULL, len);
  82 }
  83
  84 void
  85 os_deallocate(os_vm_address_t addr, os_vm_size_t len)
  86 {
  87     os_invalidate(addr,len);
  88 }
  89
  90 int
  91 os_get_errno(void)
  92 {
  93     return errno;
  94 }
  95
  96
  97 #if defined(LISP_FEATURE_SB_THREAD) && (!defined(CANNOT_USE_POSIX_SEM_T) || defined(LISP_FEATURE_WIN32))
  98
  99 void
 100 os_sem_init(os_sem_t *sem, unsigned int value)
 101 {
 102     if (-1==sem_init(sem, 0, value))
 103         lose("os_sem_init(%p, %u): %s", sem, value, strerror(errno));
 104     FSHOW((stderr, "os_sem_init(%p, %u)\n", sem, value));
 105 }
 106
 107 void
 108 os_sem_wait(os_sem_t *sem, char *what)
 109 {
 110     FSHOW((stderr, "%s: os_sem_wait(%p) ...\n", what, sem));
 111     while (-1 == sem_wait(sem))
 112         if (EINTR!=errno)
 113             lose("%s: os_sem_wait(%p): %s", what, sem, strerror(errno));
 114     FSHOW((stderr, "%s: os_sem_wait(%p) => ok\n", what, sem));
 115 }
 116
 117 void
 118 os_sem_post(sem_t *sem, char *what)
 119 {
 120     if (-1 == sem_post(sem))
 121         lose("%s: os_sem_post(%p): %s", what, sem, strerror(errno));
 122     FSHOW((stderr, "%s: os_sem_post(%p)\n", what, sem));
 123 }
 124
 125 void
 126 os_sem_destroy(os_sem_t *sem)
 127 {
 128     if (-1==sem_destroy(sem))
 129         lose("os_sem_destroy(%p): %s", sem, strerror(errno));
 130 }
 131
 132 #endif
 133
 134 #if defined(LISP_FEATURE_OS_PROVIDES_DLOPEN) && !defined(LISP_FEATURE_WIN32)
 135 void* os_dlopen(char* name, int flags) {
 136     return dlopen(name,flags);
 137 }
 138 #endif
 139
 140 #if defined(LISP_FEATURE_SB_DYNAMIC_CORE)
 141 /* When this feature is enabled, the special category of /static/ foreign
 142  * symbols disappears. Foreign fixups are resolved to linkage table locations
 143  * during genesis, and for each of them a record is added to
 144  * REQUIRED_RUNTIME_C_SYMBOLS list, of the form (cons name datap).
 145  *
 146  * Name is a base-string of a symbol name, and non-nil datap marks data
 147  * references.
 148  *
 149  * Before any code in lisp image can be called, we have to resolve all
 150  * references to runtime foreign symbols that used to be static, adding linkage
 151  * table entry for each element of REQUIRED_RUNTIME_C_SYMBOLS.
 152  */
 153
 154 #ifndef LISP_FEATURE_WIN32
 155 void *
 156 os_dlsym_default(char *name)
 157 {
 158     void *frob = dlsym(RTLD_DEFAULT, name);
 159     odxprint(misc, "%p", frob);
 160     return frob;
 161 }
 162 #endif
 163
 164 void os_link_runtime()
 165 {
 166     void *link_target = (void*)(intptr_t)LINKAGE_TABLE_SPACE_START;
 167     void *validated_end = link_target;
 168     lispobj symbol_name;
 169     char *namechars;
 170     boolean datap;
 171     void* result;
 172     int n = 0, m = 0, j;
 173
 174     struct vector* symbols = VECTOR(SymbolValue(REQUIRED_RUNTIME_C_SYMBOLS,0));
 175     n = fixnum_value(symbols->length);
 176     for (j = 0 ; j < n ; ++j)
 177     {
 178         lispobj item = symbols->data[j];
 179         symbol_name = CONS(item)->car;
 180         datap = CONS(item)->cdr != NIL;
 181         namechars = (void*)(intptr_t)
 182             (VECTOR(symbol_name)->data);
 183         result = os_dlsym_default(namechars);
 184         odxprint(runtime_link, "linking %s => %p", namechars, result);
 185
 186         if (link_target == validated_end) {
 187             validated_end = (char*)validated_end + os_vm_page_size;
 188 #ifdef LISP_FEATURE_WIN32
 189             os_validate_recommit(link_target,os_vm_page_size);
 190 #endif
 191         }
 192         if (result) {
 193             if (datap)
 194                 arch_write_linkage_table_ref(link_target,result);
 195             else
 196                 arch_write_linkage_table_jmp(link_target,result);
 197         } else {
 198             m++;
 199         }
 200
 201         link_target = (void*)(((uintptr_t)link_target)+LINKAGE_TABLE_ENTRY_SIZE);
 202     }
 203     odxprint(runtime_link, "%d total symbols linked, %d undefined",
 204              n, m);
 205 }
 206 #endif  /* sb-dynamic-core */
 207
 208 #ifndef LISP_FEATURE_WIN32
 209
 210 /* Remap a part of an already existing mapping to a file */
 211 void os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len)
 212 {
 213     os_vm_address_t actual;
 214
 215     actual = mmap(addr, len, OS_VM_PROT_ALL, MAP_PRIVATE | MAP_FIXED,
 216                   fd, (off_t) offset);
 217     if (actual == MAP_FAILED || (addr && (addr != actual))) {
 218         perror("mmap");
 219         lose("unexpected mmap(%d, %d, ...) failure\n", addr, len);
 220     }
 221 }
 222
 223 boolean
 224 gc_managed_addr_p(lispobj ad)
 225 {
 226     struct thread *th;
 227
 228     if ((READ_ONLY_SPACE_START <= ad && ad < READ_ONLY_SPACE_END)
 229         || (STATIC_SPACE_START <= ad && ad < STATIC_SPACE_END)
 230 #if defined LISP_FEATURE_IMMOBILE_SPACE
 231         || (IMMOBILE_SPACE_START <= ad && ad < IMMOBILE_SPACE_END)
 232 #endif
 233 #if defined LISP_FEATURE_GENCGC
 234         || (DYNAMIC_SPACE_START <= ad &&
 235             ad < (DYNAMIC_SPACE_START + dynamic_space_size))
 236 #else
 237         || (DYNAMIC_0_SPACE_START <= ad && ad < DYNAMIC_0_SPACE_END)
 238         || (DYNAMIC_1_SPACE_START <= ad && ad < DYNAMIC_1_SPACE_END)
 239 #endif
 240         )
 241         return 1;
 242     for_each_thread(th) {
 243         if(th->control_stack_start <= (lispobj*)ad
 244            && (lispobj*)ad < th->control_stack_end)
 245             return 1;
 246         if(th->binding_stack_start <= (lispobj*)ad
 247            && (lispobj*)ad < th->binding_stack_start + BINDING_STACK_SIZE)
 248             return 1;
 249     }
 250     return 0;
 251 }
 252
 253 #endif