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
  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 "interr.h"
  29 #if defined(LISP_FEATURE_OS_PROVIDES_DLOPEN) && !defined(LISP_FEATURE_WIN32)
  30 # define __USE_GNU /* needed for RTLD_DEFAULT */
  31 # include <dlfcn.h>
  32 #endif
  33
  34
  35 /* Except for os_zero, these routines are only called by Lisp code.
  36  * These routines may also be replaced by os-dependent versions
  37  * instead. See hpux-os.c for some useful restrictions on actual
  38  * usage. */
  39
  40 void
  41 os_zero(os_vm_address_t addr, os_vm_size_t length)
  42 {
  43     os_vm_address_t block_start;
  44     os_vm_size_t block_size;
  45
  46 #ifdef DEBUG
  47     fprintf(stderr,";;; os_zero: addr: 0x%08x, len: 0x%08x\n",addr,length);
  48 #endif
  49
  50     block_start = os_round_up_to_page(addr);
  51
  52     length -= block_start-addr;
  53     block_size = os_trunc_size_to_page(length);
  54
  55     if (block_start > addr)
  56         bzero((char *)addr, block_start-addr);
  57     if (block_size < length)
  58         bzero((char *)block_start+block_size, length-block_size);
  59
  60     if (block_size != 0) {
  61         /* Now deallocate and allocate the block so that it faults in
  62          * zero-filled. */
  63
  64         os_invalidate(block_start, block_size);
  65         addr = os_validate(block_start, block_size);
  66
  67         if (addr == NULL || addr != block_start)
  68             lose("os_zero: block moved! 0x%08x ==> 0x%08x\n",
  69                  block_start,
  70                  addr);
  71     }
  72 }
  73
  74 os_vm_address_t
  75 os_allocate(os_vm_size_t len)
  76 {
  77     return os_validate((os_vm_address_t)NULL, len);
  78 }
  79
  80 void
  81 os_deallocate(os_vm_address_t addr, os_vm_size_t len)
  82 {
  83     os_invalidate(addr,len);
  84 }
  85
  86 int
  87 os_get_errno(void)
  88 {
  89     return errno;
  90 }
  91
  92
  93 #if defined(LISP_FEATURE_SB_THREAD) && (!defined(CANNOT_USE_POSIX_SEM_T) || defined(LISP_FEATURE_WIN32))
  94
  95 void
  96 os_sem_init(os_sem_t *sem, unsigned int value)
  97 {
  98     if (-1==sem_init(sem, 0, value))
  99         lose("os_sem_init(%p, %u): %s", sem, value, strerror(errno));
 100     FSHOW((stderr, "os_sem_init(%p, %u)\n", sem, value));
 101 }
 102
 103 void
 104 os_sem_wait(os_sem_t *sem, char *what)
 105 {
 106     FSHOW((stderr, "%s: os_sem_wait(%p) ...\n", what, sem));
 107     while (-1 == sem_wait(sem))
 108         if (EINTR!=errno)
 109             lose("%s: os_sem_wait(%p): %s", what, sem, strerror(errno));
 110     FSHOW((stderr, "%s: os_sem_wait(%p) => ok\n", what, sem));
 111 }
 112
 113 void
 114 os_sem_post(sem_t *sem, char *what)
 115 {
 116     if (-1 == sem_post(sem))
 117         lose("%s: os_sem_post(%p): %s", what, sem, strerror(errno));
 118     FSHOW((stderr, "%s: os_sem_post(%p)\n", what, sem));
 119 }
 120
 121 void
 122 os_sem_destroy(os_sem_t *sem)
 123 {
 124     if (-1==sem_destroy(sem))
 125         lose("os_sem_destroy(%p): %s", sem, strerror(errno));
 126 }
 127
 128 #endif
 129
 130 #if defined(LISP_FEATURE_OS_PROVIDES_DLOPEN) && !defined(LISP_FEATURE_WIN32)
 131 void* os_dlopen(char* name, int flags) {
 132     volatile void* ret = dlopen(name,flags);
 133     return ret;
 134 }
 135 #endif
 136
 137 #if defined(LISP_FEATURE_SB_DYNAMIC_CORE)
 138 /* When this feature is enabled, the special category of /static/ foreign
 139  * symbols disappears. Foreign fixups are resolved to linkage table locations
 140  * during genesis, and for each of them a record is added to
 141  * REQUIRED_RUNTIME_C_SYMBOLS list, of the form (cons name datap).
 142  *
 143  * Name is a base-string of a symbol name, and non-nil datap marks data
 144  * references.
 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_RUNTIME_C_SYMBOLS.
 149  */
 150
 151 /* We start with a little greenspunning to make car, cdr and base-string data
 152  * accessible. */
 153
 154 /* Object tagged? (dereference (cast (untag (obj)))) */
 155 #define FOLLOW(obj,lowtagtype,ctype)            \
 156     (*(struct ctype*)(obj - lowtagtype##_LOWTAG))
 157
 158 /* For all types sharing OTHER_POINTER_LOWTAG: */
 159 #define FOTHERPTR(obj,ctype)                    \
 160     FOLLOW(obj,OTHER_POINTER,ctype)
 161
 162 static inline lispobj car(lispobj conscell)
 163 {
 164     return FOLLOW(conscell,LIST_POINTER,cons).car;
 165 }
 166
 167 static inline lispobj cdr(lispobj conscell)
 168 {
 169     return FOLLOW(conscell,LIST_POINTER,cons).cdr;
 170 }
 171
 172 extern void undefined_alien_function(); /* see interrupt.c */
 173
 174 #ifndef LISP_FEATURE_WIN32
 175 void *
 176 os_dlsym_default(char *name)
 177 {
 178     void *frob = dlsym(RTLD_DEFAULT, name);
 179     odxprint(misc, "%p", frob);
 180     return frob;
 181 }
 182 #endif
 183
 184 void os_link_runtime()
 185 {
 186     lispobj head;
 187     void *link_target = (void*)(intptr_t)LINKAGE_TABLE_SPACE_START;
 188     void *validated_end = link_target;
 189     lispobj symbol_name;
 190     char *namechars;
 191     boolean datap;
 192     void* result;
 193     int strict /* If in a cold core, fail early and often. */
 194       = (SymbolValue(GC_INHIBIT, 0) & WIDETAG_MASK) == UNBOUND_MARKER_WIDETAG;
 195     int n = 0, m = 0;
 196
 197     for (head = SymbolValue(REQUIRED_RUNTIME_C_SYMBOLS,0);
 198          head!=NIL; head = cdr(head), n++)
 199     {
 200         lispobj item = car(head);
 201         symbol_name = car(item);
 202         datap = (NIL!=(cdr(item)));
 203         namechars = (void*)(intptr_t)FOTHERPTR(symbol_name,vector).data;
 204         result = os_dlsym_default(namechars);
 205         odxprint(runtime_link, "linking %s => %p", namechars, result);
 206
 207         if (link_target == validated_end) {
 208             validated_end += os_vm_page_size;
 209 #ifdef LISP_FEATURE_WIN32
 210             os_validate_recommit(link_target,os_vm_page_size);
 211 #endif
 212         }
 213         if (result) {
 214             if (datap)
 215                 arch_write_linkage_table_ref(link_target,result);
 216             else
 217                 arch_write_linkage_table_jmp(link_target,result);
 218         } else {
 219             m++;
 220             if (strict)
 221                 fprintf(stderr,
 222                         "undefined foreign symbol in cold init: %s\n",
 223                         namechars);
 224         }
 225
 226         link_target = (void*)(((uintptr_t)link_target)+LINKAGE_TABLE_ENTRY_SIZE);
 227     }
 228     odxprint(runtime_link, "%d total symbols linked, %d undefined",
 229              n, m);
 230     if (strict && m)
 231         /* We could proceed, but rather than run into improperly
 232          * displayed internal errors, let's make ourselves heard right
 233          * here and now. */
 234         lose("Undefined aliens in cold init.");
 235 }
 236 #endif  /* sb-dynamic-core */