source: branches/1.1/ccl/lisp-kernel/image.c @ 8617

Last change on this file since 8617 was 8617, checked in by gb, 14 years ago

Set HEAP_START and HEAP_END earlier.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 13.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    if (a->static_dnodes) {
214      natural pages_size = (align_to_power_of_2((align_to_power_of_2(a->static_dnodes, 
215                                                                     log2_nbits_in_word)>>3),
216                                                log2_page_size));
217      lseek(fd,pos+mem_size, SEEK_SET);
218      pos = seek_to_next_page(fd);
219      addr = mmap(NULL,
220                  pages_size,
221                  PROT_READ | PROT_WRITE,
222                  MAP_PRIVATE,
223                  fd,
224                  pos);
225      if (addr == MAP_FAILED) {
226        return;
227      }
228      a->static_used = addr;
229      advance = pages_size;
230    }
231    sect->area = a;
232    break;
233
234  case AREA_MANAGED_STATIC:
235    a = new_area(pure_space_limit, pure_space_limit, AREA_MANAGED_STATIC);
236    sect->area = a;
237    break;
238
239  default:
240    return;
241   
242  }
243  lseek(fd, pos+advance, SEEK_SET);
244}
245   
246LispObj
247load_openmcl_image(int fd, openmcl_image_file_header *h)
248{
249  LispObj image_nil = 0;
250  area *a;
251  if (find_openmcl_image_file_header(fd, h)) {
252    int i, nsections = h->nsections;
253    openmcl_image_section_header sections[nsections], *sect=sections;
254    LispObj bias = image_base - ACTUAL_IMAGE_BASE(h);
255#if (WORD_SIZE== 64)
256    signed_natural section_data_delta = 
257      ((signed_natural)(h->section_data_offset_high) << 32L) | h->section_data_offset_low;
258#endif
259
260    if (read (fd, sections, nsections*sizeof(openmcl_image_section_header)) !=
261        nsections * sizeof(openmcl_image_section_header)) {
262      return 0;
263    }
264#if WORD_SIZE == 64
265    lseek(fd, section_data_delta, SEEK_CUR);
266#endif
267    for (i = 0; i < nsections; i++, sect++) {
268      load_image_section(fd, sect);
269      a = sect->area;
270      if (a == NULL) {
271        return 0;
272      }
273    }
274
275    for (i = 0, sect = sections; i < nsections; i++, sect++) {
276      a = sect->area;
277      switch(sect->code) {
278      case AREA_STATIC:
279        nilreg_area = a;
280#ifdef PPC
281#ifdef PPC64
282        image_nil = ptr_to_lispobj(a->low + (1024*4) + sizeof(lispsymbol) + fulltag_misc);
283#else
284        image_nil = (LispObj)(a->low + 8 + 8 + (1024*4) + fulltag_nil);
285#endif
286#endif
287#ifdef X8664
288        image_nil = (LispObj)(a->low) + (1024*4) + fulltag_nil;
289#endif
290        set_nil(image_nil);
291        if (bias) {
292          relocate_area_contents(a, bias);
293        }
294        make_dynamic_heap_executable(a->low, a->active);
295        add_area_holding_area_lock(a);
296        break;
297       
298      case AREA_READONLY:
299        readonly_area = a;
300        add_area_holding_area_lock(a);
301        break;
302      }
303    }
304    for (i = 0, sect = sections; i < nsections; i++, sect++) {
305      a = sect->area;
306      switch(sect->code) {
307      case AREA_MANAGED_STATIC:
308        if (bias) {
309          relocate_area_contents(a, bias);
310        }
311        managed_static_area = a;
312        add_area_holding_area_lock(a);
313        break;
314      case AREA_DYNAMIC:
315        if (bias) {
316          relocate_area_contents(a, bias);
317        }
318        resize_dynamic_heap(a->active, lisp_heap_gc_threshold);
319        xMakeDataExecutable(a->low, a->active - a->low);
320        break;
321      }
322    }
323  }
324  return image_nil;
325}
326     
327void
328prepare_to_write_dynamic_space()
329{
330  area *a = active_dynamic_area;
331  LispObj
332    *start = (LispObj *)(a->low + (tenured_area->static_dnodes << dnode_shift)),
333    *end = (LispObj *) (a->active),
334    x1;
335  int tag, subtag, element_count;
336
337  while (start < end) {
338    x1 = *start;
339    tag = fulltag_of(x1);
340    if (immheader_tag_p(tag)) {
341      subtag = header_subtag(x1);
342      if (subtag == subtag_macptr) {
343        if (start[1]) {
344          /* Leave NULL pointers alone */
345          *start = make_header(subtag_dead_macptr,header_element_count(x1));
346        }
347      }
348      start = (LispObj *)skip_over_ivector((natural)start, x1);
349    } else if (nodeheader_tag_p(tag)) {
350      element_count = header_element_count(x1) | 1;
351      start += (element_count+1);
352    } else {
353      start += 2;
354    }
355  }
356}
357
358OSErr
359write_area_pages(int fd, area *a)
360{
361  natural total = a->active - a->low, count, done=0;
362  signed_natural n;
363  char buffer[32768];
364
365  while (total) {
366    if (total > 32768) {
367      count = 32768;
368    } else {
369      count = total;
370    }
371    bcopy(a->low+done,buffer,count);
372    n = write(fd, buffer, count);
373    if (n < 0) {
374      return n;
375    }
376    total -= n;
377    done += n;
378  }
379  return 0;
380}
381 
382
383int
384write_file_and_section_headers(int fd, 
385                               openmcl_image_file_header *file_header,
386                               openmcl_image_section_header* section_headers,
387                               int nsections,
388                               off_t *header_pos)
389{
390  *header_pos = seek_to_next_page(fd);
391
392  if (lseek (fd, *header_pos, SEEK_SET) < 0) {
393    return errno;
394  }
395  if (write(fd, file_header, sizeof(*file_header)) != sizeof(*file_header)) {
396    return errno;
397  }
398  if (write(fd, section_headers, sizeof(section_headers[0])*nsections)
399      != (sizeof(section_headers[0])*nsections)) {
400    return errno;
401  }
402  return 0;
403}
404 
405 
406OSErr
407save_application(unsigned fd)
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] = readonly_area;
421  areas[1] = nilreg_area; 
422  areas[2] = active_dynamic_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    lisp_global(GC_NUM) and lisp_global(FWDNUM) are persistent,
470    as is DELETED_STATIC_PAIRS.
471    Nothing else is even meaningful at this point.
472  */
473  for (i = MIN_KERNEL_GLOBAL; i < 0; i++) {
474    switch (i) {
475    case FWDNUM:
476    case GC_NUM:
477    case DELETED_STATIC_PAIRS:
478      break;
479    default:
480      lisp_global(i) = 0;
481    }
482  }
483
484  for (i = 0; i < NUM_IMAGE_SECTIONS; i++) {
485    natural n, nstatic;
486    a = areas[i];
487    seek_to_next_page(fd);
488    n = sections[i].memory_size;
489    nstatic = sections[i].static_dnodes;
490    if (a->code == AREA_READONLY) {
491      /*
492         Darwin seems to have problems writing the readonly area for
493         some reason.  It seems to work better to write a page at a
494         time.
495      */
496      if (write_area_pages(fd, a) != 0) {
497        return errno;
498      }
499    } else {
500      if (write(fd, a->low, n) != n) {
501        return errno;
502      }
503      if (nstatic) {
504        /* Need to write the static_used bitmap */
505        natural static_used_size_in_bytes =
506          (align_to_power_of_2((align_to_power_of_2(nstatic, log2_nbits_in_word)>>3),
507                               log2_page_size));
508        seek_to_next_page(fd);
509        if (write(fd, tenured_area->static_used, static_used_size_in_bytes) 
510            != static_used_size_in_bytes) {
511          return errno;
512        }
513      }
514    }
515  }
516
517#if WORD_SIZE == 64
518  seek_to_next_page(fd);
519  section_data_delta = -((lseek(fd,0,SEEK_CUR)+sizeof(fh)+sizeof(sections)) -
520                         image_data_pos);
521  fh.section_data_offset_high = (int)(section_data_delta>>32L);
522  fh.section_data_offset_low = (unsigned)section_data_delta;
523  err =  write_file_and_section_headers(fd, &fh, sections, NUM_IMAGE_SECTIONS, &header_pos);
524  if (err) {
525    return err;
526  } 
527#endif
528
529  trailer.sig0 = IMAGE_SIG0;
530  trailer.sig1 = IMAGE_SIG1;
531  trailer.sig2 = IMAGE_SIG2;
532  eof_pos = lseek(fd, 0, SEEK_CUR) + sizeof(trailer);
533  trailer.delta = (int) (header_pos-eof_pos);
534  if (write(fd, &trailer, sizeof(trailer)) == sizeof(trailer)) {
535    fsync(fd);
536    close(fd);
537    return 0;
538  } 
539  i = errno;
540  close(fd);
541  return i;
542}
543     
544
545
546
Note: See TracBrowser for help on using the repository browser.