source: branches/working-0711/ccl/lisp-kernel/image.c @ 8662

Last change on this file since 8662 was 8662, checked in by gb, 12 years ago

prepare_to_write_dynamic_area() - which basically just invalidates
foreign pointers before an image is saved - needs to invalidate
pointers in frozen memory, too.

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