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 /* When :SB-DYNAMIC-CORE is enabled, the special category of /static/ foreign
 141  * symbols disappears. Foreign fixups are resolved to linkage table locations
 142  * during genesis, and for each of them a record is added to
 143  * REQUIRED_FOREIGN_SYMBOLS vector, of the form "name" for a function reference,
 144  * or ("name") for a data reference. "name" is a base-string.
 145  *
 146  * Before any code in lisp image can be called, we have to resolve all
 147  * references to runtime foreign symbols that used to be static, adding linkage
 148  * table entry for each element of REQUIRED_FOREIGN_SYMBOLS.
 149  */
 150
 151 #if defined(LISP_FEATURE_SB_DYNAMIC_CORE) && !defined(LISP_FEATURE_WIN32)
 152 void *
 153 os_dlsym_default(char *name)
 154 {
 155     void *frob = dlsym(RTLD_DEFAULT, name);
 156     odxprint(misc, "%p", frob);
 157     return frob;
 158 }
 159 #endif
 160
 161 void os_link_runtime()
 162 {
 163     extern void write_protect_immobile_space();
 164
 165 #ifdef LISP_FEATURE_SB_DYNAMIC_CORE
 166     char *link_target = (char*)(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_FOREIGN_SYMBOLS,0));
 175     n = fixnum_value(symbols->length);
 176     for (j = 0 ; j < n ; ++j)
 177     {
 178         lispobj item = symbols->data[j];
 179         datap = lowtag_of(item) == LIST_POINTER_LOWTAG;
 180         symbol_name = datap ? CONS(item)->car : item;
 181         namechars = (void*)(intptr_t)(VECTOR(symbol_name)->data);
 182         result = os_dlsym_default(namechars);
 183         odxprint(runtime_link, "linking %s => %p", namechars, result);
 184
 185         if (link_target == validated_end) {
 186             validated_end = (char*)validated_end + os_vm_page_size;
 187 #ifdef LISP_FEATURE_WIN32
 188             os_validate_recommit(link_target,os_vm_page_size);
 189 #endif
 190         }
 191         if (result) {
 192             if (datap)
 193                 arch_write_linkage_table_ref(link_target,result);
 194             else
 195                 arch_write_linkage_table_jmp(link_target,result);
 196         } else {
 197             m++;
 198         }
 199
 200         link_target += LINKAGE_TABLE_ENTRY_SIZE;
 201     }
 202     odxprint(runtime_link, "%d total symbols linked, %d undefined",
 203              n, m);
 204 #endif /* LISP_FEATURE_SB_DYNAMIC_CORE */
 205
 206 #ifdef LISP_FEATURE_IMMOBILE_SPACE
 207     /* Delayed until after dynamic space has been mapped, fixups made,
 208      * and/or immobile-space linkage entries written,
 209      * since it was too soon earlier to handle write faults. */
 210     write_protect_immobile_space();
 211 #endif
 212 }
 213
 214 #ifndef LISP_FEATURE_WIN32
 215
 216 /* Remap a part of an already existing mapping to a file */
 217 void os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len)
 218 {
 219     os_vm_address_t actual;
 220
 221     actual = mmap(addr, len, OS_VM_PROT_ALL, MAP_PRIVATE | MAP_FIXED,
 222                   fd, (off_t) offset);
 223     if (actual == MAP_FAILED || (addr && (addr != actual))) {
 224         perror("mmap");
 225         lose("unexpected mmap(%d, %d, ...) failure\n", addr, len);
 226     }
 227 }
 228
 229 boolean
 230 gc_managed_addr_p(lispobj ad)
 231 {
 232     struct thread *th;
 233
 234     if ((READ_ONLY_SPACE_START <= ad && ad < READ_ONLY_SPACE_END)
 235         || (STATIC_SPACE_START <= ad && ad < STATIC_SPACE_END)
 236 #if defined LISP_FEATURE_IMMOBILE_SPACE
 237         || (IMMOBILE_SPACE_START <= ad && ad < IMMOBILE_SPACE_END)
 238 #endif
 239 #if defined LISP_FEATURE_GENCGC
 240         || (DYNAMIC_SPACE_START <= ad &&
 241             ad < (DYNAMIC_SPACE_START + dynamic_space_size))
 242 #else
 243         || (DYNAMIC_0_SPACE_START <= ad && ad < DYNAMIC_0_SPACE_END)
 244         || (DYNAMIC_1_SPACE_START <= ad && ad < DYNAMIC_1_SPACE_END)
 245 #endif
 246         )
 247         return 1;
 248     for_each_thread(th) {
 249         if(th->control_stack_start <= (lispobj*)ad
 250            && (lispobj*)ad < th->control_stack_end)
 251             return 1;
 252         if(th->binding_stack_start <= (lispobj*)ad
 253            && (lispobj*)ad < th->binding_stack_start + BINDING_STACK_SIZE)
 254             return 1;
 255     }
 256     return 0;
 257 }
 258
 259 #endif