source: trunk/source/lisp-kernel/image.c @ 11551

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

Not the bug I was looking for either, but un-botch some of the GC-state-saving
changes from a few weeks ago: save_application() is always run with the
EGC off, so make the caller pass an extra arg indicating its state as of
the time we trapped to it. Set G2_THRESHOLD global before writing image,
don't set G1_THRESHOLD twice.

Images built a few weeks ago have EGC off and misconfigured.

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