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

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

Change the order in which areaa are written to image file.
"Nilreg area" must be first, so that kernel globals exist.
Dynamic area follows at fixed offset in file.

  • 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] = nilreg_area; 
405  areas[1] = active_dynamic_area;
406  areas[2] = readonly_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.