From: William Harold Newman Date: Tue, 17 Oct 2000 18:12:39 +0000 (+0000) Subject: 0.6.7.11: another step toward centralizing address map X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=6cbbf4fbfb46f323fefc50ff28daa42a30d5698e;p=sbcl.git 0.6.7.11: another step toward centralizing address map --- diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 85027d6..78d0e05 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1693,7 +1693,7 @@ structure representations" "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" diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index e8f9ef5..ecabc00 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -2474,7 +2474,7 @@ ;; 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 diff --git a/src/code/gc.lisp b/src/code/gc.lisp index 45a8a36..3f8f2aa 100644 --- a/src/code/gc.lisp +++ b/src/code/gc.lisp @@ -32,12 +32,6 @@ (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 () @@ -46,7 +40,7 @@ (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)) @@ -254,25 +248,11 @@ (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. diff --git a/src/code/room.lisp b/src/code/room.lisp index 7f01e04..f674ce2 100644 --- a/src/code/room.lisp +++ b/src/code/room.lisp @@ -123,7 +123,7 @@ (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)) diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index 5123b7a..2acb786 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -28,7 +28,7 @@ (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) @@ -2541,34 +2541,49 @@ (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) @@ -2940,7 +2955,7 @@ initially undefined function references:~2%") (*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)) diff --git a/src/compiler/x86/parms.lisp b/src/compiler/x86/parms.lisp index 92cae5e..0b2ec3c 100644 --- a/src/compiler/x86/parms.lisp +++ b/src/compiler/x86/parms.lisp @@ -131,14 +131,18 @@ ;;; 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: diff --git a/src/runtime/validate.c b/src/runtime/validate.c index a6fa5c3..63a5623 100644 --- a/src/runtime/validate.c +++ b/src/runtime/validate.c @@ -21,6 +21,7 @@ #include "runtime.h" #include "os.h" #include "globals.h" +#include "sbcl.h" #include "validate.h" static void ensure_space(lispobj *start, unsigned long size) diff --git a/src/runtime/x86-validate.h b/src/runtime/x86-validate.h index 8ae0588..38eeb81 100644 --- a/src/runtime/x86-validate.h +++ b/src/runtime/x86-validate.h @@ -47,14 +47,11 @@ */ #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 @@ -87,10 +84,8 @@ * 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) diff --git a/version.lisp-expr b/version.lisp-expr index 6c75e56..10fa3e6 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -15,4 +15,4 @@ ;;; 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"