"CONTROL-STACK-START" "*DYNAMIC-SPACE-START*"
"TARGET-FASL-CODE-FORMAT" "TARGET-FASL-FILE-TYPE"
"TARGET-HEAP-ADDRESS-SPACE" "*TARGET-MOST-NEGATIVE-FIXNUM*"
- "*TARGET-MOST-POSITIVE-FIXNUM*" "*READ-ONLY-SPACE-START*"
+ "*TARGET-MOST-POSITIVE-FIXNUM*" "READ-ONLY-SPACE-START"
"STATIC-SPACE-START" "TRACE-TABLE-CALL-SITE"
"TRACE-TABLE-FUNCTION-EPILOGUE" "TRACE-TABLE-FUNCTION-PROLOGUE"
"TRACE-TABLE-NORMAL" "TYPE-BITS" "TYPE-MASK" "UNBOUND-MARKER-TYPE"
;; Check that the pointer is valid. XXX Could do a better
;; job. FIXME: e.g. by calling out to an is_valid_pointer
;; routine in the C runtime support code
- (or (< sb!vm:*read-only-space-start* val
+ (or (< sb!vm:read-only-space-start val
(* sb!vm:*read-only-space-free-pointer*
sb!vm:word-bytes))
(< sb!vm::static-space-start val
(def-c-var-frob sb!vm:current-dynamic-space-start "current_dynamic_space")
#!-sb-fluid (declaim (inline dynamic-usage))
-#!-(or cgc gencgc)
-(defun dynamic-usage ()
- (the (unsigned-byte 32)
- (- (sb!sys:sap-int (sb!c::dynamic-space-free-pointer))
- (sb!vm:current-dynamic-space-start))))
-#!+(or cgc gencgc)
(def-c-var-frob dynamic-usage "bytes_allocated")
(defun static-space-usage ()
(defun read-only-space-usage ()
(- (* sb!vm::*read-only-space-free-pointer* sb!vm:word-bytes)
- sb!vm:*read-only-space-start*))
+ sb!vm:read-only-space-start))
(defun control-stack-usage ()
#!-x86 (- (sb!sys:sap-int (sb!c::control-stack-pointer-sap))
(sb!alien:def-alien-routine collect-garbage sb!c-call:int
#!+gencgc (last-gen sb!c-call:int))
-#!-ibmrt
(sb!alien:def-alien-routine set-auto-gc-trigger sb!c-call:void
(dynamic-usage sb!c-call:unsigned-long))
-#!+ibmrt
-(defun set-auto-gc-trigger (bytes)
- (let ((words (ash (+ (sb!vm:current-dynamic-space-start) bytes) -2)))
- (unless (and (fixnump words) (plusp words))
- (clear-auto-gc-trigger)
- (warn "attempt to set GC trigger to something bogus: ~S" bytes))
- (setf %rt::*internal-gc-trigger* words)))
-
-#!-ibmrt
(sb!alien:def-alien-routine clear-auto-gc-trigger sb!c-call:void)
-#!+ibmrt
-(defun clear-auto-gc-trigger ()
- (setf %rt::*internal-gc-trigger* -1))
-
;;; This variable contains the function that does the real GC. This is
;;; for low-level GC experimentation. Do not touch it if you do not
;;; know what you are doing.
(values (int-sap static-space-start)
(int-sap (* *static-space-free-pointer* word-bytes))))
(:read-only
- (values (int-sap *read-only-space-start*)
+ (values (int-sap read-only-space-start)
(int-sap (* *read-only-space-free-pointer* word-bytes))))
(:dynamic
(values (int-sap (current-dynamic-space-start))
(file-comment
"$Header$")
-;;; a magic number used to identify core files
+;;; a magic number used to identify our core files
(defconstant core-magic
(logior (ash (char-code #\S) 24)
(ash (char-code #\B) 16)
(do-external-symbols (symbol (find-package "SB!VM"))
(when (constantp symbol)
(let ((name (symbol-name symbol)))
- (labels
- ((record (prefix string priority)
- (push (list (concatenate
- 'simple-string
- prefix
- (delete #\- (string-capitalize string)))
- priority
- (symbol-value symbol)
- (fdocumentation symbol 'variable))
- constants))
- (test-tail (tail prefix priority)
- (when (tail-comp name tail)
- (record prefix
- (subseq name 0
- (- (length name)
- (length tail)))
- priority)))
- (test-head (head prefix priority)
- (when (head-comp name head)
- (record prefix
- (subseq name (length head))
- priority))))
+ (labels (;; shared machinery
+ (record (string priority)
+ (push (list string
+ priority
+ (symbol-value symbol)
+ (documentation symbol 'variable))
+ constants))
+ ;; machinery for old-style CMU CL Lisp-to-C naming
+ (record-with-munged-name (prefix string priority)
+ (record (concatenate
+ 'simple-string
+ prefix
+ (delete #\- (string-capitalize string)))
+ priority))
+ (test-tail (tail prefix priority)
+ (when (tail-comp name tail)
+ (record-with-munged-name prefix
+ (subseq name 0
+ (- (length name)
+ (length tail)))
+ priority)))
+ (test-head (head prefix priority)
+ (when (head-comp name head)
+ (record-with-munged-name prefix
+ (subseq name (length head))
+ priority)))
+ ;; machinery for new-style SBCL Lisp-to-C naming
+ (record-with-translated-name (priority)
+ (record (substitute #\_ #\- name)
+ priority)))
+ ;; This style of munging of names is used in the code
+ ;; inherited from CMU CL.
(test-tail "-TYPE" "type_" 0)
(test-tail "-FLAG" "flag_" 1)
(test-tail "-TRAP" "trap_" 2)
(test-tail "-SUBTYPE" "subtype_" 3)
(test-head "TRACE-TABLE-" "tracetab_" 4)
- (test-tail "-SC-NUMBER" "sc_" 5)))))
+ (test-tail "-SC-NUMBER" "sc_" 5)
+ ;; This simpler style of munging of names seems less
+ ;; confusing, and is used for newer code.
+ (when (some (lambda (suffix) (tail-comp name suffix))
+ #("-START" "-END"))
+ (record-with-translated-name 6))))))
(setf constants
(sort constants
#'(lambda (const1 const2)
(*cold-package-symbols* nil)
(*read-only* (make-gspace :read-only
read-only-space-id
- sb!vm:*read-only-space-start*))
+ sb!vm:read-only-space-start))
(*static* (make-gspace :static
static-space-id
sb!vm:static-space-start))
;;; stomping on an address range that the dynamic libraries want to use.
;;; (They want to use this address range even if we try to reserve it
;;; with a call to validate() as the first operation in main().)
-#!-linux (defparameter *read-only-space-start* #x10000000)
-#!-linux (defconstant static-space-start
- #!+freebsd #x30000000
- #!+openbsd #x28000000)
-#!-linux (defparameter *dynamic-space-start* #x48000000)
-#!+linux (defparameter *read-only-space-start* #x01000000)
-#!+linux (defconstant static-space-start #x05000000)
-#!+linux (defparameter *dynamic-space-start* #x09000000)
+#!+linux
+(progn
+ (defconstant read-only-space-start #x01000000)
+ (defconstant static-space-start #x05000000)
+ (defparameter *dynamic-space-start* #x09000000))
+#!+bsd
+(progn
+ (defconstant read-only-space-start #x10000000)
+ (defconstant static-space-start
+ #!+freebsd #x30000000
+ #!+openbsd #x28000000)
+ (defparameter *dynamic-space-start* #x48000000))
;;; Given that NIL is the first thing allocated in static space, we
;;; know its value at compile time:
#include "runtime.h"
#include "os.h"
#include "globals.h"
+#include "sbcl.h"
#include "validate.h"
static void ensure_space(lispobj *start, unsigned long size)
*/
#if defined(__FreeBSD__) || defined(__OpenBSD__)
-#define READ_ONLY_SPACE_START (0x10000000)
#define READ_ONLY_SPACE_SIZE (0x0ffff000) /* 256MB - 1 page */
#if defined __FreeBSD__
-#define STATIC_SPACE_START (0x30000000)
#define STATIC_SPACE_SIZE (0x07fff000) /* 128M - 1 page */
#elif defined __OpenBSD__
-#define STATIC_SPACE_START (0x28000000)
#define STATIC_SPACE_SIZE (0x0ffff000) /* 256M - 1 page */
#else
#error unsupported BSD variant
* principles" or "coding principles" file that information like this
* always flows from Lisp code to C code, through sbcl.h. */
#ifdef __linux__
-#define READ_ONLY_SPACE_START (0x01000000)
#define READ_ONLY_SPACE_SIZE (0x02800000) /* 40MB */
-#define STATIC_SPACE_START (0x05000000)
#define STATIC_SPACE_SIZE (0x02fff000) /* 48MB - 1 page */
#define BINDING_STACK_START (0x60000000)
;;; versions, and a string a la "0.6.5.12" is used for versions which
;;; aren't released but correspond only to CVS tags or snapshots.
-"0.6.7.10"
+"0.6.7.11"
projects / sbcl.git / commitdiff