[Openmcl-cvs-notifications] r14608 - in /trunk/source: lib/dumplisp.lisp lisp-kernel/mach-o-image.c
gb at clozure.com
gb at clozure.com
Sat Jan 29 20:38:15 CST 2011
Author: gb
Date: Sat Jan 29 20:38:14 2011
New Revision: 14608
Log:
dumplisp.lisp: support :native argument to SAVE-APPLICATION; only
implemented on x86[32,64] Darwin.
mach-o-image.c: declare victory.
Modified:
trunk/source/lib/dumplisp.lisp
trunk/source/lisp-kernel/mach-o-image.c
Modified: trunk/source/lib/dumplisp.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lib/dumplisp.lisp (original)
+++ trunk/source/lib/dumplisp.lisp Sat Jan 29 20:38:14 2011
@@ -74,7 +74,8 @@
impurify
(mode #o644)
prepend-kernel
- #+windows-target (application-type :console))
+ #+windows-target (application-type :console)
+ native)
(declare (ignore toplevel-function error-handler application-class
clear-clos-caches init-file impurify))
#+windows-target (check-type application-type (member :console :gui))
@@ -88,6 +89,8 @@
(when watched
(cerror "Un-watch them." "There are watched objects.")
(mapc #'unwatch watched)))
+ (when (and native prepend-kernel)
+ (error "~S and ~S can't both be specified (yet)." :native :prepend-ker=
nel))
(let* ((ip *initial-process*)
(cp *current-process*))
(when (process-verify-quit ip)
@@ -96,6 +99,12 @@
:prepend-kernel prepend-kernel
#+windows-target #+windows-target =
:application-type application-type)))
+ (when native
+ #+(or darwinx8632-target darwin-x8664-target) (setq fd (- fd))
+ #-(or darwinx8632-target darwin-x8664-target)
+ (progn
+ (warn "native image support not available, ignoring ~s option.=
" :native)))
+ =
(process-interrupt ip
#'(lambda ()
(process-exit-application
@@ -118,8 +127,9 @@
(init-file nil init-file-p)
(clear-clos-caches t)
prepend-kernel
- #+windows-target application-type)
- (declare (ignore mode prepend-kernel #+windows-target application-type))
+ #+windows-target application-type
+ native)
+ (declare (ignore mode prepend-kernel #+windows-target application-type n=
ative))
(when (and application-class (neq (class-of *application*)
(if (symbolp application-class)
(find-class application-class)
Modified: trunk/source/lisp-kernel/mach-o-image.c
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lisp-kernel/mach-o-image.c (original)
+++ trunk/source/lisp-kernel/mach-o-image.c Sat Jan 29 20:38:14 2011
@@ -26,6 +26,7 @@
#include <dlfcn.h>
#include "lisp.h"
#include "gc.h"
+#include "lisp_globals.h"
=
#if WORD_SIZE=3D=3D64
typedef struct mach_header_64 macho_header;
@@ -482,7 +483,7 @@
global_string_table =3D create_string_table();
=
seg =3D add_macho_segment(p, =
- "__TEXT",
+ "READONLY",
(natural)(readonly_area->low-4096),
4096+align_to_power_of_2(readonly_area->active-r=
eadonly_area->low,12),
0,
@@ -490,7 +491,7 @@
VM_PROT_READ|VM_PROT_WRITE|VM_PROT_EXECUTE,
VM_PROT_READ|VM_PROT_EXECUTE,
1, =
- "text");
+ "purespace");
init_macho_section(seg,
0,
(natural)(readonly_area->low),
@@ -504,7 +505,7 @@
curpos =3D align_to_power_of_2(lseek(fd,0,SEEK_CUR),12);
=
if (managed_static_area->active !=3D managed_static_area->low) {
- nrefbytes =3D (((area_dnode(managed_static_area->active,managed_static=
_area->low)>>dnode_shift)+7)>>3);
+ nrefbytes =3D ((area_dnode(managed_static_area->active,managed_static_=
area->low)+7)>>3);
=
prepare_to_write_dynamic_space(managed_static_area);
seg =3D add_macho_segment(p,
@@ -697,6 +698,7 @@
LispObj
load_native_library(char *path)
{
+ extern BytePtr allocate_from_reserved_area(natural);
void *lib;
LispObj image_nil =3D 0;
=
@@ -748,17 +750,29 @@
return 0;
} else {
area *a;
- char *p, *q;
-
- p =3D (BytePtr)dlsym(lib,"DYNAMIC_HEAP_END");
- if (p =3D=3D NULL) {
+ natural initsize,totalsize,nrefbytes;
+ char =
+ *ro_start =3D dlsym(lib,"READONLY_START"), =
+ *ro_end =3D dlsym(lib,"READONLY_END"), =
+ *ms_start =3D dlsym(lib,"MANAGED_STATIC_START"), =
+ *ms_end =3D dlsym(lib,"MANAGED_STATIC_END"), =
+ *msr_end =3D dlsym(lib,"MANAGED_STATIC_REFMAP_END"), =
+ *sc_start =3D dlsym(lib,"STATIC_CONS_START"),
+ *sc_end =3D dlsym(lib,"STATIC_CONS_START"), =
+ *dh_end =3D dlsym(lib,"DYNAMIC_HEAP_END"),
+ *p,
+ *q;
+
+ if ((dh_end =3D=3D NULL) ||
+ (ro_start !=3D pure_space_active)) {
dlclose(lib);
return 0;
}
- p =3D (BytePtr)align_to_power_of_2(p,12);
+ p =3D (BytePtr)align_to_power_of_2(dh_end,12);
q =3D static_space_active;
mprotect(q,8192,PROT_READ|PROT_WRITE|PROT_EXEC);
memcpy(q,p,8192);
+ memset(p,0,8192);
=
a =3D nilreg_area =3D new_area(q,q+8192,AREA_STATIC);
nilreg_area->active =3D nilreg_area->high; /* a little wrong */
@@ -780,21 +794,45 @@
image_nil =3D (LispObj)(a->low) + (1024*4) + fulltag_nil;
#endif
set_nil(image_nil);
- =
- =
- =
-
+ add_area_holding_area_lock(a);
=
+ a =3D new_area(pure_space_active,pure_space_limit,AREA_READONLY);
+ readonly_area =3D a;
+ add_area_holding_area_lock(a);
+ pure_space_active =3D a->active =3D ro_end;
=
- if ((BytePtr)dlsym(lib,"READONLY_START") =3D=3D pure_space_active) {
- a =3D new_area(pure_space_active,pure_space_limit,AREA_READONLY);
- readonly_area =3D a;
- add_area_holding_area_lock(a);
- pure_space_active =3D a->active =3D (BytePtr)dlsym(lib,"READONLY_END=
");
-
- =
- =
- =
- }
- }
-}
+ initsize =3D dh_end - sc_end;
+ totalsize =3D align_to_power_of_2(initsize, log2_heap_segment_size);
+ =
+ p =3D allocate_from_reserved_area(totalsize);
+ q =3D p+totalsize;
+ a =3D new_area(p,q,AREA_DYNAMIC);
+ a->active =3D dh_end;
+ a->h =3D p;
+ CommitMemory((char *)(align_to_power_of_2(dh_end,12)),
+ q-(char *)align_to_power_of_2(dh_end,12));
+ map_initial_reloctab(p, q);
+ map_initial_markbits(p, q);
+ lisp_global(HEAP_START) =3D (LispObj)p;
+ lisp_global(HEAP_END) =3D (LispObj)q;
+ add_area_holding_area_lock(a);
+ resize_dynamic_heap(dh_end, lisp_heap_gc_threshold);
+ xMakeDataExecutable(a->low, a->active - a->low);
+
+ static_cons_area =3D new_area(sc_start, sc_end, AREA_STATIC_CONS);
+ static_cons_area->active =3D sc_start;
+ lower_heap_start(sc_start,a);
+ a->static_dnodes =3D area_dnode(sc_end,sc_start);
+ =
+ managed_static_area =3D new_area(ms_start,ms_end,AREA_MANAGED_STATIC);
+ managed_static_area->active =3D ms_end;
+ lisp_global(REF_BASE) =3D (LispObj) ms_start;
+ =
+ nrefbytes =3D msr_end - ms_end;
+ CommitMemory(global_mark_ref_bits,align_to_power_of_2(nrefbytes, 12));
+ memcpy(global_mark_ref_bits,ms_end,nrefbytes);
+ memset(ms_end,0,nrefbytes);
+ =
+ return image_nil;
+ }
+}
More information about the Openmcl-cvs-notifications
mailing list