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

Last change on this file since 14261 was 14207, checked in by rme, 9 years ago

Don't do arithmetic on pointers to void.

GCC accepts this (it pretends that sizeof(void) == 1), but other
compilers choke on it.

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