From 667ec9d494530079bef28e8589dd0d3274b935ec Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Sat, 6 Oct 2001 19:54:38 +0000 Subject: [PATCH] 0.pre7.50: deleting more old byte-compiler/byte-interpreter stuff.. ..find . -name *.lisp | xargs egrep -i 'byte.*interp' ..and egrep -i 'interp.*byte' ..and egrep -i 'byte.*component' ..and egrep -i 'interpreted-frame' ..and egrep -i 'byte.*code' ..and egrep -i 'byte.*fun' ..and egrep -i 'byte.*closure' ..no longer need POSSIBLY-AN-INTERPRETED-FRAME or FRAME-REAL-FRAME, and some nearby debug-int.lisp stuff gets simpler too s/"Returns /"Return / in doc strings (and impatiently try to make corresponding grammatical changes too) s/immediate-types/*immediate-types*/ s/function-header-types/*function-header-types*/ --- doc/compiler.sgml | 7 +- doc/sbcl.1 | 9 +- package-data-list.lisp-expr | 14 +-- src/code/array.lisp | 16 +-- src/code/class.lisp | 4 +- src/code/debug-int.lisp | 195 +++++--------------------------- src/code/debug.lisp | 2 +- src/code/early-extensions.lisp | 2 +- src/code/early-fasl.lisp | 7 -- src/code/early-setf.lisp | 2 +- src/code/fdefinition.lisp | 5 +- src/code/filesys.lisp | 8 +- src/code/float.lisp | 10 +- src/code/fop.lisp | 3 +- src/code/interr.lisp | 3 - src/code/irrat.lisp | 4 +- src/code/list.lisp | 61 +++++----- src/code/load.lisp | 3 - src/code/numbers.lisp | 91 +++++++-------- src/code/pred.lisp | 2 +- src/code/print.lisp | 15 +-- src/code/reader.lisp | 4 +- src/code/seq.lisp | 76 ++++++------- src/code/stream.lisp | 20 ++-- src/code/symbol.lisp | 2 +- src/code/target-char.lisp | 34 +++--- src/code/target-error.lisp | 4 +- src/code/target-hash-table.lisp | 2 +- src/code/target-misc.lisp | 4 +- src/code/target-package.lisp | 6 +- src/code/target-pathname.lisp | 8 +- src/code/time.lisp | 4 +- src/code/x86-vm.lisp | 4 +- src/compiler/alpha/type-vops.lisp | 16 +-- src/compiler/backend.lisp | 5 +- src/compiler/codegen.lisp | 26 ++--- src/compiler/disassem.lisp | 24 ++-- src/compiler/dump.lisp | 5 - src/compiler/envanal.lisp | 5 +- src/compiler/generic/early-objdef.lisp | 3 +- src/compiler/ir1tran.lisp | 6 +- src/compiler/knownfun.lisp | 5 +- src/compiler/x86/type-vops.lisp | 17 ++- src/pcl/gray-streams.lisp | 45 ++++---- src/runtime/gc.c | 8 -- src/runtime/gencgc.c | 12 -- src/runtime/purify.c | 12 -- tests/interface.pure.lisp | 8 +- tests/stress-gc.lisp | 2 - version.lisp-expr | 2 +- 50 files changed, 312 insertions(+), 520 deletions(-) diff --git a/doc/compiler.sgml b/doc/compiler.sgml index c9c833b..44e62ce 100644 --- a/doc/compiler.sgml +++ b/doc/compiler.sgml @@ -777,10 +777,9 @@ would become something like -When speed is zero, the compiler emits byte code -instead of native code. Byte code can be substantially more compact -than native code (on the order of a factor of 2) and is usually much, -much slower than native code (on the order of a factor of 50). + (In early versions of SBCL, a speed value of zero +was used to enable byte compilation, but since version 0.7.0, SBCL +only supports native compilation.) When safety is zero, almost all runtime checking of types, array bounds, and so forth is suppressed. diff --git a/doc/sbcl.1 b/doc/sbcl.1 index 15b88f9..acbf1c6 100644 --- a/doc/sbcl.1 +++ b/doc/sbcl.1 @@ -136,13 +136,14 @@ chance to see it. SBCL aims for but has not reached ANSI compliance. -SBCL compiles Lisp to native code, or optionally to more-compact but -much slower byte code. +SBCL compiles Lisp to native code. (Unlike earlier versions of SBCL, +byte compilation is no longer supported.) -SBCL's garbage collector is generational and conservative. +SBCL uses a generational conservative garbage collector for some ports, +and a simple stop-and-copy garbage collector for other ports. SBCL includes a source level debugger, as well as the ANSI TRACE -facility and a rudimentary profiler. +facility and a profiler. .SH DIFFERENCES FROM CMU CL diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 20d6752..6c6343c 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -275,9 +275,7 @@ "BLOCK-NUMBER" "BACKEND" "IR2-BLOCK-BLOCK" - "DISASSEM-BYTE-COMPONENT" "FUNCALLABLE-INSTANCE-LEXENV" - "DISASSEM-BYTE-FUN" "VOP-BLOCK" "*ASSEMBLY-OPTIMIZE*" "LARGE-ALLOC" @@ -341,7 +339,6 @@ "DUMP-OBJECT" "FASL-CONSTANT-ALREADY-DUMPED-P" "+FASL-FILE-VERSION+" - "FASL-DUMP-BYTE-COMPONENT" "FASL-DUMP-COLD-LOAD-FORM" "FASL-DUMP-COMPONENT" "FASL-DUMP-COLD-FSET" "FASL-DUMP-LOAD-TIME-VALUE" "FASL-DUMP-LOAD-TIME-VALUE-LAMBDA" @@ -1255,8 +1252,8 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "STRUCTURE-CLASS-PRINT-FUNCTION" "DSD-READ-ONLY" "LAYOUT-INHERITS" "DD-LENGTH" "%CODE-ENTRY-POINTS" "%DENOMINATOR" - "BYTE-FUNCTION-OR-CLOSURE" "MAKE-STANDARD-CLASS" - "BYTE-FUNCTION-NAME" "CLASS-CELL-TYPEP" "BYTE-CLOSURE" + "MAKE-STANDARD-CLASS" + "CLASS-CELL-TYPEP" "FIND-CLASS-CELL" "EXTRACT-FUNCTION-TYPE" "FUNCALLABLE-STRUCTURE-CLASS" "%RANDOM-DOUBLE-FLOAT" "%RANDOM-LONG-FLOAT" @@ -1265,13 +1262,12 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "%FUNCALLABLE-INSTANCE-INFO" "RANDOM-CHUNK" "MAKE-FUNCALLABLE-STRUCTURE-CLASS" "LAYOUT-CLOS-HASH-MAX" "CLASS-CELL-NAME" "BUILT-IN-CLASS-DIRECT-SUPERCLASSES" - "INITIALIZE-BYTE-COMPILED-FUNCTION" "RANDOM-LAYOUT-CLOS-HASH" "CLASS-PCL-CLASS" "FUNCALLABLE-STRUCTURE" "FUNCALLABLE-INSTANCE-FUNCTION" "%FUNCALLABLE-INSTANCE-LAYOUT" - "BASIC-STRUCTURE-CLASS" "BYTE-CLOSURE-DATA" - "BYTE-CLOSURE-FUNCTION" "BYTE-FUNCTION" "CLASS-CELL-CLASS" + "BASIC-STRUCTURE-CLASS" + "CLASS-CELL-CLASS" "FUNCALLABLE-STRUCTURE-CLASS-P" "REGISTER-LAYOUT" "FUNCALLABLE-INSTANCE" "RANDOM-FIXNUM-MAX" "MAKE-RANDOM-PCL-CLASS" "INSTANCE-LAMBDA" @@ -1279,7 +1275,6 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "%FUNCALLABLE-INSTANCE-FUNCTION" "SYMBOL-HASH" "MAKE-UNDEFINED-CLASS" "CLASS-DIRECT-SUPERCLASSES" "MAKE-LAYOUT" - "BYTE-FUNCTION-TYPE" "REDEFINE-LAYOUT-WARNING" "SLOT-CLASS" "INSURED-FIND-CLASS" "ORDER-LAYOUT-INHERITS" "STD-COMPUTE-CLASS-PRECEDENCE-LIST" @@ -1676,7 +1671,6 @@ structure representations" "BASE-CHAR-STACK-SC-NUMBER" "BASE-CHAR-TYPE" "BIGNUM-DIGITS-OFFSET" "BIGNUM-TYPE" "BINDING-SIZE" "BINDING-SYMBOL-SLOT" "BINDING-VALUE-SLOT" "BREAKPOINT-TRAP" - "BYTE-CODE-CLOSURE-TYPE" "BYTE-CODE-FUNCTION-TYPE" "BYTE-BITS" "BYTE-REG-SC-NUMBER" "CATCH-BLOCK-CURRENT-CODE-SLOT" "CATCH-BLOCK-CURRENT-CONT-SLOT" "CATCH-BLOCK-CURRENT-UWP-SLOT" diff --git a/src/code/array.lisp b/src/code/array.lisp index 38c10fc..0435fd3 100644 --- a/src/code/array.lisp +++ b/src/code/array.lisp @@ -372,7 +372,7 @@ (defun array-in-bounds-p (array &rest subscripts) #!+sb-doc - "Returns T if the Subscipts are in bounds for the Array, Nil otherwise." + "Return T if the Subscipts are in bounds for the Array, Nil otherwise." (if (%array-row-major-index array subscripts nil) t)) @@ -381,7 +381,7 @@ (defun aref (array &rest subscripts) #!+sb-doc - "Returns the element of the Array specified by the Subscripts." + "Return the element of the Array specified by the Subscripts." (row-major-aref array (%array-row-major-index array subscripts))) (defun %aset (array &rest stuff) @@ -416,7 +416,7 @@ (defun row-major-aref (array index) #!+sb-doc - "Returns the element of array corressponding to the row-major index. This is + "Return the element of array corressponding to the row-major index. This is SETF'able." (declare (optimize (safety 1))) (row-major-aref array index)) @@ -427,7 +427,7 @@ (defun svref (simple-vector index) #!+sb-doc - "Returns the Index'th element of the given Simple-Vector." + "Return the INDEX'th element of the given Simple-Vector." (declare (optimize (safety 1))) (aref simple-vector index)) @@ -437,7 +437,7 @@ (defun bit (bit-array &rest subscripts) #!+sb-doc - "Returns the bit from the Bit-Array at the specified Subscripts." + "Return the bit from the BIT-ARRAY at the specified SUBSCRIPTS." (declare (type (array bit) bit-array) (optimize (safety 1))) (row-major-aref bit-array (%array-row-major-index bit-array subscripts))) @@ -458,7 +458,7 @@ (defun sbit (simple-bit-array &rest subscripts) #!+sb-doc - "Returns the bit from the Simple-Bit-Array at the specified Subscripts." + "Return the bit from SIMPLE-BIT-ARRAY at the specified SUBSCRIPTS." (declare (type (simple-array bit) simple-bit-array) (optimize (safety 1))) (row-major-aref simple-bit-array (%array-row-major-index simple-bit-array subscripts))) @@ -486,7 +486,7 @@ (defun array-element-type (array) #!+sb-doc - "Returns the type of the elements of the array" + "Return the type of the elements of the array" (let ((type (get-type array))) (macrolet ((pick-element-type (&rest stuff) `(cond ,@(mapcar #'(lambda (stuff) @@ -543,7 +543,7 @@ (defun array-dimension (array axis-number) #!+sb-doc - "Returns the length of dimension AXIS-NUMBER of ARRAY." + "Return the length of dimension AXIS-NUMBER of ARRAY." (declare (array array) (type index axis-number)) (cond ((not (array-header-p array)) (unless (= axis-number 0) diff --git a/src/code/class.lisp b/src/code/class.lisp index ccfb499..6951f30 100644 --- a/src/code/class.lisp +++ b/src/code/class.lisp @@ -927,9 +927,7 @@ (random-class) ; used for unknown type codes (function - :codes (#.sb!vm:byte-code-closure-type - #.sb!vm:byte-code-function-type - #.sb!vm:closure-header-type + :codes (#.sb!vm:closure-header-type #.sb!vm:function-header-type) :state :read-only) (funcallable-instance diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index a0d53af..16eae71 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -242,9 +242,7 @@ (code-location nil :type code-location) ;; an a-list of catch-tags to code-locations (%catches :unparsed :type (or list (member :unparsed))) - ;; pointer to frame on control stack. (unexported) When this frame - ;; is an interpreted-frame, this pointer is an index into the - ;; interpreter's stack. + ;; pointer to frame on control stack (unexported) pointer ;; This is the frame's number for prompt printing. Top is zero. (number 0 :type index)) @@ -281,20 +279,6 @@ "~S~:[~;, interrupted~]" (debug-function-name (frame-debug-function obj)) (compiled-frame-escaped obj)))) - -(defstruct (interpreted-frame - (:include frame) - (:constructor make-interpreted-frame - (pointer up debug-function code-location number - real-frame closure)) - (:copier nil)) - ;; This points to the compiled-frame for SB!BYTECODE:INTERNAL-APPLY-LOOP. - (real-frame nil :type compiled-frame) - ;; This is the closed over data used by the interpreter. - (closure nil :type simple-vector)) -(def!method print-object ((obj interpreted-frame) str) - (print-unreadable-object (obj str :type t) - (prin1 (debug-function-name (frame-debug-function obj)) str))) ;;;; DEBUG-FUNCTIONs @@ -380,12 +364,12 @@ #!+sb-doc (setf (fdocumentation 'debug-block-successors 'function) - "Returns the list of possible code-locations where execution may continue + "Return the list of possible code-locations where execution may continue when the basic-block represented by debug-block completes its execution.") #!+sb-doc (setf (fdocumentation 'debug-block-elsewhere-p 'function) - "Returns whether debug-block represents elsewhere code.") + "Return whether debug-block represents elsewhere code.") (defstruct (compiled-debug-block (:include debug-block) (:constructor @@ -473,20 +457,7 @@ (etypecase what (code-location nil) (debug-function (breakpoint-kind obj))))))) - -#!+sb-doc -(setf (fdocumentation 'breakpoint-hook-function 'function) - "Returns the breakpoint's function the system calls when execution encounters - the breakpoint, and it is active. This is SETF'able.") - -#!+sb-doc -(setf (fdocumentation 'breakpoint-what 'function) - "Returns the breakpoint's what specification.") - -#!+sb-doc -(setf (fdocumentation 'breakpoint-kind 'function) - "Returns the breakpoint's kind specification.") - + ;;;; CODE-LOCATIONs (defstruct (code-location (:constructor nil) @@ -516,11 +487,6 @@ (prin1 (debug-function-name (code-location-debug-function obj)) str))) -#!+sb-doc -(setf (fdocumentation 'code-location-debug-function 'function) - "Returns the debug-function representing information about the function - corresponding to the code-location.") - (defstruct (compiled-code-location (:include code-location) (:constructor make-known-code-location @@ -713,9 +679,7 @@ (defun top-frame () (/show0 "entering TOP-FRAME") (multiple-value-bind (fp pc) (%caller-frame-and-pc) - (possibly-an-interpreted-frame - (compute-calling-frame (descriptor-sap fp) pc nil) - nil))) + (compute-calling-frame (descriptor-sap fp) pc nil))) ;;; Flush all of the frames above FRAME, and renumber all the frames ;;; below FRAME. @@ -734,27 +698,24 @@ ;; them to COMPUTE-CALLING-FRAME. (let ((down (frame-%down frame))) (if (eq down :unparsed) - (let* ((real (frame-real-frame frame)) - (debug-fun (frame-debug-function real))) + (let ((debug-fun (frame-debug-function frame))) (/show0 "in DOWN :UNPARSED case") (setf (frame-%down frame) (etypecase debug-fun (compiled-debug-function (let ((c-d-f (compiled-debug-function-compiler-debug-fun debug-fun))) - (possibly-an-interpreted-frame - (compute-calling-frame - (descriptor-sap - (get-context-value - real sb!vm::ocfp-save-offset - (sb!c::compiled-debug-function-old-fp c-d-f))) + (compute-calling-frame + (descriptor-sap (get-context-value - real sb!vm::lra-save-offset - (sb!c::compiled-debug-function-return-pc c-d-f)) - frame) + frame sb!vm::ocfp-save-offset + (sb!c::compiled-debug-function-old-fp c-d-f))) + (get-context-value + frame sb!vm::lra-save-offset + (sb!c::compiled-debug-function-return-pc c-d-f)) frame))) (bogus-debug-function - (let ((fp (frame-pointer real))) + (let ((fp (frame-pointer frame))) (when (cstack-pointer-valid-p fp) #!+x86 (multiple-value-bind (ra ofp) (x86-call-context fp) @@ -824,80 +785,6 @@ (#.sb!vm::lra-save-offset (setf (sap-ref-sap pointer (- (* (1+ stack-slot) 4))) value)))))) -;;; This doesn't do anything in sbcl-0.7.0, since the functionality -;;; was lost in the switch from IR1 interpreter to bytecode interpreter. -;;; However, it might be revived someday. (See the FIXME for -;;; POSSIBLY-AN-INTERPRETED-FRAME.) -;;; -;;; (defvar *debugging-interpreter* nil -;;; #!+sb-doc -;;; "When set, the debugger foregoes making interpreted frames, so you can -;;; debug the functions that manifest the interpreter.") - -;;; Note: In CMU CL with the IR1 interpreter, this did -;;; This takes a newly computed frame, FRAME, and the frame above it -;;; on the stack, UP-FRAME, which is possibly NIL. FRAME is NIL when -;;; we hit the bottom of the control stack. When FRAME represents a -;;; call to SB!BYTECODE::INTERNAL-APPLY-LOOP, we make an interpreted frame -;;; to replace FRAME. The interpreted frame points to FRAME. -;;; But with SBCL's switch to byte-interpreter-only, this is functionality -;;; wasn't maintained, so this is just a placeholder, and when you -;;; try to "debug byte code" you end up debugging the byte interpreter -;;; instead. -;;; -;;; (It might be good to update the old CMU CL functionality so that -;;; you can really debug byte code instead of seeing a bunch of -;;; confusing byte interpreter implementation stuff, so I've left the -;;; placeholder in place. But be aware that doing so is a big messy -;;; job: grep for 'interpreted-debug-' in the sbcl-0.6.13 sources to -;;; see what you're getting into. -- WHN) -(defun possibly-an-interpreted-frame (frame up-frame) - - ;; new SBCL code, not ambitious enough to do anything tricky like - ;; hiding the byte interpreter when debugging - (declare (ignore up-frame)) - (/show "doing trivial POSSIBLY-AN-INTERPRETED-FRAME") - frame - - ;; old CMU CL code to hide IR1 interpreter when debugging: - ;; - ;;(if (or (not frame) - ;; (not (eq (debug-function-name (frame-debug-function - ;; frame)) - ;; 'sb!bytecode::internal-apply-loop)) - ;; *debugging-interpreter* - ;; (compiled-frame-escaped frame)) - ;; frame - ;; (flet ((get-var (name location) - ;; (let ((vars (sb!di:ambiguous-debug-vars - ;; (sb!di:frame-debug-function frame) name))) - ;; (when (or (null vars) (> (length vars) 1)) - ;; (error "zero or more than one ~A variable in ~ - ;; SB!BYTECODE::INTERNAL-APPLY-LOOP" - ;; (string-downcase name))) - ;; (if (eq (debug-var-validity (car vars) location) - ;; :valid) - ;; (car vars))))) - ;; (let* ((code-loc (frame-code-location frame)) - ;; (ptr-var (get-var "FRAME-PTR" code-loc)) - ;; (node-var (get-var "NODE" code-loc)) - ;; (closure-var (get-var "CLOSURE" code-loc))) - ;; (if (and ptr-var node-var closure-var) - ;; (let* ((node (debug-var-value node-var frame)) - ;; (d-fun (make-interpreted-debug-function - ;; (sb!c::block-home-lambda (sb!c::node-block - ;; node))))) - ;; (make-interpreted-frame - ;; (debug-var-value ptr-var frame) - ;; up-frame - ;; d-fun - ;; (make-interpreted-code-location node d-fun) - ;; (frame-number frame) - ;; frame - ;; (debug-var-value closure-var frame))) - ;; frame)))) - ) - ;;; This returns a frame for the one existing in time immediately ;;; prior to the frame referenced by current-fp. This is current-fp's ;;; caller or the next frame down the control stack. If there is no @@ -1169,7 +1056,7 @@ (defun frame-catches (frame) (let ((catch (descriptor-sap *current-catch-block*)) (res nil) - (fp (frame-pointer (frame-real-frame frame)))) + (fp (frame-pointer frame))) (loop (when (zerop (sap-int catch)) (return (nreverse res))) (when (sap= fp @@ -1223,12 +1110,6 @@ (sap-ref-32 catch (* sb!vm:catch-block-previous-catch-slot sb!vm:word-bytes))))))) - -;;; If an interpreted frame, return the real frame, otherwise frame. -(defun frame-real-frame (frame) - (etypecase frame - (compiled-frame frame) - (interpreted-frame (interpreted-frame-real-frame frame)))) ;;;; operations on DEBUG-FUNCTIONs @@ -2162,20 +2043,11 @@ ;;; Returns the value stored for DEBUG-VAR in frame. The value may be ;;; invalid. This is SETFable. (defun debug-var-value (debug-var frame) - (etypecase debug-var - (compiled-debug-var - (aver (typep frame 'compiled-frame)) - (let ((res (access-compiled-debug-var-slot debug-var frame))) - (if (indirect-value-cell-p res) - (value-cell-ref res) - res))) - ;; (This function used to be more interesting, with more type - ;; cases here, before the IR1 interpreter went away. It might - ;; become more interesting again if we ever try to generalize the - ;; CMU CL POSSIBLY-AN-INTERPRETED-FRAME thing to elide - ;; internal-to-the-byte-interpreter debug frames the way that CMU - ;; CL elided internal-to-the-IR1-interpreter debug frames.) - )) + (aver (typep frame 'compiled-frame)) + (let ((res (access-compiled-debug-var-slot debug-var frame))) + (if (indirect-value-cell-p res) + (value-cell-ref res) + res))) ;;; This returns what is stored for the variable represented by ;;; DEBUG-VAR relative to the FRAME. This may be an indirect value @@ -2502,24 +2374,15 @@ ;;; COMPILED-DEBUG-VAR case, access the current value to determine if ;;; it is an indirect value cell. This occurs when the variable is ;;; both closed over and set. -(defun %set-debug-var-value (debug-var frame value) - (etypecase debug-var - (compiled-debug-var - (aver (typep frame 'compiled-frame)) - (let ((current-value (access-compiled-debug-var-slot debug-var frame))) - (if (indirect-value-cell-p current-value) - (value-cell-set current-value value) - (set-compiled-debug-var-slot debug-var frame value)))) - ;; (This function used to be more interesting, with more type - ;; cases here, before the IR1 interpreter went away. It might - ;; become more interesting again if we ever try to generalize the - ;; CMU CL POSSIBLY-AN-INTERPRETED-FRAME thing to elide - ;; internal-to-the-byte-interpreter debug frames the way that CMU - ;; CL elided internal-to-the-IR1-interpreter debug frames.) - ) - value) - -;;; This stores value for the variable represented by debug-var +(defun %set-debug-var-value (debug-var frame new-value) + (aver (typep frame 'compiled-frame)) + (let ((old-value (access-compiled-debug-var-slot debug-var frame))) + (if (indirect-value-cell-p old-value) + (value-cell-set old-value new-value) + (set-compiled-debug-var-slot debug-var frame new-value))) + new-value) + +;;; This stores VALUE for the variable represented by debug-var ;;; relative to the frame. This assumes the location directly contains ;;; the variable's value; that is, there is no indirect value cell ;;; currently there in case the variable is both closed over and set. diff --git a/src/code/debug.lisp b/src/code/debug.lisp index 54099e0..e181a73 100644 --- a/src/code/debug.lisp +++ b/src/code/debug.lisp @@ -973,7 +973,7 @@ argument") (defun arg (n) #!+sb-doc - "Returns the N'th argument's value if possible. Argument zero is the first + "Return the N'th argument's value if possible. Argument zero is the first argument in a frame's default printed representation. Count keyword/value pairs as separate arguments." (multiple-value-bind (var lambda-var-p) diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp index f2c3adf..de6421e 100644 --- a/src/code/early-extensions.lisp +++ b/src/code/early-extensions.lisp @@ -232,7 +232,7 @@ ;;; like (MEMBER ITEM LIST :TEST #'EQ) (defun memq (item list) #!+sb-doc - "Returns tail of LIST beginning with first element EQ to ITEM." + "Return tail of LIST beginning with first element EQ to ITEM." ;; KLUDGE: These could be and probably should be defined as ;; (MEMBER ITEM LIST :TEST #'EQ)), ;; but when I try to cross-compile that, I get an error from diff --git a/src/code/early-fasl.lisp b/src/code/early-fasl.lisp index 9bd0c45..706c94c 100644 --- a/src/code/early-fasl.lisp +++ b/src/code/early-fasl.lisp @@ -79,13 +79,6 @@ ;;; the conventional file extension for our fasl files (declaim (type simple-string *fasl-file-type*)) (defvar *fasl-file-type* "fasl") - -;;; This is a sort of pun that we inherited from CMU CL. For ordinary, -;;; non-byte-coded fasl files, the "implementation" is basically the -;;; CPU. For byte-coded fasl files, the "implementation" is whether -;;; the data are stored big-endianly or little-endianly. -(defun backend-byte-fasl-file-implementation () - *backend-byte-order*) ;;; information about below-Lisp-level linkage ;;; diff --git a/src/code/early-setf.lisp b/src/code/early-setf.lisp index f79b473..e985443 100644 --- a/src/code/early-setf.lisp +++ b/src/code/early-setf.lisp @@ -32,7 +32,7 @@ (declaim (ftype (function (t &optional (or null sb!c::lexenv))) sb!xc:get-setf-expansion)) (defun sb!xc:get-setf-expansion (form &optional environment) #!+sb-doc - "Returns five values needed by the SETF machinery: a list of temporary + "Return five values needed by the SETF machinery: a list of temporary variables, a list of values with which to fill them, a list of temporaries for the new values, the setting function, and the accessing function." (let (temp) diff --git a/src/code/fdefinition.lisp b/src/code/fdefinition.lisp index 7b627ef..4a8c794 100644 --- a/src/code/fdefinition.lisp +++ b/src/code/fdefinition.lisp @@ -137,7 +137,7 @@ ;;; The compiler emits calls to this when someone tries to funcall a symbol. (defun %coerce-name-to-function (name) #!+sb-doc - "Returns the definition for name, including any encapsulations. Settable + "Return the definition for name, including any encapsulations. Settable with SETF." (let ((fdefn (fdefinition-object name nil))) (or (and fdefn (fdefn-function fdefn)) @@ -261,9 +261,8 @@ (setf encap-info next-info)))))) t) +;;; Does NAME have an encapsulation of the given TYPE? (defun encapsulated-p (name type) - #!+sb-doc - "Returns t if name has an encapsulation of the given type, otherwise nil." (let ((fdefn (fdefinition-object name nil))) (do ((encap-info (encapsulation-info (fdefn-function fdefn)) (encapsulation-info diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp index 5e33095..90e35e8 100644 --- a/src/code/filesys.lisp +++ b/src/code/filesys.lisp @@ -962,13 +962,13 @@ ;;; Then if necessary, we look in "/etc/passwds" ("/etc/groups") which ;;; is really long and has to be fetched over the net. ;;; +;;; The result is a SIMPLE-STRING or NIL. +;;; ;;; FIXME: Now that we no longer have lookup-group-name, we no longer need ;;; the GROUP-OR-USER argument. (defun get-group-or-user-name (group-or-user id) - #!+sb-doc - "Returns the simple-string user or group name of the user whose uid or gid - is id, or NIL if no such user or group exists. Group-or-user is either - :group or :user." + (declare (type (member :group :user) group-or-user)) + (declare (type index id)) (let ((id-string (let ((*print-base* 10)) (prin1-to-string id)))) (declare (simple-string id-string)) (multiple-value-bind (file1 file2) diff --git a/src/code/float.lisp b/src/code/float.lisp index ffd5f5b..51a621e 100644 --- a/src/code/float.lisp +++ b/src/code/float.lisp @@ -255,7 +255,7 @@ #!-sb-fluid (declaim (maybe-inline float-precision)) (defun float-precision (f) #!+sb-doc - "Returns a non-negative number of significant digits in its float argument. + "Return a non-negative number of significant digits in its float argument. Will be less than FLOAT-DIGITS if denormalized or zero." (macrolet ((frob (digits bias decode) `(cond ((zerop f) 0) @@ -280,7 +280,7 @@ (defun float-sign (float1 &optional (float2 (float 1 float1))) #!+sb-doc - "Returns a floating-point number that has the same sign as + "Return a floating-point number that has the same sign as float1 and, if float2 is given, has the same absolute value as float2." (declare (float float1 float2)) @@ -474,7 +474,7 @@ ;;; Dispatch to the correct type-specific i-d-f function. (defun integer-decode-float (x) #!+sb-doc - "Returns three values: + "Return three values: 1) an integer representation of the significand. 2) the exponent for the power of 2 that the significand must be multiplied by to get the actual value. This differs from the DECODE-FLOAT exponent @@ -599,7 +599,7 @@ ;;; Dispatch to the appropriate type-specific function. (defun decode-float (f) #!+sb-doc - "Returns three values: + "Return three values: 1) a floating-point number representing the significand. This is always between 0.5 (inclusive) and 1.0 (exclusive). 2) an integer representing the exponent. @@ -721,7 +721,7 @@ ;;; Dispatch to the correct type-specific scale-float function. (defun scale-float (f ex) #!+sb-doc - "Returns the value (* f (expt (float 2 f) ex)), but with no unnecessary loss + "Return the value (* f (expt (float 2 f) ex)), but with no unnecessary loss of precision or overflow." (number-dispatch ((f float)) ((single-float) diff --git a/src/code/fop.lisp b/src/code/fop.lisp index fe07fe7..f7d5098 100644 --- a/src/code/fop.lisp +++ b/src/code/fop.lisp @@ -24,7 +24,6 @@ `(with-fop-stack ,pushp ,@forms))) (%define-fop ',name ,fop-code))) -;;; FIXME: This can be byte coded. (defun %define-fop (name code) (let ((oname (svref *fop-names* code))) (when (and oname (not (eq oname name))) @@ -626,7 +625,7 @@ bug.~:@>") (name (pop-stack))) (setf (fdefinition name) fn))) -;;; Modify a slot in a Constants object. +;;; Modify a slot in a CONSTANTS object. (define-cloned-fops (fop-alter-code 140 nil) (fop-byte-alter-code 141) (let ((value (pop-stack)) (code (pop-stack))) diff --git a/src/code/interr.lisp b/src/code/interr.lisp index dcb2525..e02b8fb 100644 --- a/src/code/interr.lisp +++ b/src/code/interr.lisp @@ -31,9 +31,6 @@ ;; seem to add much value, and it takes a lot of space. Perhaps ;; we could do this dispatch with a big CASE statement instead? (defun ,fn-name (name ,fp ,context ,sc-offsets) - ;; FIXME: Perhaps put in OPTIMIZE declaration to make this - ;; byte coded. - ;; ;; FIXME: It would probably be good to do *STACK-TOP-HINT* ;; tricks to hide this internal error-handling logic from the ;; poor high level user, so his debugger tells him about diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp index 040bd05..1da4fb7 100644 --- a/src/code/irrat.lisp +++ b/src/code/irrat.lisp @@ -119,7 +119,7 @@ ;;; from the general complex case. (defun expt (base power) #!+sb-doc - "Returns BASE raised to the POWER." + "Return BASE raised to the POWER." (if (zerop power) (1+ (* base power)) (labels (;; determine if the double float is an integer. @@ -312,7 +312,7 @@ (defun abs (number) #!+sb-doc - "Returns the absolute value of the number." + "Return the absolute value of the number." (number-dispatch ((number number)) (((foreach single-float double-float fixnum rational)) (abs number)) diff --git a/src/code/list.lisp b/src/code/list.lisp index 2518954..54dde08 100644 --- a/src/code/list.lisp +++ b/src/code/list.lisp @@ -132,20 +132,21 @@ (defun tree-equal (x y &key (test #'eql) test-not) #!+sb-doc - "Returns T if X and Y are isomorphic trees with identical leaves." + "Return T if X and Y are isomorphic trees with identical leaves." (if test-not (tree-equal-test-not x y test-not) (tree-equal-test x y test))) (defun endp (object) #!+sb-doc - "The recommended way to test for the end of a list. True if Object is nil, - false if Object is a cons, and an error for any other types of arguments." + "This is the recommended way to test for the end of a proper list. It + returns true if OBJECT is NIL, false if OBJECT is a CONS, and an error + for any other type of OBJECT." (endp object)) (defun list-length (list) #!+sb-doc - "Returns the length of the given List, or Nil if the List is circular." + "Return the length of the given List, or Nil if the List is circular." (do ((n 0 (+ n 2)) (y list (cddr y)) (z list (cdr z))) @@ -157,47 +158,47 @@ (defun nth (n list) #!+sb-doc - "Returns the nth object in a list where the car is the zero-th element." + "Return the nth object in a list where the car is the zero-th element." (car (nthcdr n list))) (defun first (list) #!+sb-doc - "Returns the 1st object in a list or NIL if the list is empty." + "Return the 1st object in a list or NIL if the list is empty." (car list)) (defun second (list) - "Returns the 2nd object in a list or NIL if there is no 2nd object." + "Return the 2nd object in a list or NIL if there is no 2nd object." (cadr list)) (defun third (list) #!+sb-doc - "Returns the 3rd object in a list or NIL if there is no 3rd object." + "Return the 3rd object in a list or NIL if there is no 3rd object." (caddr list)) (defun fourth (list) #!+sb-doc - "Returns the 4th object in a list or NIL if there is no 4th object." + "Return the 4th object in a list or NIL if there is no 4th object." (cadddr list)) (defun fifth (list) #!+sb-doc - "Returns the 5th object in a list or NIL if there is no 5th object." + "Return the 5th object in a list or NIL if there is no 5th object." (car (cddddr list))) (defun sixth (list) #!+sb-doc - "Returns the 6th object in a list or NIL if there is no 6th object." + "Return the 6th object in a list or NIL if there is no 6th object." (cadr (cddddr list))) (defun seventh (list) #!+sb-doc - "Returns the 7th object in a list or NIL if there is no 7th object." + "Return the 7th object in a list or NIL if there is no 7th object." (caddr (cddddr list))) (defun eighth (list) #!+sb-doc - "Returns the 8th object in a list or NIL if there is no 8th object." + "Return the 8th object in a list or NIL if there is no 8th object." (cadddr (cddddr list))) (defun ninth (list) #!+sb-doc - "Returns the 9th object in a list or NIL if there is no 9th object." + "Return the 9th object in a list or NIL if there is no 9th object." (car (cddddr (cddddr list)))) (defun tenth (list) #!+sb-doc - "Returns the 10th object in a list or NIL if there is no 10th object." + "Return the 10th object in a list or NIL if there is no 10th object." (cadr (cddddr (cddddr list)))) (defun rest (list) #!+sb-doc @@ -215,7 +216,7 @@ (defun last (list &optional (n 1)) #!+sb-doc - "Returns the last N conses (not the last element!) of a list." + "Return the last N conses (not the last element!) of a list." (declare (type index n)) (do ((checked-list list (cdr checked-list)) (returned-list list) @@ -227,7 +228,7 @@ (defun list (&rest args) #!+sb-doc - "Returns constructs and returns a list of its arguments." + "Return constructs and returns a list of its arguments." args) ;;; List* is done the same as list, except that the last cons is made a @@ -235,7 +236,7 @@ (defun list* (arg &rest others) #!+sb-doc - "Returns a list of the arguments with last cons a dotted pair" + "Return a list of the arguments with last cons a dotted pair" (cond ((atom others) arg) ((atom (cdr others)) (cons arg (car others))) (t (do ((x others (cdr x))) @@ -291,7 +292,7 @@ (defun copy-list (list) #!+sb-doc - "Returns a new list which is EQUAL to LIST." + "Return a new list which is EQUAL to LIST." ;; The list is copied correctly even if the list is not terminated ;; by NIL. The new list is built by CDR'ing SPLICE which is always ;; at the tail of the new list. @@ -308,7 +309,7 @@ (defun copy-alist (alist) #!+sb-doc - "Returns a new association list which is EQUAL to ALIST." + "Return a new association list which is EQUAL to ALIST." (if (atom alist) alist (let ((result @@ -341,7 +342,7 @@ (defun revappend (x y) #!+sb-doc - "Returns (append (reverse x) y)" + "Return (append (reverse x) y)." (do ((top x (cdr top)) (result y (cons (car top) result))) ((endp top) result))) @@ -388,7 +389,7 @@ (defun nreconc (x y) #!+sb-doc - "Returns (nconc (nreverse x) y)" + "Return (nconc (nreverse x) y)." (do ((1st (cdr x) (if (atom 1st) 1st (cdr 1st))) (2nd x 1st) ;2nd follows first down the list. (3rd y 2nd)) ;3rd follows 2nd down the list. @@ -648,8 +649,8 @@ (defun member (item list &key key (test #'eql testp) (test-not nil notp)) #!+sb-doc - "Returns tail of list beginning with first element satisfying EQLity, - :TEST, or :TEST-NOT with a given item." + "Return the tail of LIST beginning with first element satisfying EQLity, + :TEST, or :TEST-NOT with the given ITEM." (do ((list list (cdr list))) ((null list) nil) (let ((car (car list))) @@ -879,7 +880,7 @@ (defun assoc (item alist &key key test test-not) #!+sb-doc - "Returns the cons in ALIST whose car is equal (by a given test or EQL) to + "Return the cons in ALIST whose car is equal (by a given test or EQL) to the ITEM." ;; FIXME: Shouldn't there be a check for existence of both TEST and TEST-NOT? (cond (test @@ -898,7 +899,7 @@ (defun assoc-if (predicate alist &key key) #!+sb-doc - "Returns the first cons in alist whose car satisfies the Predicate. If + "Return the first cons in alist whose car satisfies the Predicate. If key is supplied, apply it to the car of each cons before testing." (if key (assoc-guts (funcall predicate (funcall key (caar alist)))) @@ -906,7 +907,7 @@ (defun assoc-if-not (predicate alist &key key) #!+sb-doc - "Returns the first cons in ALIST whose car does not satisfy the PREDICATE. + "Return the first cons in ALIST whose car does not satisfy the PREDICATE. If KEY is supplied, apply it to the car of each cons before testing." (if key (assoc-guts (not (funcall predicate (funcall key (caar alist))))) @@ -915,7 +916,7 @@ (defun rassoc (item alist &key key test test-not) (declare (list alist)) #!+sb-doc - "Returns the cons in ALIST whose cdr is equal (by a given test or EQL) to + "Return the cons in ALIST whose cdr is equal (by a given test or EQL) to the ITEM." (cond (test (if key @@ -933,7 +934,7 @@ (defun rassoc-if (predicate alist &key key) #!+sb-doc - "Returns the first cons in alist whose cdr satisfies the Predicate. If key + "Return the first cons in alist whose cdr satisfies the Predicate. If key is supplied, apply it to the cdr of each cons before testing." (if key (assoc-guts (funcall predicate (funcall key (cdar alist)))) @@ -941,7 +942,7 @@ (defun rassoc-if-not (predicate alist &key key) #!+sb-doc - "Returns the first cons in alist whose cdr does not satisfy the Predicate. + "Return the first cons in alist whose cdr does not satisfy the Predicate. If key is supplied, apply it to the cdr of each cons before testing." (if key (assoc-guts (not (funcall predicate (funcall key (cdar alist))))) diff --git a/src/code/load.lisp b/src/code/load.lisp index 2a2559b..e68ff75 100644 --- a/src/code/load.lisp +++ b/src/code/load.lisp @@ -255,9 +255,6 @@ (or (check-version "native code" +backend-fasl-file-implementation+ +fasl-file-version+) - (check-version "byte code" - (backend-byte-fasl-file-implementation) - +fasl-file-version+) (error "~S was compiled for implementation ~A, but this is a ~A." stream implementation diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp index aa7304a..8e7e6ed 100644 --- a/src/code/numbers.lisp +++ b/src/code/numbers.lisp @@ -209,7 +209,7 @@ (defun upgraded-complex-part-type (spec) #!+sb-doc - "Returns the element type of the most specialized COMPLEX number type that + "Return the element type of the most specialized COMPLEX number type that can hold parts of type SPEC." (cond ((unknown-type-p (specifier-type spec)) (error "undefined type: ~S" spec)) @@ -285,7 +285,7 @@ (defun conjugate (number) #!+sb-doc - "Returns the complex conjugate of NUMBER. For non-complex numbers, this is + "Return the complex conjugate of NUMBER. For non-complex numbers, this is an identity." (if (complexp number) (complex (realpart number) (- (imagpart number))) @@ -323,9 +323,9 @@ (res (car args) (,op res (car args)))) ((null args) res)))))) (define-arith + 0 - "Returns the sum of its arguments. With no args, returns 0.") + "Return the sum of its arguments. With no args, returns 0.") (define-arith * 1 - "Returns the product of its arguments. With no args, returns 1.")) + "Return the product of its arguments. With no args, returns 1.")) (defun - (number &rest more-numbers) #!+sb-doc @@ -353,12 +353,12 @@ (defun 1+ (number) #!+sb-doc - "Returns NUMBER + 1." + "Return NUMBER + 1." (1+ number)) (defun 1- (number) #!+sb-doc - "Returns NUMBER - 1." + "Return NUMBER - 1." (1- number)) (eval-when (:compile-toplevel) @@ -556,7 +556,7 @@ (defun truncate (number &optional (divisor 1)) #!+sb-doc - "Returns number (or number/divisor) as an integer, rounded toward 0. + "Return number (or number/divisor) as an integer, rounded toward 0. The second returned value is the remainder." (macrolet ((truncate-float (rtype) `(let* ((float-div (coerce divisor ',rtype)) @@ -612,7 +612,7 @@ (defun floor (number &optional (divisor 1)) #!+sb-doc - "Returns the greatest integer not greater than number, or number/divisor. + "Return the greatest integer not greater than number, or number/divisor. The second returned value is (mod number divisor)." ;; If the numbers do not divide exactly and the result of ;; (/ NUMBER DIVISOR) would be negative then decrement the quotient @@ -627,7 +627,7 @@ (defun ceiling (number &optional (divisor 1)) #!+sb-doc - "Returns the smallest integer not less than number, or number/divisor. + "Return the smallest integer not less than number, or number/divisor. The second returned value is the remainder." ;; If the numbers do not divide exactly and the result of ;; (/ NUMBER DIVISOR) would be positive then increment the quotient @@ -663,14 +663,14 @@ (defun rem (number divisor) #!+sb-doc - "Returns second result of TRUNCATE." + "Return second result of TRUNCATE." (multiple-value-bind (tru rem) (truncate number divisor) (declare (ignore tru)) rem)) (defun mod (number divisor) #!+sb-doc - "Returns second result of FLOOR." + "Return second result of FLOOR." (let ((rem (rem number divisor))) (if (and (not (zerop rem)) (if (minusp divisor) @@ -697,7 +697,7 @@ (defun = (number &rest more-numbers) #!+sb-doc - "Returns T if all of its arguments are numerically equal, NIL otherwise." + "Return T if all of its arguments are numerically equal, NIL otherwise." (do ((nlist more-numbers (cdr nlist))) ((atom nlist) T) (declare (list nlist)) @@ -705,7 +705,7 @@ (defun /= (number &rest more-numbers) #!+sb-doc - "Returns T if no two of its arguments are numerically equal, NIL otherwise." + "Return T if no two of its arguments are numerically equal, NIL otherwise." (do* ((head number (car nlist)) (nlist more-numbers (cdr nlist))) ((atom nlist) t) @@ -718,7 +718,7 @@ (defun < (number &rest more-numbers) #!+sb-doc - "Returns T if its arguments are in strictly increasing order, NIL otherwise." + "Return T if its arguments are in strictly increasing order, NIL otherwise." (do* ((n number (car nlist)) (nlist more-numbers (cdr nlist))) ((atom nlist) t) @@ -727,7 +727,7 @@ (defun > (number &rest more-numbers) #!+sb-doc - "Returns T if its arguments are in strictly decreasing order, NIL otherwise." + "Return T if its arguments are in strictly decreasing order, NIL otherwise." (do* ((n number (car nlist)) (nlist more-numbers (cdr nlist))) ((atom nlist) t) @@ -736,7 +736,7 @@ (defun <= (number &rest more-numbers) #!+sb-doc - "Returns T if arguments are in strictly non-decreasing order, NIL otherwise." + "Return T if arguments are in strictly non-decreasing order, NIL otherwise." (do* ((n number (car nlist)) (nlist more-numbers (cdr nlist))) ((atom nlist) t) @@ -745,7 +745,7 @@ (defun >= (number &rest more-numbers) #!+sb-doc - "Returns T if arguments are in strictly non-increasing order, NIL otherwise." + "Return T if arguments are in strictly non-increasing order, NIL otherwise." (do* ((n number (car nlist)) (nlist more-numbers (cdr nlist))) ((atom nlist) t) @@ -754,7 +754,7 @@ (defun max (number &rest more-numbers) #!+sb-doc - "Returns the greatest of its arguments." + "Return the greatest of its arguments." (do ((nlist more-numbers (cdr nlist)) (result number)) ((null nlist) (return result)) @@ -763,7 +763,7 @@ (defun min (number &rest more-numbers) #!+sb-doc - "Returns the least of its arguments." + "Return the least of its arguments." (do ((nlist more-numbers (cdr nlist)) (result number)) ((null nlist) (return result)) @@ -907,7 +907,7 @@ (defun logior (&rest integers) #!+sb-doc - "Returns the bit-wise or of its arguments. Args must be integers." + "Return the bit-wise or of its arguments. Args must be integers." (declare (list integers)) (if integers (do ((result (pop integers) (logior result (pop integers)))) @@ -916,7 +916,7 @@ (defun logxor (&rest integers) #!+sb-doc - "Returns the bit-wise exclusive or of its arguments. Args must be integers." + "Return the bit-wise exclusive or of its arguments. Args must be integers." (declare (list integers)) (if integers (do ((result (pop integers) (logxor result (pop integers)))) @@ -925,7 +925,7 @@ (defun logand (&rest integers) #!+sb-doc - "Returns the bit-wise and of its arguments. Args must be integers." + "Return the bit-wise and of its arguments. Args must be integers." (declare (list integers)) (if integers (do ((result (pop integers) (logand result (pop integers)))) @@ -934,7 +934,7 @@ (defun logeqv (&rest integers) #!+sb-doc - "Returns the bit-wise equivalence of its arguments. Args must be integers." + "Return the bit-wise equivalence of its arguments. Args must be integers." (declare (list integers)) (if integers (do ((result (pop integers) (logeqv result (pop integers)))) @@ -943,37 +943,37 @@ (defun lognand (integer1 integer2) #!+sb-doc - "Returns the complement of the logical AND of integer1 and integer2." + "Return the complement of the logical AND of integer1 and integer2." (lognand integer1 integer2)) (defun lognor (integer1 integer2) #!+sb-doc - "Returns the complement of the logical OR of integer1 and integer2." + "Return the complement of the logical OR of integer1 and integer2." (lognor integer1 integer2)) (defun logandc1 (integer1 integer2) #!+sb-doc - "Returns the logical AND of (LOGNOT integer1) and integer2." + "Return the logical AND of (LOGNOT integer1) and integer2." (logandc1 integer1 integer2)) (defun logandc2 (integer1 integer2) #!+sb-doc - "Returns the logical AND of integer1 and (LOGNOT integer2)." + "Return the logical AND of integer1 and (LOGNOT integer2)." (logandc2 integer1 integer2)) (defun logorc1 (integer1 integer2) #!+sb-doc - "Returns the logical OR of (LOGNOT integer1) and integer2." + "Return the logical OR of (LOGNOT integer1) and integer2." (logorc1 integer1 integer2)) (defun logorc2 (integer1 integer2) #!+sb-doc - "Returns the logical OR of integer1 and (LOGNOT integer2)." + "Return the logical OR of integer1 and (LOGNOT integer2)." (logorc2 integer1 integer2)) (defun lognot (number) #!+sb-doc - "Returns the bit-wise logical not of integer." + "Return the bit-wise logical not of integer." (etypecase number (fixnum (lognot (truly-the fixnum number))) (bignum (bignum-logical-not number)))) @@ -1040,7 +1040,7 @@ (defun integer-length (integer) #!+sb-doc - "Returns the number of significant bits in the absolute value of integer." + "Return the number of significant bits in the absolute value of integer." (etypecase integer (fixnum (integer-length (truly-the fixnum integer))) @@ -1051,17 +1051,18 @@ (defun byte (size position) #!+sb-doc - "Returns a byte specifier which may be used by other byte functions." + "Return a byte specifier which may be used by other byte functions + (e.g. LDB)." (byte size position)) (defun byte-size (bytespec) #!+sb-doc - "Returns the size part of the byte specifier bytespec." + "Return the size part of the byte specifier bytespec." (byte-size bytespec)) (defun byte-position (bytespec) #!+sb-doc - "Returns the position part of the byte specifier bytespec." + "Return the position part of the byte specifier bytespec." (byte-position bytespec)) (defun ldb (bytespec integer) @@ -1071,7 +1072,7 @@ (defun ldb-test (bytespec integer) #!+sb-doc - "Returns T if any of the specified bits in integer are 1's." + "Return T if any of the specified bits in integer are 1's." (ldb-test bytespec integer)) (defun mask-field (bytespec integer) @@ -1081,12 +1082,12 @@ (defun dpb (newbyte bytespec integer) #!+sb-doc - "Returns new integer with newbyte in specified position, newbyte is right justified." + "Return new integer with newbyte in specified position, newbyte is right justified." (dpb newbyte bytespec integer)) (defun deposit-field (newbyte bytespec integer) #!+sb-doc - "Returns new integer with newbyte in specified position, newbyte is not right justified." + "Return new integer with newbyte in specified position, newbyte is not right justified." (deposit-field newbyte bytespec integer)) (defun %ldb (size posn integer) @@ -1219,7 +1220,7 @@ (defun gcd (&rest numbers) #!+sb-doc - "Returns the greatest common divisor of the arguments, which must be + "Return the greatest common divisor of the arguments, which must be integers. Gcd with no arguments is defined to be 0." (cond ((null numbers) 0) ((null (cdr numbers)) (abs (the integer (car numbers)))) @@ -1233,7 +1234,7 @@ (defun lcm (&rest numbers) #!+sb-doc - "Returns the least common multiple of one or more integers. LCM of no + "Return the least common multiple of one or more integers. LCM of no arguments is defined to be 1." (cond ((null numbers) 1) ((null (cdr numbers)) (abs (the integer (car numbers)))) @@ -1291,7 +1292,7 @@ ;;; From discussion on comp.lang.lisp and Akira Kurihara. (defun isqrt (n) #!+sb-doc - "Returns the root of the nearest integer less than n which is a perfect + "Return the root of the nearest integer less than n which is a perfect square." (declare (type unsigned-byte n) (values unsigned-byte)) ;; Theoretically (> n 7), i.e., n-len-quarter > 0. @@ -1316,8 +1317,8 @@ (macrolet ((def-frob (name doc) `(defun ,name (number) ,doc (,name number)))) - (def-frob zerop "Returns T if number = 0, NIL otherwise.") - (def-frob plusp "Returns T if number > 0, NIL otherwise.") - (def-frob minusp "Returns T if number < 0, NIL otherwise.") - (def-frob oddp "Returns T if number is odd, NIL otherwise.") - (def-frob evenp "Returns T if number is even, NIL otherwise.")) + (def-frob zerop "Is this number zero?") + (def-frob plusp "Is this real number strictly positive?") + (def-frob minusp "Is this real number strictly negative?") + (def-frob oddp "Is this integer odd?") + (def-frob evenp "Is this integer even?")) diff --git a/src/code/pred.lisp b/src/code/pred.lisp index 1ce49e1..79944d2 100644 --- a/src/code/pred.lisp +++ b/src/code/pred.lisp @@ -147,7 +147,7 @@ (defun equal (x y) #!+sb-doc - "Returns T if X and Y are EQL or if they are structured components + "Return T if X and Y are EQL or if they are structured components whose elements are EQUAL. Strings and bit-vectors are EQUAL if they are the same length and have identical components. Other arrays must be EQ to be EQUAL." diff --git a/src/code/print.lisp b/src/code/print.lisp index cb53bcc..b0ae43d 100644 --- a/src/code/print.lisp +++ b/src/code/print.lisp @@ -1552,15 +1552,12 @@ (defun output-function (object stream) (let* ((*print-length* 3) ; in case we have to.. (*print-level* 3) ; ..print an interpreted function definition - (name (cond ((find (function-subtype object) - #(#.sb!vm:closure-header-type - #.sb!vm:byte-code-closure-type)) - "CLOSURE") - ((find (function-subtype object) - #(#.sb!vm:function-header-type - #.sb!vm:closure-function-header-type)) - (%function-name object)) - (t 'no-name-available))) + ;; FIXME: This find-the-function-name idiom ought to be + ;; pulled out in a function somewhere. + (name (case (function-subtype object) + (#.sb!vm:closure-header-type "CLOSURE") + (#.sb!vm:function-header-type (%function-name object)) + (t 'no-name-available))) (identified-by-name-p (and (symbolp name) (fboundp name) (eq (fdefinition name) object)))) diff --git a/src/code/reader.lisp b/src/code/reader.lisp index 77a9555..51df957 100644 --- a/src/code/reader.lisp +++ b/src/code/reader.lisp @@ -205,7 +205,7 @@ (defun get-macro-character (char &optional (rt *readtable*)) #!+sb-doc - "Returns the function associated with the specified char which is a macro + "Return the function associated with the specified char which is a macro character. The optional readtable argument defaults to the current readtable." (let ((rt (or rt *standard-readtable*))) @@ -1302,7 +1302,7 @@ (defun get-dispatch-macro-character (disp-char sub-char &optional (rt *readtable*)) #!+sb-doc - "Returns the macro character function for sub-char under disp-char + "Return the macro character function for sub-char under disp-char or nil if there is no associated function." (unless (digit-char-p sub-char) (let* ((sub-char (char-upcase sub-char)) diff --git a/src/code/seq.lisp b/src/code/seq.lisp index edcd08c..4d5b1ca 100644 --- a/src/code/seq.lisp +++ b/src/code/seq.lisp @@ -35,11 +35,11 @@ (sb!xc:defmacro make-sequence-like (sequence length) #!+sb-doc - "Returns a sequence of the same type as SEQUENCE and the given LENGTH." + "Return a sequence of the same type as SEQUENCE and the given LENGTH." `(make-sequence-of-type (type-of ,sequence) ,length)) (sb!xc:defmacro type-specifier-atom (type) - #!+sb-doc "Returns the broad class of which TYPE is a specific subclass." + #!+sb-doc "Return the broad class of which TYPE is a specific subclass." `(if (atom ,type) ,type (car ,type))) ) ; EVAL-WHEN @@ -107,7 +107,7 @@ '(integer (0) (0)))))) (defun make-sequence-of-type (type length) - #!+sb-doc "Returns a sequence of the given TYPE and LENGTH." + #!+sb-doc "Return a sequence of the given TYPE and LENGTH." (declare (fixnum length)) (case (type-specifier-atom type) (list (make-list length)) @@ -123,7 +123,7 @@ (make-sequence-of-type (result-type-or-lose type) length)))) (defun elt (sequence index) - #!+sb-doc "Returns the element of SEQUENCE specified by INDEX." + #!+sb-doc "Return the element of SEQUENCE specified by INDEX." (etypecase sequence (list (do ((count index (1- count)) @@ -246,7 +246,7 @@ ;;; routines for other reasons (see above). (defun subseq (sequence start &optional end) #!+sb-doc - "Returns a copy of a subsequence of SEQUENCE starting with element number + "Return a copy of a subsequence of SEQUENCE starting with element number START and continuing to the end of SEQUENCE or the optional END." (seq-dispatch sequence (list-subseq* sequence start end) @@ -278,7 +278,7 @@ ) ; EVAL-WHEN (defun copy-seq (sequence) - #!+sb-doc "Returns a copy of SEQUENCE which is EQUAL to SEQUENCE but not EQ." + #!+sb-doc "Return a copy of SEQUENCE which is EQUAL to SEQUENCE but not EQ." (seq-dispatch sequence (list-copy-seq* sequence) (vector-copy-seq* sequence))) @@ -487,7 +487,7 @@ (defun reverse (sequence) #!+sb-doc - "Returns a new sequence containing the same elements but in reverse order." + "Return a new sequence containing the same elements but in reverse order." (seq-dispatch sequence (list-reverse* sequence) (vector-reverse* sequence))) @@ -532,7 +532,7 @@ (defun nreverse (sequence) #!+sb-doc - "Returns a sequence of the same elements in reverse order; the argument + "Return a sequence of the same elements in reverse order; the argument is destroyed." (seq-dispatch sequence (list-nreverse* sequence) @@ -599,7 +599,7 @@ ;;; efficiency, but space efficiency..) (defun concatenate (output-type-spec &rest sequences) #!+sb-doc - "Returns a new sequence of all the argument sequences concatenated together + "Return a new sequence of all the argument sequences concatenated together which shares no structure with the original argument sequences of the specified OUTPUT-TYPE-SPEC." (case (type-specifier-atom output-type-spec) @@ -1122,8 +1122,8 @@ (defun delete (item sequence &key from-end (test #'eql) test-not (start 0) end count key) #!+sb-doc - "Returns a sequence formed by destructively removing the specified Item from - the given Sequence." + "Return a sequence formed by destructively removing the specified ITEM from + the given SEQUENCE." (declare (fixnum start)) (let* ((length (length sequence)) (end (or end length)) @@ -1160,8 +1160,8 @@ (defun delete-if (predicate sequence &key from-end (start 0) key end count) #!+sb-doc - "Returns a sequence formed by destructively removing the elements satisfying - the specified Predicate from the given Sequence." + "Return a sequence formed by destructively removing the elements satisfying + the specified PREDICATE from the given SEQUENCE." (declare (fixnum start)) (let* ((length (length sequence)) (end (or end length)) @@ -1198,8 +1198,8 @@ (defun delete-if-not (predicate sequence &key from-end (start 0) end key count) #!+sb-doc - "Returns a sequence formed by destructively removing the elements not - satisfying the specified Predicate from the given Sequence." + "Return a sequence formed by destructively removing the elements not + satisfying the specified PREDICATE from the given SEQUENCE." (declare (fixnum start)) (let* ((length (length sequence)) (end (or end length)) @@ -1345,7 +1345,7 @@ (defun remove (item sequence &key from-end (test #'eql) test-not (start 0) end count key) #!+sb-doc - "Returns a copy of SEQUENCE with elements satisfying the test (default is + "Return a copy of SEQUENCE with elements satisfying the test (default is EQL) with ITEM removed." (declare (fixnum start)) (let* ((length (length sequence)) @@ -1363,8 +1363,8 @@ (defun remove-if (predicate sequence &key from-end (start 0) end count key) #!+sb-doc - "Returns a copy of sequence with elements such that predicate(element) - is non-null are removed" + "Return a copy of sequence with elements such that predicate(element) + is non-null removed" (declare (fixnum start)) (let* ((length (length sequence)) (end (or end length)) @@ -1381,8 +1381,8 @@ (defun remove-if-not (predicate sequence &key from-end (start 0) end count key) #!+sb-doc - "Returns a copy of sequence with elements such that predicate(element) - is null are removed" + "Return a copy of sequence with elements such that predicate(element) + is null removed" (declare (fixnum start)) (let* ((length (length sequence)) (end (or end length)) @@ -1668,8 +1668,8 @@ (defun substitute (new old sequence &key from-end (test #'eql) test-not (start 0) count end key) #!+sb-doc - "Returns a sequence of the same kind as Sequence with the same elements - except that all elements equal to Old are replaced with New. See manual + "Return a sequence of the same kind as SEQUENCE with the same elements, + except that all elements equal to OLD are replaced with NEW. See manual for details." (declare (fixnum start)) (let* ((length (length sequence)) @@ -1683,8 +1683,8 @@ (defun substitute-if (new test sequence &key from-end (start 0) end count key) #!+sb-doc - "Returns a sequence of the same kind as Sequence with the same elements - except that all elements satisfying the Test are replaced with New. See + "Return a sequence of the same kind as SEQUENCE with the same elements + except that all elements satisfying the TEST are replaced with NEW. See manual for details." (declare (fixnum start)) (let* ((length (length sequence)) @@ -1699,8 +1699,8 @@ (defun substitute-if-not (new test sequence &key from-end (start 0) end count key) #!+sb-doc - "Returns a sequence of the same kind as Sequence with the same elements - except that all elements not satisfying the Test are replaced with New. + "Return a sequence of the same kind as SEQUENCE with the same elements + except that all elements not satisfying the TEST are replaced with NEW. See manual for details." (declare (fixnum start)) (let* ((length (length sequence)) @@ -1717,9 +1717,9 @@ (defun nsubstitute (new old sequence &key from-end (test #'eql) test-not end count key (start 0)) #!+sb-doc - "Returns a sequence of the same kind as Sequence with the same elements - except that all elements equal to Old are replaced with New. The Sequence - may be destroyed. See manual for details." + "Return a sequence of the same kind as SEQUENCE with the same elements + except that all elements equal to OLD are replaced with NEW. The SEQUENCE + may be destructively modified. See manual for details." (declare (fixnum start)) (let ((end (or end (length sequence))) (count (or count most-positive-fixnum))) @@ -1767,9 +1767,9 @@ (defun nsubstitute-if (new test sequence &key from-end (start 0) end count key) #!+sb-doc - "Returns a sequence of the same kind as Sequence with the same elements - except that all elements satisfying the Test are replaced with New. The - Sequence may be destroyed. See manual for details." + "Return a sequence of the same kind as SEQUENCE with the same elements + except that all elements satisfying the TEST are replaced with NEW. + SEQUENCE may be destructively modified. See manual for details." (declare (fixnum start)) (let ((end (or end (length sequence))) (count (or count most-positive-fixnum))) @@ -1807,9 +1807,9 @@ (defun nsubstitute-if-not (new test sequence &key from-end (start 0) end count key) #!+sb-doc - "Returns a sequence of the same kind as Sequence with the same elements - except that all elements not satisfying the Test are replaced with New. - The Sequence may be destroyed. See manual for details." + "Return a sequence of the same kind as SEQUENCE with the same elements + except that all elements not satisfying the TEST are replaced with NEW. + SEQUENCE may be destructively modified. See manual for details." (declare (fixnum start)) (let ((end (or end (length sequence))) (count (or count most-positive-fixnum))) @@ -2019,7 +2019,7 @@ (defun count (item sequence &key from-end (test #'eql) test-not (start 0) end key) #!+sb-doc - "Returns the number of elements in SEQUENCE satisfying a test with ITEM, + "Return the number of elements in SEQUENCE satisfying a test with ITEM, which defaults to EQL." (declare (ignore from-end) (fixnum start)) (let ((end (or end (length sequence)))) @@ -2053,7 +2053,7 @@ (defun count-if (test sequence &key from-end (start 0) end key) #!+sb-doc - "Returns the number of elements in SEQUENCE satisfying TEST(el)." + "Return the number of elements in SEQUENCE satisfying TEST(el)." (declare (ignore from-end) (fixnum start)) (let ((end (or end (length sequence)))) (declare (type index end)) @@ -2084,7 +2084,7 @@ (defun count-if-not (test sequence &key from-end (start 0) end key) #!+sb-doc - "Returns the number of elements in SEQUENCE not satisfying TEST(el)." + "Return the number of elements in SEQUENCE not satisfying TEST(el)." (declare (ignore from-end) (fixnum start)) (let ((end (or end (length sequence)))) (declare (type index end)) diff --git a/src/code/stream.lisp b/src/code/stream.lisp index 244425d..a433a65 100644 --- a/src/code/stream.lisp +++ b/src/code/stream.lisp @@ -923,13 +923,13 @@ #!-high-security-support (setf (fdocumentation 'make-concatenated-stream 'function) - "Returns a stream which takes its input from each of the Streams in turn, + "Return a stream which takes its input from each of the Streams in turn, going on to the next at EOF.") #!+high-security-support (defun make-concatenated-stream (&rest streams) #!+sb-doc - "Returns a stream which takes its input from each of the Streams in turn, + "Return a stream which takes its input from each of the Streams in turn, going on to the next at EOF." (dolist (stream streams) (unless (or (and (synonym-stream-p stream) @@ -1066,8 +1066,8 @@ #!+sb-doc (setf (fdocumentation 'make-echo-stream 'function) - "Returns a bidirectional stream which gets its input from Input-Stream and - sends its output to Output-Stream. In addition, all input is echoed to + "Return a bidirectional stream which gets its input from INPUT-STREAM and + sends its output to OUTPUT-STREAM. In addition, all input is echoed to the output stream") ;;;; string input streams @@ -1147,8 +1147,8 @@ (defun make-string-input-stream (string &optional (start 0) (end (length string))) #!+sb-doc - "Returns an input stream which will supply the characters of String between - Start and End in order." + "Return an input stream which will supply the characters of STRING between + START and END in order." (declare (type string string) (type index start) (type (or index null) end)) @@ -1178,8 +1178,8 @@ #!+sb-doc (setf (fdocumentation 'make-string-output-stream 'function) - "Returns an Output stream which will accumulate all output given it for - the benefit of the function Get-Output-Stream-String.") + "Return an output stream which will accumulate all output given it for + the benefit of the function GET-OUTPUT-STREAM-STRING.") (defun string-ouch (stream character) (let ((current (string-output-stream-index stream)) @@ -1352,7 +1352,7 @@ #!+sb-doc (setf (fdocumentation 'make-indenting-stream 'function) - "Returns an output stream which indents its output by some amount.") + "Return an output stream which indents its output by some amount.") ;;; INDENTING-INDENT writes the correct number of spaces needed to indent ;;; output on the given STREAM based on the specified SUB-STREAM. @@ -1433,7 +1433,7 @@ (defun make-case-frob-stream (target kind) #!+sb-doc - "Returns a stream that sends all output to the stream TARGET, but modifies + "Return a stream that sends all output to the stream TARGET, but modifies the case of letters, depending on KIND, which should be one of: :upcase - convert to upper case. :downcase - convert to lower case. diff --git a/src/code/symbol.lisp b/src/code/symbol.lisp index 5d904e0..5182924 100644 --- a/src/code/symbol.lisp +++ b/src/code/symbol.lisp @@ -204,7 +204,7 @@ (defun keywordp (object) #!+sb-doc - "Returns true if Object is a symbol in the keyword package." + "Return true if Object is a symbol in the \"KEYWORD\" package." (and (symbolp object) (eq (symbol-package object) *keyword-package*))) diff --git a/src/code/target-char.lisp b/src/code/target-char.lisp index f8aef32..0437cc3 100644 --- a/src/code/target-char.lisp +++ b/src/code/target-char.lisp @@ -82,19 +82,19 @@ (defun char-code (char) #!+sb-doc - "Returns the integer code of CHAR." + "Return the integer code of CHAR." (etypecase char (base-char (char-code (truly-the base-char char))))) (defun char-int (char) #!+sb-doc - "Returns the integer code of CHAR. This is the same as char-code, as + "Return the integer code of CHAR. This is the same as char-code, as CMU Common Lisp does not implement character bits or fonts." (char-code char)) (defun code-char (code) #!+sb-doc - "Returns the character with the code CODE." + "Return the character with the code CODE." (declare (type char-code code)) (code-char code)) @@ -235,14 +235,14 @@ (defun char= (character &rest more-characters) #!+sb-doc - "Returns T if all of its arguments are the same character." + "Return T if all of the arguments are the same character." (do ((clist more-characters (cdr clist))) ((atom clist) T) (unless (eq (car clist) character) (return nil)))) (defun char/= (character &rest more-characters) #!+sb-doc - "Returns T if no two of its arguments are the same character." + "Return T if no two of the arguments are the same character." (do* ((head character (car list)) (list more-characters (cdr list))) ((atom list) T) @@ -253,7 +253,7 @@ (defun char< (character &rest more-characters) #!+sb-doc - "Returns T if its arguments are in strictly increasing alphabetic order." + "Return T if the arguments are in strictly increasing alphabetic order." (do* ((c character (car list)) (list more-characters (cdr list))) ((atom list) T) @@ -263,7 +263,7 @@ (defun char> (character &rest more-characters) #!+sb-doc - "Returns T if its arguments are in strictly decreasing alphabetic order." + "Return T if the arguments are in strictly decreasing alphabetic order." (do* ((c character (car list)) (list more-characters (cdr list))) ((atom list) T) @@ -273,7 +273,7 @@ (defun char<= (character &rest more-characters) #!+sb-doc - "Returns T if its arguments are in strictly non-decreasing alphabetic order." + "Return T if the arguments are in strictly non-decreasing alphabetic order." (do* ((c character (car list)) (list more-characters (cdr list))) ((atom list) T) @@ -283,7 +283,7 @@ (defun char>= (character &rest more-characters) #!+sb-doc - "Returns T if its arguments are in strictly non-increasing alphabetic order." + "Return T if the arguments are in strictly non-increasing alphabetic order." (do* ((c character (car list)) (list more-characters (cdr list))) ((atom list) T) @@ -300,7 +300,7 @@ (defun char-equal (character &rest more-characters) #!+sb-doc - "Returns T if all of its arguments are the same character. + "Return T if all of the arguments are the same character. Font, bits, and case are ignored." (do ((clist more-characters (cdr clist))) ((atom clist) T) @@ -310,7 +310,7 @@ (defun char-not-equal (character &rest more-characters) #!+sb-doc - "Returns T if no two of its arguments are the same character. + "Return T if no two of the arguments are the same character. Font, bits, and case are ignored." (do* ((head character (car list)) (list more-characters (cdr list))) @@ -324,7 +324,7 @@ (defun char-lessp (character &rest more-characters) #!+sb-doc - "Returns T if its arguments are in strictly increasing alphabetic order. + "Return T if the arguments are in strictly increasing alphabetic order. Font, bits, and case are ignored." (do* ((c character (car list)) (list more-characters (cdr list))) @@ -335,7 +335,7 @@ (defun char-greaterp (character &rest more-characters) #!+sb-doc - "Returns T if its arguments are in strictly decreasing alphabetic order. + "Return T if the arguments are in strictly decreasing alphabetic order. Font, bits, and case are ignored." (do* ((c character (car list)) (list more-characters (cdr list))) @@ -346,7 +346,7 @@ (defun char-not-greaterp (character &rest more-characters) #!+sb-doc - "Returns T if its arguments are in strictly non-decreasing alphabetic order. + "Return T if the arguments are in strictly non-decreasing alphabetic order. Font, bits, and case are ignored." (do* ((c character (car list)) (list more-characters (cdr list))) @@ -357,7 +357,7 @@ (defun char-not-lessp (character &rest more-characters) #!+sb-doc - "Returns T if its arguments are in strictly non-increasing alphabetic order. + "Return T if the arguments are in strictly non-increasing alphabetic order. Font, bits, and case are ignored." (do* ((c character (car list)) (list more-characters (cdr list))) @@ -370,7 +370,7 @@ (defun char-upcase (char) #!+sb-doc - "Returns CHAR converted to upper-case if that is possible." + "Return CHAR converted to upper-case if that is possible." (declare (character char)) (if (lower-case-p char) (code-char (- (char-code char) 32)) @@ -378,7 +378,7 @@ (defun char-downcase (char) #!+sb-doc - "Returns CHAR converted to lower-case if that is possible." + "Return CHAR converted to lower-case if that is possible." (declare (character char)) (if (upper-case-p char) (code-char (+ (char-code char) 32)) diff --git a/src/code/target-error.lisp b/src/code/target-error.lisp index 4c1ea5c..6f576f7 100644 --- a/src/code/target-error.lisp +++ b/src/code/target-error.lisp @@ -56,7 +56,7 @@ #!+sb-doc (setf (fdocumentation 'restart-name 'function) - "Returns the name of the given restart object.") + "Return the name of the given restart object.") (defun restart-report (restart stream) (funcall (or (restart-report-function restart) @@ -107,7 +107,7 @@ (defun find-restart (name &optional condition) #!+sb-doc - "Returns the first restart named name. If name is a restart, it is returned + "Return the first restart named name. If name is a restart, it is returned if it is currently active. If no such restart is found, nil is returned. It is an error to supply nil as a name. If Condition is specified and not NIL, then only restarts associated with that condition (or with no diff --git a/src/code/target-hash-table.lisp b/src/code/target-hash-table.lisp index 4bfa055..02f354e 100644 --- a/src/code/target-hash-table.lisp +++ b/src/code/target-hash-table.lisp @@ -179,7 +179,7 @@ (defun hash-table-count (hash-table) #!+sb-doc - "Returns the number of entries in the given HASH-TABLE." + "Return the number of entries in the given HASH-TABLE." (declare (type hash-table hash-table) (values index)) (hash-table-number-entries hash-table)) diff --git a/src/code/target-misc.lisp b/src/code/target-misc.lisp index 5ea1f53..00615ac 100644 --- a/src/code/target-misc.lisp +++ b/src/code/target-misc.lisp @@ -53,11 +53,11 @@ #!+sb-doc "the value of LONG-SITE-NAME") (defun short-site-name () #!+sb-doc - "Returns a string with the abbreviated site name, or NIL if not known." + "Return a string with the abbreviated site name, or NIL if not known." *short-site-name*) (defun long-site-name () #!+sb-doc - "Returns a string with the long form of the site name, or NIL if not known." + "Return a string with the long form of the site name, or NIL if not known." *long-site-name*) ;;;; dribble stuff diff --git a/src/code/target-package.lisp b/src/code/target-package.lisp index 40a9576..7201b7a 100644 --- a/src/code/target-package.lisp +++ b/src/code/target-package.lisp @@ -425,7 +425,7 @@ (defun list-all-packages () #!+sb-doc - "Returns a list of all existing packages." + "Return a list of all existing packages." (let ((res ())) (maphash #'(lambda (k v) (declare (ignore k)) @@ -435,7 +435,7 @@ (defun intern (name &optional (package (sane-package))) #!+sb-doc - "Returns a symbol having the specified name, creating it if necessary." + "Return a symbol having the specified name, creating it if necessary." ;; We just simple-stringify the name and call INTERN*, where the real ;; logic is. (let ((name (if (simple-string-p name) @@ -448,7 +448,7 @@ (defun find-symbol (name &optional (package (sane-package))) #!+sb-doc - "Returns the symbol named String in Package. If such a symbol is found + "Return the symbol named String in Package. If such a symbol is found then the second value is :internal, :external or :inherited to indicate how the symbol is accessible. If no symbol is found then both values are NIL." diff --git a/src/code/target-pathname.lisp b/src/code/target-pathname.lisp index c594357..25cf000 100644 --- a/src/code/target-pathname.lisp +++ b/src/code/target-pathname.lisp @@ -756,7 +756,7 @@ a host-structure or string." (defun host-namestring (pathname) #!+sb-doc - "Returns a string representation of the name of the host in the pathname." + "Return a string representation of the name of the host in the pathname." (declare (type pathname-designator pathname) (values (or null simple-base-string))) (with-pathname (pathname pathname) @@ -769,7 +769,7 @@ a host-structure or string." (defun directory-namestring (pathname) #!+sb-doc - "Returns a string representation of the directories used in the pathname." + "Return a string representation of the directories used in the pathname." (declare (type pathname-designator pathname) (values (or null simple-base-string))) (with-pathname (pathname pathname) @@ -782,7 +782,7 @@ a host-structure or string." (defun file-namestring (pathname) #!+sb-doc - "Returns a string representation of the name used in the pathname." + "Return a string representation of the name used in the pathname." (declare (type pathname-designator pathname) (values (or null simple-base-string))) (with-pathname (pathname pathname) @@ -797,7 +797,7 @@ a host-structure or string." &optional (defaults *default-pathname-defaults*)) #!+sb-doc - "Returns an abbreviated pathname sufficent to identify the pathname relative + "Return an abbreviated pathname sufficent to identify the pathname relative to the defaults." (declare (type pathname-designator pathname)) (with-pathname (pathname pathname) diff --git a/src/code/time.lisp b/src/code/time.lisp index ac20fce..1b4e823 100644 --- a/src/code/time.lisp +++ b/src/code/time.lisp @@ -102,7 +102,7 @@ (defun get-universal-time () #!+sb-doc - "Returns a single integer for the current time of + "Return a single integer for the current time of day in universal time format." (multiple-value-bind (res secs) (sb!unix:unix-gettimeofday) (declare (ignore res)) @@ -110,7 +110,7 @@ (defun get-decoded-time () #!+sb-doc - "Returns nine values specifying the current time as follows: + "Return nine values specifying the current time as follows: second, minute, hour, date, month, year, day of week (0 = Monday), T (daylight savings times) or NIL (standard time), and timezone." (decode-universal-time (get-universal-time))) diff --git a/src/code/x86-vm.lisp b/src/code/x86-vm.lisp index e6fd45f..dccf051 100644 --- a/src/code/x86-vm.lisp +++ b/src/code/x86-vm.lisp @@ -38,12 +38,12 @@ (defun machine-type () #!+sb-doc - "Returns a string describing the type of the local machine." + "Return a string describing the type of the local machine." "X86") (defun machine-version () #!+sb-doc - "Returns a string describing the version of the local machine." + "Return a string describing the version of the local machine." "X86") ;;;; :CODE-OBJECT fixups diff --git a/src/compiler/alpha/type-vops.lisp b/src/compiler/alpha/type-vops.lisp index 15288b9..887cc23 100644 --- a/src/compiler/alpha/type-vops.lisp +++ b/src/compiler/alpha/type-vops.lisp @@ -15,13 +15,13 @@ (eval-when (:compile-toplevel :execute) -(defparameter immediate-types +(defparameter *immediate-types* (list unbound-marker-type base-char-type)) -(defparameter function-header-types +(defparameter *function-header-types* (list funcallable-instance-header-type - byte-code-function-type byte-code-closure-type - function-header-type closure-function-header-type + function-header-type + closure-function-header-type closure-header-type)) (defun canonicalize-headers (headers) @@ -56,10 +56,10 @@ t)) (lowtags (remove lowtag-limit type-codes :test #'<)) (extended (remove lowtag-limit type-codes :test #'>)) - (immediates (intersection extended immediate-types :test #'eql)) - (headers (set-difference extended immediate-types :test #'eql)) - (function-p (if (intersection headers function-header-types) - (if (subsetp headers function-header-types) + (immediates (intersection extended *immediate-types* :test #'eql)) + (headers (set-difference extended *immediate-types* :test #'eql)) + (function-p (if (intersection headers *function-header-types*) + (if (subsetp headers *function-header-types*) t (error "Can't test for mix of function subtypes ~ and normal header types.")) diff --git a/src/compiler/backend.lisp b/src/compiler/backend.lisp index 280ec4a..f68dffb 100644 --- a/src/compiler/backend.lisp +++ b/src/compiler/backend.lisp @@ -30,10 +30,7 @@ ;;; the byte order of the target machine. :BIG-ENDIAN has the MSB first (e.g. ;;; IBM RT), :LITTLE-ENDIAN has the MSB last (e.g. DEC VAX). -;;; -;;; KLUDGE: In a sort of pun, this is also used as the value of -;;; BACKEND-BYTE-FASL-FILE-IMPLEMENTATION. -- WHN 20000302 -(defvar *backend-byte-order* nil) +(defvar *backend-byte-order*) (declaim (type (member nil :little-endian :big-endian) *backend-byte-order*)) ;;; translation from SC numbers to SC info structures. SC numbers are always diff --git a/src/compiler/codegen.lisp b/src/compiler/codegen.lisp index 56952a2..8ca6eeb 100644 --- a/src/compiler/codegen.lisp +++ b/src/compiler/codegen.lisp @@ -16,25 +16,23 @@ ;;;; utilities used during code generation +;;; the number of bytes used by the code object header (defun component-header-length (&optional (component *component-being-compiled*)) - #!+sb-doc - "Returns the number of bytes used by the code object header." (let* ((2comp (component-info component)) (constants (ir2-component-constants 2comp)) (num-consts (length constants))) (ash (logandc2 (1+ num-consts) 1) sb!vm:word-shift))) +;;; the size of the NAME'd SB in the currently compiled component. +;;; This is useful mainly for finding the size for allocating stack +;;; frames. (defun sb-allocated-size (name) - #!+sb-doc - "The size of the Name'd SB in the currently compiled component. Useful - mainly for finding the size for allocating stack frames." (finite-sb-current-size (sb-or-lose name))) +;;; the TN that is used to hold the number stack frame-pointer in +;;; VOP's function, or NIL if no number stack frame was allocated (defun current-nfp-tn (vop) - #!+sb-doc - "Return the TN that is used to hold the number stack frame-pointer in VOP's - function. Returns NIL if no number stack frame was allocated." (unless (zerop (sb-allocated-size 'non-descriptor-stack)) (let ((block (ir2-block-block (vop-block vop)))) (when (ir2-environment-number-stack-p @@ -42,19 +40,17 @@ (block-environment block))) (ir2-component-nfp (component-info (block-component block))))))) +;;; the TN that is used to hold the number stack frame-pointer in the +;;; function designated by 2ENV, or NIL if no number stack frame was +;;; allocated (defun callee-nfp-tn (2env) - #!+sb-doc - "Return the TN that is used to hold the number stack frame-pointer in the - function designated by 2env. Returns NIL if no number stack frame was - allocated." (unless (zerop (sb-allocated-size 'non-descriptor-stack)) (when (ir2-environment-number-stack-p 2env) (ir2-component-nfp (component-info *component-being-compiled*))))) +;;; the TN used for passing the return PC in a local call to the function +;;; designated by 2ENV (defun callee-return-pc-tn (2env) - #!+sb-doc - "Return the TN used for passing the return PC in a local call to the function - designated by 2env." (ir2-environment-return-pc-pass 2env)) ;;;; specials used during code generation diff --git a/src/compiler/disassem.lisp b/src/compiler/disassem.lisp index 1eea045..66cdef2 100644 --- a/src/compiler/disassem.lisp +++ b/src/compiler/disassem.lisp @@ -1167,17 +1167,17 @@ (preprocess-conditionals sub-printer args)) printer))))) +;;; Return a version of the disassembly-template PRINTER with +;;; compile-time tests (e.g. :constant without a value), and any +;;; :CHOOSE operators resolved properly for the args ARGS. +;;; +;;; (:CHOOSE Sub*) simply returns the first Sub in which every field +;;; reference refers to a valid arg. (defun preprocess-printer (printer args) - #!+sb-doc - "Returns a version of the disassembly-template PRINTER with compile-time - tests (e.g. :constant without a value), and any :CHOOSE operators resolved - properly for the args ARGS. (:CHOOSE Sub*) simply returns the first Sub in - which every field reference refers to a valid arg." (preprocess-conditionals (preprocess-chooses printer args) args)) +;;; Return the first non-keyword symbol in a depth-first search of TREE. (defun find-first-field-name (tree) - #!+sb-doc - "Returns the first non-keyword symbol in a depth-first search of TREE." (cond ((null tree) nil) ((and (symbolp tree) (not (keywordp tree))) @@ -1523,16 +1523,14 @@ (dpb int (byte size 0) -1) int)) +;;; Is ADDRESS aligned on a SIZE byte boundary? (defun aligned-p (address size) - #!+sb-doc - "Returns non-NIL if ADDRESS is aligned on a SIZE byte boundary." (declare (type address address) (type alignment size)) (zerop (logand (1- size) address))) +;;; Return ADDRESS aligned *upward* to a SIZE byte boundary. (defun align (address size) - #!+sb-doc - "Return ADDRESS aligned *upward* to a SIZE byte boundary." (declare (type address address) (type alignment size)) (logandc1 (1- size) (+ (1- size) address))) @@ -1553,10 +1551,10 @@ (optimize (speed 3) (safety 0))) (sign-extend (read-suffix length dstate) length)) +;;; Get the value of the property called NAME in DSTATE. Also SETF'able. +;;; ;;; KLUDGE: The associated run-time machinery for this is in ;;; target-disassem.lisp (much later). This is here just to make sure ;;; it's defined before it's used. -- WHN ca. 19990701 (defmacro dstate-get-prop (dstate name) - #!+sb-doc - "Get the value of the property called NAME in DSTATE. Also setf'able." `(getf (dstate-properties ,dstate) ,name)) diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp index e81d381..62e6a9a 100644 --- a/src/compiler/dump.lisp +++ b/src/compiler/dump.lisp @@ -1133,12 +1133,7 @@ (dolist (entry (sb!c::ir2-component-entries 2comp)) (let ((entry-handle (dump-one-entry entry code-handle file))) (setf (gethash entry (fasl-output-entry-table file)) entry-handle) - (let ((old (gethash entry (fasl-output-patch-table file)))) - ;; FIXME: All this code is shared with - ;; FASL-DUMP-BYTE-COMPONENT, and should probably be gathered - ;; up into a named function (DUMP-PATCHES?) called from both - ;; functions. (when old (dolist (patch old) (dump-alter-code-object (car patch) diff --git a/src/compiler/envanal.lisp b/src/compiler/envanal.lisp index 6ab14e9..0208d03 100644 --- a/src/compiler/envanal.lisp +++ b/src/compiler/envanal.lisp @@ -24,10 +24,7 @@ ;;; continuations. ;;; 4. Delete all non-top-level functions with no references. This ;;; should only get functions with non-NULL kinds, since normal -;;; functions are deleted when their references go to zero. If -;;; *BYTE-COMPILING*, then don't delete optional entries with no -;;; references, since the byte interpreter wants to call entries -;;; that the XEP doesn't. +;;; functions are deleted when their references go to zero. (defun environment-analyze (component) (declare (type component component)) (aver (every (lambda (x) diff --git a/src/compiler/generic/early-objdef.lisp b/src/compiler/generic/early-objdef.lisp index f93401c..a0da9e6 100644 --- a/src/compiler/generic/early-objdef.lisp +++ b/src/compiler/generic/early-objdef.lisp @@ -82,9 +82,8 @@ function-header closure-header funcallable-instance-header - byte-code-function - byte-code-closure closure-function-header + return-pc-header value-cell-header symbol-header diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index a51ab3a..13d61ed 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -1964,9 +1964,9 @@ ;;;; hacking function names ;;; This is like LAMBDA, except the result is tweaked so that -;;; %FUNCTION-NAME or BYTE-FUNCTION-NAME can extract a name. (Also -;;; possibly the name could also be used at compile time to emit -;;; more-informative name-based compiler diagnostic messages as well.) +;;; %FUNCTION-NAME can extract a name. (Also possibly the name could +;;; also be used at compile time to emit more-informative name-based +;;; compiler diagnostic messages as well.) (defmacro-mundanely named-lambda (name args &body body) ;; FIXME: For now, in this stub version, we just discard the name. A diff --git a/src/compiler/knownfun.lisp b/src/compiler/knownfun.lisp index 0baae50..f110444 100644 --- a/src/compiler/knownfun.lisp +++ b/src/compiler/knownfun.lisp @@ -124,7 +124,10 @@ (note (required-argument) :type string) ;; T if we should emit a failure note even if SPEED=INHIBIT-WARNINGS. (important nil :type (member t nil)) - ;; usable for byte code, native code, or both + ;; usable for byte code, native code, or both? + ;; + ;; FIXME: Now that there's no byte compiler, this is stale and could + ;; all go away. (when :native :type (member :byte :native :both))) (defprinter (transform) type note important when) diff --git a/src/compiler/x86/type-vops.lisp b/src/compiler/x86/type-vops.lisp index d00cd22..143863a 100644 --- a/src/compiler/x86/type-vops.lisp +++ b/src/compiler/x86/type-vops.lisp @@ -15,13 +15,13 @@ (eval-when (:compile-toplevel :execute) -(defparameter immediate-types +(defparameter *immediate-types* (list unbound-marker-type base-char-type)) -(defparameter function-header-types +(defparameter *function-header-types* (list funcallable-instance-header-type - byte-code-function-type byte-code-closure-type - function-header-type closure-function-header-type + function-header-type + closure-function-header-type closure-header-type)) (defun canonicalize-headers (headers) @@ -56,10 +56,10 @@ t)) (lowtags (remove lowtag-limit type-codes :test #'<)) (extended (remove lowtag-limit type-codes :test #'>)) - (immediates (intersection extended immediate-types :test #'eql)) - (headers (set-difference extended immediate-types :test #'eql)) - (function-p (if (intersection headers function-header-types) - (if (subsetp headers function-header-types) + (immediates (intersection extended *immediate-types* :test #'eql)) + (headers (set-difference extended *immediate-types* :test #'eql)) + (function-p (if (intersection headers *function-header-types*) + (if (subsetp headers *function-header-types*) t (error "can't test for mix of function subtypes ~ and normal header types")) @@ -620,7 +620,6 @@ ;;; An (unsigned-byte 32) can be represented with either a positive ;;; fixnum, a bignum with exactly one positive digit, or a bignum with ;;; exactly two digits and the second digit all zeros. - (define-vop (unsigned-byte-32-p type-predicate) (:translate unsigned-byte-32-p) (:generator 45 diff --git a/src/pcl/gray-streams.lisp b/src/pcl/gray-streams.lisp index f4b4076..1da8246 100644 --- a/src/pcl/gray-streams.lisp +++ b/src/pcl/gray-streams.lisp @@ -1,12 +1,13 @@ ;;;; Gray streams implementation for SBCL, based on the Gray streams -;;;; implementation for CMU CL, based on the stream-definition-by-user proposal -;;;; by David N. Gray. +;;;; implementation for CMU CL, based on the stream-definition-by-user +;;;; proposal by David N. Gray. ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. -;;;; This software is in the public domain and is provided with absolutely no -;;;; warranty. See the COPYING and CREDITS files for more information. +;;;; This software is in the public domain and is provided with +;;;; absolutely no warranty. See the COPYING and CREDITS files for +;;;; more information. (in-package "SB-GRAY") @@ -15,8 +16,8 @@ (defgeneric stream-element-type (stream) #+sb-doc (:documentation - "Returns a type specifier for the kind of object returned by the - Stream. Class FUNDAMENTAL-CHARACTER-STREAM provides a default method + "Return a type specifier for the kind of object returned by the + STREAM. The class FUNDAMENTAL-CHARACTER-STREAM provides a default method which returns CHARACTER.")) (defmethod stream-element-type ((stream lisp-stream)) @@ -28,7 +29,7 @@ (defgeneric pcl-open-stream-p (stream) #+sb-doc (:documentation - "Return true if Stream is not closed. A default method is provided + "Return true if STREAM is not closed. A default method is provided by class FUNDAMENTAL-STREAM which returns true if CLOSE has not been called on the stream.")) @@ -45,8 +46,8 @@ (defgeneric pcl-close (stream &key abort) #+sb-doc (:documentation - "Closes the given Stream. No more I/O may be performed, but - inquiries may still be made. If :Abort is non-nil, an attempt is made + "Close the given STREAM. No more I/O may be performed, but + inquiries may still be made. If :ABORT is true, an attempt is made to clean up the side effects of having created the stream.")) (defmethod pcl-close ((stream lisp-stream) &key abort) @@ -65,7 +66,7 @@ (defgeneric input-stream-p (stream) #+sb-doc - (:documentation "Return non-nil if the given Stream can perform input operations.")) + (:documentation "Can STREAM perform input operations?")) (defmethod input-stream-p ((stream lisp-stream)) (and (not (eq (lisp-stream-in stream) #'closed-flame)) @@ -79,7 +80,7 @@ (defgeneric output-stream-p (stream) #+sb-doc - (:documentation "Return non-nil if the given Stream can perform output operations.")) + (:documentation "Can STREAM perform output operations?")) (defmethod output-stream-p ((stream lisp-stream)) (and (not (eq (lisp-stream-in stream) #'closed-flame)) @@ -98,7 +99,7 @@ (defgeneric stream-read-char (stream) #+sb-doc (:documentation - "This reads one character from the stream. It returns either a + "Read one character from the stream. Return either a character object, or the symbol :EOF if the stream is at end-of-file. Every subclass of FUNDAMENTAL-CHARACTER-INPUT-STREAM must define a method for this function.")) @@ -106,8 +107,8 @@ (defgeneric stream-unread-char (stream character) #+sb-doc (:documentation - "Un-does the last call to STREAM-READ-CHAR, as in UNREAD-CHAR. - Returns NIL. Every subclass of FUNDAMENTAL-CHARACTER-INPUT-STREAM + "Un-do the last call to STREAM-READ-CHAR, as in UNREAD-CHAR. + Return NIL. Every subclass of FUNDAMENTAL-CHARACTER-INPUT-STREAM must define a method for this function.")) (defgeneric stream-read-char-no-hang (stream) @@ -126,7 +127,7 @@ (defgeneric stream-peek-char (stream) #+sb-doc (:documentation - "Used to implement PEEK-CHAR; this corresponds to peek-type of NIL. + "This is used to implement PEEK-CHAR; this corresponds to PEEK-TYPE of NIL. It returns either a character or :EOF. The default method calls STREAM-READ-CHAR and STREAM-UNREAD-CHAR.")) @@ -139,7 +140,7 @@ (defgeneric stream-listen (stream) #+sb-doc (:documentation - "Used by LISTEN. Returns true or false. The default method uses + "This is used by LISTEN. It returns true or false. The default method uses STREAM-READ-CHAR-NO-HANG and STREAM-UNREAD-CHAR. Most streams should define their own method since it will usually be trivial and will always be more efficient than the default method.")) @@ -153,7 +154,7 @@ (defgeneric stream-read-line (stream) #+sb-doc (:documentation - "Used by READ-LINE. A string is returned as the first value. The + "This is used by READ-LINE. A string is returned as the first value. The second value is true if the string was terminated by end-of-file instead of the end of a line. The default method uses repeated calls to STREAM-READ-CHAR.")) @@ -195,14 +196,14 @@ (defgeneric stream-write-char (stream character) #+sb-doc (:documentation - "Writes character to the stream and returns the character. Every + "Write CHARACTER to STREAM and return CHARACTER. Every subclass of FUNDAMENTAL-CHARACTER-OUTPUT-STREAM must have a method defined for this function.")) (defgeneric stream-line-column (stream) #+sb-doc (:documentation - "This function returns the column number where the next character + "Return the column number where the next character will be written, or NIL if that is not meaningful for this stream. The first column on a line is numbered 0. This function is used in the implementation of PPRINT and the FORMAT ~T directive. For every @@ -217,7 +218,7 @@ ;;; FIXME: Should we support it? Probably not.. (defgeneric stream-line-length (stream) #+sb-doc - (:documentation "Return the stream line length or Nil.")) + (:documentation "Return the stream line length or NIL.")) (defmethod stream-line-length ((stream fundamental-character-output-stream)) nil) @@ -225,8 +226,8 @@ (defgeneric stream-start-line-p (stream) #+sb-doc (:documentation - "This is a predicate which returns T if the stream is positioned at - the beginning of a line, else NIL. It is permissible to always return + "Is STREAM known to be positioned at the beginning of a line? + It is permissible for an implementation to always return NIL. This is used in the implementation of FRESH-LINE. Note that while a value of 0 from STREAM-LINE-COLUMN also indicates the beginning of a line, there are cases where STREAM-START-LINE-P can be diff --git a/src/runtime/gc.c b/src/runtime/gc.c index b7fee14..fc0b7df 100644 --- a/src/runtime/gc.c +++ b/src/runtime/gc.c @@ -1970,15 +1970,9 @@ gc_init(void) #ifdef __i386__ scavtab[type_ClosureHeader] = scav_closure_header; scavtab[type_FuncallableInstanceHeader] = scav_closure_header; - scavtab[type_ByteCodeFunction] = scav_closure_header; - scavtab[type_ByteCodeClosure] = scav_closure_header; - /* scavtab[type_DylanFunctionHeader] = scav_closure_header; */ #else scavtab[type_ClosureHeader] = scav_boxed; scavtab[type_FuncallableInstanceHeader] = scav_boxed; - scavtab[type_ByteCodeFunction] = scav_boxed; - scavtab[type_ByteCodeClosure] = scav_boxed; - /* scavtab[type_DylanFunctionHeader] = scav_boxed; */ #endif scavtab[type_ValueCellHeader] = scav_boxed; scavtab[type_SymbolHeader] = scav_boxed; @@ -2059,8 +2053,6 @@ gc_init(void) transother[type_ReturnPcHeader] = trans_return_pc_header; transother[type_ClosureHeader] = trans_boxed; transother[type_FuncallableInstanceHeader] = trans_boxed; - transother[type_ByteCodeFunction] = trans_boxed; - transother[type_ByteCodeClosure] = trans_boxed; transother[type_ValueCellHeader] = trans_boxed; transother[type_SymbolHeader] = trans_boxed; transother[type_BaseChar] = trans_immediate; diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index 29e4fa8..b7f9cbb 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -3644,13 +3644,9 @@ gc_init_tables(void) #ifdef __i386__ scavtab[type_ClosureHeader] = scav_closure_header; scavtab[type_FuncallableInstanceHeader] = scav_closure_header; - scavtab[type_ByteCodeFunction] = scav_closure_header; - scavtab[type_ByteCodeClosure] = scav_closure_header; #else scavtab[type_ClosureHeader] = scav_boxed; scavtab[type_FuncallableInstanceHeader] = scav_boxed; - scavtab[type_ByteCodeFunction] = scav_boxed; - scavtab[type_ByteCodeClosure] = scav_boxed; #endif scavtab[type_ValueCellHeader] = scav_boxed; scavtab[type_SymbolHeader] = scav_boxed; @@ -3726,8 +3722,6 @@ gc_init_tables(void) transother[type_ReturnPcHeader] = trans_return_pc_header; transother[type_ClosureHeader] = trans_boxed; transother[type_FuncallableInstanceHeader] = trans_boxed; - transother[type_ByteCodeFunction] = trans_boxed; - transother[type_ByteCodeClosure] = trans_boxed; transother[type_ValueCellHeader] = trans_boxed; transother[type_SymbolHeader] = trans_boxed; transother[type_BaseChar] = trans_immediate; @@ -3949,8 +3943,6 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) break; case type_ClosureHeader: case type_FuncallableInstanceHeader: - case type_ByteCodeFunction: - case type_ByteCodeClosure: if ((unsigned)pointer != ((unsigned)start_addr+type_FunctionPointer)) { if (gencgc_verbose) @@ -4040,8 +4032,6 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) /* only pointed to by function pointers? */ case type_ClosureHeader: case type_FuncallableInstanceHeader: - case type_ByteCodeFunction: - case type_ByteCodeClosure: if (gencgc_verbose) FSHOW((stderr, "*Wo4: %x %x %x\n", @@ -5068,8 +5058,6 @@ verify_space(lispobj *start, size_t words) case type_ComplexArray: case type_ClosureHeader: case type_FuncallableInstanceHeader: - case type_ByteCodeFunction: - case type_ByteCodeClosure: case type_ValueCellHeader: case type_SymbolHeader: case type_BaseChar: diff --git a/src/runtime/purify.c b/src/runtime/purify.c index 6612308..9bc7515 100644 --- a/src/runtime/purify.c +++ b/src/runtime/purify.c @@ -156,8 +156,6 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) break; case type_ClosureHeader: case type_FuncallableInstanceHeader: - case type_ByteCodeFunction: - case type_ByteCodeClosure: if ((int)pointer != ((int)start_addr+type_FunctionPointer)) { if (pointer_filter_verbose) { fprintf(stderr,"*Wf2: %x %x %x\n", (unsigned int) pointer, @@ -242,8 +240,6 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) /* only pointed to by function pointers? */ case type_ClosureHeader: case type_FuncallableInstanceHeader: - case type_ByteCodeFunction: - case type_ByteCodeClosure: if (pointer_filter_verbose) { fprintf(stderr,"*Wo4: %x %x %x\n", (unsigned int) pointer, (unsigned int) start_addr, *start_addr); @@ -621,12 +617,6 @@ apply_code_fixups_during_purify(struct code *old_code, struct code *new_code) unsigned displacement = (unsigned)new_code - (unsigned)old_code; struct vector *fixups_vector; - /* Byte compiled code has no fixups. The trace table offset will be - * a fixnum if it's x86 compiled code - check. */ - if (new_code->trace_table_offset & 0x3) - return; - - /* Else it's x86 machine code. */ ncode_words = fixnum_value(new_code->code_size); nheader_words = HeaderValue(*(lispobj *)new_code); nwords = ncode_words + nheader_words; @@ -1249,8 +1239,6 @@ pscav(lispobj *addr, int nwords, boolean constant) #ifdef __i386__ case type_ClosureHeader: case type_FuncallableInstanceHeader: - case type_ByteCodeFunction: - case type_ByteCodeClosure: /* The function self pointer needs special care on the * x86 because it is the real entry point. */ { diff --git a/tests/interface.pure.lisp b/tests/interface.pure.lisp index 3fb1cf4..f349903 100644 --- a/tests/interface.pure.lisp +++ b/tests/interface.pure.lisp @@ -12,9 +12,11 @@ (in-package :cl-user) ;;; Check for fbound external symbols in public packages that have no -;;; argument list information. (This can happen if we get carried away -;;; with byte compilation, since at least in sbcl-0.6.12 the byte -;;; compiler can't record argument list information.) +;;; argument list information. (This used to be possible when we got +;;; carried away with byte compilation, since the byte compiler can't +;;; record argument list information. Now that there's no byte +;;; compiler, that can't happen, but it still shouldn't hurt to check +;;; in case the argument information goes astray some other way.) (defvar *public-package-names* '("SB-ALIEN" "SB-C-CALL" "SB-DEBUG" "SB-EXT" "SB-GRAY" "SB-MP" "SB-PROFILE" "SB-PCL" "COMMON-LISP")) diff --git a/tests/stress-gc.lisp b/tests/stress-gc.lisp index f8255c7..7fff862 100644 --- a/tests/stress-gc.lisp +++ b/tests/stress-gc.lisp @@ -247,8 +247,6 @@ #| #'repr-complex-array ;; TO DO: #'repr-funcallable-instance - ;; TO DO: #'repr-byte-code-function - ;; TO DO: #'repr-byte-code-closure |# #'repr-symbol #'repr-base-char diff --git a/version.lisp-expr b/version.lisp-expr index 8e50609..247a876 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.pre7.49" +"0.pre7.50" -- 1.7.10.4