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
  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     return dlopen(name,flags);
 133 }
 134 #endif
 135
 136 #if defined(LISP_FEATURE_SB_DYNAMIC_CORE)
 137 /* When this feature is enabled, the special category of /static/ foreign
 138  * symbols disappears. Foreign fixups are resolved to linkage table locations
 139  * during genesis, and for each of them a record is added to
 140  * REQUIRED_RUNTIME_C_SYMBOLS list, of the form (cons name datap).
 141  *
 142  * Name is a base-string of a symbol name, and non-nil datap marks data
 143  * references.
 144  *
 145  * Before any code in lisp image can be called, we have to resolve all
 146  * references to runtime foreign symbols that used to be static, adding linkage
 147  * table entry for each element of REQUIRED_RUNTIME_C_SYMBOLS.
 148  */
 149
 150 /* We start with a little greenspunning to make car, cdr and base-string data
 151  * accessible. */
 152
 153 /* Object tagged? (dereference (cast (untag (obj)))) */
 154 #define FOLLOW(obj,lowtagtype,ctype)            \
 155     (*(struct ctype*)(obj - lowtagtype##_LOWTAG))
 156
 157 /* For all types sharing OTHER_POINTER_LOWTAG: */
 158 #define FOTHERPTR(obj,ctype)                    \
 159     FOLLOW(obj,OTHER_POINTER,ctype)
 160
 161 static inline lispobj car(lispobj conscell)
 162 {
 163     return FOLLOW(conscell,LIST_POINTER,cons).car;
 164 }
 165
 166 static inline lispobj cdr(lispobj conscell)
 167 {
 168     return FOLLOW(conscell,LIST_POINTER,cons).cdr;
 169 }
 170
 171 #ifndef LISP_FEATURE_WIN32
 172 void *
 173 os_dlsym_default(char *name)
 174 {
 175     void *frob = dlsym(RTLD_DEFAULT, name);
 176     odxprint(misc, "%p", frob);
 177     return frob;
 178 }
 179 #endif
 180
 181 void os_link_runtime()
 182 {
 183     lispobj head;
 184     void *link_target = (void*)(intptr_t)LINKAGE_TABLE_SPACE_START;
 185     void *validated_end = link_target;
 186     lispobj symbol_name;
 187     char *namechars;
 188     boolean datap;
 189     void* result;
 190     int strict /* If in a cold core, fail early and often. */
 191       = (SymbolValue(GC_INHIBIT, 0) & WIDETAG_MASK) == UNBOUND_MARKER_WIDETAG;
 192     int n = 0, m = 0;
 193
 194     for (head = SymbolValue(REQUIRED_RUNTIME_C_SYMBOLS,0);
 195          head!=NIL; head = cdr(head), n++)
 196     {
 197         lispobj item = car(head);
 198         symbol_name = car(item);
 199         datap = (NIL!=(cdr(item)));
 200         namechars = (void*)(intptr_t)FOTHERPTR(symbol_name,vector).data;
 201         result = os_dlsym_default(namechars);
 202         odxprint(runtime_link, "linking %s => %p", namechars, result);
 203
 204         if (link_target == validated_end) {
 205             validated_end += os_vm_page_size;
 206 #ifdef LISP_FEATURE_WIN32
 207             os_validate_recommit(link_target,os_vm_page_size);
 208 #endif
 209         }
 210         if (result) {
 211             if (datap)
 212                 arch_write_linkage_table_ref(link_target,result);
 213             else
 214                 arch_write_linkage_table_jmp(link_target,result);
 215         } else {
 216             m++;
 217             if (strict)
 218                 fprintf(stderr,
 219                         "undefined foreign symbol in cold init: %s\n",
 220                         namechars);
 221         }
 222
 223         link_target = (void*)(((uintptr_t)link_target)+LINKAGE_TABLE_ENTRY_SIZE);
 224     }
 225     odxprint(runtime_link, "%d total symbols linked, %d undefined",
 226              n, m);
 227     if (strict && m)
 228         /* We could proceed, but rather than run into improperly
 229          * displayed internal errors, let's make ourselves heard right
 230          * here and now. */
 231         lose("Undefined aliens in cold init.");
 232 }
 233 #endif  /* sb-dynamic-core */