/[cmucl]/src/lisp/os-common.c
ViewVC logotype

Contents of /src/lisp/os-common.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.33 - (show annotations)
Wed Dec 22 02:12:52 2010 UTC (3 years, 3 months ago) by rtoy
Branch: MAIN
CVS Tags: GIT-CONVERSION, cross-sol-x86-merged, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, HEAD
Changes since 1.32: +2 -2 lines
File MIME type: text/plain
Merge changes from cross-sol-x86-2010-12-20 which adds support for
Solaris/x86.  There should be no functional changes for either other
x86 ports or for the sparc port.
1 /*
2
3 $Header: /tiger/var/lib/cvsroots/cmucl/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 static int
372 os_stack_grows_down_1(int *local_var_address)
373 {
374 int dummy;
375
376 return &dummy < local_var_address;
377 }
378
379 /* Value is true if the processor stack grows down. */
380
381 int
382 os_stack_grows_down(void)
383 {
384 int dummy;
385
386 return os_stack_grows_down_1(&dummy);
387 }
388
389
390 #ifdef RED_ZONE_HIT
391
392 /* The end of the control stack contains two guard zones:
393
394 +----------+ stack start (stack growing down)
395 | |
396 ...
397 | |
398 +----------+
399 | | yellow zone
400 +----------+
401 | | red zone
402 +----------+ CONTROL_STACK_START
403
404 Both the yellow zone and the red zone are write-protected.
405
406 When entering the yellow zone, we unprotect the yellow zone and
407 make Lisp signal a control stack exhausted error, with stack
408 contents left intact for the debugger, which is entered.
409
410 When hitting the red zone we arrange for calling a function that
411 throws back to the top-level. */
412
413 #ifndef YELLOW_ZONE_SIZE
414 #define YELLOW_ZONE_SIZE 0x8000 /* 32K */
415 #endif
416
417 #ifndef RED_ZONE_SIZE
418 #define RED_ZONE_SIZE YELLOW_ZONE_SIZE
419 #endif
420
421 /* Return the start addresses of the yellow and red zones in
422 *YELLOW_START and *RED_START. */
423
424 static void
425 guard_zones(char **yellow_start, char **red_start)
426 {
427 #if (defined(i386) || defined(__x86_64))
428 if (os_stack_grows_down()) {
429 char *end = (char *) CONTROL_STACK_START;
430
431 *red_start = end;
432 *yellow_start = *red_start + RED_ZONE_SIZE;
433 } else {
434 char *end = (char *) CONTROL_STACK_START + CONTROL_STACK_SIZE;
435
436 *red_start = end - RED_ZONE_SIZE;
437 *yellow_start = *red_start - YELLOW_ZONE_SIZE;
438 }
439 #else
440 /*
441 * On Solaris/sparc, the C stack grows down, but the Lisp control
442 * stack grows up. The stack zones begin just before the end of the
443 * control stack area.
444 */
445
446 char *end = (char *) CONTROL_STACK_START + CONTROL_STACK_SIZE;
447
448 *red_start = end - RED_ZONE_SIZE;
449 *yellow_start = *red_start - YELLOW_ZONE_SIZE;
450 #endif
451 }
452
453 /* Return the guard zone FAULT_ADDR is in or 0 if not in a guard
454 zone. */
455
456 static int
457 control_stack_zone(void *fault_addr)
458 {
459 char *yellow_start, *red_start;
460 char *p = (char *) fault_addr;
461
462 guard_zones(&yellow_start, &red_start);
463
464 if (p >= yellow_start && p < yellow_start + YELLOW_ZONE_SIZE)
465 return YELLOW_ZONE;
466 else if (p >= red_start && p < red_start + RED_ZONE_SIZE)
467 return RED_ZONE;
468 else
469 return 0;
470 }
471
472 /* Protect/unprotect the guard zone ZONE of the control stack. */
473
474 void
475 os_guard_control_stack(int zone, int guard)
476 {
477 char *yellow_start, *red_start;
478 int flags;
479
480 guard_zones(&yellow_start, &red_start);
481
482 if (guard)
483 flags = OS_VM_PROT_READ | OS_VM_PROT_EXECUTE;
484 else
485 flags = OS_VM_PROT_ALL;
486
487 if (zone == YELLOW_ZONE)
488 os_protect((os_vm_address_t) yellow_start, YELLOW_ZONE_SIZE, flags);
489 else if (zone == RED_ZONE)
490 os_protect((os_vm_address_t) red_start, RED_ZONE_SIZE, flags);
491 else {
492 char *start = red_start < yellow_start ? red_start : yellow_start;
493
494 os_protect((os_vm_address_t) start, RED_ZONE_SIZE + YELLOW_ZONE_SIZE,
495 flags);
496 }
497 }
498
499 /* Handle a possible guard zone hit at FAULT_ADDR. Value is
500 non-zero if FAULT_ADDR is in a guard zone. */
501
502 int
503 os_control_stack_overflow(void *fault_addr, os_context_t * context)
504 {
505 enum stack_zone_t zone;
506
507 zone = control_stack_zone(fault_addr);
508
509 if (zone == YELLOW_ZONE || zone == RED_ZONE) {
510 lispobj error;
511
512 #if 0
513 fprintf(stderr, "hit end of control stack in zone %s\n",
514 (zone == YELLOW_ZONE) ? "YELLOW" : (zone ==
515 RED_ZONE) ? "RED" : "BOTH");
516 #endif
517 /* Unprotect the stack, giving us some room on the stack for
518 error handling in Lisp. Fake a stack frame for this
519 interruption. */
520 os_guard_control_stack(zone, 0);
521
522 build_fake_control_stack_frame(context);
523
524 /* The protection violation signal is delivered on a signal
525 stack different from the normal stack, so that we don't
526 trample on the guard pages of the normal stack while handling
527 the signal. To get a Lisp function called when the signal
528 handler returns, we change the return address of the signal
529 context to the address of the function we want to be
530 called. */
531 if (zone == RED_ZONE)
532 error = SymbolFunction(RED_ZONE_HIT);
533 else
534 error = SymbolFunction(YELLOW_ZONE_HIT);
535
536 #if defined(i386) || defined(__x86_64)
537 SC_PC(context) = (int) ((struct function *) PTR(error))->code;
538 SC_REG(context, reg_NARGS) = 0;
539 #elif defined(sparc)
540 /* This part should be common to all non-x86 ports */
541 SC_PC(context) = (long) ((struct function *) PTR(error))->code;
542 SC_NPC(context) = SC_PC(context) + 4;
543 SC_REG(context, reg_NARGS) = 0;
544 SC_REG(context, reg_LIP) =
545 (long) ((struct function *) PTR(error))->code;
546 SC_REG(context, reg_CFP) = (long) current_control_frame_pointer;
547 /* This is sparc specific */
548 SC_REG(context, reg_CODE) = ((long) PTR(error)) + type_FunctionPointer;
549 #else
550 #error os_control_stack_overflow not implemented for this system
551 #endif
552 return 1;
553 }
554
555 return 0;
556 }
557
558 #else /* not RED_ZONE_HIT */
559
560 /* Dummy for bootstrapping. */
561
562 void
563 os_guard_control_stack(int zone, int guard)
564 {
565 }
566
567 #endif /* not RED_ZONE_HIT */

  ViewVC Help
Powered by ViewVC 1.1.5