diff --git a/doc/sbcl.1 b/doc/sbcl.1 index c368b58..2ff0cce 100644 --- a/doc/sbcl.1 +++ b/doc/sbcl.1 @@ -267,7 +267,9 @@ standard toplevel options. .TP 3 .B \-\-dynamic-space-size Size of the dynamic space reserved on startup in megabytes. Default value -is platform dependent. +is platform dependent. If SBCL has been compiled with incremental +allocation support, this value is only a soft limit that can be raised +at run time, without an effect on the amount of address space reserved. .TP 3 .B \-\-noinform Suppress the printing of any banner or other informational message at diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index dcb9dfc..a5ed0b8 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -2462,12 +2462,12 @@ structure representations" "*BINDING-STACK-START*" "*CONTROL-STACK-START*" "*CONTROL-STACK-END*" "CONTROL-STACK-POINTER-VALID-P" - "DYNAMIC-SPACE-START" "DYNAMIC-SPACE-END" + "DEFAULT-DYNAMIC-SPACE-START" "DEFAULT-DYNAMIC-SPACE-END" #!+c-stack-is-control-stack "ALTERNATE-SIGNAL-STACK-START" - #!-gencgc "DYNAMIC-0-SPACE-START" - #!-gencgc "DYNAMIC-0-SPACE-END" - #!-gencgc "DYNAMIC-1-SPACE-START" - #!-gencgc "DYNAMIC-1-SPACE-END" + #!-gencgc "DEFAULT-DYNAMIC-0-SPACE-START" + #!-gencgc "DEFAULT-DYNAMIC-0-SPACE-END" + #!-gencgc "DEFAULT-DYNAMIC-1-SPACE-START" + #!-gencgc "DEFAULT-DYNAMIC-1-SPACE-END" "READ-ONLY-SPACE-START" "READ-ONLY-SPACE-END" "TARGET-BYTE-ORDER" "TARGET-HEAP-ADDRESS-SPACE" "STATIC-SPACE-START" "STATIC-SPACE-END" diff --git a/src/code/error.lisp b/src/code/error.lisp index 0e663cf..a4b3c0a 100644 --- a/src/code/error.lisp +++ b/src/code/error.lisp @@ -165,6 +165,10 @@ *heap-exhausted-error-requested-bytes*) (print-unreadable-object (condition stream)))))) +#!+incremental-allocation +(define-condition soft-heap-exhausted-error (storage-condition) + ()) + (define-condition system-condition (condition) ((address :initarg :address :reader system-condition-address :initform nil) (context :initarg :context :reader system-condition-context :initform nil))) diff --git a/src/code/gc.lisp b/src/code/gc.lisp index 7ba3b3b..7d94a8a 100644 --- a/src/code/gc.lisp +++ b/src/code/gc.lisp @@ -19,12 +19,13 @@ (eval-when (:compile-toplevel :execute) (sb!xc:defmacro def-c-var-fun (lisp-fun c-var-name) `(defun ,lisp-fun () - (sb!alien:extern-alien ,c-var-name (sb!alien:unsigned 32))))) + (sb!alien:extern-alien ,c-var-name + (sb!alien:unsigned #.sb!vm:n-word-bits))))) #!-sb-fluid (declaim (inline current-dynamic-space-start)) #!+gencgc -(defun current-dynamic-space-start () sb!vm:dynamic-space-start) +(def-c-var-fun current-dynamic-space-start "dynamic_space_start") #!-gencgc (def-c-var-fun current-dynamic-space-start "current_dynamic_space") @@ -123,7 +124,13 @@ (setf *n-bytes-freed-or-purified* 0 *gc-run-time* 0 ;; See comment in interr.lisp - *heap-exhausted-error-condition* (make-condition 'heap-exhausted-error))) + *heap-exhausted-error-condition* (make-condition 'heap-exhausted-error) + ;; Preallocating the soft error is less essential, but still a + ;; reasonable idea: + #!+incremental-allocation + #!+incremental-allocation + *soft-heap-exhausted-error-condition* + (make-condition 'soft-heap-exhausted-error))) (declaim (ftype (function () unsigned-byte) get-bytes-consed)) (defun get-bytes-consed () diff --git a/src/code/interr.lisp b/src/code/interr.lisp index 8fb4657..c4abb2f 100644 --- a/src/code/interr.lisp +++ b/src/code/interr.lisp @@ -477,6 +477,37 @@ (*heap-exhausted-error-requested-bytes* requested)) (error *heap-exhausted-error-condition*)))) +#!+incremental-allocation +(progn + (defvar *soft-heap-exhausted-error-condition* nil) + (defvar *in-soft-heap-exhausted-error-p* nil) + + (define-alien-variable soft-pages-limit int) + + (defun read-soft-heap-limit () + (format *query-io* + "~&Enter a new soft heap limit in megabytes: ") + (force-output *query-io*) + (list (floor (ash (read *query-io*) 20) sb!vm:gencgc-page-size))) + + (defun soft-heap-exhausted-error () + (unless + ;; don't signal the error recursively. We expect having to exceed + ;; the soft limit a little while handling the error anyway. + *in-soft-heap-exhausted-error-p* + (let ((*in-soft-heap-exhausted-error-p* t)) + (restart-case + (error (or *soft-heap-exhausted-error-condition* + (make-condition 'soft-heap-exhausted-error))) + (change (limit-in-pages) + :report "Specify a new soft limit" + :interactive read-soft-heap-limit + (setf soft-pages-limit limit-in-pages)) + (disable () + :report "Disable the soft limit entirely" + (setf soft-pages-limit 0))) + nil)))) + (defun undefined-alien-variable-error () (error 'undefined-alien-variable-error)) diff --git a/src/compiler/alpha/parms.lisp b/src/compiler/alpha/parms.lisp index 5254a2b..154e6e2 100644 --- a/src/compiler/alpha/parms.lisp +++ b/src/compiler/alpha/parms.lisp @@ -108,25 +108,14 @@ ;;; Where to put the different spaces. ;;; -#!+linux -(progn - (def!constant read-only-space-start #x20000000) - (def!constant read-only-space-end #x24000000)) - -#!+osf1 -(progn - (defconstant read-only-space-start #x10000000) - (defconstant read-only-space-end #x25000000)) - - (def!constant static-space-start #x28000000) (def!constant static-space-end #x2c000000) -(def!constant dynamic-0-space-start #x30000000) -(def!constant dynamic-0-space-end #x3fff0000) +(def!constant default-dynamic-0-space-start #x30000000) +(def!constant default-dynamic-0-space-end #x3fff0000) -(def!constant dynamic-1-space-start #x40000000) -(def!constant dynamic-1-space-end #x4fff0000) +(def!constant default-dynamic-1-space-start #x40000000) +(def!constant default-dynamic-1-space-end #x4fff0000) ;;; FIXME nothing refers to either of these in alpha or x86 cmucl ;;; backend, so they could probably be removed. diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index a67217c..da55262 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -3165,16 +3165,20 @@ initially undefined function references:~2%") (*cold-fdefn-objects* (make-hash-table :test 'equal)) (*cold-symbols* (make-hash-table :test 'equal)) (*cold-package-symbols* nil) + (read-only-space-symbol + (cold-foreign-symbol-address "read_only_space")) + (read-only-space-start + (logandc2 (+ read-only-space-symbol #xffff) #xffff)) (*read-only* (make-gspace :read-only read-only-core-space-id - sb!vm:read-only-space-start)) + read-only-space-start)) (*static* (make-gspace :static static-core-space-id sb!vm:static-space-start)) (*dynamic* (make-gspace :dynamic dynamic-core-space-id - #!+gencgc sb!vm:dynamic-space-start - #!-gencgc sb!vm:dynamic-0-space-start)) + #!+gencgc sb!vm:default-dynamic-space-start + #!-gencgc sb!vm:default-dynamic-0-space-start)) (*nil-descriptor* (make-nil-descriptor)) (*current-reversed-cold-toplevels* *nil-descriptor*) (*unbound-marker* (make-other-immediate-descriptor @@ -3256,6 +3260,10 @@ initially undefined function references:~2%") (/show "back from FINISH-SYMBOLS") (finalize-load-time-value-noise) + ;; Tell the target Lisp about space positions. + (cold-set 'sb!vm:read-only-space-start + (make-fixnum-descriptor read-only-space-start)) + ;; Tell the target Lisp how much stuff we've allocated. (cold-set 'sb!vm:*read-only-space-free-pointer* (allocate-cold-descriptor *read-only* diff --git a/src/compiler/generic/parms.lisp b/src/compiler/generic/parms.lisp index c39ffe5..e7e99f3 100644 --- a/src/compiler/generic/parms.lisp +++ b/src/compiler/generic/parms.lisp @@ -17,6 +17,8 @@ sb!kernel::internal-error sb!kernel::control-stack-exhausted-error sb!kernel::heap-exhausted-error + #!+incremental-allocation + sb!kernel::soft-heap-exhausted-error sb!kernel::undefined-alien-variable-error sb!kernel::undefined-alien-function-error sb!kernel::memory-fault-error @@ -27,6 +29,9 @@ #!+sb-thread sb!thread::run-interruption #!+win32 sb!kernel::handle-win32-exception)) +(defvar read-only-space-start) +(defvar read-only-space-end) + (defparameter *common-static-symbols* '(t @@ -70,4 +75,8 @@ :key :value :key-and-value - :key-or-value)) + :key-or-value + + ;; recursion check for soft-heap-exhausted-error + #!+incremental-allocation + sb!kernel::*in-soft-heap-exhausted-error-p*)) diff --git a/src/compiler/hppa/parms.lisp b/src/compiler/hppa/parms.lisp index 30cba51..ce617e5 100644 --- a/src/compiler/hppa/parms.lisp +++ b/src/compiler/hppa/parms.lisp @@ -62,16 +62,13 @@ ;;; Where to put the different spaces. ;;; -(def!constant read-only-space-start #x20000000) -(def!constant read-only-space-end #x24000000) - (def!constant static-space-start #x28000000) (def!constant static-space-end #x2a000000) -(def!constant dynamic-0-space-start #x30000000) -(def!constant dynamic-0-space-end #x37fff000) -(def!constant dynamic-1-space-start #x38000000) -(def!constant dynamic-1-space-end #x3ffff000) +(def!constant default-dynamic-0-space-start #x30000000) +(def!constant default-dynamic-0-space-end #x37fff000) +(def!constant default-dynamic-1-space-start #x38000000) +(def!constant default-dynamic-1-space-end #x3ffff000) ;;; FIXME: WTF are these for? diff --git a/src/compiler/mips/parms.lisp b/src/compiler/mips/parms.lisp index 5d6f495..f8e4bac 100644 --- a/src/compiler/mips/parms.lisp +++ b/src/compiler/mips/parms.lisp @@ -73,33 +73,27 @@ ;; Where to put the different spaces. ;; Old definitions, might be still relevant for an IRIX port. ;; - (def!constant read-only-space-start #x01000000) - (def!constant read-only-space-end #x05000000) - (def!constant static-space-start #x06000000) (def!constant static-space-end #x08000000) - (def!constant dynamic-0-space-start #x08000000) - (def!constant dynamic-0-space-end #x0c000000) - (def!constant dynamic-1-space-start #x0c000000) - (def!constant dynamic-1-space-end #x10000000)) + (def!constant default-dynamic-0-space-start #x08000000) + (def!constant default-dynamic-0-space-end #x0c000000) + (def!constant default-dynamic-1-space-start #x0c000000) + (def!constant default-dynamic-1-space-end #x10000000)) #!+linux (progn ;; Where to put the address spaces on Linux. ;; ;; C runtime executable segment starts at 0x00400000 - (def!constant read-only-space-start #x01000000) - (def!constant read-only-space-end #x07ff0000) - (def!constant static-space-start #x08000000) (def!constant static-space-end #x0fff0000) ;; C runtime read/write segment starts at 0x10000000, heap and DSOs ;; start at 0x2a000000 - (def!constant dynamic-0-space-start #x30000000) - (def!constant dynamic-0-space-end #x4fff0000) - (def!constant dynamic-1-space-start #x50000000) - (def!constant dynamic-1-space-end #x6fff0000) + (def!constant default-dynamic-0-space-start #x30000000) + (def!constant default-dynamic-0-space-end #x4fff0000) + (def!constant default-dynamic-1-space-start #x50000000) + (def!constant default-dynamic-1-space-end #x6fff0000) (def!constant linkage-table-space-start #x70000000) (def!constant linkage-table-space-end #x71000000) diff --git a/src/compiler/ppc/parms.lisp b/src/compiler/ppc/parms.lisp index c644978..e14ce3b 100644 --- a/src/compiler/ppc/parms.lisp +++ b/src/compiler/ppc/parms.lisp @@ -90,8 +90,6 @@ ;;; On non-gencgc we need large dynamic and static spaces for PURIFY #!-gencgc (progn - (def!constant read-only-space-start #x04000000) - (def!constant read-only-space-end #x07ff8000) (def!constant static-space-start #x08000000) (def!constant static-space-end #x097fff00) @@ -101,8 +99,6 @@ ;;; While on gencgc we don't. #!+gencgc (progn - (def!constant read-only-space-start #x04000000) - (def!constant read-only-space-end #x040ff000) (def!constant static-space-start #x04100000) (def!constant static-space-end #x041ff000) @@ -115,41 +111,41 @@ (progn #!+gencgc (progn - (def!constant dynamic-space-start #x4f000000) - (def!constant dynamic-space-end #x7efff000)) + (def!constant default-dynamic-space-start #x4f000000) + (def!constant default-dynamic-space-end #x7efff000)) #!-gencgc (progn - (def!constant dynamic-0-space-start #x4f000000) - (def!constant dynamic-0-space-end #x66fff000) - (def!constant dynamic-1-space-start #x67000000) - (def!constant dynamic-1-space-end #x7efff000))) + (def!constant default-dynamic-0-space-start #x4f000000) + (def!constant default-dynamic-0-space-end #x66fff000) + (def!constant default-dynamic-1-space-start #x67000000) + (def!constant default-dynamic-1-space-end #x7efff000))) #!+netbsd (progn #!+gencgc (progn - (def!constant dynamic-space-start #x4f000000) - (def!constant dynamic-space-end #x7efff000)) + (def!constant default-dynamic-space-start #x4f000000) + (def!constant default-dynamic-space-end #x7efff000)) #!-gencgc (progn - (def!constant dynamic-0-space-start #x4f000000) - (def!constant dynamic-0-space-end #x66fff000) - (def!constant dynamic-1-space-start #x67000000) - (def!constant dynamic-1-space-end #x7efff000))) + (def!constant default-dynamic-0-space-start #x4f000000) + (def!constant default-dynamic-0-space-end #x66fff000) + (def!constant default-dynamic-1-space-start #x67000000) + (def!constant default-dynamic-1-space-end #x7efff000))) #!+darwin (progn #!+gencgc (progn - (def!constant dynamic-space-start #x10000000) - (def!constant dynamic-space-end #x6ffff000)) + (def!constant default-dynamic-space-start #x10000000) + (def!constant default-dynamic-space-end #x6ffff000)) #!-gencgc (progn - (def!constant dynamic-0-space-start #x10000000) - (def!constant dynamic-0-space-end #x3ffff000) + (def!constant default-dynamic-0-space-start #x10000000) + (def!constant default-dynamic-0-space-end #x3ffff000) - (def!constant dynamic-1-space-start #x40000000) - (def!constant dynamic-1-space-end #x6ffff000))) + (def!constant default-dynamic-1-space-start #x40000000) + (def!constant default-dynamic-1-space-end #x6ffff000))) ;;;; Other miscellaneous constants. diff --git a/src/compiler/sparc/parms.lisp b/src/compiler/sparc/parms.lisp index 55b5c26..cbe3d79 100644 --- a/src/compiler/sparc/parms.lisp +++ b/src/compiler/sparc/parms.lisp @@ -95,43 +95,34 @@ (def!constant linkage-table-space-start #x0f800000) (def!constant linkage-table-space-end #x10000000) - (def!constant read-only-space-start #x10000000) - (def!constant read-only-space-end #x15000000) - (def!constant static-space-start #x28000000) (def!constant static-space-end #x2c000000) - (def!constant dynamic-0-space-start #x30000000) - (def!constant dynamic-0-space-end #x38000000) + (def!constant default-dynamic-0-space-start #x30000000) + (def!constant default-dynamic-0-space-end #x38000000) - (def!constant dynamic-1-space-start #x40000000) - (def!constant dynamic-1-space-end #x48000000)) + (def!constant default-dynamic-1-space-start #x40000000) + (def!constant default-dynamic-1-space-end #x48000000)) #!+sunos ; might as well start by trying the same numbers (progn (def!constant linkage-table-space-start #x0f800000) (def!constant linkage-table-space-end #x10000000) - (def!constant read-only-space-start #x10000000) - (def!constant read-only-space-end #x15000000) - (def!constant static-space-start #x28000000) (def!constant static-space-end #x2c000000) - (def!constant dynamic-0-space-start #x30000000) - (def!constant dynamic-0-space-end #x38000000) + (def!constant default-dynamic-0-space-start #x30000000) + (def!constant default-dynamic-0-space-end #x38000000) - (def!constant dynamic-1-space-start #x40000000) - (def!constant dynamic-1-space-end #x48000000)) + (def!constant default-dynamic-1-space-start #x40000000) + (def!constant default-dynamic-1-space-end #x48000000)) #!+netbsd ; Need a gap at 0x4000000 for shared libraries (progn (def!constant linkage-table-space-start #x0f800000) (def!constant linkage-table-space-end #x10000000) - (def!constant read-only-space-start #x10000000) - (def!constant read-only-space-end #x15000000) - (def!constant static-space-start #x18000000) (def!constant static-space-end #x1c000000) diff --git a/src/compiler/x86-64/parms.lisp b/src/compiler/x86-64/parms.lisp index 6913f59..5ebbd33 100644 --- a/src/compiler/x86-64/parms.lisp +++ b/src/compiler/x86-64/parms.lisp @@ -104,14 +104,19 @@ ;;; it would cause. -- JES, 2005-12-11 (progn - (def!constant read-only-space-start #x20000000) - (def!constant read-only-space-end #x200ff000) - (def!constant static-space-start #x20100000) (def!constant static-space-end #x201ff000) - (def!constant dynamic-space-start #x1000000000) - (def!constant dynamic-space-end #x11ffff0000) + #!+incremental-allocation + (progn + (def!constant default-dynamic-space-start #x20300000) + ;; -end is used only to compute the default soft limit: + (def!constant default-dynamic-space-end #x60300000)) + + #!-incremental-allocation + (progn + (def!constant default-dynamic-space-start #x1000000000) + (def!constant default-dynamic-space-end #x11ffff0000)) (def!constant linkage-table-space-start #x20200000) (def!constant linkage-table-space-end #x202ff000) diff --git a/src/compiler/x86/parms.lisp b/src/compiler/x86/parms.lisp index 6a19fc0..891b63a 100644 --- a/src/compiler/x86/parms.lisp +++ b/src/compiler/x86/parms.lisp @@ -163,70 +163,58 @@ #!+win32 (progn - (def!constant read-only-space-start #x02000000) - (def!constant read-only-space-end #x020ff000) - (def!constant static-space-start #x02100000) (def!constant static-space-end #x021ff000) - (def!constant dynamic-space-start #x09000000) - (def!constant dynamic-space-end #x29000000) + (def!constant default-dynamic-space-start #x09000000) + (def!constant default-dynamic-space-end #x29000000) (def!constant linkage-table-space-start #x02200000) (def!constant linkage-table-space-end #x022ff000)) #!+linux (progn - (def!constant read-only-space-start #x01000000) - (def!constant read-only-space-end #x010ff000) - (def!constant static-space-start #x01100000) (def!constant static-space-end #x011ff000) - (def!constant dynamic-space-start #x09000000) - (def!constant dynamic-space-end #x29000000) + #!+incremental-allocation + (def!constant default-dynamic-space-start #x81B0000) + #!-incremental-allocation + (def!constant default-dynamic-space-start #x09000000) + (def!constant default-dynamic-space-end #x29000000) (def!constant linkage-table-space-start #x01200000) (def!constant linkage-table-space-end #x012ff000)) #!+sunos (progn - (def!constant read-only-space-start #x20000000) - (def!constant read-only-space-end #x200ff000) - (def!constant static-space-start #x20100000) (def!constant static-space-end #x201ff000) - (def!constant dynamic-space-start #x48000000) - (def!constant dynamic-space-end #xA0000000) + (def!constant default-dynamic-space-start #x48000000) + (def!constant default-dynamic-space-end #xA0000000) (def!constant linkage-table-space-start #x20200000) (def!constant linkage-table-space-end #x202ff000)) #!+freebsd (progn - (def!constant read-only-space-start #x01000000) - (def!constant read-only-space-end #x010ff000) - (def!constant static-space-start #x01100000) (def!constant static-space-end #x011ff000) - (def!constant dynamic-space-start #x58000000) - (def!constant dynamic-space-end #x98000000) + (def!constant default-dynamic-space-start #x58000000) + (def!constant default-dynamic-space-end #x98000000) (def!constant linkage-table-space-start #x01200000) (def!constant linkage-table-space-end #x012ff000)) #!+openbsd (progn - (def!constant read-only-space-start #x10000000) - (def!constant read-only-space-end #x100ff000) - (def!constant static-space-start #x10100000) (def!constant static-space-end #x101ff000) - (def!constant dynamic-space-start #x80000000) - (def!constant dynamic-space-end #xA0000000) + (def!constant default-dynamic-space-start #x80000000) + (def!constant default-dynamic-space-end #xA0000000) ;; In CMUCL: 0xB0000000->0xB1000000 (def!constant linkage-table-space-start #x10200000) @@ -234,14 +222,11 @@ #!+netbsd (progn - (def!constant read-only-space-start #x20000000) - (def!constant read-only-space-end #x200ff000) - (def!constant static-space-start #x20100000) (def!constant static-space-end #x201ff000) - (def!constant dynamic-space-start #x60000000) - (def!constant dynamic-space-end #x98000000) + (def!constant default-dynamic-space-start #x60000000) + (def!constant default-dynamic-space-end #x98000000) ;; In CMUCL: 0xB0000000->0xB1000000 (def!constant linkage-table-space-start #x20200000) @@ -250,9 +235,6 @@ #!+darwin (progn - (def!constant read-only-space-start #x04000000) - (def!constant read-only-space-end #x040ff000) - (def!constant static-space-start #x04100000) (def!constant static-space-end #x041ff000) diff --git a/src/runtime/GNUmakefile b/src/runtime/GNUmakefile index 2e6be50..8daff34 100644 --- a/src/runtime/GNUmakefile +++ b/src/runtime/GNUmakefile @@ -42,7 +42,7 @@ COMMON_SRC = alloc.c backtrace.c breakpoint.c coreparse.c \ dynbind.c funcall.c gc-common.c globals.c interr.c interrupt.c \ largefile.c monitor.c os-common.c parse.c print.c purify.c \ pthread-futex.c pthread-lutex.c \ - regnames.c run-program.c runtime.c save.c search.c \ + regnames.c relocate.c run-program.c runtime.c save.c search.c \ thread.c time.c util.c validate.c vars.c wrap.c C_SRC = $(COMMON_SRC) ${ARCH_SRC} ${OS_SRC} ${GC_SRC} diff --git a/src/runtime/bsd-os.c b/src/runtime/bsd-os.c index f169720..b140508 100644 --- a/src/runtime/bsd-os.c +++ b/src/runtime/bsd-os.c @@ -94,11 +94,11 @@ os_context_sigmask_addr(os_context_t *context) } os_vm_address_t -os_validate(os_vm_address_t addr, os_vm_size_t len) +os_validate(os_vm_address_t addr, os_vm_size_t len, int fixedp) { int flags = MAP_PRIVATE | MAP_ANON; - if (addr) + if (addr && fixedp) flags |= MAP_FIXED; addr = mmap(addr, len, OS_VM_PROT_ALL, flags, -1, 0); @@ -158,7 +158,7 @@ is_valid_lisp_addr(os_vm_address_t addr) if (in_range_p(addr, READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE) || in_range_p(addr, STATIC_SPACE_START, STATIC_SPACE_SIZE) || - in_range_p(addr, DYNAMIC_SPACE_START, dynamic_space_size)) + gc_is_valid_lisp_addr(addr)) return 1; for_each_thread(th) { if (((os_vm_address_t)th->control_stack_start <= addr) && diff --git a/src/runtime/cheneygc-internal.h b/src/runtime/cheneygc-internal.h index 5b58bf6..89a3761 100644 --- a/src/runtime/cheneygc-internal.h +++ b/src/runtime/cheneygc-internal.h @@ -4,6 +4,8 @@ extern lispobj *from_space_free_pointer; extern lispobj *new_space; extern lispobj *new_space_free_pointer; +extern void *dynamic_0_space_start; +extern void *dynamic_1_space_start; /* predicates */ /* #if defined(DEBUG_SPACE_PREDICATES) */ diff --git a/src/runtime/cheneygc.c b/src/runtime/cheneygc.c index db74f54..40d41c9 100644 --- a/src/runtime/cheneygc.c +++ b/src/runtime/cheneygc.c @@ -47,6 +47,9 @@ lispobj *from_space_free_pointer; lispobj *new_space; lispobj *new_space_free_pointer; +void *dynamic_0_space_start; +void *dynamic_1_space_start; + static void scavenge_newspace(void); @@ -150,10 +153,10 @@ collect_garbage(generation_index_t ignore) fprintf(stderr,"from_space = %lx\n", (unsigned long) current_dynamic_space); #endif - if (current_dynamic_space == (lispobj *) DYNAMIC_0_SPACE_START) - new_space = (lispobj *)DYNAMIC_1_SPACE_START; - else if (current_dynamic_space == (lispobj *) DYNAMIC_1_SPACE_START) - new_space = (lispobj *) DYNAMIC_0_SPACE_START; + if (current_dynamic_space == (lispobj *) dynamic_0_space_start) + new_space = (lispobj *)dynamic_1_space_start; + else if (current_dynamic_space == (lispobj *) dynamic_1_space_start) + new_space = (lispobj *) dynamic_0_space_start; else { lose("GC lossage. Current dynamic space is bogus!\n"); } @@ -559,7 +562,7 @@ void gc_initialize_pointers(void) { /* FIXME: We do nothing here. We (briefly) misguidedly attempted - to set current_dynamic_space to DYNAMIC_0_SPACE_START here, + to set current_dynamic_space to dynamic_0_space_start here, forgetting that (a) actually it could be the other and (b) it's set in coreparse.c anyway. There's a FIXME note left here to note that current_dynamic_space is a violation of OAOO: we can @@ -615,7 +618,7 @@ void clear_auto_gc_trigger(void) #if defined(SUNOS) || defined(SOLARIS) /* don't want to force whole space into swapping mode... */ - os_validate(addr, length); + os_validate(addr, length, 1); #else os_protect(addr, length, OS_VM_PROT_ALL); #endif diff --git a/src/runtime/coreparse.c b/src/runtime/coreparse.c index d657bac..7060731 100644 --- a/src/runtime/coreparse.c +++ b/src/runtime/coreparse.c @@ -34,6 +34,7 @@ #include "validate.h" #include "gc-internal.h" +#include "relocate.h" /* lutex stuff */ #if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX) @@ -107,10 +108,15 @@ lose: return -1; } +/* kludge */ +static os_vm_address_t old_dynamic_space_start; +static os_vm_address_t old_dynamic_space_end; + static void process_directory(int fd, lispobj *ptr, int count, os_vm_offset_t file_offset) { struct ndir_entry *entry; + long static_space_len = 0; FSHOW((stderr, "/process_directory(..), count=%d\n", count)); @@ -120,9 +126,53 @@ process_directory(int fd, lispobj *ptr, int count, os_vm_offset_t file_offset) long offset = os_vm_page_size * (1 + entry->data_page); os_vm_address_t addr = (os_vm_address_t) (os_vm_page_size * entry->address); - lispobj *free_pointer = (lispobj *) addr + entry->nwords; + lispobj *free_pointer; long len = os_vm_page_size * entry->page_count; + if (id == DYNAMIC_CORE_SPACE_ID) { + old_dynamic_space_start = addr; + old_dynamic_space_end = addr + len; +#if !defined(LISP_FEATURE_GENCGC) + if (addr != dynamic_1_space_start) + addr = dynamic_0_space_start; +#elif !defined(LISP_FEATURE_INCREMENTAL_ALLOCATION) + addr = dynamic_space_start; +#else + /* In incremental allocation mode, dynamic space hasn't + * been allocated yet, because we want to start with a dynamic + * space that is as small as possible. + * + * The address range covered by the page table starts at the + * bottom of the address space so the page table only needs + * to grow towards larger addresses. + * + * On 64 bit architectures, we don't use mmap(), because then + * the page table might have to span terrabytes of virtual + * memory if we are unlucky and successive mmap() calls jump + * around at lot. Instead we use brk(), which will give us + * a low address. + * + * On 32 bit architectures, brk() also wins because this way + * we don't have to worry about extending the page table at + * the beginning if mmap() suddenly hands out low addresses. + */ + { + /* try to avoid relocation if we can get the default + * dynamic space address without wasting much memory. + * In particular, parms.lisp takes the linkage table end + * and rounds it up to the next 0x10000 byte boundary: */ + os_vm_address_t current = (os_vm_address_t) sbrk(0); + if (current <= addr && current + 0x10000 > addr) + sbrk(addr - current); + } + addr = sbrk(len); + if ((os_vm_address_t) addr == (os_vm_address_t) -1) + lose("failed to brk dynamic space"); + dynamic_space_start = addr; + dynamic_space_size = len; +#endif + } + if (len != 0) { os_vm_address_t real_addr; FSHOW((stderr, "/mapping %ld(0x%lx) bytes at 0x%lx\n", @@ -135,12 +185,14 @@ process_directory(int fd, lispobj *ptr, int count, os_vm_offset_t file_offset) addr); } } + free_pointer = (lispobj *) addr + entry->nwords; FSHOW((stderr, "/space id = %ld, free pointer = 0x%lx\n", id, (unsigned long)free_pointer)); switch (id) { case DYNAMIC_CORE_SPACE_ID: + gc_init(); if (len > dynamic_space_size) { fprintf(stderr, "dynamic space too small for core: %ldKiB required, %ldKiB available.\n", @@ -148,22 +200,31 @@ process_directory(int fd, lispobj *ptr, int count, os_vm_offset_t file_offset) (long)dynamic_space_size >> 10); exit(1); } -#ifdef LISP_FEATURE_GENCGC - if (addr != (os_vm_address_t)DYNAMIC_SPACE_START) { - fprintf(stderr, "in core: 0x%lx; in runtime: 0x%lx \n", - (long)addr, (long)DYNAMIC_SPACE_START); - lose("core/runtime address mismatch: DYNAMIC_SPACE_START\n"); - } -#else - if ((addr != (os_vm_address_t)DYNAMIC_0_SPACE_START) && - (addr != (os_vm_address_t)DYNAMIC_1_SPACE_START)) { - fprintf(stderr, "in core: 0x%lx; in runtime: 0x%lx or 0x%lx\n", - (long)addr, - (long)DYNAMIC_0_SPACE_START, - (long)DYNAMIC_1_SPACE_START); - lose("warning: core/runtime address mismatch: DYNAMIC_SPACE_START\n"); + if (addr != old_dynamic_space_start) { + struct relocation_segment segment; + void *start = old_dynamic_space_start; + + /* KLUDGE: make the printf conditional on --noinform? + * Or just use FSHOW? */ + fprintf(stderr, + "relocating dynamic space to: 0x%lx; from: 0x%lx \n", + (long)addr, (long)old_dynamic_space_start); + + relocate_single((long *) addr, + len / N_WORD_BYTES, + (long *) old_dynamic_space_start, + (long) addr - (long) old_dynamic_space_start); + /* We assume that static space comes before dynamic space, + * and both in one directory */ + segment.old_start = start; + segment.old_end = start + len; + segment.displacement = (long) addr - (long) start; + relocation_fixup((long *) STATIC_SPACE_START, + static_space_len / N_WORD_BYTES, + 1, + &segment); } -#endif + #if defined(ALLOCATION_POINTER) SetSymbolValue(ALLOCATION_POINTER, (lispobj)free_pointer,0); #else @@ -181,6 +242,7 @@ process_directory(int fd, lispobj *ptr, int count, os_vm_offset_t file_offset) (long)addr, (long)STATIC_SPACE_START); lose("core/runtime address mismatch: STATIC_SPACE_START\n"); } + static_space_len = len; break; case READ_ONLY_CORE_SPACE_ID: if (addr != (os_vm_address_t)READ_ONLY_SPACE_START) { @@ -296,7 +358,15 @@ load_core_file(char *file, os_vm_offset_t file_offset) case INITIAL_FUN_CORE_ENTRY_TYPE_CODE: SHOW("INITIAL_FUN_CORE_ENTRY_TYPE_CODE case"); - initial_function = (lispobj)*ptr; + if ((lispobj) old_dynamic_space_start <= *ptr + && *ptr < (lispobj) old_dynamic_space_end) + { + initial_function + = (lispobj)*ptr + + (long) dynamic_space_start + - (long) old_dynamic_space_start; + } else + initial_function = (lispobj)*ptr; break; #if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX) diff --git a/src/runtime/gc-internal.h b/src/runtime/gc-internal.h index c9d1911..9674d99 100644 --- a/src/runtime/gc-internal.h +++ b/src/runtime/gc-internal.h @@ -71,8 +71,11 @@ NWORDS(unsigned long x, unsigned long n_bits) #define FREE_PAGE_FLAG 0 #define BOXED_PAGE_FLAG 1 #define UNBOXED_PAGE_FLAG 2 +#define HOLE_PAGE_FLAG 3 #define OPEN_REGION_PAGE_FLAG 4 +#define PAGE_TYPE_MASK (BOXED_PAGE_FLAG | UNBOXED_PAGE_FLAG) + #define ALLOC_BOXED 0 #define ALLOC_UNBOXED 1 #define ALLOC_QUICK 1 diff --git a/src/runtime/gencgc-internal.h b/src/runtime/gencgc-internal.h index ba56529..216e3ab 100644 --- a/src/runtime/gencgc-internal.h +++ b/src/runtime/gencgc-internal.h @@ -24,6 +24,8 @@ #include "gencgc-alloc-region.h" #include "genesis/code.h" +extern void *dynamic_space_start; + void gc_free_heap(void); inline page_index_t find_page_index(void *); inline void *page_address(page_index_t); @@ -108,13 +110,15 @@ void gc_alloc_update_page_tables(int unboxed, void gc_alloc_update_all_page_tables(void); void gc_set_region_empty(struct alloc_region *region); +int gc_find_dynamic_space_segments(lispobj ***start_out, lispobj ***end_out); + /* * predicates */ static inline boolean space_matches_p(lispobj obj, generation_index_t space) { - page_index_t page_index=(void*)obj - (void *)DYNAMIC_SPACE_START; + page_index_t page_index=(void*)obj - (void *)dynamic_space_start; return ((page_index >= 0) && ((page_index = ((unsigned long)page_index)/PAGE_BYTES) < page_table_pages) @@ -133,6 +137,8 @@ new_space_p(lispobj obj) return space_matches_p(obj,new_space); } +boolean gc_is_valid_lisp_addr(os_vm_address_t addr); + extern page_index_t last_free_page; extern boolean gencgc_partial_pickup; diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index a43d374..64cb0f7 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -59,6 +59,9 @@ /* forward declarations */ page_index_t gc_find_freeish_pages(long *restart_page_ptr, long nbytes, int unboxed); +static void gc_soft_limit_cerror(long requested); +void *gc_alloc_with_region(long, int, struct alloc_region *, int); + /* @@ -166,9 +169,18 @@ static boolean conservative_stack = 1; unsigned page_table_pages; struct page *page_table; +/* + * The total number of non-hole pages allocated, for comparision to + * the soft pages limit. + */ +#ifdef LISP_FEATURE_INCREMENTAL_ALLOCATION +unsigned total_usable_pages; +#endif + /* To map addresses to page structures the address of the first page * is needed. */ static void *heap_base = NULL; +void *dynamic_space_start = NULL; /* Calculate the start address for the given page number. */ inline void * @@ -193,6 +205,20 @@ find_page_index(void *addr) return (-1); } +boolean +gc_is_valid_lisp_addr(os_vm_address_t addr) +{ +#ifdef LISP_FEATURE_INCREMENTAL_ALLOCATION + page_index_t index = find_page_index(addr); + return index != -1 && page_table[index].allocated != HOLE_PAGE_FLAG; +#else + size_t ad = (size_t) addr; + return ((size_t) dynamic_space_start <= ad + && ad < ((size_t) dynamic_space_start + + DEFAULT_DYNAMIC_SPACE_SIZE)); +#endif +} + /* a structure to hold the state of a generation */ struct generation { @@ -404,7 +430,9 @@ print_generation_stats(int verbose) /* FIXME: should take FILE argument */ /* Count the number of boxed pages within the given * generation. */ - if (page_table[j].allocated & BOXED_PAGE_FLAG) { + if ((page_table[j].allocated & PAGE_TYPE_MASK) + == BOXED_PAGE_FLAG) + { if (page_table[j].large_object) large_boxed_cnt++; else @@ -413,7 +441,9 @@ print_generation_stats(int verbose) /* FIXME: should take FILE argument */ if(page_table[j].dont_move) pinned_cnt++; /* Count the number of unboxed pages within the given * generation. */ - if (page_table[j].allocated & UNBOXED_PAGE_FLAG) { + if ((page_table[j].allocated & PAGE_TYPE_MASK) + == UNBOXED_PAGE_FLAG) + { if (page_table[j].large_object) large_unboxed_cnt++; else @@ -465,7 +495,7 @@ void zero_pages_with_mmap(page_index_t start, page_index_t end) { return; os_invalidate(addr, length); - new_addr = os_validate(addr, length); + new_addr = os_validate(addr, length, 1); if (new_addr == NULL || new_addr != addr) { lose("remap_free_pages: page moved, 0x%08x ==> 0x%08x", start, new_addr); } @@ -618,6 +648,17 @@ gc_alloc_new_region(long nbytes, int unboxed, struct alloc_region *alloc_region) generations[gc_alloc_generation].alloc_start_page; } last_page=gc_find_freeish_pages(&first_page,nbytes,unboxed); +#ifdef LISP_FEATURE_INCREMENTAL_ALLOCATION + if (last_page == -1) { + /* the soft allocation limit had been reached. */ + ret = thread_mutex_unlock(&free_pages_lock); + gc_assert(ret == 0); + gc_soft_limit_cerror(nbytes); + + /* restart selected, user wants to try again */ + gc_alloc_with_region(nbytes, unboxed, alloc_region, 1); + } +#endif bytes_found=(PAGE_BYTES - page_table[first_page].bytes_used) + PAGE_BYTES*(last_page-first_page); @@ -966,7 +1007,21 @@ gc_alloc_large(long nbytes, int unboxed, struct alloc_region *alloc_region) last_page=gc_find_freeish_pages(&first_page,nbytes,unboxed); +#ifdef LISP_FEATURE_INCREMENTAL_ALLOCATION + if (last_page == -1) { + /* the soft allocation limit had been reached. */ + ret = thread_mutex_unlock(&free_pages_lock); + gc_assert(ret == 0); + gc_soft_limit_cerror(nbytes); + + /* restart selected, user wants to try again */ + return gc_alloc_large(nbytes, unboxed, alloc_region); + } +#endif + +#ifndef LISP_FEATURE_INCREMENTAL_ALLOCATION gc_assert(first_page > alloc_region->last_page); +#endif if (unboxed) generations[gc_alloc_generation].alloc_large_unboxed_start_page = last_page; @@ -1103,6 +1158,226 @@ gc_heap_exhausted_error_or_lose (long available, long requested) } } +#ifdef LISP_FEATURE_INCREMENTAL_ALLOCATION + +#if N_WORD_BITS == 32 + +static void *gc_validate_restart = 0; + +/* + * Map nbytes of memory at a position higher than or (preferrably) equal + * to target_pos. Never return a value smaller than any other value + * returned earlier. + * + * (This loop is specificially for 32 bit architectures. A version for + * 64 architectures would just call os_validate once with fixed=1 for a + * position that is known to be free.) + */ +static void * +gc_validate_monotonically(void *target_pos, long nbytes) +{ + void *actual_pos; + + if (gc_validate_restart == 0) + gc_validate_restart = target_pos; + + for (;;) { + /* use fixed=0 with os_validate because we want to skip over + * shared libraries, not destroy them. The 32 bit address space + * being as small as it is, this is important, even though + * it causes the problems explained below: */ + actual_pos = os_validate(gc_validate_restart, nbytes, 0); + if (actual_pos == NULL) + return (void *) -1; + if (actual_pos == gc_validate_restart) + break; + /* + * We couldn't get an address at the position we wanted. + * + * Although we can skip over a hole in memory (see Case 2) below, + * we have to expect that mmap() hasn't actually given us the closest + * chunk of memory available, and gave us memory somewhere else + * entirely. In that case a later allocation could jump into + * the hole and try to fill it. (See case 1 below.) + * + * The problem is that I can't get case 1 to actually work. It + * causes segfaults and other GC misbehaviour which I haven't + * figured out so far. + * + * So instead we loop: We give back the memory allocated to us + * and try again with a different position. + * + * Beware that this will loop forever if os_validate() doesn't + * take address hints without MAP_FIXED. So don't try this on + * Solaris. + */ + os_invalidate(actual_pos, nbytes); + actual_pos = gc_validate_restart; /* for the overflow check */ + gc_validate_restart += PAGE_BYTES; + if (gc_validate_restart < actual_pos) { + /* overflow */ + fprintf(stderr, "overflow in gc_map_new_pages, giving up\n"); + return (void *) -1; + } + } + gc_validate_restart += nbytes; + return actual_pos; +} +#endif + +static unsigned page_table_preallocated_size = 0; + +/* + * enlarge the page table exponentially + * (glibc's realloc would copy it every time) + */ +static void +realloc_page_table(unsigned new_page_table_pages, long nbytes_for_condition) +{ + struct page_table *new_page_table; + + if (page_table_preallocated_size == 0) + page_table_preallocated_size = page_table_pages; + + if (new_page_table_pages <= page_table_preallocated_size) + return; + + page_table_preallocated_size *= 2; + + new_page_table = realloc( + page_table, page_table_preallocated_size * sizeof(struct page)); + if (!new_page_table) { + fprintf(stderr, "out of memory: failed to realloc page_table\n"); + gc_heap_exhausted_error_or_lose(0, nbytes_for_condition); + } + page_table = (void *) new_page_table; +} + +static void +gc_soft_limit_cerror(long requested) +{ + fprintf(stderr, + "Soft heap limit of %d pages reached with %d pages in use and %ld bytes requested.\n(1 page == %d bytes)\n", + soft_pages_limit, + total_usable_pages, + requested / PAGE_BYTES, + PAGE_BYTES); + funcall0(StaticSymbolFunction(SOFT_HEAP_EXHAUSTED_ERROR)); +} + +static page_index_t +gc_map_new_pages(page_index_t *restart_page_ptr, long nbytes) +{ + page_index_t i, first_page, new_page_table_pages; + void *target_pos = dynamic_space_start + (page_table_pages*PAGE_BYTES); + void *actual_pos; + + /* Round up to a page size, just to be sure. */ + nbytes = CEILING(nbytes, PAGE_BYTES); + + /* first check the soft allocation limit */ + if (soft_pages_limit + && !gc_active_p + && total_usable_pages + (nbytes / PAGE_BYTES) >= soft_pages_limit) + { + struct thread *thread = arch_os_get_current_thread(); + if (SymbolValue(IN_SOFT_HEAP_EXHAUSTED_ERROR_P, thread) == NIL) + return -1; + } + +#if N_WORD_BITS == 32 + actual_pos = gc_validate_monotonically(target_pos, nbytes); +#else + actual_pos = sbrk(nbytes); +#endif + + if (actual_pos == (void *) -1) + gc_heap_exhausted_error_or_lose(0, nbytes); + + gc_assert(actual_pos >= target_pos); + + /* We got memory after the current dynamic space. Find out how + * large the hole between them is (if any) and enlarge the page + * table. + * + * +-------------------------------+................. + * |1111102222033333333331111022220| + * +-------------------------------+................. + * old page table ^ ^ + * | | + * +--------+-------+ + * |33333333|0000000| + * +--------+-------+ + * hole new pages + */ + + first_page = page_table_pages + (unsigned) (actual_pos - target_pos) / PAGE_BYTES; + new_page_table_pages = first_page + nbytes / PAGE_BYTES; + + gc_assert(page_table_pages <= first_page); + + realloc_page_table(new_page_table_pages, nbytes); + for (i = page_table_pages; i < first_page; i++) { + page_table[i].allocated = HOLE_PAGE_FLAG; + page_table[i].bytes_used = 0; + page_table[i].write_protected = 0; + } + for (; i < new_page_table_pages; i++) { + page_table[i].allocated = FREE_PAGE_FLAG; + page_table[i].bytes_used = 0; + page_table[i].write_protected = 0; + total_usable_pages++; + } + + *restart_page_ptr = first_page; + page_table_pages = new_page_table_pages; + return page_table_pages - 1; +} + +int +gc_find_dynamic_space_segments(lispobj ***start_out, lispobj ***end_out) +{ + lispobj **start; + lispobj **end; + int nsegments, was_hole; + page_index_t page; + + /* the number of segments is one plus the number of pages where + * `allocated' switches from hole to non-hole */ + was_hole = 1; + nsegments = 0; + for (page = 0; page < last_free_page; page++) { + int is_hole = page_table[page].allocated == HOLE_PAGE_FLAG; + if (was_hole && !is_hole) + nsegments++; + was_hole = is_hole; + } + start = successful_malloc(sizeof(lispobj) * nsegments); + end = successful_malloc(sizeof(lispobj) * nsegments); + + /* loop again, this time recording the positions */ + was_hole = 1; + nsegments = 0; + for (page = 0; page < last_free_page; page++) { + int is_hole = page_table[page].allocated == HOLE_PAGE_FLAG; + if (was_hole) { + if (!is_hole) { + start[nsegments] = page_address(page); + nsegments++; + } + } else if (is_hole) + end[nsegments - 1] = page_address(page); + was_hole = is_hole; + } + if (!was_hole) + end[nsegments - 1] = page_address(page); + + *start_out = start; + *end_out = end; + return nsegments; +} +#endif + page_index_t gc_find_freeish_pages(page_index_t *restart_page_ptr, long nbytes, int unboxed) { @@ -1146,7 +1421,11 @@ gc_find_freeish_pages(page_index_t *restart_page_ptr, long nbytes, int unboxed) } if (first_page >= page_table_pages) +#ifdef LISP_FEATURE_INCREMENTAL_ALLOCATION + return gc_map_new_pages(restart_page_ptr, nbytes); +#else gc_heap_exhausted_error_or_lose(0, nbytes); +#endif gc_assert(page_table[first_page].write_protected == 0); @@ -1172,7 +1451,11 @@ gc_find_freeish_pages(page_index_t *restart_page_ptr, long nbytes, int unboxed) /* Check for a failure */ if ((restart_page >= page_table_pages) && (bytes_found < nbytes)) +#ifdef LISP_FEATURE_INCREMENTAL_ALLOCATION + return gc_map_new_pages(restart_page_ptr, nbytes); +#else gc_heap_exhausted_error_or_lose(bytes_found, nbytes); +#endif *restart_page_ptr=first_page; @@ -2624,6 +2907,7 @@ preserve_pointer(void *addr) /* quick check 1: Address is quite likely to have been invalid. */ if ((addr_page_index == -1) || (page_table[addr_page_index].allocated == FREE_PAGE_FLAG) + || (page_table[addr_page_index].allocated == HOLE_PAGE_FLAG) || (page_table[addr_page_index].bytes_used == 0) || (page_table[addr_page_index].gen != from_space) /* Skip if already marked dont_move. */ @@ -2756,13 +3040,15 @@ update_page_write_prot(page_index_t page) /* Shouldn't be a free page. */ gc_assert(page_table[page].allocated != FREE_PAGE_FLAG); + gc_assert(page_table[page].allocated != HOLE_PAGE_FLAG); gc_assert(page_table[page].bytes_used != 0); /* Skip if it's already write-protected, pinned, or unboxed */ if (page_table[page].write_protected /* FIXME: What's the reason for not write-protecting pinned pages? */ || page_table[page].dont_move - || (page_table[page].allocated & UNBOXED_PAGE_FLAG)) + || ((page_table[page].allocated & PAGE_TYPE_MASK) + == UNBOXED_PAGE_FLAG)) return (0); /* Scan the page for pointers to younger generations or the @@ -2849,7 +3135,8 @@ scavenge_generations(generation_index_t from, generation_index_t to) for (i = 0; i < last_free_page; i++) { generation_index_t generation = page_table[i].gen; - if ((page_table[i].allocated & BOXED_PAGE_FLAG) + if (((page_table[i].allocated & PAGE_TYPE_MASK) + == BOXED_PAGE_FLAG) && (page_table[i].bytes_used != 0) && (generation != new_space) && (generation >= from) @@ -2866,7 +3153,8 @@ scavenge_generations(generation_index_t from, generation_index_t to) write_protected && page_table[last_page].write_protected; if ((page_table[last_page].bytes_used < PAGE_BYTES) /* Or it is PAGE_BYTES and is the last in the block */ - || (!(page_table[last_page+1].allocated & BOXED_PAGE_FLAG)) + || ((page_table[last_page+1].allocated & PAGE_TYPE_MASK) + != BOXED_PAGE_FLAG) || (page_table[last_page+1].bytes_used == 0) || (page_table[last_page+1].gen != generation) || (page_table[last_page+1].first_object_offset == 0)) @@ -2952,7 +3240,7 @@ scavenge_newspace_generation_one_scan(generation_index_t generation) generation)); for (i = 0; i < last_free_page; i++) { /* Note that this skips over open regions when it encounters them. */ - if ((page_table[i].allocated & BOXED_PAGE_FLAG) + if (((page_table[i].allocated & PAGE_TYPE_MASK) == BOXED_PAGE_FLAG) && (page_table[i].bytes_used != 0) && (page_table[i].gen == generation) && ((page_table[i].write_protected == 0) @@ -2980,7 +3268,8 @@ scavenge_newspace_generation_one_scan(generation_index_t generation) * contiguous block */ if ((page_table[last_page].bytes_used < PAGE_BYTES) /* Or it is PAGE_BYTES and is the last in the block */ - || (!(page_table[last_page+1].allocated & BOXED_PAGE_FLAG)) + || ((page_table[last_page+1].allocated & PAGE_TYPE_MASK) + != BOXED_PAGE_FLAG) || (page_table[last_page+1].bytes_used == 0) || (page_table[last_page+1].gen != generation) || (page_table[last_page+1].first_object_offset == 0)) @@ -3599,7 +3888,7 @@ verify_zero_fill(void) lose("free page not zero at %x\n", start_addr + i); } } - } else { + } else if (page_table[page].allocated != HOLE_PAGE_FLAG) { long free_bytes = PAGE_BYTES - page_table[page].bytes_used; if (free_bytes > 0) { long *start_addr = (long *)((unsigned long)page_address(page) @@ -4353,6 +4642,14 @@ collect_garbage(generation_index_t last_gen) gc_active_p = 0; +#ifdef LISP_FEATURE_INCREMENTAL_ALLOCATION + if (soft_pages_limit && total_usable_pages >= soft_pages_limit) { + struct thread *thread = arch_os_get_current_thread(); + if (SymbolValue(IN_SOFT_HEAP_EXHAUSTED_ERROR_P, thread) == NIL) + gc_soft_limit_cerror(0); + } +#endif + SHOW("returning from collect_garbage"); } @@ -4391,7 +4688,7 @@ gc_free_heap(void) page_table[page].write_protected = 0; os_invalidate(page_start,PAGE_BYTES); - addr = os_validate(page_start,PAGE_BYTES); + addr = os_validate(page_start,PAGE_BYTES,1); if (addr == NULL || addr != page_start) { lose("gc_free_heap: page moved, 0x%08x ==> 0x%08x\n", page_start, @@ -4460,6 +4757,10 @@ gc_init(void) page_table_pages = dynamic_space_size/PAGE_BYTES; gc_assert(dynamic_space_size == (size_t) page_table_pages*PAGE_BYTES); +#ifdef LISP_FEATURE_INCREMENTAL_ALLOCATION + total_usable_pages = page_table_pages; +#endif + page_table = calloc(page_table_pages, sizeof(struct page)); gc_assert(page_table); @@ -4473,7 +4774,7 @@ gc_init(void) sizetab[LUTEX_WIDETAG] = size_lutex; #endif - heap_base = (void*)DYNAMIC_SPACE_START; + heap_base = dynamic_space_start; /* Initialize each page structure. */ for (i = 0; i < page_table_pages; i++) { diff --git a/src/runtime/globals.c b/src/runtime/globals.c index 07d56b5..2e0712c 100644 --- a/src/runtime/globals.c +++ b/src/runtime/globals.c @@ -49,7 +49,7 @@ boolean stop_the_world=0; /* For copying GCs, this points to the start of the dynamic space * currently in use (that will become the from_space when the next GC - * is done). For the GENCGC, it always points to DYNAMIC_SPACE_START. */ + * is done). For the GENCGC, it always points to dynamic_space_start. */ lispobj *current_dynamic_space; #if defined(LISP_FEATURE_SB_THREAD) && !defined(LISP_FEATURE_GCC_TLS) @@ -75,3 +75,10 @@ void globals_init(void) pthread_key_create(&specials,0); #endif } + +char read_only_space[READ_ONLY_SPACE_SIZE + GENESIS_ALIGNMENT]; + +#ifdef LISP_FEATURE_INCREMENTAL_ALLOCATION +unsigned soft_pages_limit = + (DEFAULT_DYNAMIC_SPACE_END - DEFAULT_DYNAMIC_SPACE_START) / PAGE_BYTES; +#endif diff --git a/src/runtime/globals.h b/src/runtime/globals.h index 9dca797..40aa902 100644 --- a/src/runtime/globals.h +++ b/src/runtime/globals.h @@ -70,6 +70,10 @@ extern lispobj *current_dynamic_space; extern void globals_init(void); +#ifdef LISP_FEATURE_INCREMENTAL_ALLOCATION +extern unsigned soft_pages_limit; +#endif + #else /* LANGUAGE_ASSEMBLY */ # ifdef LISP_FEATURE_MIPS @@ -127,4 +131,11 @@ EXTERN(dynamic_space_free_pointer, POINTERSIZE) #endif /* LANGUAGE_ASSEMBLY */ +#define GENESIS_ALIGNMENT 0x10000 +#define READ_ONLY_SPACE_SIZE 0xff000 +#define READ_ONLY_SPACE_START ((((long) read_only_space) + (GENESIS_ALIGNMENT - 1)) & (~(GENESIS_ALIGNMENT - 1))) +#define READ_ONLY_SPACE_END (READ_ONLY_SPACE_START + READ_ONLY_SPACE_SIZE) + +extern char read_only_space[READ_ONLY_SPACE_SIZE + GENESIS_ALIGNMENT]; + #endif /* _INCLUDED_GLOBALS_H_ */ diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c index e72bdd9..dc38ef0 100644 --- a/src/runtime/interrupt.c +++ b/src/runtime/interrupt.c @@ -865,7 +865,7 @@ arrange_return_to_lisp_function(os_context_t *context, lispobj function) u32 *sp=(u32 *)*os_context_register_addr(context,reg_ESP); #if defined(LISP_FEATURE_DARWIN) - u32 *register_save_area = (u32 *)os_validate(0, 0x40); + u32 *register_save_area = (u32 *)os_validate(0, 0x40, 1); FSHOW_SIGNAL((stderr, "/arrange_return_to_lisp_function: preparing to go to function %x, sp: %x\n", function, sp)); FSHOW_SIGNAL((stderr, "/arrange_return_to_lisp_function: context: %x, &context %x\n", context, &context)); diff --git a/src/runtime/linux-os.c b/src/runtime/linux-os.c index f50b7b1..a23d79c 100644 --- a/src/runtime/linux-os.c +++ b/src/runtime/linux-os.c @@ -271,11 +271,14 @@ static void * under_2gb_free_pointer=DYNAMIC_1_SPACE_END; #endif os_vm_address_t -os_validate(os_vm_address_t addr, os_vm_size_t len) +os_validate(os_vm_address_t addr, os_vm_size_t len, int fixedp) { int flags = MAP_PRIVATE | MAP_ANONYMOUS | MAP_NORESERVE; os_vm_address_t actual; + if (addr && fixedp) + flags |= MAP_FIXED; + #ifdef LISP_FEATURE_ALPHA if (!addr) { addr=under_2gb_free_pointer; @@ -287,12 +290,6 @@ os_validate(os_vm_address_t addr, os_vm_size_t len) return 0; /* caller should check this */ } - if (addr && (addr!=actual)) { - fprintf(stderr, "mmap: wanted %lu bytes at %p, actually mapped at %p\n", - (unsigned long) len, addr, actual); - return 0; - } - #ifdef LISP_FEATURE_ALPHA len=(len+(os_vm_page_size-1))&(~(os_vm_page_size-1)); @@ -348,11 +345,11 @@ is_valid_lisp_addr(os_vm_address_t addr) if ((READ_ONLY_SPACE_START <= ad && ad < READ_ONLY_SPACE_END) || (STATIC_SPACE_START <= ad && ad < STATIC_SPACE_END) -#if defined LISP_FEATURE_GENCGC - || (DYNAMIC_SPACE_START <= ad && ad < DYNAMIC_SPACE_END) -#else - || (DYNAMIC_0_SPACE_START <= ad && ad < DYNAMIC_0_SPACE_END) - || (DYNAMIC_1_SPACE_START <= ad && ad < DYNAMIC_1_SPACE_END) +#if defined(LISP_FEATURE_GENCGC) + || gc_is_valid_lisp_addr(addr) +#elif !defined(LISP_FEATURE_GENCGC) + || ((size_t) dynamic_0_space_start <= ad && ad < ((size_t) dynamic_0_space_start + DEFAULT_DYNAMIC_SPACE_SIZE)) + || ((size_t) dynamic_1_space_start <= ad && ad < ((size_t) dynamic_1_space_start + DEFAULT_DYNAMIC_SPACE_SIZE)) #endif ) return 1; diff --git a/src/runtime/monitor.c b/src/runtime/monitor.c index 0856db7..0375323 100644 --- a/src/runtime/monitor.c +++ b/src/runtime/monitor.c @@ -199,7 +199,7 @@ regs_cmd(char **ptr) #endif #ifdef LISP_FEATURE_GENCGC - /* printf("DYNAMIC\t=\t0x%08lx\n", DYNAMIC_SPACE_START); */ + /* printf("DYNAMIC\t=\t0x%08lx\n", dynamic_space_start); */ #else printf("DYNAMIC\t=\t0x%08lx\n", (unsigned long)current_dynamic_space); #endif diff --git a/src/runtime/os-common.c b/src/runtime/os-common.c index 3fdf925..0142722 100644 --- a/src/runtime/os-common.c +++ b/src/runtime/os-common.c @@ -47,7 +47,7 @@ os_zero(os_vm_address_t addr, os_vm_size_t length) * zero-filled. */ os_invalidate(block_start, block_size); - addr = os_validate(block_start, block_size); + addr = os_validate(block_start, block_size, 1); if (addr == NULL || addr != block_start) lose("os_zero: block moved! 0x%08x ==> 0x%08x\n", @@ -59,7 +59,7 @@ os_zero(os_vm_address_t addr, os_vm_size_t length) os_vm_address_t os_allocate(os_vm_size_t len) { - return os_validate((os_vm_address_t)NULL, len); + return os_validate((os_vm_address_t)NULL, len, 1); } void diff --git a/src/runtime/os.h b/src/runtime/os.h index a471ab6..69feb14 100644 --- a/src/runtime/os.h +++ b/src/runtime/os.h @@ -71,9 +71,12 @@ extern void os_zero(os_vm_address_t addr, os_vm_size_t length); /* It looks as though this function allocates 'len' bytes at 'addr', * or at an OS-chosen address if 'addr' is zero. * + * With fixedp, make sure the memory is allocated exactly to `addr', otherwise + * allow relocation to a different address. + * * FIXME: There was some documentation for these functions in * "hp-ux.c" in the old CMU CL code. Perhaps move/merge it in here. */ -extern os_vm_address_t os_validate(os_vm_address_t addr, os_vm_size_t len); +extern os_vm_address_t os_validate(os_vm_address_t addr, os_vm_size_t len, int fixedp); /* This function seems to undo the effect of os_validate(..). */ extern void os_invalidate(os_vm_address_t addr, os_vm_size_t len); diff --git a/src/runtime/osf1-os.c b/src/runtime/osf1-os.c index baba3bf..91c259f 100644 --- a/src/runtime/osf1-os.c +++ b/src/runtime/osf1-os.c @@ -59,10 +59,10 @@ os_init(char *argv[], char *envp[]) os_vm_address_t -os_validate(os_vm_address_t addr, os_vm_size_t len) +os_validate(os_vm_address_t addr, os_vm_size_t len, int fixedp) { int flags = MAP_PRIVATE|MAP_ANONYMOUS; - if (addr) flags |= MAP_FIXED; + if (addr && fixedp) flags |= MAP_FIXED; else flags |= MAP_VARIABLE; if((addr=mmap(addr,len,OS_VM_PROT_ALL,flags,-1,0)) == (os_vm_address_t) -1) diff --git a/src/runtime/parse.c b/src/runtime/parse.c index b4218e5..c1a84d2 100644 --- a/src/runtime/parse.c +++ b/src/runtime/parse.c @@ -261,7 +261,7 @@ static boolean lookup_symbol(char *name, lispobj *result) /* Search dynamic space. */ #if defined(LISP_FEATURE_GENCGC) - headerptr = (lispobj *)DYNAMIC_SPACE_START; + headerptr = (lispobj *)dynamic_space_start; count = (lispobj *)get_alloc_pointer() - headerptr; #else headerptr = (lispobj *)current_dynamic_space; diff --git a/src/runtime/relocate.c b/src/runtime/relocate.c new file mode 100644 index 0000000..68d6cac --- /dev/null +++ b/src/runtime/relocate.c @@ -0,0 +1,586 @@ +/* -*- indent-tabs-mode: nil -*- */ + +/* Copyright (c) 2006,2007 David Lichteblau + * partly derived from SBCL source code (gc-common.c/gencgc.c) + */ +/* + * Note to Windows 64 users: + * + * This code consistently uses `long' rather than the confusing mix of + * {size_t, os_vm_address_t, os_vm_size_t, os_vm_off_t, char*, void*, + * lispobj, lispobj*, etc pp} seen elsewhere, which seemed like a good + * idea at the time it was written. + * + * But if we ever port to an LLP64 system (thank you Microsoft), long is + * the wrong type and needs to be search&replaced to ptrdiff_t. Except + * for the one place we use "unsigned long", which would then be size_t. + * I think. + */ +/* + * Permission is hereby granted, free of charge, to any person + * obtaining a copy of this software and associated documentation files + * (the "Software"), to deal in the Software without restriction, + * including without limitation the rights to use, copy, modify, merge, + * publish, distribute, sublicense, and/or sell copies of the Software, + * and to permit persons to whom the Software is furnished to do so, + * subject to the following conditions: + * + * The above copyright notice and this permission notice shall be + * included in all copies or substantial portions of the Software. + * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, + * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND + * NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS + * BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN + * ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN + * CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE + * SOFTWARE. + */ +#include +#include +#include +#include "genesis/config.h" +#include "validate.h" +#include "gc.h" +#include "gc-internal.h" +#ifdef LISP_FEATURE_GENCGC +#include "gencgc-internal.h" +#else +#include "cheneygc-internal.h" +#endif +#include "runtime.h" +#include "interr.h" +#include "genesis/fdefn.h" +#include "genesis/closure.h" +#include "genesis/instance.h" +#include "genesis/layout.h" +#include "genesis/code.h" +#include "genesis/simple-fun.h" +#include "genesis/vector.h" +#include "genesis/hash-table.h" +#include "genesis/static-symbols.h" +#include "relocate.h" + +/* + * our stuff + */ +#define ALIGN(len) CEILING(len, 2) +#define RELOCATE_BOXED 0 +#define RELOCATE_IMMEDIATE 0 + +#ifndef LISP_FEATURE_GENCGC +#define PAGE_BYTES 0x1000 +#endif + +struct relocator { + /* table of segments of dynamic space, listing their old + * positions and displacement to the new position */ + int nsegments; + struct relocation_segment *segments; + + /* for the segment whose addresses are currently being rewritten: */ + /* + * kludge: Replace `self_tmp_start' and `self_old_start' with just one + * slot for their difference, and rename it to + * self_distance_from_oldspace_to_tmpspace + * (or something descriptive like that :-)) + */ + void *self_tmp_start; /* temporary position */ + void *self_old_start; /* old position */ + long self_displacement; /* new position minus old position */ + + /* don't mark hash tables (magic for static space) */ + int no_rehash; +}; + +typedef long (*relocfn)(long *, struct relocator *); +static relocfn reloctab[256]; + +static int reloctab_initialized = 0; + +static void relocate_init(); +static void sub_relocate(long *ptr, long nwords, struct relocator *ctx); + + +/* + * relocation + */ +static void * +natify(lispobj thing, struct relocator *ctx) +{ + /* + * take a lispobj that has already been rewritten, and find the + * -current- native position of that object in temporary space. + * + * Used to find layouts from their instances, hash tables from + * their vectors, and weird stuff from a code component. + * + * Note that the contents of the object being pointed to might + * or might not have been rewritten already, so we cannot walk + * tagged pointers in its contents recursively. We can, + * however, peek at and modify unboxed slots, in particular + * n_untagged_slots and needs_rehash_p. + * + * Case 1: relocate_single + * - We only have one segment (but finding the old pointer + * using the loop from (2) doesn't hurt) + * - the difference between self_tmp_start and self_old_start + * turns the old pointer into a tmpspace pointer. + * + * Case 2: relocate_all + * - segments sit at their old locations + * - We need to find the segment being referenced, and + * undisplace the pointer. + * + * Case 3: relocate_fixup + * - dynamic space already sits at its new position + * + * We can do the arithmetic from (1) in both cases, since + * the difference is zero for (2) and (3). + */ + int i; + void *ptr = native_pointer((long) thing); + + /* loop for (2) */ + for (i = 0; i < ctx->nsegments; i++) { + struct relocation_segment s = ctx->segments[i]; + /* note the cast from (long *) to (void *), needed because + * displacement is measured in bytes, not words */ + void *new_start = (void *) s.old_start + s.displacement; + void *new_end = (void *) s.old_end + s.displacement; + if (new_start <= ptr && ptr < new_end) { + void *old = ptr - s.displacement; + + /* adjust for (1) */ + long offset = ctx->self_tmp_start + - ctx->self_old_start; + return old + offset; + } + } + return ptr; +} + +#ifdef LISP_FEATURE_X86 +static void * +oldify(void *ptr, struct relocator *ctx) +{ + /* take a pointer into temporary space and compute its "old + * position" before relocation. + * + * Used only for x86 fixups, where ptr is a code component. We + * will compare the result to a fixup, which is still an + * unrelocated "pointer" to oldspace. + * + * Case 1: relocate_single + * - self_tmp_start points to temporary space + * - segments[0].old_start points to old space + * Caller puts that into self_old_start for us. + * - simple pointer arithmetic adjusts for the difference + * + * Case 2: relocate_all + * - segments still sit at their old locations, so we have + * nothing to do. + * + * Caller sets self_old_start == self_tmp_start. + * + * Case 3: relocate_fixup + * - also self_old_start == self_tmp_start + * - but self_displacement is zero here, so it wouldn't matter what + * we return anyway. + */ + return (void *) ctx->self_old_start + + (ptr - (void *) ctx->self_tmp_start); +} +#endif + +void +relocate_single(long *ptr, long nwords, long *old_start, long displacement) +{ + struct relocator ctx; + struct relocation_segment segment; + + if (!reloctab_initialized) { + relocate_init(); + reloctab_initialized = 1; + } + + segment.old_start = old_start; + segment.old_end = old_start + nwords; + segment.displacement = displacement; + + ctx.self_tmp_start = ptr; + ctx.self_old_start = old_start; + ctx.no_rehash = 0; + ctx.nsegments = 1; + ctx.segments = &segment; + ctx.self_displacement = displacement; + + sub_relocate(ptr, nwords, &ctx); +} + +void +relocate_all(int nsegments, struct relocation_segment *segments) +{ + struct relocator ctx; + int i; + + if (!reloctab_initialized) { + relocate_init(); + reloctab_initialized = 1; + } + + ctx.no_rehash = 0; + ctx.nsegments = nsegments; + ctx.segments = segments; + + for (i = 0; i < nsegments; i++) { + long *start = segments[i].old_start; + long *end = segments[i].old_end; + ctx.self_tmp_start = start; + ctx.self_old_start = start; + ctx.self_displacement = segments[i].displacement; + + sub_relocate(start, end - start, &ctx); + } +} + +void +relocation_fixup(long *fixup_ptr, + long n_fixup_words, + int nsegments, struct relocation_segment *segments) +{ + struct relocator ctx; + + if (!reloctab_initialized) { + relocate_init(); + reloctab_initialized = 1; + } + + ctx.no_rehash = 1; + ctx.nsegments = nsegments; + ctx.segments = segments; + ctx.self_displacement = 0; + /* see kludge in the struct definition; would be easier to just + * set a difference of 0 here: */ + ctx.self_tmp_start = (void *) 0xdeadbeef; + ctx.self_old_start = ctx.self_tmp_start; + + sub_relocate(fixup_ptr, n_fixup_words, &ctx); +} + +static void +sub_relocate(long *ptr, long nwords, struct relocator *ctx) +{ + int nsegments = ctx->nsegments; + struct relocation_segment *segments = ctx->segments; + + long *p; + long *q = ptr + nwords; + long nrelocated; + int i; + + for (p = ptr; p < q; p += nrelocated) { + long word = *p; + if (is_lisp_pointer(word)) { + long *address = (long *) native_pointer(word); + for (i = 0; i < nsegments; i++) + if (segments[i].old_start <= address + && address < segments[i].old_end) + { + *p += ctx->segments[i].displacement; + break; + } + nrelocated = 1; + } else { + relocfn fn = reloctab[widetag_of(word)]; + if (fn) + nrelocated = fn(p, ctx); + else + nrelocated = 1; + } + } +} + +static long +relocate_lose(long *ptr, struct relocator *ctx) +{ + lose("no relocation function for header 0x%08x at 0x%08x\n", + *ptr, ptr); + return 0; +} + +static long +relocate_unboxed(long *ptr, struct relocator *ctx) +{ + return ALIGN(HeaderValue(*ptr) + 1); +} + +static long +relocate_raw_vector(long *ptr, struct relocator *ctx) +{ + return sizetab[widetag_of(*ptr)]((void *) ptr); +} + +static long +relocate_simple_vector(long *ptr, struct relocator *ctx) +{ + struct hash_table *table; + + if (ctx->no_rehash + || HeaderValue(*ptr) != subtype_VectorValidHashing) + return 2; + + sub_relocate(ptr + 2, 1, ctx); + table = (struct hash_table *) natify(ptr[2], ctx); + table->needs_rehash_p = T; + return 3; +} + +static long +relocate_fdefn(long *ptr, struct relocator *ctx) +{ + struct fdefn *fdefn = (struct fdefn *) ptr; + char *nontramp_raw_addr = (char *) fdefn->fun + FUN_RAW_ADDR_OFFSET; + + sub_relocate(ptr + 1, 2, ctx); + if (fdefn->raw_addr == nontramp_raw_addr) + fdefn->raw_addr = (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET); + return sizeof(struct fdefn) / sizeof(lispobj); +} + +#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) +static long +relocate_closure_header(long *ptr, struct relocator *ctx) +{ + struct closure *closure = (struct closure *) ptr; + long fun = (long) closure->fun - FUN_RAW_ADDR_OFFSET; + sub_relocate(&fun, 1, ctx); + closure->fun = fun + FUN_RAW_ADDR_OFFSET; + return 2; +} +#endif + +static long +relocate_instance(long *ptr, struct relocator *ctx) +{ + unsigned long nuntagged; + struct instance *instance = (struct instance *) ptr; + unsigned long ntotal = HeaderValue(*ptr); + lispobj original_layout = instance->slots[0]; + + sub_relocate((long *) &instance->slots[0], 1, ctx); + if (fixnump(instance->slots[0])) + /* (for sb-heapdump:) + * If the layout is a fixup, the dumper stores `nuntagged' + * here for us to find. */ + nuntagged = fixnum_value(instance->slots[0]); + else { + struct layout *layout = natify(instance->slots[0], ctx); + nuntagged = fixnum_value(layout->n_untagged_slots); + + /* natify is a non-trivial function, so let's make sure + * it doesn't lead us astray when computing the next nwords + * value */ + if (nuntagged > ntotal) + lose("bogus instance layout %lx -> %lx -> %lx?\n" + "nuntagged == %lx > %lx == ntotal", + (long) original_layout, + (long) instance->slots[0], + (long) layout, + nuntagged, + ntotal); + } + + sub_relocate(ptr + 2, ntotal - nuntagged - 1, ctx); + return ntotal + 1; +} + +static long +relocate_code_header(long *ptr, struct relocator *ctx) +{ + long header = *ptr; + struct code *code = (struct code *) ptr; + long n_header_words = HeaderValue(header); + long n_code_words = fixnum_value(code->code_size); + long n_words = ALIGN(n_header_words + n_code_words); + lispobj ep; + + sub_relocate(ptr + 1, n_header_words - 1, ctx); + + ep = code->entry_points; + while (ep != NIL) { + struct simple_fun *fun = natify(ep, ctx); +#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) + fun->self = (long) ep + FUN_RAW_ADDR_OFFSET; +#else + fun->self = ep; +#endif + sub_relocate((void *) &fun->next, 1, ctx); + sub_relocate((void *) &fun->name, 1, ctx); + sub_relocate((void *) &fun->arglist, 1, ctx); + sub_relocate((void *) &fun->type, 1, ctx); + sub_relocate((void *) &fun->xrefs, 1, ctx); + ep = fun->next; + } + +#ifdef LISP_FEATURE_X86 + if (is_lisp_pointer(code->constants[0])) { + long word_displacement = ctx->self_displacement / N_WORD_BYTES; + char *code_start + = ((char *) code) + n_header_words * N_WORD_BYTES; + long *old_start = oldify(ptr, ctx); + long *old_end = old_start + n_words; + + struct vector *fixups = natify(code->constants[0], ctx); + long n = fixnum_value(fixups->length); + long i; + + for (i = 0; i < n; i++) { + unsigned long offset = fixups->data[i]; + long **place = (long **) (code_start + offset); + long *old_value = *place; + + if (old_start <= old_value && old_value < old_end) + *place = old_value + word_displacement; + else + *place = old_value - word_displacement; + } + } +#endif + + return n_words; +} + +void +relocate_init() +{ + int i; + + for (i = 0; i < ((sizeof reloctab)/(sizeof reloctab[0])); i++) + reloctab[i] = relocate_lose; + + for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) { + reloctab[EVEN_FIXNUM_LOWTAG|(i<= argc) lose("missing argument for --dynamic-space-size"); errno = 0; - dynamic_space_size = strtol(argv[argi++], 0, 0) << 20; + nbytes = strtol(argv[argi++], 0, 0) << 20; if (errno) lose("argument to --dynamic-space-size is not a number"); +#ifdef LISP_FEATURE_INCREMENTAL_ALLOCATION + soft_pages_limit = nbytes / PAGE_BYTES; +#else + dynamic_space_size = nbytes; +#endif } else if (0 == strcmp(arg, "--debug-environment")) { int n = 0; printf("; Commandline arguments:\n"); @@ -340,7 +346,6 @@ main(int argc, char *argv[], char *envp[]) * it must follow os_init(). -- WHN 2000-01-26 */ os_init(argv, envp); arch_init(); - gc_init(); validate(); /* If no core file was specified, look for one. */ diff --git a/src/runtime/save.c b/src/runtime/save.c index 78a56ad..46470b6 100644 --- a/src/runtime/save.c +++ b/src/runtime/save.c @@ -30,6 +30,7 @@ #include "validate.h" #include "gc-internal.h" #include "thread.h" +#include "relocate.h" #include "genesis/static-symbols.h" #include "genesis/symbol.h" @@ -154,30 +155,57 @@ scan_for_lutexes(lispobj *addr, long n_words) #endif static void -output_space(FILE *file, int id, lispobj *addr, lispobj *end, os_vm_offset_t file_offset) +output_space_segments(FILE *file, int id, os_vm_offset_t file_offset, + int nsegments, lispobj **addrs, lispobj **end_addrs) { size_t words, bytes, data; static char *names[] = {NULL, "dynamic", "static", "read-only"}; + int i; write_lispobj(id, file); - words = end - addr; + + words = 0; + for (i = 0; i < nsegments; i++) + words += end_addrs[i] - addrs[i]; write_lispobj(words, file); bytes = words * sizeof(lispobj); + data = 0; + for (i = 0; i < nsegments; i++) { + lispobj *addr = addrs[i]; + lispobj *end = end_addrs[i]; + size_t segment_bytes = (end - addr) * sizeof(lispobj); + int tmp; + + printf("writing %lu bytes from the %s space at 0x%08lx\n", + (unsigned long)segment_bytes, names[id], (unsigned long)addr); + tmp = write_bytes(file, (char *)addr, segment_bytes, file_offset); + if (i == 0) + data = tmp; + } + + write_lispobj(data, file); + write_lispobj((long)addrs[0] / os_vm_page_size, file); + write_lispobj((bytes + os_vm_page_size - 1) / os_vm_page_size, file); +} + +static void +output_space(FILE *file, int id, lispobj *addr, lispobj *end, os_vm_offset_t file_offset) +{ #if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX) + /* Kludge: With LISP_FEATURE_INCREMENTAL_ALLOCATION, it would be too + * late for lutex scanning here, because lutex pointer relocation has + * already been done. + * + * OTOH, read-only and static-space don't contain lutexes anyway, so + * that shouldn't hurt. Perhaps worth an explicit assertion? + */ printf("scanning space for lutexes...\n"); - scan_for_lutexes((char *)addr, words); + scan_for_lutexes((char *)addr, end - addr); #endif - printf("writing %lu bytes from the %s space at 0x%08lx\n", - (unsigned long)bytes, names[id], (unsigned long)addr); - - data = write_bytes(file, (char *)addr, bytes, file_offset); - - write_lispobj(data, file); - write_lispobj((long)addr / os_vm_page_size, file); - write_lispobj((bytes + os_vm_page_size - 1) / os_vm_page_size, file); + output_space_segments(file, id, file_offset, 1, &addr, &end); } FILE * @@ -190,12 +218,82 @@ open_core_for_saving(char *filename) return fopen(filename, "wb"); } +#ifdef LISP_FEATURE_INCREMENTAL_ALLOCATION +static void +compact_dynamic_space_segments( + int nsegments, + lispobj **start, + lispobj **end, + void *init_function_place) +{ + int i; + +#if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX) + printf("scanning space for lutexes...\n"); + for (i = 0; i < nsegments; i++) { + lispobj *start = (lispobj *) start[i]; + lispobj *end = (lispobj *) end[i]; + scan_for_lutexes(start, end - start); + } +#endif + + gc_assert(nsegments >= 1); + + if (nsegments > 1) { + int n = nsegments + 1; /* one for the init function */ + struct relocation_segment *segments; + void *target = start[0]; + +#if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX) + n++; +#endif + + printf("compacting %d segments of dynamic space:\n", nsegments); + + segments = successful_malloc(sizeof(struct relocation_segment) * n); + for (i = 0; i < nsegments; i++) { + void *from = start[i]; + void *to = end[i]; + + printf("segment %lx-%lx to %lx\n", + (long) from, (long) to, (long) target); + segments[i].old_start = from; + segments[i].old_end = to; + segments[i].displacement = target - from; + target += to - from; + } + segments[nsegments].old_start = init_function_place; + segments[nsegments].old_end = init_function_place + sizeof(lispobj); + segments[nsegments].displacement = 0; +#if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX) + segments[nsegments + 1].old_start = lutex_addresses; + segments[nsegments + 1].old_end = lutex_addresses + n_lutexes + segments[nsegments + 1].displacement = 0; +#endif + relocate_all(n, segments); + relocation_fixup((long *) STATIC_SPACE_START, + (STATIC_SPACE_END-STATIC_SPACE_START) / N_WORD_BYTES, + n, + segments); + + printf("done compacting\n"); + fflush(stdout); + free(segments); + } +} +#endif + boolean save_to_filehandle(FILE *file, char *filename, lispobj init_function, boolean make_executable) { struct thread *th; os_vm_offset_t core_start_pos, core_end_pos, core_size; +#ifdef LISP_FEATURE_INCREMENTAL_ALLOCATION + int nsegments; + lispobj **dynamic_start; + lispobj **dynamic_end; +#endif /* Smash the enclosing state. (Once we do this, there's no good * way to go back, which is a sufficient reason that this ends up @@ -215,6 +313,12 @@ save_to_filehandle(FILE *file, char *filename, lispobj init_function, printf("[saving current Lisp image into %s:\n", filename); fflush(stdout); +#ifdef LISP_FEATURE_INCREMENTAL_ALLOCATION + nsegments = gc_find_dynamic_space_segments(&dynamic_start, &dynamic_end); + compact_dynamic_space_segments(nsegments, dynamic_start, dynamic_end, + &init_function); +#endif + core_start_pos = ftell(file); write_lispobj(CORE_MAGIC, file); @@ -253,11 +357,16 @@ save_to_filehandle(FILE *file, char *filename, lispobj init_function, gc_alloc_update_all_page_tables(); update_dynamic_space_free_pointer(); #endif -#ifdef reg_ALLOC +#ifdef LISP_FEATURE_INCREMENTAL_ALLOCATION + output_space_segments(file, DYNAMIC_CORE_SPACE_ID, core_start_pos, + nsegments, dynamic_start, dynamic_end); + free(dynamic_start); + free(dynamic_end); +#elif defined(reg_ALLOC) #ifdef LISP_FEATURE_GENCGC output_space(file, DYNAMIC_CORE_SPACE_ID, - (lispobj *)DYNAMIC_SPACE_START, + (lispobj *)dynamic_space_start, dynamic_space_free_pointer, core_start_pos); #else @@ -270,7 +379,7 @@ save_to_filehandle(FILE *file, char *filename, lispobj init_function, #else output_space(file, DYNAMIC_CORE_SPACE_ID, - (lispobj *)DYNAMIC_SPACE_START, + (lispobj *)dynamic_space_start, (lispobj *)SymbolValue(ALLOCATION_POINTER,0), core_start_pos); #endif @@ -281,14 +390,32 @@ save_to_filehandle(FILE *file, char *filename, lispobj init_function, #ifdef LISP_FEATURE_GENCGC { - size_t size = (last_free_page*sizeof(long)+os_vm_page_size-1) - &~(os_vm_page_size-1); - long *data = calloc(size, 1); - if (data) { - long offset; + size_t size; + long *data; + +#ifndef LISP_FEATURE_INCREMENTAL_ALLOCATION + int npages = last_free_page; +#else + int npages = 0; + { int i; for (i = 0; i < last_free_page; i++) { - data[i] = page_table[i].first_object_offset; + if (page_table[i].allocated != HOLE_PAGE_FLAG) + npages++; + } + } +#endif + + size = (npages*sizeof(long)+os_vm_page_size-1) &~(os_vm_page_size-1); + data = calloc(size, 1); + if (data) { + long offset; + int i, j; + for (i = 0, j = 0; i < last_free_page; i++) { + if (page_table[i].allocated != HOLE_PAGE_FLAG) { + data[j] = page_table[i].first_object_offset; + j++; + } } write_lispobj(PAGE_TABLE_CORE_ENTRY_TYPE_CODE, file); write_lispobj(4, file); diff --git a/src/runtime/sunos-os.c b/src/runtime/sunos-os.c index 8d8bb28..34cecee 100644 --- a/src/runtime/sunos-os.c +++ b/src/runtime/sunos-os.c @@ -101,10 +101,12 @@ os_init(char *argv[], char *envp[]) } } -os_vm_address_t os_validate(os_vm_address_t addr, os_vm_size_t len) +os_vm_address_t os_validate(os_vm_address_t addr, os_vm_size_t len, int fixedp) { int flags = MAP_PRIVATE | MAP_NORESERVE | KLUDGE_MAYBE_MAP_ANON; if (addr) + /* always use MAP_FIXED here even without `fixedp', since Solaris + * seems to ignore `addr' otherwise */ flags |= MAP_FIXED; addr = mmap(addr, len, @@ -173,14 +175,21 @@ boolean is_valid_lisp_addr(os_vm_address_t addr) comment above) but maybe associating these functions with the GC rather than the OS would be a maintainability win. -- CSR, 2003-04-04 */ + /* Incremental copy&paste reduction: For the GENCGC parts of this + function, there is now gc_is_valid_lisp_addr(). Should probably + move the rest, too, as CSR suggests. + + (I wonder where the CMUCL comment about sunos-os is actually from + though, since we -are- in sunos-os.c here... Only osf1-os.c is + special.) */ struct thread *th; if(in_range_p(addr, READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE) || in_range_p(addr, STATIC_SPACE_START , STATIC_SPACE_SIZE) || #ifdef LISP_FEATURE_GENCGC - in_range_p(addr, DYNAMIC_SPACE_START , dynamic_space_size) + gc_is_valid_lisp_addr(addr) || #else - in_range_p(addr, DYNAMIC_0_SPACE_START, dynamic_space_size) || - in_range_p(addr, DYNAMIC_1_SPACE_START, dynamic_space_size) + in_range_p(addr, dynamic_0_space_start, dynamic_space_size) || + in_range_p(addr, dynamic_1_space_start, dynamic_space_size) #endif ) return 1; diff --git a/src/runtime/thread.c b/src/runtime/thread.c index d38fd72..d31cf48 100644 --- a/src/runtime/thread.c +++ b/src/runtime/thread.c @@ -162,7 +162,7 @@ queue_freeable_thread_stack(struct thread *thread_to_be_cleaned_up) /* FIXME: os_validate is mmap -- for small things like these * malloc would probably perform better. */ new_freeable_stack = (struct freeable_stack *) - os_validate(0, sizeof(struct freeable_stack)); + os_validate(0, sizeof(struct freeable_stack), 0); new_freeable_stack->next = NULL; new_freeable_stack->os_thread = thread_to_be_cleaned_up->os_thread; new_freeable_stack->os_address = thread_to_be_cleaned_up->os_address; @@ -245,7 +245,7 @@ free_thread_stack_later(struct thread *thread_to_be_cleaned_up) struct freeable_stack *new_freeable_stack = 0; if (thread_to_be_cleaned_up) { new_freeable_stack = (struct freeable_stack *) - os_validate(0, sizeof(struct freeable_stack)); + os_validate(0, sizeof(struct freeable_stack), 1); new_freeable_stack->os_thread = thread_to_be_cleaned_up->os_thread; new_freeable_stack->os_address = (os_vm_address_t) thread_to_be_cleaned_up->os_address; @@ -374,7 +374,7 @@ create_thread_struct(lispobj initial_function) { * alignment passed from os_validate, since that might assume the * current (e.g. 4k) pagesize, while we calculate with the biggest * (e.g. 64k) pagesize allowed by the ABI. */ - spaces=os_validate(0, THREAD_STRUCT_SIZE); + spaces=os_validate(0, THREAD_STRUCT_SIZE, 1); if(!spaces) return NULL; /* Aligning up is safe as THREAD_STRUCT_SIZE has BACKEND_PAGE_SIZE @@ -473,7 +473,7 @@ create_thread_struct(lispobj initial_function) { #endif th->interrupt_data = (struct interrupt_data *) - os_validate(0,(sizeof (struct interrupt_data))); + os_validate(0,(sizeof (struct interrupt_data)),1); if (!th->interrupt_data) { free_thread_struct(th); return 0; diff --git a/src/runtime/trymap.c b/src/runtime/trymap.c index f55f167..f457b6b 100644 --- a/src/runtime/trymap.c +++ b/src/runtime/trymap.c @@ -50,7 +50,7 @@ main(int argc, char *argv[]) addr = mmap(requested_addr, hexparse(argv[2]), 0x7, - MAP_PRIVATE | MAP_ANON | MAP_FIXED, + MAP_PRIVATE | MAP_ANON, -1, 0); diff --git a/src/runtime/validate.c b/src/runtime/validate.c index 0efa39f..9fd9e22 100644 --- a/src/runtime/validate.c +++ b/src/runtime/validate.c @@ -28,7 +28,7 @@ static void ensure_space(lispobj *start, unsigned long size) { - if (os_validate((os_vm_address_t)start,(os_vm_size_t)size)==NULL) { + if (os_validate((os_vm_address_t)start,(os_vm_size_t)size,1)==NULL) { fprintf(stderr, "ensure_space: failed to validate %ld bytes at 0x%08lx\n", size, @@ -43,7 +43,7 @@ os_vm_address_t undefined_alien_address = 0; static void ensure_undefined_alien(void) { - os_vm_address_t start = os_validate(NULL, os_vm_page_size); + os_vm_address_t start = os_validate(NULL, os_vm_page_size, 0); if (start) { os_protect(start, os_vm_page_size, OS_VM_PROT_NONE); undefined_alien_address = start; @@ -60,19 +60,48 @@ validate(void) fflush(stdout); #endif - ensure_space( (lispobj *)READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE); - ensure_space( (lispobj *)STATIC_SPACE_START , STATIC_SPACE_SIZE); -#ifdef LISP_FEATURE_GENCGC - ensure_space( (lispobj *)DYNAMIC_SPACE_START , dynamic_space_size); -#else - ensure_space( (lispobj *)DYNAMIC_0_SPACE_START, dynamic_space_size); - ensure_space( (lispobj *)DYNAMIC_1_SPACE_START, dynamic_space_size); +#ifdef LISP_FEATURE_INCREMENTAL_ALLOCATION + /* We use brk() to get dynamic space. Unfortunately, brk() fails if + * it hits mmap()ed memory, and we need to mmap() read-only and + * static space into low locations. The problem can be fixed by calling + * brk() early to skip over memory that mmap() can then overwrite. + */ + { + size_t top; + size_t current = (size_t) sbrk(0); + + top = STATIC_SPACE_START + STATIC_SPACE_SIZE; +#ifdef LISP_FEATURE_LINKAGE_TABLE + if (LINKAGE_TABLE_SPACE_START > top) + top = LINKAGE_TABLE_SPACE_START + LINKAGE_TABLE_SPACE_SIZE; +#endif + if (current < top) + if (sbrk(top - current) == (void *) -1) + lose("failed to brk read-only and static space"); + } #endif + ensure_space( (lispobj *)STATIC_SPACE_START , STATIC_SPACE_SIZE); #ifdef LISP_FEATURE_LINKAGE_TABLE ensure_space( (lispobj *)LINKAGE_TABLE_SPACE_START, LINKAGE_TABLE_SPACE_SIZE); #endif +#ifdef LISP_FEATURE_GENCGC +#ifndef LISP_FEATURE_INCREMENTAL_ALLOCATION + dynamic_space_start = os_validate( + (void *) DEFAULT_DYNAMIC_SPACE_START, dynamic_space_size, 0); + if (dynamic_space_start == 0) + lose("failed to validate dynamic space"); +#endif +#else + dynamic_0_space_start = os_validate( + DEFAULT_DYNAMIC_0_SPACE_START, dynamic_space_size, 0); + dynamic_1_space_start = os_validate( + DEFAULT_DYNAMIC_1_SPACE_START, dynamic_space_size, 0); + if (dynamic_0_space_start == 0 || dynamic_1_space_start == 0) + lose("failed to validate dynamic space"); +#endif + #ifdef LISP_FEATURE_OS_PROVIDES_DLOPEN ensure_undefined_alien(); #endif diff --git a/src/runtime/validate.h b/src/runtime/validate.h index 26f4670..34a0df1 100644 --- a/src/runtime/validate.h +++ b/src/runtime/validate.h @@ -16,6 +16,14 @@ /* FIXME: genesis/constants.h also defines this with a constant value */ #define DYNAMIC_SPACE_START current_dynamic_space #endif +#ifndef LANGUAGE_ASSEMBLY +#ifdef LISP_FEATURE_GENCGC +extern void *dynamic_space_start; +#else +extern void *dynamic_0_space_start; +extern void *dynamic_1_space_start; +#endif +#endif #define BINDING_STACK_SIZE (1024*1024) /* chosen at random */ /* eventually choosable per-thread: */ @@ -23,11 +31,10 @@ /* constants derived from the fundamental constants in passed by GENESIS */ #ifdef LISP_FEATURE_GENCGC -#define DEFAULT_DYNAMIC_SPACE_SIZE (DYNAMIC_SPACE_END - DYNAMIC_SPACE_START) +#define DEFAULT_DYNAMIC_SPACE_SIZE (DEFAULT_DYNAMIC_SPACE_END - DEFAULT_DYNAMIC_SPACE_START) #else -#define DEFAULT_DYNAMIC_SPACE_SIZE (DYNAMIC_0_SPACE_END - DYNAMIC_0_SPACE_START) +#define DEFAULT_DYNAMIC_SPACE_SIZE (DEFAULT_DYNAMIC_0_SPACE_END - DEFAULT_DYNAMIC_0_SPACE_START) #endif -#define READ_ONLY_SPACE_SIZE (READ_ONLY_SPACE_END - READ_ONLY_SPACE_START) #define STATIC_SPACE_SIZE (STATIC_SPACE_END - STATIC_SPACE_START) #ifdef LISP_FEATURE_LINKAGE_TABLE #define LINKAGE_TABLE_SPACE_SIZE \ diff --git a/src/runtime/win32-os.c b/src/runtime/win32-os.c index b0e9b6f..f0a0b72 100644 --- a/src/runtime/win32-os.c +++ b/src/runtime/win32-os.c @@ -141,7 +141,7 @@ void os_init(char *argv[], char *envp[]) */ os_vm_address_t -os_validate(os_vm_address_t addr, os_vm_size_t len) +os_validate(os_vm_address_t addr, os_vm_size_t len, int fixedp) { MEMORY_BASIC_INFORMATION mem_info; @@ -170,7 +170,9 @@ os_validate(os_vm_address_t addr, os_vm_size_t len) if (!VirtualAlloc(addr, len, (mem_info.State == MEM_RESERVE)? MEM_COMMIT: MEM_RESERVE, PAGE_EXECUTE_READWRITE)) { fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError()); - return 0; + if (fixedp) + return 0; + return os_validate(0, len, 0); } return addr; @@ -284,7 +286,7 @@ is_valid_lisp_addr(os_vm_address_t addr) struct thread *th; if(in_range_p(addr, READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE) || in_range_p(addr, STATIC_SPACE_START , STATIC_SPACE_SIZE) || - in_range_p(addr, DYNAMIC_SPACE_START , dynamic_space_size)) + gc_is_valid_lisp_addr(addr)) return 1; for_each_thread(th) { if(((os_vm_address_t)th->control_stack_start <= addr) && (addr < (os_vm_address_t)th->control_stack_end)) diff --git a/src/runtime/x86-64-darwin-os.c b/src/runtime/x86-64-darwin-os.c index 5a05656..56d7bda 100644 --- a/src/runtime/x86-64-darwin-os.c +++ b/src/runtime/x86-64-darwin-os.c @@ -219,8 +219,8 @@ void signal_emulation_wrapper(x86_thread_state64_t *thread_state, darwin_ucontext *context; darwin_mcontext *regs; - context = (darwin_ucontext *) os_validate(0, sizeof(darwin_ucontext)); - regs = (darwin_mcontext*) os_validate(0, sizeof(darwin_mcontext)); + context = (darwin_ucontext *) os_validate(0, sizeof(darwin_ucontext), 0); + regs = (darwin_mcontext*) os_validate(0, sizeof(darwin_mcontext), 0); context->uc_mcontext = regs; /* when BSD signals are fired, they mask they signals in sa_mask diff --git a/src/runtime/x86-darwin-os.c b/src/runtime/x86-darwin-os.c index 248e782..a30627c 100644 --- a/src/runtime/x86-darwin-os.c +++ b/src/runtime/x86-darwin-os.c @@ -260,11 +260,11 @@ void signal_emulation_wrapper(x86_thread_state32_t *thread_state, struct mcontext *regs; #endif - context = (os_context_t*) os_validate(0, sizeof(os_context_t)); + context = (os_context_t*) os_validate(0, sizeof(os_context_t), 0); #if MAC_OS_X_VERSION_10_5 - regs = (struct __darwin_mcontext32*) os_validate(0, sizeof(struct __darwin_mcontext32)); + regs = (struct __darwin_mcontext32*) os_validate(0, sizeof(struct __darwin_mcontext32), 0); #else - regs = (struct mcontext*) os_validate(0, sizeof(struct mcontext)); + regs = (struct mcontext*) os_validate(0, sizeof(struct mcontext), 0); #endif context->uc_mcontext = regs; diff --git a/tests/bit-vector.impure-cload.lisp b/tests/bit-vector.impure-cload.lisp index 2b22e32..2342fa2 100644 --- a/tests/bit-vector.impure-cload.lisp +++ b/tests/bit-vector.impure-cload.lisp @@ -81,9 +81,9 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (defun dynamic-space-size () #+gencgc - (- sb-vm:dynamic-space-end sb-vm:dynamic-space-start) + (- sb-vm:default-dynamic-space-end sb-vm:default-dynamic-space-start) #-gencgc - (- sb-vm:dynamic-space-0-end sb-vm:dynamic-space-0-start))) + (- sb-vm:default-dynamic-space-0-end sb-vm:default-dynamic-space-0-start))) ;; except on machines where the arrays won't fit into the dynamic space. #+#.(cl:if (cl:> (cl-user::dynamic-space-size) diff --git a/tests/core.test.sh b/tests/core.test.sh index 1fd0ad4..80190e2 100644 --- a/tests/core.test.sh +++ b/tests/core.test.sh @@ -85,6 +85,37 @@ else exit 1 fi +# Test dynamic space compaction. +$SBCL <&1 +*/ +#include +#include +#include +#include "genesis/constants.h" +#include "genesis/config.h" +#include + +static void +steal(FILE *f, void *start, long len) +{ + if (f) + fprintf(f, + "Blocking 0x%lx bytes of space starting at 0x%lx.\n", + (long) len, + (long) start); + + void *actual = mmap(start, + len, + PROT_READ | PROT_WRITE | PROT_EXEC, + MAP_PRIVATE | MAP_ANONYMOUS | MAP_NORESERVE, + -1, + 0); + if (actual != start) { + if (actual == MAP_FAILED) { + perror("Failed to steal memory"); + exit(1); + } + fprintf(stderr, + "Blocked memory at 0x%lx instead, giving up.\n", + (long) actual); + exit(1); + } +} + +void +_init() +{ + FILE *f = fdopen(3, "w"); + void *start = (void *) DEFAULT_DYNAMIC_SPACE_START; + /* arbitrary core file length that should be about right */ + int len = 1024 * 1024 * 30; + +#ifdef LISP_FEATURE_INCREMENTAL_ALLOCATION + if (f) + fprintf(f, "Blocking dynamic space using brk...\n"); + if (brk(start + len) == -1) { + perror("brk"); + exit(1); + } +#else + steal(f, start, 4096); + steal(f, start + len - 4096, 4096); +#endif +}