source: branches/purify/source/lisp-kernel/image.c @ 13272

Last change on this file since 13272 was 13272, checked in by gb, 10 years ago

Since pure area may contain pointers (at least to managed_static_area),
it may need to be relocated on startup.

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