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

Last change on this file since 14261 was 14207, checked in by rme, 10 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.