source: release/1.7/source/lisp-kernel/image.c @ 15267

Last change on this file since 15267 was 14601, checked in by gb, 8 years ago

save_application's first arg is signed; if it's negative, save
a native library on Darwin (so far.)

Juggle things around to enable this.

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