* bug fix: :ALLOCATION :CLASS slots are type-checked properly
in safe code. (reported by Didier Verna)
* bug fix: #430; nested structure constructors can stack allocate.
+ * bug fix: on some 64-bit platforms dynamic space size was truncated
+ to #xffff0000 bytes. (reported by Benjamin Lambert)
changes in sbcl-1.0.23 relative to 1.0.22:
* enhancement: when disassembling method functions, disassembly
;; This hardcoded 2 matches the one in gc_find_freeish_pages. It's not
;; really worth genesifying.
#+gencgc
- (* 2 sb-vm:gencgc-page-size))
+ (* 2 sb-vm:gencgc-page-bytes))
(declaim (type number *alloc-region-size*))
(defvar *samples* nil)
File: src/compiler/ppc/parms.lisp
-* Add gencgc-page-size variable. Currently 4096. Bump to 32k later.
+* Add gencgc-page-bytes variable. Currently 4096. Bump to 32k later.
* Added dynamic-space-start and dynamic-space-end constants for linux
and darwin #!+gencgc. Conditionalized dynamic-0 and dynamic-1
File: src/compiler/ppc/parms.lisp
-* gencgc-page-size -> 4096
+* gencgc-page-bytes -> 4096
* added pseudo-atomic-interrupted-flag and pseudo-atomic-flag
"*BACKEND-BYTE-ORDER*" "*BACKEND-DISASSEM-PARAMS*"
"*BACKEND-INSTRUCTION-FLAVORS*" "*BACKEND-INSTRUCTION-FORMATS*"
- "*BACKEND-INTERNAL-ERRORS*" "*BACKEND-PAGE-SIZE*"
+ "*BACKEND-INTERNAL-ERRORS*" "*BACKEND-PAGE-BYTES*"
"*BACKEND-REGISTER-SAVE-PENALTY*"
"*BACKEND-SB-LIST*" "*BACKEND-SB-NAMES*"
"*BACKEND-SC-NAMES*" "*BACKEND-SC-NUMBERS*"
"FUN-POINTER-LOWTAG"
"SIMPLE-FUN-SELF-SLOT"
"SIMPLE-FUN-TYPE-SLOT"
- "GENCGC-PAGE-SIZE"
+ "GENCGC-PAGE-BYTES"
#!+ppc "PSEUDO-ATOMIC-INTERRUPTED-FLAG"
#!+ppc "PSEUDO-ATOMIC-FLAG"
"GENESIS" "HALT-TRAP" "IGNORE-ME-SC-NUMBER"
;;; Return the system page size.
(defun get-page-size ()
- sb!c:*backend-page-size*)
\ No newline at end of file
+ sb!c:*backend-page-bytes*)
;; will be a short. On platforms with larger ones, it'll
;; be an int.
(bytes-used (unsigned
- #.(if (typep sb!vm:gencgc-page-size
+ #.(if (typep sb!vm:gencgc-page-bytes
'(unsigned-byte 16))
16
32)))
(maybe-skip-page ()
#!+gencgc
(when (eq space :dynamic)
- (loop with page-mask = #.(1- sb!vm:gencgc-page-size)
+ (loop with page-mask = #.(1- sb!vm:gencgc-page-bytes)
for addr of-type sb!vm:word = (sap-int current)
while (>= addr skip-tests-until-addr)
do
(return-from maybe-skip-page))
;; Move CURRENT to start of next page.
(setf current (int-sap (+ (logandc2 addr page-mask)
- sb!vm:gencgc-page-size)))
+ sb!vm:gencgc-page-bytes)))
(maybe-finish-mapping))))))
(maybe-map (obj obj-tag n-obj-bytes &optional (ok t))
(let ((next (typecase n-obj-bytes
(initial-offset (logand csp (1- bytes-per-scrub-unit)))
(end-of-stack
(- (sap-int (sb!di::descriptor-sap sb!vm:*control-stack-end*))
- sb!c:*backend-page-size*)))
+ sb!c:*backend-page-bytes*)))
(labels
((scrub (ptr offset count)
(declare (type system-area-pointer ptr)
#!+stack-grows-downward-not-upward
(let* ((csp (sap-int (sb!c::control-stack-pointer-sap)))
(end-of-stack (+ (sap-int (sb!di::descriptor-sap sb!vm:*control-stack-start*))
- sb!c:*backend-page-size*))
+ sb!c:*backend-page-bytes*))
(initial-offset (logand csp (1- bytes-per-scrub-unit))))
(labels
((scrub (ptr offset count)
;;; XXX the C runtime gets page size using getpagesize() - can't we
;;; look at that instead of hardcoding it here too?
-(setf *backend-page-size* 8192)
-
+(setf *backend-page-bytes* 8192)
(in-package "SB!C")
\f
;;; the maximum number of bytes per page on this system (used by GENESIS)
-(defvar *backend-page-size* 0)
-(declaim (type index *backend-page-size*))
+(defvar *backend-page-bytes* 0)
+(declaim (type index *backend-page-bytes*))
(when (constantp symbol)
(let ((name (symbol-name symbol)))
(labels ( ;; shared machinery
- (record (string priority)
+ (record (string priority suffix)
(push (list string
priority
(symbol-value symbol)
+ suffix
(documentation symbol 'variable))
constants))
;; machinery for old-style CMU CL Lisp-to-C
'simple-string
prefix
(delete #\- (string-capitalize string)))
- priority))
+ priority
+ ""))
(maybe-record-with-munged-name (tail prefix priority)
(when (tailwise-equal name tail)
(record-with-munged-name prefix
(length tail)))
priority)))
;; machinery for new-style SBCL Lisp-to-C naming
- (record-with-translated-name (priority)
- (record (c-name name) priority))
- (maybe-record-with-translated-name (suffixes priority)
+ (record-with-translated-name (priority large)
+ (record (c-name name) priority (if large "LU" "")))
+ (maybe-record-with-translated-name (suffixes priority &key large)
(when (some (lambda (suffix)
(tailwise-equal name suffix))
suffixes)
- (record-with-translated-name priority))))
-
+ (record-with-translated-name priority large))))
(maybe-record-with-translated-name '("-LOWTAG") 0)
- (maybe-record-with-translated-name '("-WIDETAG") 1)
+ (maybe-record-with-translated-name '("-WIDETAG" "-SHIFT") 1)
(maybe-record-with-munged-name "-FLAG" "flag_" 2)
(maybe-record-with-munged-name "-TRAP" "trap_" 3)
(maybe-record-with-munged-name "-SUBTYPE" "subtype_" 4)
(maybe-record-with-munged-name "-SC-NUMBER" "sc_" 5)
- (maybe-record-with-translated-name '("-START" "-END" "-SIZE" "-SHIFT") 6)
- (maybe-record-with-translated-name '("-CORE-ENTRY-TYPE-CODE") 7)
- (maybe-record-with-translated-name '("-CORE-SPACE-ID") 8))))))
+ (maybe-record-with-translated-name '("-SIZE") 6)
+ (maybe-record-with-translated-name '("-START" "-END" "-PAGE-BYTES") 7 :large t)
+ (maybe-record-with-translated-name '("-CORE-ENTRY-TYPE-CODE") 8)
+ (maybe-record-with-translated-name '("-CORE-SPACE-ID") 9))))))
;; KLUDGE: these constants are sort of important, but there's no
;; pleasing way to inform the code above about them. So we fake
;; it for now. nikodemus on #lisp (2004-08-09) suggested simply
(push (list (c-symbol-name c)
-1 ; invent a new priority
(symbol-value c)
+ ""
nil)
constants))
;; One more symbol that doesn't fit into the code above.
(push (list (c-symbol-name c)
9
(symbol-value c)
+ "LU"
nil)
constants))
(setf constants
(< (second const1) (second const2))))))
(let ((prev-priority (second (car constants))))
(dolist (const constants)
- (destructuring-bind (name priority value doc) const
+ (destructuring-bind (name priority value suffix doc) const
(unless (= prev-priority priority)
(terpri)
(setf prev-priority priority))
- (format t "#define ~A " name)
- (format t
- ;; KLUDGE: We're dumping two different kinds of
- ;; values here, (1) small codes and (2) machine
- ;; addresses. The small codes can be dumped as bare
- ;; integer values. The large machine addresses might
- ;; cause problems if they're large and represented
- ;; as (signed) C integers, so we want to force them
- ;; to be unsigned by appending an U to the
- ;; literal. We can't dump all the values using the
- ;; literal-U syntax, since the assembler doesn't
- ;; support that syntax and some of the small
- ;; constants can be used in assembler files.
- (let ( ;; cutoff for treatment as a small code
- (cutoff (expt 2 16)))
- (cond ((minusp value)
- (error "stub: negative values unsupported"))
- ((< value cutoff)
- "~D")
- (t
- "~DU")))
- value)
- (format t " /* 0x~X */~@[ /* ~A */~]~%" value doc))))
+ (when (minusp value)
+ (error "stub: negative values unsupported"))
+ (format t "#define ~A ~A~A /* 0x~X ~@[ -- ~A ~]*/~%" name value suffix value doc))))
(terpri))
;; writing information about internal errors
;; I'm not really sure why this is in SB!C, since it seems
;; conceptually like something that belongs to SB!VM. In any case,
;; it's needed C-side.
- (format t "#define BACKEND_PAGE_SIZE ~DU~%" sb!c:*backend-page-size*)
+ (format t "#define BACKEND_PAGE_BYTES ~DLU~%" sb!c:*backend-page-bytes*)
(terpri)
(force-output *core-file*)
(file-position *core-file*
(round-up (file-position *core-file*)
- sb!c:*backend-page-size*)))
+ sb!c:*backend-page-bytes*)))
(defun output-gspace (gspace)
(force-output *core-file*)
(let* ((posn (file-position *core-file*))
(bytes (* (gspace-free-word-index gspace) sb!vm:n-word-bytes))
- (pages (ceiling bytes sb!c:*backend-page-size*))
- (total-bytes (* pages sb!c:*backend-page-size*)))
+ (pages (ceiling bytes sb!c:*backend-page-bytes*))
+ (total-bytes (* pages sb!c:*backend-page-bytes*)))
(file-position *core-file*
- (* sb!c:*backend-page-size* (1+ *data-page*)))
+ (* sb!c:*backend-page-bytes* (1+ *data-page*)))
(format t
"writing ~S byte~:P [~S page~:P] from ~S~%"
total-bytes
(write-word (gspace-free-word-index gspace))
(write-word *data-page*)
(multiple-value-bind (floor rem)
- (floor (gspace-byte-address gspace) sb!c:*backend-page-size*)
+ (floor (gspace-byte-address gspace) sb!c:*backend-page-bytes*)
(aver (zerop rem))
(write-word floor))
(write-word pages)
;; stack guard pages.
(values-subtypep (lvar-derived-type words)
(load-time-value
- (specifier-type `(integer 0 ,(- (/ sb!vm::*backend-page-size*
+ (specifier-type `(integer 0 ,(- (/ sb!vm::*backend-page-bytes*
sb!vm:n-word-bytes)
sb!vm:vector-data-offset)))))))
(def!constant +backend-fasl-file-implementation+ :hppa)
(setf *backend-register-save-penalty* 3)
(setf *backend-byte-order* :big-endian)
-(setf *backend-page-size* 4096)
-
+(setf *backend-page-bytes* 4096)
(eval-when (:compile-toplevel :load-toplevel :execute)
;; The o32 ABI specifies 4k-64k as page size. We have to pick the
;; maximum since mprotect() works only with page granularity.
- (setf *backend-page-size* 65536))
+ (setf *backend-page-bytes* 65536))
;; find out whether using exact multiples of the page size actually
;; matters in the few places where that's done, or whether we could
;; just use 4k everywhere.
- (setf *backend-page-size* #!+linux 65536 #!-linux 4096))
+ (setf *backend-page-bytes* #!+linux 65536 #!-linux 4096))
;;; The size in bytes of the GENCGC pages. Should be a multiple of the
;;; architecture page size.
-(def!constant gencgc-page-size *backend-page-size*)
+(def!constant gencgc-page-bytes *backend-page-bytes*)
(setf *backend-byte-order* :big-endian)
-(setf *backend-page-size* 8192)
+(setf *backend-page-bytes* 8192)
;;; compatible systems to return different values for getpagesize().
;;; -- JES, 2007-01-06
(eval-when (:compile-toplevel :load-toplevel :execute)
- (setf *backend-page-size* 4096))
+ (setf *backend-page-bytes* 4096))
;;; The size in bytes of the GENCGC pages. Should be a multiple of the
;;; architecture code size.
-(def!constant gencgc-page-size 4096)
+(def!constant gencgc-page-bytes *backend-page-bytes*)
;;; compatible systems to return different values for getpagesize().
;;; -- JES, 2007-01-06
(eval-when (:compile-toplevel :load-toplevel :execute)
- (setf *backend-page-size* 4096))
+ (setf *backend-page-bytes* 4096))
;;; comment from CMU CL:
;;;
;;; in case we ever wanted to do this for Windows NT..
;;; page size is 512, but that doesn't do us a whole lot of good.
;;; Effectively, the page size is 64K.
;;;
-;;; would be: (setf *backend-page-size* 65536)
+;;; would be: (setf *backend-page-bytes* 65536)
;;; The size in bytes of the GENCGC pages. Should be a multiple of the
;;; architecture code size.
-(def!constant gencgc-page-size *backend-page-size*)
+(def!constant gencgc-page-bytes *backend-page-bytes*)
#include "sbcl.h"
#ifdef LISP_FEATURE_GENCGC
-#define PAGE_BYTES GENCGC_PAGE_SIZE
+#define PAGE_BYTES GENCGC_PAGE_BYTES
#else
-#define PAGE_BYTES BACKEND_PAGE_SIZE
+#define PAGE_BYTES BACKEND_PAGE_BYTES
#endif
typedef signed long page_index_t;
generations[i].num_gc,
gen_av_mem_age(i));
}
- fprintf(stderr," Total bytes allocated=%ld\n", bytes_allocated);
+ fprintf(stderr," Total bytes allocated = %lu\n", bytes_allocated);
+ fprintf(stderr," Dynamic-space-size bytes = %lu\n", dynamic_space_size);
fpu_restore(fpu_state);
}
* kernel versions on some architectures (for example PPC). FIXME:
* possibly the same should be done on other architectures too.
*/
- os_vm_page_size = BACKEND_PAGE_SIZE;
+ os_vm_page_size = BACKEND_PAGE_BYTES;
/* KLUDGE: Disable memory randomization on new Linux kernels
* by setting a personality flag and re-executing. (We need
#define CONTROL_STACK_ALIGNMENT_BYTES 8192 /* darwin wants page-aligned stacks */
#define THREAD_ALIGNMENT_BYTES CONTROL_STACK_ALIGNMENT_BYTES
#else
-#define THREAD_ALIGNMENT_BYTES BACKEND_PAGE_SIZE
+#define THREAD_ALIGNMENT_BYTES BACKEND_PAGE_BYTES
#define CONTROL_STACK_ALIGNMENT_BYTES 16
#endif
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.23.39"
+"1.0.23.40"
projects / sbcl.git / commitdiff