From f6f734d73e39dc01b2bef9238542b8393e08fbc4 Mon Sep 17 00:00:00 2001 From: Douglas Katzman Date: Mon, 14 Nov 2016 21:44:01 -0500 Subject: [PATCH] Implement defragmentation of immobile code. This feature is not in its final form. It only defragments during self-build, not on every call to save-lisp-and-die. --- make-target-2-load.lisp | 1 + src/code/immobile-code.lisp | 146 +++++++++++++++++ src/cold/warm.lisp | 1 + src/compiler/x86-64/target-insts.lisp | 91 +++++++++++ src/runtime/gencgc.c | 13 ++ src/runtime/marknsweepgc.c | 290 +++++++++++++++++++++++++++++++++- 6 files changed, 537 insertions(+), 5 deletions(-) create mode 100644 src/code/immobile-code.lisp diff --git a/make-target-2-load.lisp b/make-target-2-load.lisp index 6c495e1cc..06e9e71b8 100644 --- a/make-target-2-load.lisp +++ b/make-target-2-load.lisp @@ -87,6 +87,7 @@ #+sb-fasteval (setq sb-ext:*evaluator-mode* :interpret) (sb-ext:save-lisp-and-die (progn + #+immobile-code (sb-kernel::choose-code-component-ordering) ;; See comment in 'reader.lisp' #+sb-unicode (setq sb-impl::*read-prefer-base-string* nil) ;; This is a base string since the flag wasn't set to NIL yet. diff --git a/src/code/immobile-code.lisp b/src/code/immobile-code.lisp new file mode 100644 index 000000000..714080826 --- /dev/null +++ b/src/code/immobile-code.lisp @@ -0,0 +1,146 @@ +;;;; Reorganization of immobile code space. + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + +(in-package "SB-KERNEL") + +(defun immobile-space-p (obj) + (<= sb-vm:immobile-space-start (get-lisp-obj-address obj) sb-vm:immobile-space-end)) + +(defun order-by-in-degree () + (let ((compiler-stuff (make-hash-table :test 'eq)) + (other-stuff (make-hash-table :test 'eq))) + (flet ((pick-table (fun-name) + (if (symbolp fun-name) + (let ((package (symbol-package fun-name))) + (if (member package + (load-time-value + (cons sb-assem::*backend-instruction-set-package* + (mapcar 'find-package + '("SB-C" "SB-VM" "SB-FASL" + "SB-ASSEM" "SB-DISASSEM" + "SB-REGALLOC"))) + t)) + compiler-stuff + other-stuff)) + other-stuff)) + (hashtable-keys-sorted (table) + (mapcar #'car + (sort (%hash-table-alist table) + (lambda (a b) + (cond ((> (cdr a) (cdr b)) t) ; higher in-degree + ((< (cdr a) (cdr b)) nil) ; lower in-degree + ;; break ties by name, and failing that, + ;; by address (which = random) + (t + (let ((name1 + (%simple-fun-name (%code-entry-points (car a)))) + (name2 + (%simple-fun-name (%code-entry-points (car b))))) + (if (and (symbolp name1) (symbolp name2)) + (let ((p1 (package-name (symbol-package name1))) + (p2 (package-name (symbol-package name2)))) + (cond ((string< p1 p2) t) + ((string> p1 p2) nil) + ((string< name1 name2)))) + (< (get-lisp-obj-address (car a)) + (get-lisp-obj-address (car b)))))))))))) + (sb-vm::map-allocated-objects + (lambda (obj type size) + size + (when (= type sb-vm:code-header-widetag) + (loop for i from sb-vm:code-constants-offset + below (code-header-words obj) + do (let ((ref (code-header-ref obj i))) + (when (and (fdefn-p ref) + (simple-fun-p (fdefn-fun ref))) + (let ((code (fun-code-header (fdefn-fun ref)))) + (when (immobile-space-p code) + (let ((ht (pick-table + (%simple-fun-name + (%code-entry-points code))))) + (incf (gethash code ht 0)))))))))) + :immobile) + (append (hashtable-keys-sorted other-stuff) + (hashtable-keys-sorted compiler-stuff))))) + +;;; Passing your own toplevel functions as the root set +;;; will encourage the defrag procedure to place them early +;;; in the space, which should be better than leaving the +;;; organization to random chance. +;;; Note that these aren't roots in the GC sense, just a locality sense. +(defun choose-code-component-ordering + (&optional (roots '(read print eval compile))) + (let ((ordering (make-array 10000 :adjustable t :fill-pointer 0)) + (hashset (make-hash-table :test 'eq))) + (labels ((visit (thing) + (typecase thing + (code-component (visit-code thing)) + (simple-fun (visit-code (fun-code-header thing))) + (closure (visit (%closure-fun thing))) + (symbol (when (and (fboundp thing) + (not (special-operator-p thing)) + (not (macro-function thing))) + (visit (symbol-function thing)))))) + (visit-code (code-component) + (when (or (not (immobile-space-p code-component)) + (gethash code-component hashset)) + (return-from visit-code)) + (setf (gethash code-component hashset) t) + (vector-push-extend code-component ordering) + (loop for i from sb-vm:code-constants-offset + below (code-header-words code-component) + do (let ((obj (code-header-ref code-component i))) + (typecase obj + (fdefn (awhen (fdefn-fun obj) (visit it))) + (symbol (visit obj)) + (vector (map nil #'visit obj))))))) + (mapc #'visit + (mapcar (lambda (x) + (fun-code-header (the simple-fun (coerce x 'function)))) + roots))) + ; (format t "~&Roots reached ~D code objects~%" (length ordering)) + + (dolist (code (order-by-in-degree)) + (unless (gethash code hashset) + (setf (gethash code hashset) t) + (vector-push-extend code ordering))) + ; (format t "~&Added ~D code objects by static frequency~%" (length ordering)) + + (sb-vm::map-allocated-objects + (lambda (obj type size) + (declare (ignore size)) + (when (and (= type sb-vm:code-header-widetag) + (not (gethash obj hashset))) + (setf (gethash obj hashset) t) + (vector-push-extend obj ordering))) + :immobile) + ; (format t "~&Total ~D code objects~%" (length ordering)) + + (let* ((n (length ordering)) + (array (make-alien int (1+ (* n 2))))) + (setf (deref array 0) (* n 2)) + (loop for i below n + do (setf (deref array (* i 2)) + (get-lisp-obj-address (aref ordering i)))) + (setf (extern-alien "code_component_order" unsigned) + (sap-int (alien-value-sap array))))) + + (multiple-value-bind (index relocs) (sb-vm::collect-immobile-code-relocs) + (let* ((n (length index)) + (array (make-alien int n))) + (dotimes (i n) (setf (deref array i) (aref index i))) + (setf (extern-alien "immobile_space_reloc_index" unsigned) + (sap-int (alien-value-sap array)))) + (let* ((n (length relocs)) + (array (make-alien int n))) + (dotimes (i n) (setf (deref array i) (aref relocs i))) + (setf (extern-alien "immobile_space_relocs" unsigned) + (sap-int (alien-value-sap array)))))) diff --git a/src/cold/warm.lisp b/src/cold/warm.lisp index 019b3c9a7..e4ece62a8 100644 --- a/src/cold/warm.lisp +++ b/src/cold/warm.lisp @@ -168,6 +168,7 @@ #+win32 "SRC;CODE;WARM-MSWIN" "SRC;CODE;RUN-PROGRAM" + #+immobile-code "SRC;CODE;IMMOBILE-CODE" "SRC;CODE;REPACK-XREF")) (sb-c::*handled-conditions* sb-c::*handled-conditions*)) (declare (special *compile-files-p*)) diff --git a/src/compiler/x86-64/target-insts.lisp b/src/compiler/x86-64/target-insts.lisp index b533e7063..5ea79c36f 100644 --- a/src/compiler/x86-64/target-insts.lisp +++ b/src/compiler/x86-64/target-insts.lisp @@ -355,3 +355,94 @@ (nt "single-step trap (before)")) (#.invalid-arg-count-trap (nt "Invalid argument count trap"))))) + +;;;; + +#!+immobile-code +(defun sb!vm::collect-immobile-code-relocs () + (let ((code-components + (make-array 20000 :element-type '(unsigned-byte 32) + :fill-pointer 0 :adjustable t)) + (relocs + (make-array 100000 :element-type '(unsigned-byte 32) + :fill-pointer 0 :adjustable t)) + ;; Look for these two instruction formats. + (jmp-inst (find-inst #b11101001 (get-inst-space))) + (call-inst (find-inst #b11101000 (get-inst-space))) + (seg (sb!disassem::%make-segment + :sap-maker #'error :virtual-location 0)) + (dstate (make-dstate))) + (flet ((scan-function (fun-entry-addr fun-end-addr predicate) + (setf (seg-virtual-location seg) fun-entry-addr + (seg-length seg) (- fun-end-addr fun-entry-addr) + (seg-sap-maker seg) + (let ((sap (int-sap fun-entry-addr))) (lambda () sap))) + (map-segment-instructions + (lambda (dchunk inst) + (when (and (or (eq inst jmp-inst) + (eq inst call-inst)) + (funcall predicate + (+ (sb!disassem::sign-extend + (ldb (byte 32 8) dchunk) 32) + (dstate-next-addr dstate)))) + (vector-push-extend (dstate-cur-addr dstate) relocs))) + seg dstate nil)) + (finish-component (code start-relocs-index) + (when (> (fill-pointer relocs) start-relocs-index) + (vector-push-extend (get-lisp-obj-address code) code-components) + (vector-push-extend start-relocs-index code-components)))) + + ;; Assembler routines are in read-only space, and they can have + ;; relative jumps to immobile space. + ;; Since these code components do not contain simple-funs, + ;; we have to group the routines by looking at addresses. + (let ((asm-routines + (mapcar #'cdr (%hash-table-alist sb!fasl:*assembler-routines*))) + code-components) + (sb!vm::map-allocated-objects (lambda (obj type size) + (declare (ignore type size)) + (push obj code-components)) + :read-only) + (dolist (code (nreverse code-components)) + (let* ((text-origin (sap-int (code-instructions code))) + (text-end (+ text-origin (%code-code-size code))) + (relocs-index (fill-pointer relocs))) + (mapl (lambda (list) + (scan-function (car list) + (if (cdr list) (cadr list) text-end) + ;; Look for transfers into immobile code + (lambda (jmp-targ-addr) + (<= sb!vm:immobile-space-start + jmp-targ-addr sb!vm:immobile-space-end)))) + (sort (remove-if-not (lambda (address) + (<= text-origin address text-end)) + asm-routines) #'<)) + (finish-component code relocs-index)))) + + ;; Immobile space - code components can jump to immobile space, + ;; read-only space, and C runtime routines. + (sb!vm::map-allocated-objects + (lambda (code type size) + (declare (ignore size)) + (when (= type code-header-widetag) + (let* ((text-origin (sap-int (code-instructions code))) + (text-end (+ text-origin (%code-code-size code))) + (relocs-index (fill-pointer relocs))) + (do ((fun (%code-entry-points code) (%simple-fun-next fun))) + ((null fun) (finish-component code relocs-index)) + (scan-function + (+ (get-lisp-obj-address fun) (- fun-pointer-lowtag) + (ash simple-fun-code-offset word-shift)) + (acond ((%simple-fun-next fun) + (- (get-lisp-obj-address it) fun-pointer-lowtag)) + (t + text-end)) + ;; Exclude transfers within this code component + (lambda (jmp-targ-addr) + (not (<= text-origin jmp-targ-addr text-end)))))))) + :immobile)) + + ;; Write a delimiter into the array passed to C + (vector-push-extend 0 code-components) + (vector-push-extend (fill-pointer relocs) code-components) + (values code-components relocs))) diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index e25ef76c8..523739ec3 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -2741,6 +2741,10 @@ extern void scavenge_immobile_newspace(), sweep_immobile_space(int raise), write_protect_immobile_space(); +#ifdef LISP_FEATURE_IMMOBILE_CODE +lispobj code_component_order; +extern void defrag_immobile_space(lispobj); +#endif #else #define immobile_scav_queue_count 0 #endif @@ -4859,6 +4863,15 @@ gc_and_save(char *filename, boolean prepend_runtime, gencgc_alloc_start_page = -1; collect_garbage(HIGHEST_NORMAL_GENERATION+1); +#ifdef LISP_FEATURE_IMMOBILE_CODE + if (code_component_order) { + printf("\n[defragmenting immobile space... "); + fflush(stdout); + defrag_immobile_space(code_component_order); + printf("done]\n"); + } +#endif + if (prepend_runtime) save_runtime_to_filehandle(file, runtime_bytes, runtime_size, application_type); diff --git a/src/runtime/marknsweepgc.c b/src/runtime/marknsweepgc.c index c4091d48d..0d20efcc2 100644 --- a/src/runtime/marknsweepgc.c +++ b/src/runtime/marknsweepgc.c @@ -20,9 +20,6 @@ * 2. Heuristic for auto-trigger. (Can't yet because no space accounting) * Currently happens with regular GC trigger mechanism. * 3. Specify space size on startup - * 4. De-fragment the space on save-lisp-and-die, - * but possibly also in out-of-space conditions. - * Fragmentation is typically not more than 5%, so this is not a huge issue. */ #include "gc.h" @@ -378,7 +375,7 @@ void update_immobile_nursery_bits() #define MAXIMUM_STRING_WIDETAG SIMPLE_BASE_STRING_WIDETAG #endif -static inline boolean unboxed_obj_p(int widetag) +static inline boolean unboxed_array_p(int widetag) { // This is not an exhaustive test for unboxed objects, // but it's enough to avoid some unnecessary scavenging. @@ -394,7 +391,7 @@ promote_immobile_obj(lispobj *ptr, int rescan) // a native pointer if (widetag_of(*ptr) == SIMPLE_FUN_HEADER_WIDETAG) ptr = (lispobj*)code_obj_from_simple_fun((struct simple_fun*)ptr); gc_assert(__immobile_obj_gen_bits(ptr) == from_space); - int pointerish = !unboxed_obj_p(widetag_of(*ptr)); + int pointerish = !unboxed_array_p(widetag_of(*ptr)); assign_generation(ptr, (pointerish ? 0 : IMMOBILE_OBJ_VISITED_FLAG) | new_space); low_page_index_t page_index = find_immobile_page_index(ptr); @@ -1500,6 +1497,289 @@ lispobj alloc_fdefn(lispobj name) return (lispobj)f | OTHER_POINTER_LOWTAG; } +#ifdef LISP_FEATURE_IMMOBILE_CODE +//// Defragmentation + +/// It's tricky to try to use the scavenging functions +/// for fixing up moved code. There are a few reasons: +/// - we need to rewrite the space on top of itself +/// - we store forwarding pointers outside of the space +/// - we'd want to modify the transport functions +/// to deliberately fail in case one got called by mistake. +/// So the approach is to basically do a large switch +/// over all possible objects that we might need to fixup. +/// There are some other strategies, none of which seem to +/// make things obviously easier, such as: +/// * variation (A) +// Copy the whole space to a shadow space, +/// deposit FPs in the real space but perform fixups +/// in the shadow space; then copy it back. +/// At least one problem here is that the chain of +/// pointers in simple-funs in the shadow space +/// has to compensate for their temporary address. +/// * variation (B) +/// First permute all code into the shadow space, +/// copy it back, then fix it up. This is bad +/// because we can't figure out original jump targets +/// unless we have a reverse forwarding-pointer map. + +static char* tempspace; + +static void adjust_words(lispobj *where, size_t n_words) +{ + int i; + for (i=0;i= IMMOBILE_VARYOBJ_SUBSPACE_START) { + int offset_in_space = native_ptr - IMMOBILE_VARYOBJ_SUBSPACE_START; + lispobj* fp_where = (lispobj*)(tempspace + offset_in_space); + int new = *fp_where; + gc_assert(new); + where[i] = new; + } + } + } +} + +static lispobj adjust_fun_entry(lispobj raw_entry) +{ + if (raw_entry > READ_ONLY_SPACE_END) { + lispobj simple_fun = raw_entry - FUN_RAW_ADDR_OFFSET; + adjust_words(&simple_fun, 1); + return simple_fun + FUN_RAW_ADDR_OFFSET; + } + return raw_entry; // for fdefn which has a tramp +} + +static void fixup_space(lispobj* where, size_t n_words) +{ + lispobj* end = where + n_words; + lispobj header_word, obj; + int widetag; + long size; + struct simple_fun* f; + lispobj next; + + while (where < end) { + header_word = *where; + if (is_lisp_pointer(header_word) || is_lisp_immediate(header_word)) { + adjust_words(where, 2); // A cons. + where += 2; + continue; + } + widetag = widetag_of(header_word); + size = sizetab[widetag](where); + switch (widetag) { + default: + if (!(widetag <= COMPLEX_DOUBLE_FLOAT_WIDETAG + || widetag == SAP_WIDETAG // Better not point to code! + || widetag == SIMD_PACK_WIDETAG + || unboxed_array_p(widetag))) + lose("Unhandled widetag in fixup_range: %p\n", (void*)header_word); + break; + case INSTANCE_HEADER_WIDETAG: + instance_scan_interleaved(adjust_words, where, + instance_length(header_word) | 1, + native_pointer(instance_layout(where))); + break; + case CODE_HEADER_WIDETAG: + // Fixup all embedded simple-funs + for ( obj = ((struct code*)where)->entry_points ; obj != NIL ; obj = next ) { + f = (struct simple_fun*)(obj - FUN_POINTER_LOWTAG); + next = f->next; // Read before adjusting. + f->self = adjust_fun_entry(f->self); + adjust_words(&f->next, 5); + } + // Fixup the constant pool. Do this last so that 'entry_points' + // is read before adjustment. + adjust_words(where+1, code_header_words(header_word)-1); + break; + case CLOSURE_HEADER_WIDETAG: + where[1] = adjust_fun_entry(where[1]); + // Fallthrough intended. + case FUNCALLABLE_INSTANCE_HEADER_WIDETAG: + // skip the trampoline word at where[1] + adjust_words(where+2, HeaderValue(header_word)-1); + break; + case FDEFN_WIDETAG: + adjust_words(where+1, 2); + where[3] = adjust_fun_entry(where[3]); + break; + + // All the array header widetags. + case SIMPLE_VECTOR_WIDETAG: + case SIMPLE_ARRAY_WIDETAG: + case COMPLEX_CHARACTER_STRING_WIDETAG: + case COMPLEX_BASE_STRING_WIDETAG: + case COMPLEX_VECTOR_NIL_WIDETAG: + case COMPLEX_BIT_VECTOR_WIDETAG: + case COMPLEX_VECTOR_WIDETAG: + case COMPLEX_ARRAY_WIDETAG: + // And the other entirely boxed objects. + case SYMBOL_HEADER_WIDETAG: + case VALUE_CELL_HEADER_WIDETAG: + case WEAK_POINTER_WIDETAG: + case RATIO_WIDETAG: + case COMPLEX_WIDETAG: + // Use the sizing functions for generality. + // Symbols can contain strange header bytes, + // and vectors might have a padding word, etc. + adjust_words(where+1, size-1); + break; + } + where += size; + } +} + +extern void +walk_generation(void (*proc)(lispobj*,size_t), + generation_index_t generation); + +// Both pointers are untagged. +static void set_load_address(lispobj* old, lispobj new) +{ + int offset_in_space = (lispobj)old - IMMOBILE_VARYOBJ_SUBSPACE_START; + lispobj* fp_loc = (lispobj*)(tempspace + offset_in_space); + *fp_loc = new; +} +// Take and return an untagged code pointer. +static lispobj get_load_address(lispobj* old) +{ + int offset_in_space = (lispobj)old - IMMOBILE_VARYOBJ_SUBSPACE_START; + lispobj* fp_loc = (lispobj*)(tempspace + offset_in_space); + return *fp_loc; +} + +int* immobile_space_reloc_index; +int* immobile_space_relocs; + +void defrag_immobile_space(int* components) +{ + int i, size; + long total_size = 0; + lispobj* addr; + + // Compute where each code component will be moved to. + lispobj new_vaddr = IMMOBILE_VARYOBJ_SUBSPACE_START; + for (i=0 ; components[i*2] ; ++i) { + addr = (lispobj*)(long)components[i*2]; + gc_assert(lowtag_of((lispobj)addr) == OTHER_POINTER_LOWTAG); + addr = native_pointer((lispobj)addr); + int widetag = widetag_of(*addr); + // FIXME: generalize + gc_assert(widetag == CODE_HEADER_WIDETAG); + if (immobile_filler_p(addr)) { + components[i*2+1] = 0; + } else { + components[i*2+1] = new_vaddr; + size = sizetab[widetag](addr); + total_size += size << WORD_SHIFT; + new_vaddr += size << WORD_SHIFT; + } + } + // tempspace is the old total size, not the new total size, + // because forwarding pointers are stashed there prior to defrag. + // (It's a perfect hashtable by any other name.) + size_t tempspace_bytes = (SYMBOL(IMMOBILE_SPACE_FREE_POINTER)->value + - IMMOBILE_VARYOBJ_SUBSPACE_START); + tempspace = calloc(tempspace_bytes, 1); + + // Deposit forwarding pointers into the temp space. + for (i=0 ; components[i*2] ; ++i) { + if ((new_vaddr = components[i*2+1]) != 0) { + addr = native_pointer(components[i*2]); + int displacement = new_vaddr - (lispobj)addr; + struct simple_fun* f; + lispobj obj; + set_load_address(addr, new_vaddr); + if (widetag_of(*addr) == CODE_HEADER_WIDETAG) { + for ( obj = ((struct code*)addr)->entry_points ; obj != NIL ; obj = f->next ) { + set_load_address(native_pointer(obj), obj + displacement); + f = (struct simple_fun*)(obj - FUN_POINTER_LOWTAG); + } + } + } + } + +#ifdef LISP_FEATURE_X86_64 + // Fix displacements in JMP and CALL instructions + for (i = 0 ; immobile_space_reloc_index[i*2] ; ++i) { + lispobj code = immobile_space_reloc_index[i*2] - OTHER_POINTER_LOWTAG; + lispobj load_addr = 0; + if (code >= READ_ONLY_SPACE_START && code < READ_ONLY_SPACE_END) + load_addr = code; // This code can not be moved or GCed. + else + load_addr = get_load_address((lispobj*)code); + if (load_addr) { // Skip any code that was dropped by GC. + int reloc_index = immobile_space_reloc_index[i*2+1]; + int end_reloc_index = immobile_space_reloc_index[i*2+3]; + for ( ; reloc_index < end_reloc_index ; ++reloc_index ) { + unsigned char* inst_addr = (unsigned char*)(long)immobile_space_relocs[reloc_index]; + gc_assert(*inst_addr == 0xE8 || *inst_addr == 0xE9); + int target_addr = (int)inst_addr + 5 + *(int*)(inst_addr+1); + int target_adjust = 0; + if (target_addr >= IMMOBILE_VARYOBJ_SUBSPACE_START && target_addr < IMMOBILE_SPACE_END) { + lispobj* ptarg_fun_header = + (lispobj*)(target_addr - offsetof(struct simple_fun, code)); + gc_assert(widetag_of(*ptarg_fun_header) == SIMPLE_FUN_HEADER_WIDETAG); + lispobj* ptarg_code_header = + ptarg_fun_header - HeaderValue(*ptarg_fun_header); + gc_assert(widetag_of(*ptarg_code_header) == CODE_HEADER_WIDETAG); + lispobj targ_load_addr = get_load_address(ptarg_code_header); + gc_assert(targ_load_addr); // was not discarded + target_adjust = targ_load_addr - (lispobj)ptarg_code_header; + } + *(int*)(inst_addr+1) += target_adjust + ((lispobj)code - load_addr); + } + } + } +#endif + free(immobile_space_relocs); + free(immobile_space_reloc_index); + + // Fix Lisp pointers in static, immobile, and dynamic spaces + fixup_space((lispobj*)STATIC_SPACE_START, + (SYMBOL(STATIC_SPACE_FREE_POINTER)->value + - STATIC_SPACE_START) >> WORD_SHIFT); + fixup_space((lispobj*)IMMOBILE_SPACE_START, + (SYMBOL(IMMOBILE_FIXEDOBJ_FREE_POINTER)->value + - IMMOBILE_SPACE_START) >> WORD_SHIFT); + fixup_space((lispobj*)IMMOBILE_VARYOBJ_SUBSPACE_START, + (SYMBOL(IMMOBILE_SPACE_FREE_POINTER)->value + - IMMOBILE_VARYOBJ_SUBSPACE_START) >> WORD_SHIFT); + walk_generation(fixup_space, -1); + + // Now permute the code components + for (i=0 ; components[i*2] ; ++i) { + if ((new_vaddr = components[i*2+1]) != 0) { + addr = native_pointer(components[i*2]); + char* to_addr = tempspace + ((char*)new_vaddr - (char*)IMMOBILE_VARYOBJ_SUBSPACE_START); + size_t size = sizetab[widetag_of(*addr)](addr) << WORD_SHIFT; + memcpy(to_addr, addr, size); + } + } + // Copy the permuted space back where it belongs. + memcpy((char*)IMMOBILE_VARYOBJ_SUBSPACE_START, tempspace, total_size); + + // Zero-fill the unused remainder of the immobile space + lispobj free_ptr = IMMOBILE_VARYOBJ_SUBSPACE_START + total_size; + lispobj old_free_ptr = SYMBOL(IMMOBILE_SPACE_FREE_POINTER)->value; + bzero((char*)free_ptr, old_free_ptr - free_ptr); + SYMBOL(IMMOBILE_SPACE_FREE_POINTER)->value = free_ptr; + if (free_ptr & (IMMOBILE_CARD_BYTES-1)) { // unless page-aligned + int remainder = IMMOBILE_CARD_BYTES - (free_ptr & (IMMOBILE_CARD_BYTES-1)); + ((lispobj*)free_ptr)[0] = SIMPLE_ARRAY_FIXNUM_WIDETAG; + ((lispobj*)free_ptr)[1] = make_fixnum((remainder >> WORD_SHIFT) - 2); + } + + free(tempspace); + free(components); +} +#endif + void verify_immobile_page_protection(int keep_gen, int new_gen) { low_page_index_t page; -- 2.11.4.GIT