source: branches/working-0709/ccl/lisp-kernel/image.c @ 7303

Last change on this file since 7303 was 7303, checked in by gb, 13 years ago

More heap-freezing changes.

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