src/lisp/os-common.c

   1 /*
   2
   3  $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/os-common.c,v 1.33 2010/12/22 02:12:52 rtoy Exp $
   4
   5  This code was written as part of the CMU Common Lisp project at
   6  Carnegie Mellon University, and has been placed in the public domain.
   7
   8 */
   9
  10 #include <errno.h>
  11 #include <netdb.h>
  12 #include <stdio.h>
  13 #include <string.h>
  14
  15 #include "os.h"
  16 #include "internals.h"
  17 #include "validate.h"
  18 #include "lisp.h"
  19 #include "lispregs.h"
  20 #include "globals.h"
  21 #include "interr.h"
  22 #include "arch.h"
  23 #include "interrupt.h"
  24
  25 /* Except for os_zero, these routines are only called by Lisp code.  These
  26    routines may also be replaced by os-dependent versions instead.  See
  27    hpux-os.c for some useful restrictions on actual usage. */
  28
  29 void
  30 os_zero(os_vm_address_t addr, os_vm_size_t length)
  31 {
  32     os_vm_address_t block_start;
  33     os_vm_size_t block_size;
  34
  35 #ifdef PRINTNOISE
  36     fprintf(stderr, ";;; os_zero: addr: 0x%08x, len: 0x%08x\n", addr, length);
  37 #endif
  38
  39     block_start = os_round_up_to_page(addr);
  40
  41     length -= block_start - addr;
  42     block_size = os_trunc_size_to_page(length);
  43
  44     if (block_start > addr)
  45         memset((char *) addr, 0, block_start - addr);
  46     if (block_size < length)
  47         memset((char *) block_start + block_size, 0, length - block_size);
  48
  49     if (block_size != 0) {
  50         /* Now deallocate and allocate the block so that it */
  51         /* faults in  zero-filled. */
  52
  53         os_invalidate(block_start, block_size);
  54         addr = os_validate(block_start, block_size);
  55
  56         if (addr == NULL || addr != block_start)
  57             fprintf(stderr, "os_zero: block moved, 0x%p ==> 0x%8p!\n",
  58                     (void *) block_start, (void *) addr);
  59     }
  60 }
  61
  62 os_vm_address_t
  63 os_allocate(os_vm_size_t len)
  64 {
  65     return os_validate((os_vm_address_t) NULL, len);
  66 }
  67
  68 os_vm_address_t
  69 os_allocate_at(os_vm_address_t addr, os_vm_size_t len)
  70 {
  71     return os_validate(addr, len);
  72 }
  73
  74 void
  75 os_deallocate(os_vm_address_t addr, os_vm_size_t len)
  76 {
  77     os_invalidate(addr, len);
  78 }
  79
  80 /* This function once tried to grow the chunk by asking os_validate if the
  81    space was available, but this really only works under Mach. */
  82
  83 os_vm_address_t
  84 os_reallocate(os_vm_address_t addr, os_vm_size_t old_len, os_vm_size_t len)
  85 {
  86     addr = os_trunc_to_page(addr);
  87     len = os_round_up_size_to_page(len);
  88     old_len = os_round_up_size_to_page(old_len);
  89
  90     if (addr == NULL)
  91         return os_allocate(len);
  92     else {
  93         long len_diff = len - old_len;
  94
  95         if (len_diff < 0)
  96             os_invalidate(addr + len, -len_diff);
  97         else {
  98             if (len_diff != 0) {
  99                 os_vm_address_t new = os_allocate(len);
 100
 101                 if (new != NULL) {
 102                     memcpy((char *) new, (char *) addr, old_len);
 103                     os_invalidate(addr, old_len);
 104                 }
 105
 106                 addr = new;
 107             }
 108         }
 109         return addr;
 110     }
 111 }
 112
 113 int
 114 os_get_errno(void)
 115 {
 116     return errno;
 117 }
 118
 119 int
 120 os_set_errno(int value)
 121 {
 122     return errno = value;
 123 }
 124
 125 int
 126 os_get_h_errno(void)
 127 {
 128     return h_errno;
 129 }
 130
 131 #ifdef LINKAGE_TABLE
 132
 133 typedef enum {
 134     LINKAGE_CODE_TYPE = 1,
 135     LINKAGE_DATA_TYPE = 2
 136 } linkage_type_t;
 137
 138
 139 /* These declarations are lies.  They actually take args, but are
 140    never called by C.  Only by Lisp */
 141 extern void resolve_linkage_tramp(void);
 142 extern void call_into_c(void);
 143
 144 /* In words */
 145 #define LINKAGE_DATA_ENTRY_SIZE 3
 146 #endif
 147
 148
 149 char*
 150 convert_lisp_string(char* c_string, void* lisp_string, int len)
 151 {
 152 #ifdef UNICODE
 153    /*
 154     * FIXME: Unicode hack to convert Lisp 16-bit string to 8-bit string
 155     * by lopping off the high bits.
 156     */
 157
 158     int k;
 159     unsigned short int* wide_string = (unsigned short int*) lisp_string;
 160
 161     for (k = 0; k < len; ++k) {
 162         c_string[k] = (wide_string[k]) & 0xff;
 163     }
 164     c_string[k] = 0;
 165 #else
 166     strcpy(c_string, lisp_string);
 167 #endif
 168
 169     return c_string;
 170 }
 171
 172 void
 173 os_foreign_linkage_init(void)
 174 {
 175 #ifdef LINKAGE_TABLE
 176     lispobj linkage_data_obj = SymbolValue(LINKAGE_TABLE_DATA);
 177     struct array *linkage_data = 0;
 178     long table_size = 0;
 179     struct vector *data_vector = 0;
 180     long i;
 181
 182     linkage_data = (struct array *) PTR(linkage_data_obj);
 183     table_size = fixnum_value(linkage_data->fill_pointer);
 184     data_vector = (struct vector *) PTR(linkage_data->data);
 185     for (i = 0; i < table_size; i += LINKAGE_DATA_ENTRY_SIZE) {
 186         struct vector *symbol_name
 187             = (struct vector *) PTR(data_vector->data[i]);
 188         long type = fixnum_value(data_vector->data[i + 1]);
 189         lispobj lib_list = data_vector->data[i + 2];
 190         /* FIXME:  1000 may not be long enough.  Add checks to make sure it's ok!!!!*/
 191         char c_symbol_name[1000];
 192         /*
 193          * Verify the "known" entries.  This had better match what
 194          * init-foreign-linkage in new-genesis does!
 195          */
 196
 197         convert_lisp_string(c_symbol_name, symbol_name->data, (symbol_name->length >> 2));
 198
 199 #if 0
 200         fprintf(stderr, "i =%2d:  %s\n", i, c_symbol_name);
 201         {
 202             int k;
 203             unsigned short int* wide_string;
 204
 205             fprintf(stderr, "  symbol_name->data = ");
 206
 207             wide_string = (unsigned short int *) symbol_name->data;
 208
 209             for (k = 0; k < (symbol_name->length >> 2); ++k) {
 210                 fprintf(stderr, "%4x ", wide_string[k]);
 211             }
 212             fprintf(stderr, "\n");
 213         }
 214 #endif
 215         if (i == 0) {
 216 #if defined(sparc)
 217             if (type != LINKAGE_CODE_TYPE || strcmp(c_symbol_name, "call_into_c")) {
 218                 fprintf(stderr, "linkage_data is %s but expected call_into_c\n",
 219                         (char *) symbol_name->data);
 220                 lose("First element of linkage_data is bogus.\n");
 221             }
 222             arch_make_linkage_entry(i, (void*) call_into_c, 1);
 223 #elif (defined(DARWIN) && defined(__ppc__))
 224             if (type != 1 || strcmp(c_symbol_name, "_call_into_c")) {
 225                 fprintf(stderr, "linkage_data is %s but expected call_into_c\n",
 226                         (char *) c_symbol_name);
 227                 lose("First element of linkage_data is bogus.\n");
 228             }
 229             arch_make_linkage_entry(i, &call_into_c, 1);
 230 #else
 231             if (type != LINKAGE_CODE_TYPE || strcmp(c_symbol_name,
 232                                                     "resolve_linkage_tramp")) {
 233                 fprintf(stderr,
 234                         "linkage_data is %s but expected resolve_linkage_tramp\n",
 235                         (char *) c_symbol_name);
 236                 lose("First element of linkage_data is bogus.\n");
 237             }
 238             arch_make_linkage_entry(i, (void *) &resolve_linkage_tramp, 1);
 239 #endif
 240             continue;
 241         }
 242         if (type == LINKAGE_DATA_TYPE && lib_list == NIL) {
 243             void *target_addr = os_dlsym(c_symbol_name, NIL);
 244
 245             if (!target_addr) {
 246 #if 0
 247                 int k;
 248                 unsigned short int* wide_string;
 249
 250                 fprintf(stderr, "c_symbol_name = `%s'\n", c_symbol_name);
 251                 fprintf(stderr, "symbol_name->data = \n");
 252
 253                 wide_string = (unsigned short int *) symbol_name->data;
 254
 255                 for (k = 0; k < (symbol_name->length >> 2); ++k) {
 256                     fprintf(stderr, "%4x ", wide_string[k]);
 257                 }
 258                 fprintf(stderr, "\n");
 259 #endif
 260                 lose("%s is not defined.\n",  c_symbol_name);
 261             }
 262             arch_make_linkage_entry(i / LINKAGE_DATA_ENTRY_SIZE, target_addr,
 263                                     type);
 264         } else {
 265             arch_make_lazy_linkage(i / LINKAGE_DATA_ENTRY_SIZE);
 266         }
 267
 268     }
 269 #endif /* LINKAGE_TABLE */
 270 }
 271
 272 /* At the second stage of initialization, after Lisp has dlopened all
 273    needed shared libraries, go back through the table and initialize
 274    data symbols. */
 275
 276 void
 277 os_resolve_data_linkage(void)
 278 {
 279 #ifdef LINKAGE_TABLE
 280     lispobj linkage_data_obj = SymbolValue(LINKAGE_TABLE_DATA);
 281     struct array *linkage_data = 0;
 282     long table_size = 0;
 283     struct vector *data_vector = 0;
 284     long i;
 285
 286     linkage_data = (struct array *) PTR(linkage_data_obj);
 287     table_size = fixnum_value(linkage_data->fill_pointer);
 288     data_vector = (struct vector *) PTR(linkage_data->data);
 289     for (i = 0; i < table_size; i += LINKAGE_DATA_ENTRY_SIZE) {
 290         struct vector *symbol_name
 291             = (struct vector *) PTR(data_vector->data[i]);
 292         long type = fixnum_value(data_vector->data[i + 1]);
 293         lispobj lib_list = data_vector->data[i + 2];
 294         char c_symbol_name[1000];
 295
 296         convert_lisp_string(c_symbol_name, symbol_name->data, (symbol_name->length >> 2));
 297
 298         if (type == LINKAGE_DATA_TYPE && lib_list != NIL) {
 299             void *target_addr = os_dlsym(c_symbol_name, lib_list);
 300
 301             if (!target_addr) {
 302                 lose("%s is not defined.\n", c_symbol_name);
 303             }
 304             arch_make_linkage_entry(i / LINKAGE_DATA_ENTRY_SIZE, target_addr,
 305                                     type);
 306         }
 307     }
 308 #endif /* LINKAGE_TABLE */
 309 }
 310
 311 /* Make entry for the symbol at entry in LINKAGE_TABLE_DATA.  Called
 312    from register-foreign-linkage. */
 313 #ifdef LINKAGE_TABLE
 314 extern void undefined_foreign_symbol_trap(lispobj arg);
 315 #endif
 316
 317 unsigned long
 318 os_link_one_symbol(long entry)
 319 {
 320 #ifdef LINKAGE_TABLE
 321     lispobj linkage_data_obj = SymbolValue(LINKAGE_TABLE_DATA);
 322     struct array *linkage_data = 0;
 323     long table_size = 0;
 324     struct vector *data_vector = 0;
 325     struct vector *symbol_name;
 326     long type;
 327     void *target_addr;
 328     long table_index = entry * LINKAGE_DATA_ENTRY_SIZE;
 329     char c_symbol_name[1000];
 330
 331     linkage_data = (struct array *) PTR(linkage_data_obj);
 332     table_size = fixnum_value(linkage_data->fill_pointer);
 333     if (table_index >= table_size - 1) {
 334         return 0;
 335     }
 336     data_vector = (struct vector *) PTR(linkage_data->data);
 337     symbol_name = (struct vector *) PTR(data_vector->data[table_index]);
 338     type = fixnum_value(data_vector->data[table_index + 1]);
 339
 340     convert_lisp_string(c_symbol_name, symbol_name->data, (symbol_name->length >> 2));
 341
 342     target_addr = os_dlsym(c_symbol_name,
 343                            data_vector->data[table_index + 2]);
 344 #if 0
 345     fprintf(stderr, "Looked up %s symbol %s at %lx\n",
 346             type == LINKAGE_CODE_TYPE ? "code" : "data",
 347             c_symbol_name, (unsigned long) target_addr);
 348 #endif
 349     if (!target_addr) {
 350         undefined_foreign_symbol_trap((lispobj) data_vector->data[table_index]);
 351     }
 352     arch_make_linkage_entry(entry, target_addr, type);
 353     return (unsigned long) target_addr;
 354 #else
 355     return 0;
 356 #endif /* LINKAGE_TABLE */
 357 }
 358
 359 unsigned long
 360 lazy_resolve_linkage(unsigned long retaddr)
 361 {
 362 #ifdef LINKAGE_TABLE
 363     unsigned long target_addr = os_link_one_symbol(arch_linkage_entry(retaddr));
 364
 365     return target_addr;
 366 #else
 367     return 0;
 368 #endif /* LINKAGE_TABLE */
 369 }
 370
 371 \f
 372
 373 #ifdef RED_ZONE_HIT
 374
 375 /* The end of the control stack contains two guard zones:
 376
 377    +----------+ stack start (stack growing down)
 378    |          |
 379        ...
 380    |          |
 381    +----------+
 382    |          | yellow zone
 383    +----------+
 384    |          | red zone
 385    +----------+                         CONTROL_STACK_START
 386
 387    Both the yellow zone and the red zone are write-protected.
 388
 389    When entering the yellow zone, we unprotect the yellow zone and
 390    make Lisp signal a control stack exhausted error, with stack
 391    contents left intact for the debugger, which is entered.
 392
 393    When hitting the red zone we arrange for calling a function that
 394    throws back to the top-level.  */
 395
 396 #ifndef YELLOW_ZONE_SIZE
 397 #define YELLOW_ZONE_SIZE 0x8000 /* 32K */
 398 #endif
 399
 400 #ifndef RED_ZONE_SIZE
 401 #define RED_ZONE_SIZE YELLOW_ZONE_SIZE
 402 #endif
 403
 404 /* Return the start addresses of the yellow and red zones in
 405    *YELLOW_START and *RED_START.  */
 406
 407 static void
 408 guard_zones(char **yellow_start, char **red_start)
 409 {
 410 #if (defined(i386) || defined(__x86_64))
 411     /*
 412      * All x86's have a control stack (aka C stack) that grows down.
 413      */
 414     char *end = (char *) CONTROL_STACK_START;
 415
 416     *red_start = end;
 417     *yellow_start = *red_start + RED_ZONE_SIZE;
 418 #else
 419     /*
 420      * On Solaris/sparc, the C stack grows down, but the Lisp control
 421      * stack grows up.  The stack zones begin just before the end of the
 422      * control stack area.
 423      */
 424
 425     char *end = (char *) CONTROL_STACK_START + control_stack_size;
 426
 427     *red_start = end - RED_ZONE_SIZE;
 428     *yellow_start = *red_start - YELLOW_ZONE_SIZE;
 429 #endif
 430 }
 431
 432 /* Return the guard zone FAULT_ADDR is in or 0 if not in a guard
 433    zone.  */
 434
 435 static int
 436 control_stack_zone(void *fault_addr)
 437 {
 438     char *yellow_start, *red_start;
 439     char *p = (char *) fault_addr;
 440
 441     guard_zones(&yellow_start, &red_start);
 442
 443     if (p >= yellow_start && p < yellow_start + YELLOW_ZONE_SIZE)
 444         return YELLOW_ZONE;
 445     else if (p >= red_start && p < red_start + RED_ZONE_SIZE)
 446         return RED_ZONE;
 447     else
 448         return 0;
 449 }
 450
 451 /* Protect/unprotect the guard zone ZONE of the control stack.  */
 452
 453 void
 454 os_guard_control_stack(int zone, int guard)
 455 {
 456     char *yellow_start, *red_start;
 457     int flags;
 458
 459     guard_zones(&yellow_start, &red_start);
 460
 461     if (guard)
 462         flags = OS_VM_PROT_READ | OS_VM_PROT_EXECUTE;
 463     else
 464         flags = OS_VM_PROT_ALL;
 465
 466     if (zone == YELLOW_ZONE)
 467         os_protect((os_vm_address_t) yellow_start, YELLOW_ZONE_SIZE, flags);
 468     else if (zone == RED_ZONE)
 469         os_protect((os_vm_address_t) red_start, RED_ZONE_SIZE, flags);
 470     else {
 471         char *start = red_start < yellow_start ? red_start : yellow_start;
 472
 473         os_protect((os_vm_address_t) start, RED_ZONE_SIZE + YELLOW_ZONE_SIZE,
 474                    flags);
 475     }
 476 }
 477
 478 /* Handle a possible guard zone hit at FAULT_ADDR.  Value is
 479    non-zero if FAULT_ADDR is in a guard zone.  */
 480
 481 int
 482 os_control_stack_overflow(void *fault_addr, os_context_t * context)
 483 {
 484     enum stack_zone_t zone;
 485
 486     zone = control_stack_zone(fault_addr);
 487
 488     if (zone == YELLOW_ZONE || zone == RED_ZONE) {
 489         lispobj error;
 490
 491 #if 0
 492         fprintf(stderr, "hit end of control stack in zone %s\n",
 493                 (zone == YELLOW_ZONE) ? "YELLOW" : (zone ==
 494                                                     RED_ZONE) ? "RED" : "BOTH");
 495 #endif
 496         /* Unprotect the stack, giving us some room on the stack for
 497            error handling in Lisp.  Fake a stack frame for this
 498            interruption.  */
 499         os_guard_control_stack(zone, 0);
 500
 501         build_fake_control_stack_frame(context);
 502
 503         /* The protection violation signal is delivered on a signal
 504            stack different from the normal stack, so that we don't
 505            trample on the guard pages of the normal stack while handling
 506            the signal.  To get a Lisp function called when the signal
 507            handler returns, we change the return address of the signal
 508            context to the address of the function we want to be
 509            called.  */
 510         if (zone == RED_ZONE)
 511             error = SymbolFunction(RED_ZONE_HIT);
 512         else
 513             error = SymbolFunction(YELLOW_ZONE_HIT);
 514
 515 #if defined(i386) || defined(__x86_64)
 516         SC_PC(context) = (int) ((struct function *) PTR(error))->code;
 517         SC_REG(context, reg_NARGS) = 0;
 518 #elif defined(sparc)
 519         /* This part should be common to all non-x86 ports */
 520         SC_PC(context) = (long) ((struct function *) PTR(error))->code;
 521         SC_NPC(context) = SC_PC(context) + 4;
 522         SC_REG(context, reg_NARGS) = 0;
 523         SC_REG(context, reg_LIP) =
 524             (long) ((struct function *) PTR(error))->code;
 525         SC_REG(context, reg_CFP) = (long) current_control_frame_pointer;
 526         /* This is sparc specific */
 527         SC_REG(context, reg_CODE) = ((long) PTR(error)) + type_FunctionPointer;
 528 #else
 529 #error os_control_stack_overflow not implemented for this system
 530 #endif
 531         return 1;
 532     }
 533
 534     return 0;
 535 }
 536
 537 #else /* not RED_ZONE_HIT */
 538
 539 /* Dummy for bootstrapping.  */
 540
 541 void
 542 os_guard_control_stack(int zone, int guard)
 543 {
 544 }
 545
 546 #endif /* not RED_ZONE_HIT */