From b27034c44f6f8465fd19964525794615a34b5d41 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Sat, 7 Oct 2000 14:18:21 +0000 Subject: [PATCH 1/1] a step along the way to setting address space parameters in just one place --- BUGS | 55 ------------------------------------------- NEWS | 4 +++- package-data-list.lisp-expr | 26 +++++++------------- src/code/debug-int.lisp | 10 ++++---- src/code/early-impl.lisp | 4 ++-- src/code/gc.lisp | 51 +++++++++++++++------------------------ src/code/room.lisp | 11 +++++---- version.lisp-expr | 2 +- 8 files changed, 45 insertions(+), 118 deletions(-) diff --git a/BUGS b/BUGS index c296e96..f9d65a1 100644 --- a/BUGS +++ b/BUGS @@ -63,17 +63,6 @@ TODO file. Eventually more such information may move here.) * It should cause a STYLE-WARNING, not a WARNING, when the system ignores an FTYPE proclamation for a slot accessor. -* Missing ordinary arguments in a macro call aren't reported when the - macro lambda list contains &KEY: - (DEFMACRO FOO (BAR &KEY) BAR) => FOO - (FOO) => NIL - Also in DESTRUCTURING-BIND: - (DESTRUCTURING-BIND (X Y &REST REST) '(1) (VECTOR X Y REST)) - => #(1 NIL NIL) - Also with &REST lists: - (DEFMACRO FOO (BAR &REST REST) BAR) => FOO - (FOO) => NIL - * Error reporting on various stream-requiring operations is not very good when the stream argument has the wrong type, because the operation tries to fall through to Gray stream code, and then @@ -179,10 +168,6 @@ TODO file. Eventually more such information may move here.) function COMPUTE-EFFECTIVE-METHOD). This is not very helpful.. -* The message "The top of the stack was encountered." from the debugger - is not helpful when I type "FRAME 0" -- I know I'm going to the top - of the stack. - * (SUBTYPEP '(FUNCTION (T BOOLEAN) NIL) '(FUNCTION (FIXNUM FIXNUM) NIL)) => T, T (Also, when this is fixed, we can enable the code in PROCLAIM which @@ -293,46 +278,6 @@ becomes FASL: a secondary error "caught ERROR: unrecoverable error during compilation" and then return with FAILURE-P true, -* The print system doesn't conform to ANSI - "22.1.3.3.1 Package Prefixes for Symbols" for keywords printed when - *PACKAGE* is the KEYWORD package. - - from a message by Ray Toy on CMU CL mailing list Fri, 28 Apr 2000: - -In a discussion on comp.lang.lisp, the following code was given (by -Erik Naggum): - -(let ((*package* (find-package :keyword))) - (write-to-string object :readably t)) - -If OBJECT is a keyword, CMUCL prints out the keyword, but without a -colon. Hence, it's not readable, as requested. - -I think the following patch will make this work as expected. The -patch just basically checks for the keyword package first before -checking the current package. - -Ray - ---- ../cmucl-18c/src/code/print.lisp Wed Dec 8 14:33:47 1999 -+++ ../cmucl-18c/new/code/print.lisp Fri Apr 28 09:21:29 2000 -@@ -605,12 +605,12 @@ - (let ((package (symbol-package object)) - (name (symbol-name object))) - (cond -- ;; If the symbol's home package is the current one, then a -- ;; prefix is never necessary. -- ((eq package *package*)) - ;; If the symbol is in the keyword package, output a colon. - ((eq package *keyword-package*) - (write-char #\: stream)) -+ ;; If the symbol's home package is the current one, then a -+ ;; prefix is never necessary. -+ ((eq package *package*)) - ;; Uninterned symbols print with a leading #:. - ((null package) - (when (or *print-gensym* *print-readably*) - * from CMU CL mailing list 01 May 2000 I realize I can take care of this by doing (proclaim (ignore pcl::.slots1.)) diff --git a/NEWS b/NEWS index bd06fa8..95dbaf2 100644 --- a/NEWS +++ b/NEWS @@ -493,7 +493,9 @@ changes in sbcl-0.6.8 relative to sbcl-0.6.7: have been added. * Raymond Wiker's patches to port dynamic loading from Linux to FreeBSD have been added. -?? The debugger now flushes standard output streams before it begins +* The BUGS file is now more nearly up to date, thanks in large part + to Martin Atzmueller's review of it. +* The debugger now flushes standard output streams before it begins its output ("debugger invoked" and so forth). ?? FINISH-OUTPUT now works better than it did before. (It used to have trouble with characters which weren't followed by a linefeed.) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index d69819e..35ffdee 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1204,20 +1204,7 @@ is a good idea, but see SB-SYS for blurring of boundaries." "%SETELT" "%SET-ROW-MAJOR-AREF" "%SET-FILL-POINTER" "%SET-FDEFINITION" "%SCHARSET" "%SBITSET" "%RPLACD" "%RPLACA" "%PUT" "%CHARSET" "%BITSET" "%ASET" - "%ARRAY-TYPEP" "%SET-SAP-REF-DESCRIPTOR" - - ;; Note: These are out of lexicographical order only because - ;; historically in CMU CL they were imported into package VM - ;; from LISP instead of being exported from package VM. In - ;; SBCL we achieve more or less the same effect by putting them - ;; in SB!KERNEL, where they're visible both in SB!IMPL and in - ;; SB!VM. But as far as I can tell, though, there's no - ;; fundamental reason that they're different from the other - ;; exports. -- WHN 19991020 - "STATIC-SPACE-START" "READ-ONLY-SPACE-START" - "DYNAMIC-1-SPACE-START" "DYNAMIC-0-SPACE-START" - "CURRENT-DYNAMIC-SPACE-START" "*STATIC-SPACE-FREE-POINTER*" - "*READ-ONLY-SPACE-FREE-POINTER*")) + "%ARRAY-TYPEP" "%SET-SAP-REF-DESCRIPTOR")) #s(sb-cold:package-data :name "SB!LOOP" @@ -1598,6 +1585,7 @@ structure representations" "CONTEXT-PC" "CONTEXT-REGISTER" "CONTROL-STACK-FORK" "CONTROL-STACK-RESUME" "CONTROL-STACK-RETURN" "CONTROL-STACK-SC-NUMBER" "COUNT-NO-OPS" + "CURRENT-DYNAMIC-SPACE-START" "CURRENT-FLOAT-TRAP" "DEFINE-FOR-EACH-PRIMITIVE-OBJECT" "DESCRIPTOR-REG-SC-NUMBER" "DESCRIPTOR-VS-NON-DESCRIPTOR-STORAGE" "DOUBLE-FLOAT-EXPONENT-BYTE" "DOUBLE-FLOAT-BIAS" @@ -1635,7 +1623,7 @@ structure representations" "FUNCALLABLE-INSTANCE-LEXENV-SLOT" "GENESIS" "HALT-TRAP" "IGNORE-ME-SC-NUMBER" "IMMEDIATE-BASE-CHAR-SC-NUMBER" "IMMEDIATE-SAP-SC-NUMBER" - "IMMEDIATE-SC-NUMBER" + "IMMEDIATE-SC-NUMBER" "*INITIAL-DYNAMIC-SPACE-FREE-POINTER*" "INSTANCE-HEADER-TYPE" "INSTANCE-POINTER-TYPE" "INSTANCE-SLOTS-OFFSET" "INSTANCE-USAGE" "INTERIOR-REG-SC-NUMBER" "INTERNAL-ERROR-ARGUMENTS" @@ -1660,6 +1648,7 @@ structure representations" "PRIMITIVE-OBJECT-VARIABLE-LENGTH" "PRINT-ALLOCATED-OBJECTS" "RANDOM-IMMEDIATE-SC-NUMBER" "RATIO-DENOMINATOR-SLOT" "RATIO-NUMERATOR-SLOT" "RATIO-SIZE" "RATIO-TYPE" + "*READ-ONLY-SPACE-FREE-POINTER*" "REGISTER-SAVE-PENALTY" "RETURN-PC-HEADER-TYPE" "RETURN-PC-RETURN-POINT-OFFSET" "SANCTIFY-FOR-EXECUTION" "SAP-POINTER-SLOT" "SAP-REG-SC-NUMBER" "SAP-SIZE" @@ -1693,14 +1682,15 @@ structure representations" "SINGLE-VALUE-RETURN-BYTE-OFFSET" "SLOT-DOCS" "SLOT-LENGTH" "SLOT-NAME" "SLOT-OFFSET" "SLOT-OPTIONS" "SLOT-REST-P" "*STATIC-FUNCTIONS*" "STATIC-FUNCTION-OFFSET" - "STATIC-SYMBOL-OFFSET" "STATIC-SYMBOL-P" "*STATIC-SYMBOLS*" + "STATIC-SYMBOL-OFFSET" "STATIC-SYMBOL-P" + "*STATIC-SPACE-FREE-POINTER*" "*STATIC-SYMBOLS*" "STRUCTURE-USAGE" "SYMBOL-FUNCTION-SLOT" "SYMBOL-HASH-SLOT" "SYMBOL-HEADER-TYPE" "SYMBOL-NAME-SLOT" "SYMBOL-PACKAGE-SLOT" "SYMBOL-PLIST-SLOT" "SYMBOL-RAW-FUNCTION-ADDR-SLOT" "SYMBOL-SETF-FUNCTION-SLOT" "SYMBOL-SIZE" "SYMBOL-UNUSED-SLOT" "SYMBOL-VALUE-SLOT" - "*BINDING-STACK-START*" "TARGET-BYTE-ORDER" - "*CONTROL-STACK-START*" "*DYNAMIC-SPACE-START*" + "BINDING-STACK-START" "TARGET-BYTE-ORDER" + "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*" diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 96d064c..b06b89c 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -2474,13 +2474,13 @@ ;; 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!impl::read-only-space-start) val - (* sb!impl::*read-only-space-free-pointer* + (or (< sb!vm:*read-only-space-start* val + (* sb!vm:*read-only-space-free-pointer* sb!vm:word-bytes)) - (< (sb!impl::static-space-start) val - (* sb!impl::*static-space-free-pointer* + (< sb!vm::*static-space-start* val + (* sb!vm:*static-space-free-pointer* sb!vm:word-bytes)) - (< (sb!impl::current-dynamic-space-start) val + (< (sb!vm:current-dynamic-space-start) val (sap-int (dynamic-space-free-pointer)))))) (make-lisp-obj val) :invalid-object)) diff --git a/src/code/early-impl.lisp b/src/code/early-impl.lisp index 6c8b33f..87a1506 100644 --- a/src/code/early-impl.lisp +++ b/src/code/early-impl.lisp @@ -17,8 +17,8 @@ (declaim (special *posix-argv* *!initial-fdefn-objects* *read-only-space-free-pointer* - *static-space-free-pointer* - *initial-dynamic-space-free-pointer* + sb!vm:*static-space-free-pointer* + sb!vm:*initial-dynamic-space-free-pointer* *current-catch-block* *current-unwind-protect-block* sb!c::*eval-stack-top* diff --git a/src/code/gc.lisp b/src/code/gc.lisp index 3aa11b4..7921d48 100644 --- a/src/code/gc.lisp +++ b/src/code/gc.lisp @@ -16,8 +16,8 @@ ;;;; DYNAMIC-USAGE and friends -(declaim (special *read-only-space-free-pointer* - *static-space-free-pointer*)) +(declaim (special sb!vm:*read-only-space-free-pointer* + sb!vm:*static-space-free-pointer*)) (eval-when (:compile-toplevel :execute) (sb!xc:defmacro def-c-var-frob (lisp-fun c-var-name) @@ -26,31 +26,27 @@ (defun ,lisp-fun () (sb!alien:extern-alien ,c-var-name (sb!alien:unsigned 32)))))) -(def-c-var-frob read-only-space-start "read_only_space") -(def-c-var-frob static-space-start "static_space") -(def-c-var-frob dynamic-0-space-start "dynamic_0_space") -(def-c-var-frob dynamic-1-space-start "dynamic_1_space") -(def-c-var-frob control-stack-start "control_stack") -#!+x86 (def-c-var-frob control-stack-end "control_stack_end") -(def-c-var-frob binding-stack-start "binding_stack") -(def-c-var-frob current-dynamic-space-start "current_dynamic_space") +(def-c-var-frob sb!vm:control-stack-start "control_stack") +#!+x86 (def-c-var-frob control-stack-end "control_stack_end") +(def-c-var-frob sb!vm:binding-stack-start "binding_stack") +(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)) - (current-dynamic-space-start)))) + (sb!vm:current-dynamic-space-start)))) #!+(or cgc gencgc) (def-c-var-frob dynamic-usage "bytes_allocated") (defun static-space-usage () - (- (* sb!impl::*static-space-free-pointer* sb!vm:word-bytes) - (static-space-start))) + (- (* sb!vm:*static-space-free-pointer* sb!vm:word-bytes) + sb!vm:*static-space-start*)) (defun read-only-space-usage () - (- (* sb!impl::*read-only-space-free-pointer* sb!vm:word-bytes) - (read-only-space-start))) + (- (* sb!vm::*read-only-space-free-pointer* sb!vm:word-bytes) + sb!vm:*read-only-space-start*)) (defun control-stack-usage () #!-x86 (- (sb!sys:sap-int (sb!c::control-stack-pointer-sap)) @@ -59,26 +55,17 @@ (sb!sys:sap-int (sb!c::control-stack-pointer-sap)))) (defun binding-stack-usage () - (- (sb!sys:sap-int (sb!c::binding-stack-pointer-sap)) (binding-stack-start))) - -(defun current-dynamic-space () - (let ((start (current-dynamic-space-start))) - (cond ((= start (dynamic-0-space-start)) - 0) - ((= start (dynamic-1-space-start)) - 1) - (t - (error "Oh no! The current dynamic space is missing!"))))) + (- (sb!sys:sap-int (sb!c::binding-stack-pointer-sap)) + (sb!vm:binding-stack-start))) ;;;; ROOM (defun room-minimal-info () - (format t "Dynamic Space Usage: ~10:D bytes.~%" (dynamic-usage)) - (format t "Read-Only Space Usage: ~10:D bytes.~%" (read-only-space-usage)) - (format t "Static Space Usage: ~10:D bytes.~%" (static-space-usage)) - (format t "Control Stack Usage: ~10:D bytes.~%" (control-stack-usage)) - (format t "Binding Stack Usage: ~10:D bytes.~%" (binding-stack-usage)) - (format t "The current dynamic space is ~D.~%" (current-dynamic-space)) + (format t "Dynamic space usage is: ~10:D bytes.~%" (dynamic-usage)) + (format t "Read-only space usage is: ~10:D bytes.~%" (read-only-space-usage)) + (format t "Static space usage is: ~10:D bytes.~%" (static-space-usage)) + (format t "Control stack usage is: ~10:D bytes.~%" (control-stack-usage)) + (format t "Binding stack usage is: ~10:D bytes.~%" (binding-stack-usage)) (format t "Garbage collection is currently ~:[enabled~;DISABLED~].~%" *gc-inhibit*)) @@ -273,7 +260,7 @@ #!+ibmrt (defun set-auto-gc-trigger (bytes) - (let ((words (ash (+ (current-dynamic-space-start) bytes) -2))) + (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)) diff --git a/src/code/room.lisp b/src/code/room.lisp index 15a7742..9827be8 100644 --- a/src/code/room.lisp +++ b/src/code/room.lisp @@ -110,17 +110,20 @@ ;;;; MAP-ALLOCATED-OBJECTS -(declaim (type fixnum *static-space-free-pointer* - *read-only-space-free-pointer* )) +;;; Since they're represented as counts of words, we should never +;;; need bignums to represent these: +(declaim (type fixnum + *static-space-free-pointer* + *read-only-space-free-pointer*)) (defun space-bounds (space) (declare (type spaces space)) (ecase space (:static - (values (int-sap (static-space-start)) + (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/version.lisp-expr b/version.lisp-expr index eea400b..417836e 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.8" +"0.6.7.9" -- 1.7.10.4