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

Last change on this file since 8547 was 8547, checked in by andreas, 13 years ago

Big #ifdef WINDOWS hack&slash: stub out every function that references
things unimplemented on Windows. This is mainly exception (a.k.a.
signal handling) stuff, pthread-related things and memory management.

Using this code, and the compiler from:


http://downloads.sourceforge.net/mingw-w64/mingw-w64-bin_x86_64-linux_20080203.tar.bz2?modtime=1202034209&big_mirror=0

I am able to cross-compile a Win64 executable from my Ubuntu. Of
course, it crashes pretty soon, but this was to be expected.

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