source: release/1.4/source/lisp-kernel/image.c @ 13176

Last change on this file since 13176 was 13176, checked in by gb, 10 years ago

Propagate r13175 (x8632 image relocation/large functions) and
r13171 (x8632 callback winabi/ObjC exception disentanglement)
to 1.4.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 13.0 KB
Line 
1/*
2   Copyright (C) 2002-2009 Clozure Associates
3   This file is part of Clozure CL. 
4
5   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
6   License , known as the LLGPL and distributed with Clozure CL as the
7   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
8   which is distributed with Clozure CL as the file "LGPL".  Where these
9   conflict, the preamble takes precedence. 
10
11   Clozure CL is referenced in the preamble as the "LIBRARY."
12
13   The LLGPL is also available online at
14   http://opensource.franz.com/preamble.html
15*/
16
17#include "lisp.h"
18#include "lisp_globals.h"
19#include "area.h"
20#include "image.h"
21#include "gc.h"
22#include <errno.h>
23#include <unistd.h>
24#ifndef WINDOWS
25#include <sys/mman.h>
26#endif
27#include <stdio.h>
28#include <limits.h>
29
30
31
32#if defined(PPC64) || defined(X8632)
33#define RELOCATABLE_FULLTAG_MASK \
34  ((1<<fulltag_cons)|(1<<fulltag_misc))
35#else
36#ifdef X8664
37#define RELOCATABLE_FULLTAG_MASK \
38  ((1<<fulltag_cons)|(1<<fulltag_misc)|(1<<fulltag_symbol)|(1<<fulltag_function))
39#else
40#define RELOCATABLE_FULLTAG_MASK \
41  ((1<<fulltag_cons)|(1<<fulltag_nil)|(1<<fulltag_misc))
42#endif
43#endif
44
45void
46relocate_area_contents(area *a, LispObj bias)
47{
48  LispObj
49    *start = (LispObj *)(a->low), 
50    *end = (LispObj *)(a->active),
51    low = (LispObj)image_base - bias,
52    high = ptr_to_lispobj(active_dynamic_area->active) - bias,
53    w0;
54  int fulltag;
55
56  while (start < end) {
57    w0 = *start;
58    fulltag = fulltag_of(w0);
59    if (immheader_tag_p(fulltag)) {
60      start = (LispObj *)skip_over_ivector((natural)start, w0);
61    } else {
62#ifdef X86
63      if (header_subtag(w0) == subtag_function) {
64#ifdef X8664
65        int skip = ((int) start[1])+1;
66#else
67        extern void update_self_references(LispObj *);
68        extern natural imm_word_count(LispObj);
69
70        natural skip = (natural)imm_word_count(((LispObj)start)+fulltag_misc)+1;
71        update_self_references(start);
72#endif
73     
74        start += skip;
75        if (((LispObj) start) & node_size) {
76          --start;
77        }
78        w0 = *start;
79        fulltag = fulltag_of(w0);
80      }
81#endif
82
83      if ((w0 >= low) && (w0 < high) &&
84          ((1<<fulltag) & RELOCATABLE_FULLTAG_MASK)) {
85        *start = (w0+bias);
86      }
87      w0 = *++start;
88      fulltag = fulltag_of(w0);
89      if ((w0 >= low) && (w0 < high) &&
90          ((1<<fulltag) & RELOCATABLE_FULLTAG_MASK)) {
91        *start = (w0+bias);
92      }
93      ++start;
94    }
95  }
96  if (start > end) {
97    Bug(NULL, "Overran area bounds in relocate_area_contents");
98  }
99}
100     
101
102
103
104off_t
105seek_to_next_page(int fd)
106{
107  off_t pos = LSEEK(fd, 0, SEEK_CUR);
108  pos = align_to_power_of_2(pos, log2_page_size);
109  return LSEEK(fd, pos, SEEK_SET);
110}
111 
112/*
113  fd is positioned to EOF; header has been allocated by caller.
114  If we find a trailer (and that leads us to the header), read
115  the header & return true else return false.
116*/
117Boolean
118find_openmcl_image_file_header(int fd, openmcl_image_file_header *header)
119{
120  openmcl_image_file_trailer trailer;
121  int disp;
122  off_t pos;
123  unsigned version, flags;
124
125  pos = LSEEK(fd, 0, SEEK_END);
126  if (pos < 0) {
127    return false;
128  }
129  pos -= sizeof(trailer);
130
131  if (LSEEK(fd, pos, SEEK_SET) < 0) {
132    return false;
133  }
134  if (read(fd, &trailer, sizeof(trailer)) != sizeof(trailer)) {
135    return false;
136  }
137  if ((trailer.sig0 != IMAGE_SIG0) ||
138      (trailer.sig1 != IMAGE_SIG1) ||
139      (trailer.sig2 != IMAGE_SIG2)) {
140    return false;
141  }
142  disp = trailer.delta;
143 
144  if (disp >= 0) {
145    return false;
146  }
147  if (LSEEK(fd, disp, SEEK_CUR) < 0) {
148    return false;
149  }
150  if (read(fd, header, sizeof(openmcl_image_file_header)) !=
151      sizeof(openmcl_image_file_header)) {
152    return false;
153  }
154  if ((header->sig0 != IMAGE_SIG0) ||
155      (header->sig1 != IMAGE_SIG1) ||
156      (header->sig2 != IMAGE_SIG2) ||
157      (header->sig3 != IMAGE_SIG3)) {
158    return false;
159  }
160  version = (header->abi_version) & 0xffff;
161  if (version < ABI_VERSION_MIN) {
162    fprintf(dbgout, "Heap image is too old for this kernel.\n");
163    return false;
164  }
165  if (version > ABI_VERSION_MAX) {
166    fprintf(dbgout, "Heap image is too new for this kernel.\n");
167    return false;
168  }
169  flags = header->flags;
170  if (flags != PLATFORM) {
171    fprintf(dbgout, "Heap image was saved for another platform.\n");
172    return false;
173  }
174  return true;
175}
176
177void
178load_image_section(int fd, openmcl_image_section_header *sect)
179{
180  extern area* allocate_dynamic_area(unsigned);
181  off_t
182    pos = seek_to_next_page(fd), advance;
183  natural
184    mem_size = sect->memory_size;
185  void *addr;
186  area *a;
187
188  advance = mem_size;
189  switch(sect->code) {
190  case AREA_READONLY:
191    if (!MapFile(pure_space_active,
192                 pos,
193                 align_to_power_of_2(mem_size,log2_page_size),
194                 MEMPROTECT_RX,
195                 fd)) {
196      return;
197    }
198    a = new_area(pure_space_active, pure_space_limit, AREA_READONLY);
199    pure_space_active += mem_size;
200    a->active = pure_space_active;
201    sect->area = a;     
202    break;
203
204  case AREA_STATIC:
205    if (!MapFile(static_space_active,
206                 pos,
207                 align_to_power_of_2(mem_size,log2_page_size),
208                 MEMPROTECT_RWX,
209                 fd)) {
210      return;
211    }
212    a = new_area(static_space_active, static_space_limit, AREA_STATIC);
213    static_space_active += mem_size;
214    a->active = static_space_active;
215    sect->area = a;
216    break;
217
218  case AREA_DYNAMIC:
219    a = allocate_dynamic_area(mem_size);
220    if (!MapFile(a->low,
221                 pos,
222                 align_to_power_of_2(mem_size,log2_page_size),
223                 MEMPROTECT_RWX,
224                 fd)) {
225      return;
226    }
227
228    a->static_dnodes = sect->static_dnodes;
229    sect->area = a;
230    break;
231
232  case AREA_MANAGED_STATIC:
233    a = new_area(pure_space_limit, pure_space_limit, AREA_MANAGED_STATIC);
234    sect->area = a;
235    break;
236
237  default:
238    return;
239   
240  }
241  LSEEK(fd, pos+advance, SEEK_SET);
242}
243
244LispObj
245load_openmcl_image(int fd, openmcl_image_file_header *h)
246{
247  LispObj image_nil = 0;
248  area *a;
249  if (find_openmcl_image_file_header(fd, h)) {
250    int i, nsections = h->nsections;
251    openmcl_image_section_header sections[nsections], *sect=sections;
252    LispObj bias = image_base - ACTUAL_IMAGE_BASE(h);
253#if (WORD_SIZE== 64)
254    signed_natural section_data_delta = 
255      ((signed_natural)(h->section_data_offset_high) << 32L) | h->section_data_offset_low;
256#endif
257
258    if (read (fd, sections, nsections*sizeof(openmcl_image_section_header)) !=
259        nsections * sizeof(openmcl_image_section_header)) {
260      return 0;
261    }
262#if WORD_SIZE == 64
263    LSEEK(fd, section_data_delta, SEEK_CUR);
264#endif
265    for (i = 0; i < nsections; i++, sect++) {
266      load_image_section(fd, sect);
267      a = sect->area;
268      if (a == NULL) {
269        return 0;
270      }
271    }
272
273    for (i = 0, sect = sections; i < nsections; i++, sect++) {
274      a = sect->area;
275      switch(sect->code) {
276      case AREA_STATIC:
277        nilreg_area = a;
278#ifdef PPC
279#ifdef PPC64
280        image_nil = ptr_to_lispobj(a->low + (1024*4) + sizeof(lispsymbol) + fulltag_misc);
281#else
282        image_nil = (LispObj)(a->low + 8 + 8 + (1024*4) + fulltag_nil);
283#endif
284#endif
285#ifdef X86
286#ifdef X8664
287        image_nil = (LispObj)(a->low) + (1024*4) + fulltag_nil;
288#else
289        image_nil = (LispObj)(a->low) + (1024*4) + fulltag_cons;
290#endif
291#endif
292        set_nil(image_nil);
293        if (bias) {
294          relocate_area_contents(a, bias);
295        }
296        make_dynamic_heap_executable(a->low, a->active);
297        add_area_holding_area_lock(a);
298        break;
299       
300      case AREA_READONLY:
301        readonly_area = a;
302        add_area_holding_area_lock(a);
303        break;
304      }
305    }
306    for (i = 0, sect = sections; i < nsections; i++, sect++) {
307      a = sect->area;
308      switch(sect->code) {
309      case AREA_MANAGED_STATIC:
310        if (bias) {
311          relocate_area_contents(a, bias);
312        }
313        managed_static_area = a;
314        add_area_holding_area_lock(a);
315        break;
316      case AREA_DYNAMIC:
317        if (bias) {
318          relocate_area_contents(a, bias);
319        }
320        resize_dynamic_heap(a->active, lisp_heap_gc_threshold);
321        xMakeDataExecutable(a->low, a->active - a->low);
322        break;
323      }
324    }
325  }
326  return image_nil;
327}
328 
329void
330prepare_to_write_dynamic_space()
331{
332  area *a = active_dynamic_area;
333  LispObj
334    *start = (LispObj *)(a->low),
335    *end = (LispObj *) (a->active),
336    x1;
337  int tag, subtag, element_count;
338
339  while (start < end) {
340    x1 = *start;
341    tag = fulltag_of(x1);
342    if (immheader_tag_p(tag)) {
343      subtag = header_subtag(x1);
344      if (subtag == subtag_macptr) {
345        if ((start[1] >= (natural)0x10000) && (start[1] < (natural)-0x10000)) {
346          /* Leave small pointers alone */
347          *start = make_header(subtag_dead_macptr,header_element_count(x1));
348        }
349      }
350      start = (LispObj *)skip_over_ivector((natural)start, x1);
351    } else if (nodeheader_tag_p(tag)) {
352      element_count = header_element_count(x1) | 1;
353      start += (element_count+1);
354    } else {
355      start += 2;
356    }
357  }
358}
359
360 
361
362int
363write_file_and_section_headers(int fd, 
364                               openmcl_image_file_header *file_header,
365                               openmcl_image_section_header* section_headers,
366                               int nsections,
367                               off_t *header_pos)
368{
369  *header_pos = seek_to_next_page(fd);
370
371  if (LSEEK (fd, *header_pos, SEEK_SET) < 0) {
372    return errno;
373  }
374  if (write(fd, file_header, sizeof(*file_header)) != sizeof(*file_header)) {
375    return errno;
376  }
377  if (write(fd, section_headers, sizeof(section_headers[0])*nsections)
378      != (sizeof(section_headers[0])*nsections)) {
379    return errno;
380  }
381  return 0;
382}
383 
384natural
385writebuf(int fd, char *bytes, natural n)
386{
387  natural remain = n, this_size;
388  signed_natural result;
389
390  while (remain) {
391    this_size = remain;
392    if (this_size > INT_MAX) {
393      this_size = INT_MAX;
394    }
395    result = write(fd, bytes, this_size);
396    if (result < 0) {
397      return errno;
398    }
399    bytes += result;
400
401    remain -= result;
402  }
403  return 0;
404}
405
406OSErr
407save_application(unsigned fd, Boolean egc_was_enabled)
408{
409  openmcl_image_file_header fh;
410  openmcl_image_section_header sections[NUM_IMAGE_SECTIONS];
411  openmcl_image_file_trailer trailer;
412  area *areas[NUM_IMAGE_SECTIONS], *a;
413  int i, err;
414  off_t header_pos, eof_pos;
415#if WORD_SIZE == 64
416  off_t image_data_pos;
417  signed_natural section_data_delta;
418#endif
419
420  areas[0] = nilreg_area; 
421  areas[1] = active_dynamic_area;
422  areas[2] = readonly_area;
423  areas[3] = managed_static_area;
424  for (i = 0; i < NUM_IMAGE_SECTIONS; i++) {
425    a = areas[i];
426    sections[i].code = a->code;
427    sections[i].area = NULL;
428    sections[i].memory_size  = a->active - a->low;
429    if (a == active_dynamic_area) {
430      sections[i].static_dnodes = tenured_area->static_dnodes;
431    } else {
432      sections[i].static_dnodes = 0;
433    }
434  }
435  fh.sig0 = IMAGE_SIG0;
436  fh.sig1 = IMAGE_SIG1;
437  fh.sig2 = IMAGE_SIG2;
438  fh.sig3 = IMAGE_SIG3;
439  fh.timestamp = time(NULL);
440  CANONICAL_IMAGE_BASE(&fh) = IMAGE_BASE_ADDRESS;
441  ACTUAL_IMAGE_BASE(&fh) = image_base;
442  fh.nsections = NUM_IMAGE_SECTIONS;
443  fh.abi_version=ABI_VERSION_CURRENT;
444#if WORD_SIZE == 64
445  fh.section_data_offset_high = 0;
446  fh.section_data_offset_low = 0;
447#else
448  fh.pad0[0] = fh.pad0[1] = 0;
449  fh.pad1[0] = fh.pad1[1] = fh.pad1[2] = fh.pad1[3] = 0;
450#endif
451  fh.flags = PLATFORM;
452
453#if WORD_SIZE == 64
454  image_data_pos = seek_to_next_page(fd);
455#else
456  err = write_file_and_section_headers(fd, &fh, sections, NUM_IMAGE_SECTIONS, &header_pos);
457  if (err) {
458    return err;
459  }
460#endif
461
462  /*
463    Coerce macptrs to dead_macptrs.
464  */
465 
466  prepare_to_write_dynamic_space(active_dynamic_area);
467
468  {
469    area *g0_area = g1_area->younger;
470
471    /* Save GC config */
472    lisp_global(LISP_HEAP_THRESHOLD) = lisp_heap_gc_threshold;
473    lisp_global(G0_THRESHOLD) = g0_area->threshold;
474    lisp_global(G1_THRESHOLD) = g1_area->threshold;
475    lisp_global(G2_THRESHOLD) = g2_area->threshold;
476    lisp_global(EGC_ENABLED) = (LispObj)egc_was_enabled;
477  }
478  /*
479    lisp_global(GC_NUM) and lisp_global(FWDNUM) are persistent,
480    as is DELETED_STATIC_PAIRS.
481    Nothing else is even meaningful at this point.
482  */
483  for (i = MIN_KERNEL_GLOBAL; i < 0; i++) {
484    switch (i) {
485    case FWDNUM:
486    case GC_NUM:
487    case STATIC_CONSES:
488    case WEAK_GC_METHOD:
489    case LISP_HEAP_THRESHOLD:
490    case EGC_ENABLED:
491    case G0_THRESHOLD:
492    case G1_THRESHOLD:
493    case G2_THRESHOLD:
494      break;
495    default:
496      lisp_global(i) = 0;
497    }
498  }
499
500  for (i = 0; i < NUM_IMAGE_SECTIONS; i++) {
501    natural n;
502    a = areas[i];
503    seek_to_next_page(fd);
504    n = sections[i].memory_size;
505    if (writebuf(fd, a->low, n)) {
506        return errno;
507    }
508  }
509
510#if WORD_SIZE == 64
511  seek_to_next_page(fd);
512  section_data_delta = -((LSEEK(fd,0,SEEK_CUR)+sizeof(fh)+sizeof(sections)) -
513                         image_data_pos);
514  fh.section_data_offset_high = (int)(section_data_delta>>32L);
515  fh.section_data_offset_low = (unsigned)section_data_delta;
516  err =  write_file_and_section_headers(fd, &fh, sections, NUM_IMAGE_SECTIONS, &header_pos);
517  if (err) {
518    return err;
519  } 
520#endif
521
522  trailer.sig0 = IMAGE_SIG0;
523  trailer.sig1 = IMAGE_SIG1;
524  trailer.sig2 = IMAGE_SIG2;
525  eof_pos = LSEEK(fd, 0, SEEK_CUR) + sizeof(trailer);
526  trailer.delta = (int) (header_pos-eof_pos);
527  if (write(fd, &trailer, sizeof(trailer)) == sizeof(trailer)) {
528#ifndef WINDOWS
529    fsync(fd);
530#endif
531    close(fd);
532    return 0;
533  } 
534  i = errno;
535  close(fd);
536  return i;
537}
538     
539
540
541
Note: See TracBrowser for help on using the repository browser.