From: Nikodemus Siivola Date: Sat, 13 Dec 2008 10:52:07 +0000 (+0000) Subject: 1.0.23.40: export page sizes to C with LU suffix X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=2db410feb35e7e30c95af8f20f67e6177fa92488;p=sbcl.git 1.0.23.40: export page sizes to C with LU suffix * Rename GENCGC-PAGE-SIZE and *BACKEND-PAGE-SIZE* to GENCGC-PAGE-BYTES and *BACKEND-PAGE-BYTES* respectively. * Clean up constant.h generation: instead of guessing when to add an U suffix, specify when the value is "large", and then add an LU suffix. * Without the LU suffix some C compilers chose to truncate results of some operations where these quantities featured, leading at least to an upper limit of #xffff0000 bytes in dynamic space on certain 64 bit systems. --- diff --git a/NEWS b/NEWS index ac86ff2..2318661 100644 --- a/NEWS +++ b/NEWS @@ -28,6 +28,8 @@ * 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 diff --git a/contrib/sb-sprof/sb-sprof.lisp b/contrib/sb-sprof/sb-sprof.lisp index 902cefc..3b6aad6 100644 --- a/contrib/sb-sprof/sb-sprof.lisp +++ b/contrib/sb-sprof/sb-sprof.lisp @@ -363,7 +363,7 @@ profiling") ;; 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) diff --git a/doc/internals-notes/GENCGC-PORTING-NOTES b/doc/internals-notes/GENCGC-PORTING-NOTES index badadaa..07a5d1d 100644 --- a/doc/internals-notes/GENCGC-PORTING-NOTES +++ b/doc/internals-notes/GENCGC-PORTING-NOTES @@ -137,7 +137,7 @@ File: src/code/ppc-vm.lisp 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 @@ -457,7 +457,7 @@ File: src/compiler/ppc/macros.lisp File: src/compiler/ppc/parms.lisp -* gencgc-page-size -> 4096 +* gencgc-page-bytes -> 4096 * added pseudo-atomic-interrupted-flag and pseudo-atomic-flag diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index c8e837c..3017d38 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -198,7 +198,7 @@ of SBCL which maintained the CMU-CL-style split into two packages.)" "*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*" @@ -2449,7 +2449,7 @@ structure representations" "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" diff --git a/src/code/linux-os.lisp b/src/code/linux-os.lisp index 640320e..134ca54 100644 --- a/src/code/linux-os.lisp +++ b/src/code/linux-os.lisp @@ -45,4 +45,4 @@ ;;; 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*) diff --git a/src/code/room.lisp b/src/code/room.lisp index bb91438..c9c2587 100644 --- a/src/code/room.lisp +++ b/src/code/room.lisp @@ -214,7 +214,7 @@ ;; 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))) @@ -259,7 +259,7 @@ (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 @@ -291,7 +291,7 @@ (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 diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp index 135028c..16243a2 100644 --- a/src/code/toplevel.lisp +++ b/src/code/toplevel.lisp @@ -207,7 +207,7 @@ command-line.") (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) @@ -240,7 +240,7 @@ command-line.") #!+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) diff --git a/src/compiler/alpha/backend-parms.lisp b/src/compiler/alpha/backend-parms.lisp index ab49a3c..294f370 100644 --- a/src/compiler/alpha/backend-parms.lisp +++ b/src/compiler/alpha/backend-parms.lisp @@ -25,5 +25,4 @@ ;;; 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) diff --git a/src/compiler/early-backend.lisp b/src/compiler/early-backend.lisp index 54baf6d..b03a178 100644 --- a/src/compiler/early-backend.lisp +++ b/src/compiler/early-backend.lisp @@ -10,5 +10,5 @@ (in-package "SB!C") ;;; 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*)) diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index bc6b7f5..f1f1c96 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -2667,10 +2667,11 @@ core and return a descriptor to it." (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 @@ -2682,7 +2683,8 @@ core and return a descriptor to it." '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 @@ -2691,23 +2693,23 @@ core and return a descriptor to it." (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 @@ -2721,6 +2723,7 @@ core and return a descriptor to it." (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. @@ -2728,6 +2731,7 @@ core and return a descriptor to it." (push (list (c-symbol-name c) 9 (symbol-value c) + "LU" nil) constants)) (setf constants @@ -2738,33 +2742,13 @@ core and return a descriptor to it." (< (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 @@ -2782,7 +2766,7 @@ core and return a descriptor to it." ;; 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) @@ -2977,17 +2961,17 @@ initially undefined function references:~2%") (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 @@ -3017,7 +3001,7 @@ initially undefined function references:~2%") (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) diff --git a/src/compiler/generic/vm-ir2tran.lisp b/src/compiler/generic/vm-ir2tran.lisp index c864d26..25e3ed4 100644 --- a/src/compiler/generic/vm-ir2tran.lisp +++ b/src/compiler/generic/vm-ir2tran.lisp @@ -185,7 +185,7 @@ ;; 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))))))) diff --git a/src/compiler/hppa/backend-parms.lisp b/src/compiler/hppa/backend-parms.lisp index 01ac9d0..3523ad4 100644 --- a/src/compiler/hppa/backend-parms.lisp +++ b/src/compiler/hppa/backend-parms.lisp @@ -3,5 +3,4 @@ (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) diff --git a/src/compiler/mips/backend-parms.lisp b/src/compiler/mips/backend-parms.lisp index 48a61ff..11aa425 100644 --- a/src/compiler/mips/backend-parms.lisp +++ b/src/compiler/mips/backend-parms.lisp @@ -9,4 +9,4 @@ (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)) diff --git a/src/compiler/ppc/backend-parms.lisp b/src/compiler/ppc/backend-parms.lisp index d15cc53..cfb3bb4 100644 --- a/src/compiler/ppc/backend-parms.lisp +++ b/src/compiler/ppc/backend-parms.lisp @@ -10,8 +10,8 @@ ;; 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*) diff --git a/src/compiler/sparc/backend-parms.lisp b/src/compiler/sparc/backend-parms.lisp index 3ca7012..c7474fc 100644 --- a/src/compiler/sparc/backend-parms.lisp +++ b/src/compiler/sparc/backend-parms.lisp @@ -23,5 +23,5 @@ (setf *backend-byte-order* :big-endian) -(setf *backend-page-size* 8192) +(setf *backend-page-bytes* 8192) diff --git a/src/compiler/x86-64/backend-parms.lisp b/src/compiler/x86-64/backend-parms.lisp index 595ff0a..8e9e67b 100644 --- a/src/compiler/x86-64/backend-parms.lisp +++ b/src/compiler/x86-64/backend-parms.lisp @@ -33,8 +33,8 @@ ;;; 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*) diff --git a/src/compiler/x86/backend-parms.lisp b/src/compiler/x86/backend-parms.lisp index 7414281..3f8cf62 100644 --- a/src/compiler/x86/backend-parms.lisp +++ b/src/compiler/x86/backend-parms.lisp @@ -33,7 +33,7 @@ ;;; 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.. @@ -43,8 +43,8 @@ ;;; 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*) diff --git a/src/runtime/gc.h b/src/runtime/gc.h index a619175..35f9d12 100644 --- a/src/runtime/gc.h +++ b/src/runtime/gc.h @@ -19,9 +19,9 @@ #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; diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index 49b7a16..a13bbeb 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -507,7 +507,8 @@ print_generation_stats(int verbose) /* FIXME: should take FILE argument */ 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); } diff --git a/src/runtime/linux-os.c b/src/runtime/linux-os.c index 388e7af..4a3f994 100644 --- a/src/runtime/linux-os.c +++ b/src/runtime/linux-os.c @@ -201,7 +201,7 @@ os_init(char *argv[], char *envp[]) * 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 diff --git a/src/runtime/thread.h b/src/runtime/thread.h index 9d72005..c252afa 100644 --- a/src/runtime/thread.h +++ b/src/runtime/thread.h @@ -38,7 +38,7 @@ extern int dynamic_values_bytes; #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 diff --git a/version.lisp-expr b/version.lisp-expr index 298df66..db7535b 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; 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"