From 581e3d62de8cb37e13ad9db63e5537c0f962be28 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Sun, 15 Sep 2002 18:18:11 +0000 Subject: [PATCH] 0.7.7.26: merged APD "compile-time type errors v. 2" patch (sbcl-devel 2002-09-14) various trivial comment systematization --- NEWS | 8 +++- src/code/debug-info.lisp | 6 +-- src/code/hppa-vm.lisp | 4 +- src/code/mips-vm.lisp | 4 +- src/code/numbers.lisp | 2 +- src/code/ppc-vm.lisp | 4 +- src/code/room.lisp | 2 +- src/code/setf-funs.lisp | 2 +- src/compiler/alpha/call.lisp | 2 +- src/compiler/backend.lisp | 2 +- src/compiler/checkgen.lisp | 58 +++++++++------------------- src/compiler/debug.lisp | 4 +- src/compiler/dump.lisp | 2 +- src/compiler/hppa/call.lisp | 77 ++++++++++---------------------------- src/compiler/hppa/macros.lisp | 5 +-- src/compiler/hppa/nlx.lisp | 17 ++------- src/compiler/hppa/static-fn.lisp | 2 +- src/compiler/hppa/vm.lisp | 18 ++------- src/compiler/ir2tran.lisp | 6 +-- src/compiler/knownfun.lisp | 6 +-- src/compiler/life.lisp | 10 ++--- src/compiler/locall.lisp | 2 +- src/compiler/meta-vmdef.lisp | 48 ++++++++++++------------ src/compiler/mips/call.lisp | 68 +++++++++------------------------ src/compiler/mips/macros.lisp | 5 +-- src/compiler/mips/nlx.lisp | 18 +++------ src/compiler/mips/static-fn.lisp | 2 +- src/compiler/mips/vm.lisp | 17 ++------- src/compiler/node.lisp | 7 +--- src/compiler/pack.lisp | 2 +- src/compiler/physenvanal.lisp | 2 +- src/compiler/ppc/call.lisp | 63 +++++++++++-------------------- src/compiler/ppc/macros.lisp | 5 +-- src/compiler/ppc/memory.lisp | 5 +-- src/compiler/ppc/nlx.lisp | 30 +++++---------- src/compiler/ppc/sanctify.lisp | 5 +-- src/compiler/ppc/static-fn.lisp | 4 +- src/compiler/ppc/vm.lisp | 34 +++++------------ src/compiler/sparc/call.lisp | 24 ++++++------ src/compiler/sparc/insts.lisp | 2 +- src/compiler/sparc/macros.lisp | 6 +-- src/compiler/sparc/vm.lisp | 17 ++------- src/compiler/tn.lisp | 23 ++++++------ src/compiler/vop.lisp | 42 ++++++++++----------- src/compiler/x86/call.lisp | 8 ++-- tests/compiler.impure.lisp | 12 ++++++ version.lisp-expr | 2 +- 47 files changed, 251 insertions(+), 443 deletions(-) diff --git a/NEWS b/NEWS index 12d2d17..254f4f5 100644 --- a/NEWS +++ b/NEWS @@ -1268,7 +1268,13 @@ changes in sbcl-0.7.8 relative to sbcl-0.7.7: (thanks to Alexey Dejneka) * fixed several bugs in PCL's error checking (thanks to Gerd Moellmann) - * fixed bug in printing of FILE-ERROR (thanks to Antonio Martinez) + * fixed bug in printing of FILE-ERROR (thanks to Antonio + Martinez-Shotton) + * fixed bug in compilation of functions as first class values + (thanks to Antonio Martinez-Shotton) + * The compiler's handling TYPE-ERRORs which it can prove will + inevitably happen at runtime has been cleaned up and corrected. + (thanks to Alexey Dejneka) planned incompatible changes in 0.7.x: * When the profiling interface settles down, maybe in 0.7.x, maybe diff --git a/src/code/debug-info.lisp b/src/code/debug-info.lisp index 829694c..9b58481 100644 --- a/src/code/debug-info.lisp +++ b/src/code/debug-info.lisp @@ -46,7 +46,7 @@ ;;; ...package name bytes...] ;;; [If has ID, ID as var-length integer] ;;; SC-Offset of primary location (as var-length integer) -;;; [If has save SC, SC-Offset of save location (as var-length integer)] +;;; [If has save SC, SC-OFFSET of save location (as var-length integer)] ;;; FIXME: The first two are no longer used in SBCL. ;;;(defconstant compiled-debug-var-uninterned #b00000001) @@ -184,10 +184,10 @@ ;; The function returns using the fixed-values convention, but ;; in order to save space, we elected not to store a vector. (returns :fixed :type (or (simple-array * (*)) (member :standard :fixed))) - ;; SC-Offsets describing where the return PC and return FP are kept. + ;; SC-OFFSETs describing where the return PC and return FP are kept. (return-pc (missing-arg) :type sc-offset) (old-fp (missing-arg) :type sc-offset) - ;; SC-Offset for the number stack FP in this function, or NIL if no + ;; SC-OFFSET for the number stack FP in this function, or NIL if no ;; NFP allocated. (nfp nil :type (or sc-offset null)) ;; The earliest PC in this function at which the environment is properly diff --git a/src/code/hppa-vm.lisp b/src/code/hppa-vm.lisp index f468470..d692e8a 100644 --- a/src/code/hppa-vm.lisp +++ b/src/code/hppa-vm.lisp @@ -13,8 +13,8 @@ "HPPA") -;;; FIXUP-CODE-OBJECT -- Interface -;;; +;;;; FIXUP-CODE-OBJECT + (defun fixup-code-object (code offset value kind) (unless (zerop (rem offset n-word-bytes)) (error "Unaligned instruction? offset=#x~X." offset)) diff --git a/src/code/mips-vm.lisp b/src/code/mips-vm.lisp index 6b0664e..365fbb9 100644 --- a/src/code/mips-vm.lisp +++ b/src/code/mips-vm.lisp @@ -14,8 +14,8 @@ #!-little-endian "big-endian") -;;; FIXUP-CODE-OBJECT -- Interface -;;; +;;;; FIXUP-CODE-OBJECT + (defun fixup-code-object (code offset value kind) (unless (zerop (rem offset n-word-bytes)) (error "Unaligned instruction? offset=#x~X." offset)) diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp index 8e668dc..03ba7c5 100644 --- a/src/code/numbers.lisp +++ b/src/code/numbers.lisp @@ -411,7 +411,7 @@ (nd (if (eql t2 1) t3 (* t2 t3)))) (if (eql nd 1) nn (%make-ratio nn nd)))))))))))) -); Eval-When (Compile) +) ; EVAL-WHEN (two-arg-+/- two-arg-+ + add-bignums) (two-arg-+/- two-arg-- - subtract-bignum) diff --git a/src/code/ppc-vm.lisp b/src/code/ppc-vm.lisp index 278fb82..7b0e199 100644 --- a/src/code/ppc-vm.lisp +++ b/src/code/ppc-vm.lisp @@ -20,8 +20,8 @@ -;;; FIXUP-CODE-OBJECT -- Interface -;;; +;;;; FIXUP-CODE-OBJECT + (defun fixup-code-object (code offset fixup kind) (declare (type index offset)) (unless (zerop (rem offset n-word-bytes)) diff --git a/src/code/room.lisp b/src/code/room.lisp index 7fb999c..d549fa7 100644 --- a/src/code/room.lisp +++ b/src/code/room.lisp @@ -100,7 +100,7 @@ (make-room-info :name 'instance :kind :instance)) -); eval-when (compile eval) +) ; EVAL-WHEN (defparameter *room-info* '#.*meta-room-info*) (deftype spaces () '(member :static :dynamic :read-only)) diff --git a/src/code/setf-funs.lisp b/src/code/setf-funs.lisp index 16c0878..3e18ea6 100644 --- a/src/code/setf-funs.lisp +++ b/src/code/setf-funs.lisp @@ -48,7 +48,7 @@ (res (compute-one-setter sym type)))))) `(progn ,@(res)))) -); eval-when (compile eval) +) ; EVAL-WHEN (define-setters ("COMMON-LISP") ;; Semantically silly... diff --git a/src/compiler/alpha/call.lisp b/src/compiler/alpha/call.lisp index 3807d6e..14f1753 100644 --- a/src/compiler/alpha/call.lisp +++ b/src/compiler/alpha/call.lisp @@ -187,7 +187,7 @@ (inst lda csp-tn (* nargs n-word-bytes) csp-tn)))) ;;; Emit code needed at the return-point from an unknown-values call -;;; for a fixed number of values. Values is the head of the TN-Ref +;;; for a fixed number of values. Values is the head of the TN-REF ;;; list for the locations that the values are to be received into. ;;; Nvals is the number of values that are to be received (should ;;; equal the length of Values). diff --git a/src/compiler/backend.lisp b/src/compiler/backend.lisp index 0184618..cf140b1 100644 --- a/src/compiler/backend.lisp +++ b/src/compiler/backend.lisp @@ -107,7 +107,7 @@ (defvar *backend-t-primitive-type*) (declaim (type primitive-type *backend-t-primitive-type*)) -;;; a hashtable translating from VOP names to the corresponding VOP-Parse +;;; a hashtable translating from VOP names to the corresponding VOP-PARSE ;;; structures. This information is only used at meta-compile time. (defvar *backend-parsed-vops* (make-hash-table :test 'eq)) (declaim (type hash-table *backend-parsed-vops*)) diff --git a/src/compiler/checkgen.lisp b/src/compiler/checkgen.lisp index f7375d9..1712cfe 100644 --- a/src/compiler/checkgen.lisp +++ b/src/compiler/checkgen.lisp @@ -185,7 +185,7 @@ ;;; ;;; A type is checkable if it either represents a fixed number of ;;; values (as determined by VALUES-TYPES), or it is the assertion for -;;; an MV-Bind. A type is simply checkable if all the type assertions +;;; an MV-BIND. A type is simply checkable if all the type assertions ;;; have a TYPE-CHECK-TEMPLATE. In this :SIMPLE case, the second value ;;; is a list of the type restrictions specified for the leading ;;; positional values. @@ -240,8 +240,8 @@ ;;; -- nobody uses the value, or ;;; -- safety is totally unimportant, or ;;; -- the continuation is an argument to an unknown function, or -;;; -- the continuation is an argument to a known function that has -;;; no IR2-Convert method or :FAST-SAFE templates that are +;;; -- the continuation is an argument to a known function that has +;;; no IR2-CONVERT method or :FAST-SAFE templates that are ;;; compatible with the call's type. ;;; ;;; We must only return NIL when it is *certain* that a check will not @@ -250,25 +250,10 @@ ;;; type checks. The penalty for erring by being too speculative is ;;; much nastier, e.g. falling through without ever being able to find ;;; an appropriate VOP. -;;; -;;; If there is a compile-time type error, then we always return true -;;; unless the DEST is a full call. With a full call, the theory is -;;; that the type error is probably from a declaration in (or on) the -;;; callee, so the callee should be able to do the check. We want to -;;; let the callee do the check, because it is possible that the error -;;; is really in the callee, not the caller. We don't want to make -;;; people recompile all calls to a function when they were originally -;;; compiled with a bad declaration (or an old type assertion derived -;;; from a definition appearing after the call.) (defun probable-type-check-p (cont) (declare (type continuation cont)) (let ((dest (continuation-dest cont))) - (cond ((eq (continuation-type-check cont) :error) - (if (and (combination-p dest) - (eq (combination-kind dest) :error)) - nil - t)) - ((or (not dest) + (cond ((or (not dest) (policy dest (zerop safety))) nil) ((basic-combination-p dest) @@ -276,6 +261,19 @@ (cond ((eq cont (basic-combination-fun dest)) t) ((eq kind :local) t) ((member kind '(:full :error)) nil) + ;; :ERROR means that we have an invalid syntax of + ;; the call and the callee will detect it before + ;; thinking about types. When KIND is :FULL, the + ;; theory is that the type assertion is probably + ;; from a declaration in (or on) the callee, so the + ;; callee should be able to do the check. We want + ;; to let the callee do the check, because it is + ;; possible that by the time of call that + ;; declaration will be changed and we do not want + ;; to make people recompile all calls to a function + ;; when they were originally compiled with a bad + ;; declaration. (See also bug 35.) + ((fun-info-ir2-convert kind) t) (t (dolist (template (fun-info-templates kind) nil) @@ -430,25 +428,6 @@ what (type-specifier dtype) atype-spec)))) (values)) -;;; Mark CONT as being a continuation with a manifest type error. We -;;; set the kind to :ERROR, and clear any FUN-INFO if the -;;; continuation is an argument to a known call. The last is done so -;;; that the back end doesn't have to worry about type errors in -;;; arguments to known functions. This clearing is inhibited for -;;; things with IR2-CONVERT methods, since we can't do a full call to -;;; funny functions. -(defun mark-error-continuation (cont) - (declare (type continuation cont)) - (setf (continuation-%type-check cont) :error) - (let ((dest (continuation-dest cont))) - (when (and (combination-p dest) - (let ((kind (basic-combination-kind dest))) - (or (eq kind :full) - (and (fun-info-p kind) - (not (fun-info-ir2-convert kind)))))) - (setf (basic-combination-kind dest) :error))) - (values)) - ;;; Loop over all blocks in COMPONENT that have TYPE-CHECK set, ;;; looking for continuations with TYPE-CHECK T. We do two mostly ;;; unrelated things: detect compile-time type errors and determine if @@ -484,12 +463,11 @@ (when (block-type-check block) (do-nodes (node cont block) (let ((type-check (continuation-type-check cont))) - (unless (member type-check '(nil :error :deleted)) + (unless (member type-check '(nil :deleted)) (let ((atype (continuation-asserted-type cont))) (do-uses (use cont) (unless (values-types-equal-or-intersect (node-derived-type use) atype) - (mark-error-continuation cont) (unless (policy node (= inhibit-warnings 3)) (emit-type-warning use)))))) (when (eq type-check t) diff --git a/src/compiler/debug.lisp b/src/compiler/debug.lisp index 56c5b61..b6e2753 100644 --- a/src/compiler/debug.lisp +++ b/src/compiler/debug.lisp @@ -594,7 +594,7 @@ (unless (find-in #'tn-ref-next-ref target vop-refs) (barf "The target for ~S isn't in REFS for ~S." ref vop))))))) -;;; Verify the sanity of the VOP-Refs slot in VOP. This involves checking +;;; Verify the sanity of the VOP-REFS slot in VOP. This involves checking ;;; that each referenced TN appears as an argument, result or temp, and also ;;; basic checks for the plausibility of the specified ordering of the refs. (defun check-vop-refs (vop) @@ -1188,7 +1188,7 @@ (defun nth-vop (thing n) #!+sb-doc - "Return the Nth VOP in the IR2-Block pointed to by Thing." + "Return the Nth VOP in the IR2-BLOCK pointed to by THING." (let ((block (block-info (block-or-lose thing)))) (do ((i 0 (1+ i)) (vop (ir2-block-start-vop block) (vop-next vop))) diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp index 398bfca..9e50e68 100644 --- a/src/compiler/dump.lisp +++ b/src/compiler/dump.lisp @@ -155,7 +155,7 @@ (dump-byte ',val ,file)) (error "compiler bug: ~S is not a legal fasload operator." fs)))) -;;; Dump a FOP-Code along with an integer argument, choosing the FOP +;;; Dump a FOP-CODE along with an integer argument, choosing the FOP ;;; based on whether the argument will fit in a single byte. ;;; ;;; FIXME: This, like DUMP-FOP, should be a function with a diff --git a/src/compiler/hppa/call.lisp b/src/compiler/hppa/call.lisp index 041deaa..ee7485d 100644 --- a/src/compiler/hppa/call.lisp +++ b/src/compiler/hppa/call.lisp @@ -3,11 +3,8 @@ ;;;; Interfaces to IR2 conversion: -;;; Standard-Argument-Location -- Interface -;;; -;;; Return a wired TN describing the N'th full call argument passing +;;; Return a wired TN describing the N'th full call argument passing ;;; location. -;;; (!def-vm-support-routine standard-arg-location (n) (declare (type unsigned-byte n)) (if (< n register-arg-count) @@ -18,43 +15,34 @@ control-stack-arg-scn n))) -;;; Make-Return-PC-Passing-Location -- Interface -;;; -;;; Make a passing location TN for a local call return PC. If standard is +;;; Make a passing location TN for a local call return PC. If standard is ;;; true, then use the standard (full call) location, otherwise use any legal ;;; location. Even in the non-standard case, this may be restricted by a ;;; desire to use a subroutine call instruction. -;;; (!def-vm-support-routine make-return-pc-passing-location (standard) (if standard (make-wired-tn *backend-t-primitive-type* register-arg-scn lra-offset) (make-restricted-tn *backend-t-primitive-type* register-arg-scn))) -;;; Make-Old-FP-Passing-Location -- Interface -;;; -;;; Similar to Make-Return-PC-Passing-Location, but makes a location to pass -;;; Old-FP in. This is (obviously) wired in the standard convention, but is -;;; totally unrestricted in non-standard conventions, since we can always fetch -;;; it off of the stack using the arg pointer. -;;; +;;; This is similar to MAKE-RETURN-PC-PASSING-LOCATION, but makes a +;;; location to pass OLD-FP in. This is (obviously) wired in the +;;; standard convention, but is totally unrestricted in non-standard +;;; conventions, since we can always fetch it off of the stack using +;;; the arg pointer. (!def-vm-support-routine make-old-fp-passing-location (standard) (if standard (make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset) (make-normal-tn *fixnum-primitive-type*))) -;;; Make-Old-FP-Save-Location, Make-Return-PC-Save-Location -- Interface -;;; -;;; Make the TNs used to hold Old-FP and Return-PC within the current -;;; function. We treat these specially so that the debugger can find them at a -;;; known location. -;;; +;;; Make the TNs used to hold OLD-FP and RETURN-PC within the current +;;; function. We treat these specially so that the debugger can find +;;; them at a known location. (!def-vm-support-routine make-old-fp-save-location (env) (specify-save-tn (physenv-debug-live-tn (make-normal-tn *fixnum-primitive-type*) env) (make-wired-tn *fixnum-primitive-type* control-stack-arg-scn ocfp-save-offset))) -;;; (!def-vm-support-routine make-return-pc-save-location (env) (specify-save-tn (physenv-debug-live-tn (make-normal-tn *backend-t-primitive-type*) env) @@ -62,52 +50,36 @@ control-stack-arg-scn lra-save-offset))) -;;; Make-Arg-Count-Location -- Interface -;;; -;;; Make a TN for the standard argument count passing location. We only +;;; Make a TN for the standard argument count passing location. We only ;;; need to make the standard location, since a count is never passed when we ;;; are using non-standard conventions. -;;; (!def-vm-support-routine make-arg-count-location () (make-wired-tn *fixnum-primitive-type* immediate-arg-scn nargs-offset)) -;;; MAKE-NFP-TN -- Interface -;;; -;;; Make a TN to hold the number-stack frame pointer. This is allocated +;;; Make a TN to hold the number-stack frame pointer. This is allocated ;;; once per component, and is component-live. -;;; (!def-vm-support-routine make-nfp-tn () (component-live-tn (make-wired-tn *fixnum-primitive-type* immediate-arg-scn nfp-offset))) -;;; MAKE-STACK-POINTER-TN () -;;; (!def-vm-support-routine make-stack-pointer-tn () (make-normal-tn *fixnum-primitive-type*)) -;;; MAKE-NUMBER-STACK-POINTER-TN () -;;; (!def-vm-support-routine make-number-stack-pointer-tn () (make-normal-tn *fixnum-primitive-type*)) -;;; Make-Unknown-Values-Locations -- Interface -;;; -;;; Return a list of TNs that can be used to represent an unknown-values +;;; Return a list of TNs that can be used to represent an unknown-values ;;; continuation within a function. -;;; (!def-vm-support-routine make-unknown-values-locations () (list (make-stack-pointer-tn) (make-normal-tn *fixnum-primitive-type*))) -;;; Select-Component-Format -- Interface -;;; -;;; This function is called by the Entry-Analyze phase, allowing -;;; VM-dependent initialization of the IR2-Component structure. We push +;;; This function is called by the ENTRY-ANALYZE phase, allowing +;;; VM-dependent initialization of the IR2-COMPONENT structure. We push ;;; placeholder entries in the Constants to leave room for additional ;;; noise in the code object header. -;;; (!def-vm-support-routine select-component-format (component) (declare (type component component)) (dotimes (i code-constants-offset) @@ -118,11 +90,8 @@ ;;;; Frame hackery: -;;; BYTES-NEEDED-FOR-NON-DESCRIPTOR-STACK-FRAME -- internal -;;; ;;; Return the number of bytes needed for the current non-descriptor stack. ;;; We have to allocate multiples of 64 bytes. -;;; (defun bytes-needed-for-non-descriptor-stack-frame () (logandc2 (+ (* (sb-allocated-size 'non-descriptor-stack) n-word-bytes) 63) 63)) @@ -202,14 +171,12 @@ (inst addi (* nargs n-word-bytes) csp-tn csp-tn)))) -;;; Default-Unknown-Values -- Internal +;;; Emit code needed at the return-point from an unknown-values call for a +;;; fixed number of values. VALUES is the head of the TN-REF list for the +;;; locations that the values are to be received into. NVALS is the number of +;;; values that are to be received (should equal the length of VALUES). ;;; -;;; Emit code needed at the return-point from an unknown-values call for a -;;; fixed number of values. Values is the head of the TN-Ref list for the -;;; locations that the values are to be received into. Nvals is the number of -;;; values that are to be received (should equal the length of Values). -;;; -;;; Move-Temp is a Descriptor-Reg TN used as a temporary. +;;; MOVE-TEMP is a DESCRIPTOR-REG TN used as a temporary. ;;; ;;; This code exploits the fact that in the unknown-values convention, a ;;; single value return returns at the return PC + 8, whereas a return of other @@ -359,8 +326,6 @@ default-value-8 ;;;; Unknown values receiving: -;;; Receive-Unknown-Values -- Internal -;;; ;;; Emit code needed at the return point for an unknown-values call for an ;;; arbitrary number of values. ;;; @@ -601,8 +566,6 @@ default-value-8 ;;; arguments, we don't bother allocating a partial frame, and instead set FP ;;; to SP just before the call. -;;; Define-Full-Call -- Internal -;;; ;;; This macro helps in the definition of full call VOPs by avoiding code ;;; replication in defining the cross-product VOPs. ;;; diff --git a/src/compiler/hppa/macros.lisp b/src/compiler/hppa/macros.lisp index 5daaace..0995411 100644 --- a/src/compiler/hppa/macros.lisp +++ b/src/compiler/hppa/macros.lisp @@ -87,9 +87,7 @@ ;;;; Stack TN's -;;; Load-Stack-TN, Store-Stack-TN -- Interface -;;; -;;; Move a stack TN to a register and vice-versa. +;;; Move a stack TN to a register and vice-versa. (defmacro load-stack-tn (reg stack) `(let ((reg ,reg) (stack ,stack)) @@ -97,7 +95,6 @@ (sc-case stack ((control-stack) (loadw reg cfp-tn offset)))))) - (defmacro store-stack-tn (stack reg) `(let ((stack ,stack) (reg ,reg)) diff --git a/src/compiler/hppa/nlx.lisp b/src/compiler/hppa/nlx.lisp index c2b042f..745cd6a 100644 --- a/src/compiler/hppa/nlx.lisp +++ b/src/compiler/hppa/nlx.lisp @@ -1,19 +1,13 @@ (in-package "SB!VM") -;;; MAKE-NLX-SP-TN -- Interface -;;; -;;; Make an environment-live stack TN for saving the SP for NLX entry. -;;; +;;; Make an environment-live stack TN for saving the SP for NLX entry. (!def-vm-support-routine make-nlx-sp-tn (env) (physenv-live-tn (make-representation-tn *fixnum-primitive-type* immediate-arg-scn) env)) -;;; Make-NLX-Entry-Argument-Start-Location -- Interface -;;; -;;; Make a TN for the argument count passing location for a +;;; Make a TN for the argument count passing location for a ;;; non-local entry. -;;; (!def-vm-support-routine make-nlx-entry-arg-start-location () (make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset)) @@ -28,11 +22,8 @@ ;;; pointers. -;;; Make-Dynamic-State-TNs -- Interface -;;; -;;; Return a list of TNs that can be used to snapshot the dynamic state for -;;; use with the Save/Restore-Dynamic-Environment VOPs. -;;; +;;; Return a list of TNs that can be used to snapshot the dynamic state for +;;; use with the Save/Restore-DYNAMIC-ENVIRONMENT VOPs. (!def-vm-support-routine make-dynamic-state-tns () (make-n-tns 4 *backend-t-primitive-type*)) diff --git a/src/compiler/hppa/static-fn.lisp b/src/compiler/hppa/static-fn.lisp index 8527975..c6d9e7f 100644 --- a/src/compiler/hppa/static-fn.lisp +++ b/src/compiler/hppa/static-fn.lisp @@ -97,7 +97,7 @@ (load-stack-tn cur-nfp nfp-save)) ,@(moves (temp-names) (result-names)))))))) -) ; eval-when (compile load eval) +) ; EVAL-WHEN (macrolet ((foo () diff --git a/src/compiler/hppa/vm.lisp b/src/compiler/hppa/vm.lisp index 3a2477a..faceddc 100644 --- a/src/compiler/hppa/vm.lisp +++ b/src/compiler/hppa/vm.lisp @@ -258,11 +258,8 @@ :offset 0)) -;;; Immediate-Constant-SC -- Interface -;;; -;;; If value can be represented as an immediate constant, then return the -;;; appropriate SC number, otherwise return NIL. -;;; +;;; If VALUE can be represented as an immediate constant, then return +;;; the appropriate SC number, otherwise return NIL. (!def-vm-support-routine immediate-constant-sc (value) (typecase value ((integer 0 0) @@ -308,7 +305,7 @@ ;;; (defconstant-eqx register-arg-names '(a0 a1 a2 a3 a4 a5) #'equal) -); Eval-When (:Compile-Toplevel :Load-Toplevel :Execute) +) ; EVAL-WHEN ;;; A list of TN's describing the register arguments. @@ -320,18 +317,11 @@ :offset n)) *register-arg-offsets*)) -;;; SINGLE-VALUE-RETURN-BYTE-OFFSET -;;; ;;; This is used by the debugger. -;;; (defconstant single-value-return-byte-offset 4) - -;;; LOCATION-PRINT-NAME -- Interface -;;; -;;; This function is called by debug output routines that want a pretty name +;;; This function is called by debug output routines that want a pretty name ;;; for a TN's location. It returns a thing that can be printed with PRINC. -;;; (!def-vm-support-routine location-print-name (tn) (declare (type tn tn)) (let ((sb (sb-name (sc-sb (tn-sc tn)))) diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp index 0243abc..9059525 100644 --- a/src/compiler/ir2tran.lisp +++ b/src/compiler/ir2tran.lisp @@ -266,7 +266,7 @@ ;;;; utilities for receiving fixed values ;;; Return a TN that can be referenced to get the value of CONT. CONT -;;; must be LTN-Annotated either as a delayed leaf ref or as a fixed, +;;; must be LTN-ANNOTATED either as a delayed leaf ref or as a fixed, ;;; single-value continuation. If a type check is called for, do it. ;;; ;;; The primitive-type of the result will always be the same as the @@ -470,7 +470,7 @@ ;;;; template conversion -;;; Build a TN-Refs list that represents access to the values of the +;;; Build a TN-REFS list that represents access to the values of the ;;; specified list of continuations ARGS for TEMPLATE. Any :CONSTANT ;;; arguments are returned in the second value as a list rather than ;;; being accessed as a normal argument. NODE and BLOCK provide the @@ -588,7 +588,7 @@ cont (find-template-result-types call cont template rtypes))))) -;;; Get the operands into TNs, make TN-Refs for them, and then call +;;; Get the operands into TNs, make TN-REFs for them, and then call ;;; the template emit function. (defun ir2-convert-template (call block) (declare (type combination call) (type ir2-block block)) diff --git a/src/compiler/knownfun.lisp b/src/compiler/knownfun.lisp index c5fa533..f3f510c 100644 --- a/src/compiler/knownfun.lisp +++ b/src/compiler/knownfun.lisp @@ -89,13 +89,13 @@ ;; If true, a special-case LTN annotation method that is used in ;; place of the standard type/policy template selection. It may use ;; arbitrary code to choose a template, decide to do a full call, or - ;; conspire with the IR2-Convert method to do almost anything. The - ;; Combination node is passed as the argument. + ;; conspire with the IR2-CONVERT method to do almost anything. The + ;; COMBINATION node is passed as the argument. (ltn-annotate nil :type (or function null)) ;; If true, the special-case IR2 conversion method for this ;; function. This deals with funny functions, and anything else that ;; can't be handled using the template mechanism. The Combination - ;; node and the IR2-Block are passed as arguments. + ;; node and the IR2-BLOCK are passed as arguments. (ir2-convert nil :type (or function null)) ;; all the templates that could be used to translate this function ;; into IR2, sorted by increasing cost. diff --git a/src/compiler/life.lisp b/src/compiler/life.lisp index a44a4d0..7c2a903 100644 --- a/src/compiler/life.lisp +++ b/src/compiler/life.lisp @@ -177,7 +177,7 @@ (values)) -(defevent split-ir2-block "Split an IR2 block to meet Local-TN-Limit.") +(defevent split-ir2-block "Split an IR2 block to meet LOCAL-TN-LIMIT.") ;;; Move the code after the VOP LOSE in 2BLOCK into its own block. The ;;; block is linked into the emit order following 2BLOCK. NUMBER is @@ -262,8 +262,8 @@ ;;; since all &MORE args (and results) are referenced simultaneously ;;; as far as conflict analysis is concerned. ;;; -;;; BLOCK is the IR2-Block that the more VOP is at the end of. OPS is -;;; the full argument or result TN-Ref list. Fixed is the types of the +;;; BLOCK is the IR2-BLOCK that the MORE VOP is at the end of. OPS is +;;; the full argument or result TN-REF list. Fixed is the types of the ;;; fixed operands (used only to skip those operands.) ;;; ;;; What we do is grab a LTN number, then make a :READ-ONLY global @@ -315,7 +315,7 @@ (values)) (defevent coalesce-more-ltn-numbers - "Coalesced LTN numbers for a more operand to meet Local-TN-Limit.") + "Coalesced LTN numbers for a more operand to meet LOCAL-TN-LIMIT.") ;;; Loop over the blocks in COMPONENT, assigning LTN numbers and ;;; recording TN birth and death. The only interesting action is when @@ -622,7 +622,7 @@ (values live-bits live-list)) ;;; Return as values, a LTN bit-vector and a list (threaded by -;;; TN-Next*) representing the TNs live at the end of Block (exclusive +;;; TN-NEXT*) representing the TNs live at the end of BLOCK (exclusive ;;; of :LIVE TNs). ;;; ;;; We iterate over the TNs in the global conflicts that are live at diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp index cc552d3..3d163b8 100644 --- a/src/compiler/locall.lisp +++ b/src/compiler/locall.lisp @@ -427,7 +427,7 @@ (values)) ;;; Attempt to convert a multiple-value call. The only interesting -;;; case is a call to a function that Looks-Like-An-MV-Bind, has +;;; case is a call to a function that LOOKS-LIKE-AN-MV-BIND, has ;;; exactly one reference and no XEP, and is called with one values ;;; continuation. ;;; diff --git a/src/compiler/meta-vmdef.lisp b/src/compiler/meta-vmdef.lisp index 03ab8e6..7d5b1bb 100644 --- a/src/compiler/meta-vmdef.lisp +++ b/src/compiler/meta-vmdef.lisp @@ -519,9 +519,9 @@ (error "~S is not an operand to ~S." name (vop-parse-name parse)))) found)) -;;; Get the VOP-Parse structure for NAME or die trying. For all -;;; meta-compile time uses, the VOP-Parse should be used instead of -;;; the VOP-Info. +;;; Get the VOP-PARSE structure for NAME or die trying. For all +;;; meta-compile time uses, the VOP-PARSE should be used instead of +;;; the VOP-INFO. (defun vop-parse-or-lose (name) (the vop-parse (or (gethash name *backend-parsed-vops*) @@ -544,7 +544,7 @@ (res `(,(operand-parse-name more-operand) ,prev)))) (res))) -;;; This is used with ACCESS-OPERANDS to prevent warnings for TN-Ref +;;; This is used with ACCESS-OPERANDS to prevent warnings for TN-REF ;;; temps not used by some particular function. It returns the name of ;;; the last operand, or NIL if Operands is NIL. (defun ignore-unreferenced-temps (operands) @@ -823,7 +823,7 @@ ,load-tn (tn-ref-tn ,temp)))))) -;;; Make a lambda that parses the VOP TN-Refs, does automatic operand +;;; Make a lambda that parses the VOP TN-REFS, does automatic operand ;;; loading, and runs the appropriate code generator. (defun make-generator-function (parse) (declare (type vop-parse parse)) @@ -1337,7 +1337,7 @@ (values)) ;;; Compute stuff that can only be computed after we are done parsing -;;; everying. We set the VOP-Parse-Operands, and do various error checks. +;;; everying. We set the VOP-PARSE-OPERANDS, and do various error checks. (defun !grovel-vop-operands (parse) (declare (type vop-parse parse)) @@ -1367,8 +1367,8 @@ ;;;; function translation stuff ;;; Return forms to establish this VOP as a IR2 translation template -;;; for the :TRANSLATE functions specified in the VOP-Parse. We also -;;; set the Predicate attribute for each translated function when the +;;; for the :TRANSLATE functions specified in the VOP-PARSE. We also +;;; set the PREDICATE attribute for each translated function when the ;;; VOP is conditional, causing IR1 conversion to ensure that a call ;;; to the translated is always used in a predicate position. (defun !set-up-fun-translation (parse n-template) @@ -1440,13 +1440,13 @@ (defparameter *slot-inherit-alist* '((:generator-function . vop-info-generator-function)))) -;;; This is something to help with inheriting VOP-Info slots. We +;;; This is something to help with inheriting VOP-INFO slots. We ;;; return a keyword/value pair that can be passed to the constructor. ;;; SLOT is the keyword name of the slot, Parse is a form that -;;; evaluates to the VOP-Parse structure for the VOP inherited. If +;;; evaluates to the VOP-PARSE structure for the VOP inherited. If ;;; PARSE is NIL, then we do nothing. If the TEST form evaluates to ;;; true, then we return a form that selects the named slot from the -;;; VOP-Info structure corresponding to PARSE. Otherwise, we return +;;; VOP-INFO structure corresponding to PARSE. Otherwise, we return ;;; the FORM so that the slot is recomputed. (defmacro inherit-vop-info (slot parse test form) `(if (and ,parse ,test) @@ -1455,7 +1455,7 @@ (template-or-lose ',(vop-parse-name ,parse)))) (list ,slot ,form))) -;;; Return a form that creates a VOP-Info structure which describes VOP. +;;; Return a form that creates a VOP-INFO structure which describes VOP. (defun set-up-vop-info (iparse parse) (declare (type vop-parse parse) (type (or vop-parse null) iparse)) (let ((same-operands @@ -1523,7 +1523,7 @@ ;;; operand. ;;; ;;; :MORE T-or-NIL -;;; If specified, NAME is bound to the TN-Ref for the first +;;; If specified, NAME is bound to the TN-REF for the first ;;; argument or result following the fixed arguments or results. ;;; A :MORE operand must appear last, and cannot be targeted or ;;; restricted. @@ -1683,12 +1683,12 @@ ;;;; emission macros ;;; Return code to make a list of VOP arguments or results, linked by -;;; TN-Ref-Across. The first value is code, the second value is LET* +;;; TN-REF-ACROSS. The first value is code, the second value is LET* ;;; forms, and the third value is a variable that evaluates to the ;;; head of the list, or NIL if there are no operands. Fixed is a list -;;; of forms that evaluate to TNs for the fixed operands. TN-Refs will +;;; of forms that evaluate to TNs for the fixed operands. TN-REFS will ;;; be made for these operands according using the specified value of -;;; Write-P. More is an expression that evaluates to a list of TN-Refs +;;; WRITE-P. More is an expression that evaluates to a list of TN-REFS ;;; that will be made the tail of the list. If it is constant NIL, ;;; then we don't bother to set the tail. (defun make-operand-list (fixed more write-p) @@ -1789,12 +1789,12 @@ ;;; ;;; This is like VOP, but allows for emission of templates with ;;; arbitrary numbers of arguments, and for emission of templates -;;; using already-created TN-Ref lists. +;;; using already-created TN-REF lists. ;;; -;;; The Arguments and Results are TNs to be referenced as the first +;;; The ARGS and RESULTS are TNs to be referenced as the first ;;; arguments and results to the template. More-Args and More-Results -;;; are heads of TN-Ref lists that are added onto the end of the -;;; TN-Refs for the explicitly supplied operand TNs. The TN-Refs for +;;; are heads of TN-REF lists that are added onto the end of the +;;; TN-REFS for the explicitly supplied operand TNs. The TN-REFS for ;;; the more operands must have the TN and WRITE-P slots correctly ;;; initialized. ;;; @@ -1853,15 +1853,15 @@ (collect ((clauses)) (do ((cases forms (rest cases))) ((null cases) - (clauses `(t (error "unknown SC to SC-Case for ~S:~% ~S" ,n-tn + (clauses `(t (error "unknown SC to SC-CASE for ~S:~% ~S" ,n-tn (sc-name (tn-sc ,n-tn)))))) (let ((case (first cases))) (when (atom case) - (error "illegal SC-Case clause: ~S" case)) + (error "illegal SC-CASE clause: ~S" case)) (let ((head (first case))) (when (eq head t) (when (rest cases) - (error "T case is not last in SC-Case.")) + (error "T case is not last in SC-CASE.")) (clauses `(t nil ,@(rest case))) (return)) (clauses `((or ,@(mapcar (lambda (x) @@ -1890,7 +1890,7 @@ ,@forms)) ;;; Iterate over all the TNs live at some point, with the live set -;;; represented by a local conflicts bit-vector and the IR2-Block +;;; represented by a local conflicts bit-vector and the IR2-BLOCK ;;; containing the location. (defmacro do-live-tns ((tn-var live block &optional result) &body body) (let ((n-conf (gensym)) diff --git a/src/compiler/mips/call.lisp b/src/compiler/mips/call.lisp index eae7209..117e382 100644 --- a/src/compiler/mips/call.lisp +++ b/src/compiler/mips/call.lisp @@ -3,11 +3,8 @@ ;;;; Interfaces to IR2 conversion: -;;; Standard-Argument-Location -- Interface -;;; -;;; Return a wired TN describing the N'th full call argument passing +;;; Return a wired TN describing the N'th full call argument passing ;;; location. -;;; (!def-vm-support-routine standard-arg-location (n) (declare (type unsigned-byte n)) (if (< n register-arg-count) @@ -18,95 +15,70 @@ control-stack-arg-scn n))) -;;; Make-Return-PC-Passing-Location -- Interface -;;; -;;; Make a passing location TN for a local call return PC. If standard is +;;; Make a passing location TN for a local call return PC. If standard is ;;; true, then use the standard (full call) location, otherwise use any legal ;;; location. Even in the non-standard case, this may be restricted by a ;;; desire to use a subroutine call instruction. -;;; (!def-vm-support-routine make-return-pc-passing-location (standard) (if standard (make-wired-tn *backend-t-primitive-type* register-arg-scn lra-offset) (make-restricted-tn *backend-t-primitive-type* register-arg-scn))) -;;; Make-Old-FP-Passing-Location -- Interface -;;; -;;; Similar to Make-Return-PC-Passing-Location, but makes a location to pass -;;; Old-FP in. This is (obviously) wired in the standard convention, but is -;;; totally unrestricted in non-standard conventions, since we can always fetch -;;; it off of the stack using the arg pointer. -;;; +;;; This is similar to MAKE-RETURN-PC-PASSING-LOCATION, but makes a +;;; location to pass Old-FP in. This is (obviously) wired in the +;;; standard convention, but is totally unrestricted in non-standard +;;; conventions, since we can always fetch it off of the stack using +;;; the arg pointer. (!def-vm-support-routine make-old-fp-passing-location (standard) (if standard (make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset) (make-normal-tn *fixnum-primitive-type*))) -;;; Make-Old-FP-Save-Location, Make-Return-PC-Save-Location -- Interface -;;; -;;; Make the TNs used to hold Old-FP and Return-PC within the current -;;; function. We treat these specially so that the debugger can find them at a -;;; known location. -;;; +;;; Make the TNs used to hold OLD-FP and RETURN-PC within the current +;;; function. We treat these specially so that the debugger can find +;;; them at a known location. (!def-vm-support-routine make-old-fp-save-location (env) (specify-save-tn (physenv-debug-live-tn (make-normal-tn *fixnum-primitive-type*) env) (make-wired-tn *fixnum-primitive-type* control-stack-arg-scn ocfp-save-offset))) -;;; (!def-vm-support-routine make-return-pc-save-location (env) (let ((ptype *backend-t-primitive-type*)) (specify-save-tn (physenv-debug-live-tn (make-normal-tn ptype) env) (make-wired-tn ptype control-stack-arg-scn lra-save-offset)))) -;;; Make-Argument-Count-Location -- Interface -;;; -;;; Make a TN for the standard argument count passing location. We only +;;; Make a TN for the standard argument count passing location. We only ;;; need to make the standard location, since a count is never passed when we ;;; are using non-standard conventions. -;;; (!def-vm-support-routine make-arg-count-location () (make-wired-tn *fixnum-primitive-type* immediate-arg-scn nargs-offset)) -;;; MAKE-NFP-TN -- Interface -;;; -;;; Make a TN to hold the number-stack frame pointer. This is allocated +;;; Make a TN to hold the number-stack frame pointer. This is allocated ;;; once per component, and is component-live. -;;; (!def-vm-support-routine make-nfp-tn () (component-live-tn (make-wired-tn *fixnum-primitive-type* immediate-arg-scn nfp-offset))) -;;; MAKE-STACK-POINTER-TN () -;;; (!def-vm-support-routine make-stack-pointer-tn () (make-normal-tn *fixnum-primitive-type*)) -;;; MAKE-NUMBER-STACK-POINTER-TN () -;;; (!def-vm-support-routine make-number-stack-pointer-tn () (make-normal-tn *fixnum-primitive-type*)) -;;; Make-Unknown-Values-Locations -- Interface -;;; -;;; Return a list of TNs that can be used to represent an unknown-values +;;; Return a list of TNs that can be used to represent an unknown-values ;;; continuation within a function. -;;; (!def-vm-support-routine make-unknown-values-locations () (list (make-stack-pointer-tn) (make-normal-tn *fixnum-primitive-type*))) -;;; Select-Component-Format -- Interface -;;; -;;; This function is called by the Entry-Analyze phase, allowing -;;; VM-dependent initialization of the IR2-Component structure. We push +;;; This function is called by the ENTRY-ANALYZE phase, allowing +;;; VM-dependent initialization of the IR2-COMPONENT structure. We push ;;; placeholder entries in the Constants to leave room for additional ;;; noise in the code object header. -;;; (!def-vm-support-routine select-component-format (component) (declare (type component component)) (dotimes (i code-constants-offset) @@ -209,14 +181,12 @@ -;;; Default-Unknown-Values -- Internal -;;; -;;; Emit code needed at the return-point from an unknown-values call for a +;;; Emit code needed at the return-point from an unknown-values call for a ;;; fixed number of values. Values is the head of the TN-Ref list for the ;;; locations that the values are to be received into. Nvals is the number of ;;; values that are to be received (should equal the length of Values). ;;; -;;; Move-Temp is a Descriptor-Reg TN used as a temporary. +;;; MOVE-TEMP is a DESCRIPTOR-REG TN used as a temporary. ;;; ;;; This code exploits the fact that in the unknown-values convention, a ;;; single value return returns at the return PC + 8, whereas a return of other @@ -357,8 +327,6 @@ default-value-8 ;;;; Unknown values receiving: -;;; Receive-Unknown-Values -- Internal -;;; ;;; Emit code needed at the return point for an unknown-values call for an ;;; arbitrary number of values. ;;; @@ -612,8 +580,6 @@ default-value-8 ;;; arguments, we don't bother allocating a partial frame, and instead set FP ;;; to SP just before the call. -;;; Define-Full-Call -- Internal -;;; ;;; This macro helps in the definition of full call VOPs by avoiding code ;;; replication in defining the cross-product VOPs. ;;; diff --git a/src/compiler/mips/macros.lisp b/src/compiler/mips/macros.lisp index 45ce543..a9bf98b 100644 --- a/src/compiler/mips/macros.lisp +++ b/src/compiler/mips/macros.lisp @@ -105,9 +105,7 @@ ;;;; Stack TN's -;;; Load-Stack-TN, Store-Stack-TN -- Interface -;;; -;;; Move a stack TN to a register and vice-versa. +;;; Move a stack TN to a register and vice-versa. (defmacro load-stack-tn (reg stack) `(let ((reg ,reg) (stack ,stack)) @@ -115,7 +113,6 @@ (sc-case stack ((control-stack) (loadw reg cfp-tn offset)))))) - (defmacro store-stack-tn (stack reg) `(let ((stack ,stack) (reg ,reg)) diff --git a/src/compiler/mips/nlx.lisp b/src/compiler/mips/nlx.lisp index 45286b1..ccdb61c 100644 --- a/src/compiler/mips/nlx.lisp +++ b/src/compiler/mips/nlx.lisp @@ -1,17 +1,12 @@ (in-package "SB!VM") -;;; MAKE-NLX-SP-TN -- Interface -;;; -;;; Make an environment-live stack TN for saving the SP for NLX entry. -;;; +;;; Make an environment-live stack TN for saving the SP for NLX entry. (!def-vm-support-routine make-nlx-sp-tn (env) (physenv-live-tn (make-representation-tn *fixnum-primitive-type* immediate-arg-scn) env)) -;;; Make-NLX-Entry-Argument-Start-Location -- Interface -;;; -;;; Make a TN for the argument count passing location for a +;;; Make a TN for the argument count passing location for a ;;; non-local entry. ;;; (!def-vm-support-routine make-nlx-entry-arg-start-location () @@ -20,7 +15,7 @@ ;;; Save and restore dynamic environment. ;;; -;;; These VOPs are used in the reentered function to restore the appropriate +;;; These VOPs are used in the reentered function to restore the appropriate ;;; dynamic environment. Currently we only save the Current-Catch and binding ;;; stack pointer. We don't need to save/restore the current unwind-protect, ;;; since unwind-protects are implicitly processed during unwinding. If there @@ -28,11 +23,8 @@ ;;; pointers. -;;; Make-Dynamic-State-TNs -- Interface -;;; -;;; Return a list of TNs that can be used to snapshot the dynamic state for -;;; use with the Save/Restore-Dynamic-Environment VOPs. -;;; +;;; Return a list of TNs that can be used to snapshot the dynamic state for +;;; use with the Save/Restore-DYNAMIC-ENVIRONMENT VOPs. (!def-vm-support-routine make-dynamic-state-tns () (make-n-tns 4 *backend-t-primitive-type*)) diff --git a/src/compiler/mips/static-fn.lisp b/src/compiler/mips/static-fn.lisp index 3cc774d..f53f230 100644 --- a/src/compiler/mips/static-fn.lisp +++ b/src/compiler/mips/static-fn.lisp @@ -98,7 +98,7 @@ ,@(moves (result-names) (temp-names)))))))) -) ; eval-when (compile load eval) +) ; EVAL-WHEN (expand diff --git a/src/compiler/mips/vm.lisp b/src/compiler/mips/vm.lisp index fb2eeb3..340066e 100644 --- a/src/compiler/mips/vm.lisp +++ b/src/compiler/mips/vm.lisp @@ -263,12 +263,8 @@ (defregtn nsp any-reg) (defregtn nfp any-reg)) -;;; -;;; Immediate-Constant-SC -- Interface -;;; -;;; If value can be represented as an immediate constant, then return the +;;; If VALUE can be represented as an immediate constant, then return the ;;; appropriate SC number, otherwise return NIL. -;;; (!def-vm-support-routine immediate-constant-sc (value) (typecase value ((integer 0 0) @@ -314,7 +310,7 @@ ;;; (defconstant-eqx register-arg-names '(a0 a1 a2 a3 a4 a5) #'equal) -); Eval-When (Compile Load Eval) +) ; EVAL-WHEN ;;; A list of TN's describing the register arguments. @@ -326,18 +322,11 @@ :offset n)) *register-arg-offsets*)) -;;; SINGLE-VALUE-RETURN-BYTE-OFFSET -;;; ;;; This is used by the debugger. -;;; (defconstant single-value-return-byte-offset 8) - -;;; LOCATION-PRINT-NAME -- Interface -;;; -;;; This function is called by debug output routines that want a pretty name +;;; This function is called by debug output routines that want a pretty name ;;; for a TN's location. It returns a thing that can be printed with PRINC. -;;; (!def-vm-support-routine location-print-name (tn) (declare (type tn tn)) (let ((sb (sb-name (sc-sb (tn-sc tn)))) diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp index 44f0bfe..3671b05 100644 --- a/src/compiler/node.lisp +++ b/src/compiler/node.lisp @@ -124,14 +124,9 @@ ;; will be used. In the latter case, LTN must ensure that a safe ;; implementation *is* used. ;; - ;; :ERROR - ;; There is a compile-time type error in some use of this - ;; continuation. A type check should still be generated, but be - ;; careful. - ;; ;; This is computed lazily by CONTINUATION-DERIVED-TYPE, so use ;; CONTINUATION-TYPE-CHECK instead of the %'ed slot accessor. - (%type-check t :type (member t nil :deleted :no-check :error)) + (%type-check t :type (member t nil :deleted :no-check)) ;; something or other that the back end annotates this continuation with (info nil) ;; uses of this continuation in the lexical environment. They are diff --git a/src/compiler/pack.lisp b/src/compiler/pack.lisp index 727db03..01cafe4 100644 --- a/src/compiler/pack.lisp +++ b/src/compiler/pack.lisp @@ -31,7 +31,7 @@ ;;; any of the component's blocks (always-live /= 0), then there ;;; is a conflict. ;;; -- If TN is global (Confs true), then iterate over the blocks TN -;;; is live in (using TN-Global-Conflicts). If the TN is live +;;; is live in (using TN-GLOBAL-CONFLICTS). If the TN is live ;;; everywhere in the block (:LIVE), then there is a conflict ;;; if the element at offset is used anywhere in the block ;;; (Always-Live /= 0). Otherwise, we use the local TN number for diff --git a/src/compiler/physenvanal.lisp b/src/compiler/physenvanal.lisp index ca8d927..2ded900 100644 --- a/src/compiler/physenvanal.lisp +++ b/src/compiler/physenvanal.lisp @@ -279,7 +279,7 @@ ;;; the component tail. ;;; -- Close over the NLX-INFO in the exit environment. ;;; -- If the exit is from an :ESCAPE function, then substitute a -;;; constant reference to NLX-Info structure for the escape +;;; constant reference to NLX-INFO structure for the escape ;;; function reference. This will cause the escape function to ;;; be deleted (although not removed from the DFO.) The escape ;;; function is no longer needed, and we don't want to emit code diff --git a/src/compiler/ppc/call.lisp b/src/compiler/ppc/call.lisp index 2087a31..daf6a32 100644 --- a/src/compiler/ppc/call.lisp +++ b/src/compiler/ppc/call.lisp @@ -29,37 +29,30 @@ ;;; otherwise use any legal location. Even in the non-standard case, ;;; this may be restricted by a desire to use a subroutine call ;;; instruction. -;;; (!def-vm-support-routine make-return-pc-passing-location (standard) (if standard (make-wired-tn *backend-t-primitive-type* register-arg-scn lra-offset) (make-restricted-tn *backend-t-primitive-type* register-arg-scn))) -;;; Make-Old-FP-Passing-Location -- Interface -;;; -;;; Similar to Make-Return-PC-Passing-Location, but makes a location to pass -;;; Old-FP in. This is (obviously) wired in the standard convention, but is -;;; totally unrestricted in non-standard conventions, since we can always fetch -;;; it off of the stack using the arg pointer. -;;; +;;; This is similar to MAKE-RETURN-PC-PASSING-LOCATION, but makes a +;;; location to pass OLD-FP in. This is (obviously) wired in the +;;; standard convention, but is totally unrestricted in non-standard +;;; conventions, since we can always fetch it off of the stack using +;;; the arg pointer. (!def-vm-support-routine make-old-fp-passing-location (standard) (if standard (make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset) (make-normal-tn *fixnum-primitive-type*))) -;;; Make-Old-FP-Save-Location, Make-Return-PC-Save-Location -- Interface -;;; -;;; Make the TNs used to hold Old-FP and Return-PC within the current -;;; function. We treat these specially so that the debugger can find them at a -;;; known location. -;;; +;;; Make the TNs used to hold OLD-FP and RETURN-PC within the current +;;; function. We treat these specially so that the debugger can find +;;; them at a known location. (!def-vm-support-routine make-old-fp-save-location (env) (specify-save-tn (physenv-debug-live-tn (make-normal-tn *fixnum-primitive-type*) env) (make-wired-tn *fixnum-primitive-type* control-stack-arg-scn ocfp-save-offset))) -;;; (!def-vm-support-routine make-return-pc-save-location (env) (specify-save-tn (physenv-debug-live-tn (make-normal-tn *backend-t-primitive-type*) env) @@ -86,23 +79,16 @@ (!def-vm-support-routine make-number-stack-pointer-tn () (make-normal-tn *fixnum-primitive-type*)) -;;; Make-Unknown-Values-Locations -- Interface -;;; -;;; Return a list of TNs that can be used to represent an unknown-values +;;; Return a list of TNs that can be used to represent an unknown-values ;;; continuation within a function. -;;; (!def-vm-support-routine make-unknown-values-locations () (list (make-stack-pointer-tn) (make-normal-tn *fixnum-primitive-type*))) - -;;; Select-Component-Format -- Interface -;;; -;;; This function is called by the Entry-Analyze phase, allowing -;;; VM-dependent initialization of the IR2-Component structure. We push +;;; This function is called by the ENTRY-ANALYZE phase, allowing +;;; VM-dependent initialization of the IR2-COMPONENT structure. We push ;;; placeholder entries in the Constants to leave room for additional ;;; noise in the code object header. -;;; (!def-vm-support-routine select-component-format (component) (declare (type component component)) (dotimes (i code-constants-offset) @@ -209,12 +195,12 @@ ;;; Emit code needed at the return-point from an unknown-values call -;;; for a fixed number of values. Values is the head of the TN-Ref +;;; for a fixed number of values. Values is the head of the TN-REF ;;; list for the locations that the values are to be received into. ;;; Nvals is the number of values that are to be received (should ;;; equal the length of Values). ;;; -;;; Move-Temp is a Descriptor-Reg TN used as a temporary. +;;; MOVE-TEMP is a DESCRIPTOR-REG TN used as a temporary. ;;; ;;; This code exploits the fact that in the unknown-values convention, ;;; a single value return returns at the return PC + 8, whereas a @@ -350,8 +336,6 @@ default-value-8 ;;;; Unknown values receiving: -;;; Receive-Unknown-Values -- Internal -;;; ;;; Emit code needed at the return point for an unknown-values call for an ;;; arbitrary number of values. ;;; @@ -603,35 +587,32 @@ default-value-8 ;;; arguments, we don't bother allocating a partial frame, and instead set FP ;;; to SP just before the call. -;;; Define-Full-Call -- Internal -;;; ;;; This macro helps in the definition of full call VOPs by avoiding code ;;; replication in defining the cross-product VOPs. ;;; -;;; Name is the name of the VOP to define. +;;; NAME is the name of the VOP to define. ;;; -;;; Named is true if the first argument is a symbol whose global function +;;; NAMED is true if the first argument is a symbol whose global function ;;; definition is to be called. ;;; -;;; Return is either :Fixed, :Unknown or :Tail: -;;; -- If :Fixed, then the call is for a fixed number of values, returned in +;;; RETURN is either :FIXED, :UNKNOWN or :TAIL: +;;; -- If :FIXED, then the call is for a fixed number of values, returned in ;;; the standard passing locations (passed as result operands). -;;; -- If :Unknown, then the result values are pushed on the stack, and the +;;; -- If :UNKNOWN, then the result values are pushed on the stack, and the ;;; result values are specified by the Start and Count as in the ;;; unknown-values continuation representation. -;;; -- If :Tail, then do a tail-recursive call. No values are returned. +;;; -- If :TAIL, then do a tail-recursive call. No values are returned. ;;; The Old-Fp and Return-PC are passed as the second and third arguments. ;;; ;;; In non-tail calls, the pointer to the stack arguments is passed as the last -;;; fixed argument. If Variable is false, then the passing locations are -;;; passed as a more arg. Variable is true if there are a variable number of -;;; arguments passed on the stack. Variable cannot be specified with :Tail +;;; fixed argument. If VARIABLE is false, then the passing locations are +;;; passed as a more arg. VARIABLE is true if there are a variable number of +;;; arguments passed on the stack. VARIABLE cannot be specified with :TAIL ;;; return. TR variable argument call is implemented separately. ;;; ;;; In tail call with fixed arguments, the passing locations are passed as a ;;; more arg, but there is no new-FP, since the arguments have been set up in ;;; the current frame. -;;; (defmacro define-full-call (name named return variable) (assert (not (and variable (eq return :tail)))) `(define-vop (,name diff --git a/src/compiler/ppc/macros.lisp b/src/compiler/ppc/macros.lisp index 03748fa..e8c5cdf 100644 --- a/src/compiler/ppc/macros.lisp +++ b/src/compiler/ppc/macros.lisp @@ -102,9 +102,7 @@ ;;;; Stack TN's -;;; Load-Stack-TN, Store-Stack-TN -- Interface -;;; -;;; Move a stack TN to a register and vice-versa. +;;; Move a stack TN to a register and vice-versa. (defmacro load-stack-tn (reg stack) `(let ((reg ,reg) (stack ,stack)) @@ -112,7 +110,6 @@ (sc-case stack ((control-stack) (loadw reg cfp-tn offset)))))) - (defmacro store-stack-tn (stack reg) `(let ((stack ,stack) (reg ,reg)) diff --git a/src/compiler/ppc/memory.lisp b/src/compiler/ppc/memory.lisp index 0e9a19b..6a71ba7 100644 --- a/src/compiler/ppc/memory.lisp +++ b/src/compiler/ppc/memory.lisp @@ -50,10 +50,7 @@ ;;;; Indexed references: -;;; Define-Indexer -- Internal -;;; -;;; Define some VOPs for indexed memory reference. -;;; +;;; Define some VOPs for indexed memory reference. (defmacro define-indexer (name write-p ri-op rr-op shift &optional sign-extend-byte) `(define-vop (,name) (:args (object :scs (descriptor-reg)) diff --git a/src/compiler/ppc/nlx.lisp b/src/compiler/ppc/nlx.lisp index 58506d0..b69a533 100644 --- a/src/compiler/ppc/nlx.lisp +++ b/src/compiler/ppc/nlx.lisp @@ -2,39 +2,29 @@ ;;; (in-package "SB!VM") -;;; MAKE-NLX-SP-TN -- Interface -;;; -;;; Make an environment-live stack TN for saving the SP for NLX entry. -;;; +;;; Make an environment-live stack TN for saving the SP for NLX entry. (!def-vm-support-routine make-nlx-sp-tn (env) (physenv-live-tn (make-representation-tn *fixnum-primitive-type* immediate-arg-scn) env)) -;;; Make-NLX-Entry-Arg-Start-Location -- Interface -;;; -;;; Make a TN for the argument count passing location for a +;;; Make a TN for the argument count passing location for a ;;; non-local entry. -;;; (!def-vm-support-routine make-nlx-entry-arg-start-location () (make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset)) -;;; Save and restore dynamic environment. -;;; -;;; These VOPs are used in the reentered function to restore the appropriate -;;; dynamic environment. Currently we only save the Current-Catch and binding -;;; stack pointer. We don't need to save/restore the current unwind-protect, -;;; since unwind-protects are implicitly processed during unwinding. If there -;;; were any additional stacks, then this would be the place to restore the top +;;; These VOPs are used in the reentered function to restore the +;;; appropriate dynamic environment. Currently we only save the +;;; CURRENT-CATCH and binding stack pointer. We don't need to +;;; save/restore the current unwind-protect, since UNWIND-PROTECTs are +;;; implicitly processed during unwinding. If there were any +;;; additional stacks, then this would be the place to restore the top ;;; pointers. -;;; Make-Dynamic-State-TNs -- Interface -;;; -;;; Return a list of TNs that can be used to snapshot the dynamic state for -;;; use with the Save/Restore-Dynamic-Environment VOPs. -;;; +;;; Return a list of TNs that can be used to snapshot the dynamic state for +;;; use with the Save/Restore-DYNAMIC-ENVIRONMENT VOPs. (!def-vm-support-routine make-dynamic-state-tns () (make-n-tns 4 *backend-t-primitive-type*)) diff --git a/src/compiler/ppc/sanctify.lisp b/src/compiler/ppc/sanctify.lisp index 490dc51..feee980 100644 --- a/src/compiler/ppc/sanctify.lisp +++ b/src/compiler/ppc/sanctify.lisp @@ -16,12 +16,9 @@ -;;; SANCTIFY-FOR-EXECUTION -- Interface. -;;; ;;; Do whatever is necessary to make the given code component executable. ;;; On the 601, we have less to do than on some other PowerPC chips. -;;; This should what needs to be done in the general case. -;;; +;;; This should be what needs to be done in the general case. (defun sanctify-for-execution (component) (without-gcing (alien-funcall (extern-alien "ppc_flush_icache" diff --git a/src/compiler/ppc/static-fn.lisp b/src/compiler/ppc/static-fn.lisp index faf19e6..820b676 100644 --- a/src/compiler/ppc/static-fn.lisp +++ b/src/compiler/ppc/static-fn.lisp @@ -105,8 +105,7 @@ ,@(moves (result-names) (temp-names)))))))) -) ; eval-when (:compile-toplevel :load-toplevel :execute) - +) ; EVAL-WHEN (macrolet ((frob (num-args num-res) (static-fun-template-vop (eval num-args) (eval num-res)))) @@ -117,7 +116,6 @@ (frob 4 1) #|(frob 5 1)|#) - (defmacro define-static-fun (name args &key (results '(x)) translate policy cost arg-types result-types) `(define-vop (,name diff --git a/src/compiler/ppc/vm.lisp b/src/compiler/ppc/vm.lisp index 2b0a7cd..1a0333b 100644 --- a/src/compiler/ppc/vm.lisp +++ b/src/compiler/ppc/vm.lisp @@ -242,14 +242,9 @@ (defregtn cfp any-reg) (defregtn ocfp any-reg) (defregtn nsp any-reg)) - - -;;; Immediate-Constant-SC -- Interface -;;; -;;; If value can be represented as an immediate constant, then return the +;;; If VALUE can be represented as an immediate constant, then return the ;;; appropriate SC number, otherwise return NIL. -;;; (!def-vm-support-routine immediate-constant-sc (value) (typecase value ((integer 0 0) @@ -262,32 +257,28 @@ (if (static-symbol-p value) (sc-number-or-lose 'immediate) nil)))) - -;;;; Function Call Parameters +;;;; function call parameters -;;; The SC numbers for register and stack arguments/return values. -;;; +;;; the SC numbers for register and stack arguments/return values (def!constant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg)) (def!constant immediate-arg-scn (meta-sc-number-or-lose 'any-reg)) (def!constant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack)) (eval-when (:compile-toplevel :load-toplevel :execute) -;;; Offsets of special stack frame locations +;;; offsets of special stack frame locations (def!constant ocfp-save-offset 0) (def!constant lra-save-offset 1) (def!constant nfp-save-offset 2) -;;; The number of arguments/return values passed in registers. -;;; +;;; the number of arguments/return values passed in registers (def!constant register-arg-count 4) -;;; Names to use for the argument registers. -;;; +;;; names to use for the argument registers -); Eval-When (:compile-toplevel :load-toplevel :execute) +) ; EVAL-WHEN ;;; A list of TN's describing the register arguments. @@ -301,18 +292,11 @@ (export 'single-value-return-byte-offset) -;;; SINGLE-VALUE-RETURN-BYTE-OFFSET -;;; ;;; This is used by the debugger. -;;; (def!constant single-value-return-byte-offset 8) - -;;; LOCATION-PRINT-NAME -- Interface -;;; -;;; This function is called by debug output routines that want a pretty name +;;; This function is called by debug output routines that want a pretty name ;;; for a TN's location. It returns a thing that can be printed with PRINC. -;;; (!def-vm-support-routine location-print-name (tn) (declare (type tn tn)) (let ((sb (sb-name (sc-sb (tn-sc tn)))) @@ -327,7 +311,7 @@ (immediate-constant "Immed")))) ;;; The loader uses this to convert alien names to the form they -;;; occur in the symbol table. This is ELF, so do nothing +;;; occur in the symbol table. This is ELF, so do nothing. (defun extern-alien-name (name) (declare (type simple-base-string name)) diff --git a/src/compiler/sparc/call.lisp b/src/compiler/sparc/call.lisp index 6d8098e..6a0b2a3 100644 --- a/src/compiler/sparc/call.lisp +++ b/src/compiler/sparc/call.lisp @@ -34,9 +34,9 @@ (make-wired-tn *backend-t-primitive-type* register-arg-scn lra-offset) (make-restricted-tn *backend-t-primitive-type* register-arg-scn))) -;;; Similar to Make-Return-PC-Passing-Location, but makes a location -;;; to pass Old-FP in. This is (obviously) wired in the standard -;;; convention, but is totally unrestricted in non-standard +;;; This is similar to MAKE-RETURN-PC-PASSING-LOCATION, but makes a +;;; location to pass OLD-FP in. This is (obviously) wired in the +;;; standard convention, but is totally unrestricted in non-standard ;;; conventions, since we can always fetch it off of the stack using ;;; the arg pointer. (!def-vm-support-routine make-old-fp-passing-location (standard) @@ -87,9 +87,9 @@ (make-normal-tn *fixnum-primitive-type*))) -;;; This function is called by the Entry-Analyze phase, allowing -;;; VM-dependent initialization of the IR2-Component structure. We push -;;; placeholder entries in the Constants to leave room for additional +;;; This function is called by the ENTRY-ANALYZE phase, allowing +;;; VM-dependent initialization of the IR2-COMPONENT structure. We push +;;; placeholder entries in the CONSTANTS to leave room for additional ;;; noise in the code object header. (!def-vm-support-routine select-component-format (component) (declare (type component component)) @@ -182,7 +182,7 @@ ;;; Emit code needed at the return-point from an unknown-values call -;;; for a fixed number of values. Values is the head of the TN-Ref +;;; for a fixed number of values. Values is the head of the TN-REF ;;; list for the locations that the values are to be received into. ;;; Nvals is the number of values that are to be received (should ;;; equal the length of Values). @@ -317,8 +317,6 @@ default-value-8 (values)) -;;; Receive-Unknown-Values -- Internal -;;; ;;; Emit code needed at the return point for an unknown-values call ;;; for an arbitrary number of values. ;;; @@ -330,12 +328,12 @@ default-value-8 ;;; returning the old SP and 1. ;;; ;;; When there is a variable number of values, we move all of the -;;; argument registers onto the stack, and return Args and Nargs. +;;; argument registers onto the stack, and return ARGS and NARGS. ;;; -;;; Args and Nargs are TNs wired to the named locations. We must +;;; ARGS and NARGS are TNs wired to the named locations. We must ;;; explicitly allocate these TNs, since their lifetimes overlap with -;;; the results Start and Count (also, it's nice to be able to target -;;; them). +;;; the results START and COUNT. (Also, it's nice to be able to target +;;; them.) (defun receive-unknown-values (args nargs start count lra-label temp) (declare (type tn args nargs start count temp)) (let ((variable-values (gen-label)) diff --git a/src/compiler/sparc/insts.lisp b/src/compiler/sparc/insts.lisp index 5f0b275..7f05f71 100644 --- a/src/compiler/sparc/insts.lisp +++ b/src/compiler/sparc/insts.lisp @@ -949,7 +949,7 @@ about function addresses and register values.") (with-ref-format `(:NAME :TAB rd ", " ,ref-format)) #'equalp) -) ; eval-when (compile eval) +) ; EVAL-WHEN (macrolet ((define-f3-inst (name op op3 &key fixup load-store (dest-kind 'reg) (printer :default) reads writes flushable print-name) diff --git a/src/compiler/sparc/macros.lisp b/src/compiler/sparc/macros.lisp index a7c2abd..6ab3463 100644 --- a/src/compiler/sparc/macros.lisp +++ b/src/compiler/sparc/macros.lisp @@ -100,11 +100,9 @@ -;;;; Stack TN's +;;;; stack TN's -;;; Load-Stack-TN, Store-Stack-TN -- Interface -;;; -;;; Move a stack TN to a register and vice-versa. +;;; Move a stack TN to a register and vice-versa. (defmacro load-stack-tn (reg stack) `(let ((reg ,reg) (stack ,stack)) diff --git a/src/compiler/sparc/vm.lisp b/src/compiler/sparc/vm.lisp index 40eca83..cf1041d 100644 --- a/src/compiler/sparc/vm.lisp +++ b/src/compiler/sparc/vm.lisp @@ -271,11 +271,8 @@ ;; A catch or unwind block. (catch-block control-stack :element-size sb!vm::kludge-nondeterministic-catch-block-size)) - - -;;;; Make some random tns for important registers. - +;;;; Make some miscellaneous TNs for important registers. (macrolet ((defregtn (name sc) (let ((offset-sym (symbolicate name "-OFFSET")) (tn-sym (symbolicate name "-TN"))) @@ -294,10 +291,8 @@ (defregtn cfp any-reg) (defregtn ocfp any-reg) (defregtn nsp any-reg)) - - -;;; If value can be represented as an immediate constant, then return the +;;; If VALUE can be represented as an immediate constant, then return the ;;; appropriate SC number, otherwise return NIL. (!def-vm-support-routine immediate-constant-sc (value) (typecase value @@ -311,7 +306,6 @@ (if (static-symbol-p value) (sc-number-or-lose 'immediate) nil)))) - ;;;; function call parameters @@ -328,16 +322,14 @@ (def!constant nfp-save-offset 2) ;; the number of arguments/return values passed in registers. - ;; (def!constant register-arg-count 6) ;; names to use for the argument registers. - ;; (defparameter register-arg-names '(a0 a1 a2 a3 a4 a5)) -); eval-when (:compile-toplevel :load-toplevel :execute) +) ; EVAL-WHEN -;;; a list of TN's describing the register arguments. +;;; a list of TN's describing the register arguments (defparameter *register-arg-tns* (mapcar (lambda (n) (make-random-tn :kind :normal @@ -347,7 +339,6 @@ ;;; This is used by the debugger. (def!constant single-value-return-byte-offset 8) - ;;; This function is called by debug output routines that want a ;;; pretty name for a TN's location. It returns a thing that can be diff --git a/src/compiler/tn.lisp b/src/compiler/tn.lisp index 8ec5260..11a8334 100644 --- a/src/compiler/tn.lisp +++ b/src/compiler/tn.lisp @@ -16,9 +16,9 @@ ;;; in this component. (defvar *component-being-compiled*) -;;; Do-Packed-TNs (TN-Var Component [Result]) Declaration* Form* +;;; DO-PACKED-TNS (TN-Var Component [Result]) Declaration* Form* ;;; -;;; Iterate over all packed TNs allocated in Component. +;;; Iterate over all packed TNs allocated in COMPONENT. (defmacro do-packed-tns ((tn component &optional result) &body body) (let ((n-component (gensym))) `(let ((,n-component (component-info ,component))) @@ -267,9 +267,10 @@ ;;;; TN referencing -;;; Make a TN-Ref that references TN and return it. Write-P should be true -;;; if this is a write reference, otherwise false. All we do other than -;;; calling the constructor is add the reference to the TN's references. +;;; Make a TN-REF that references TN and return it. WRITE-P should be +;;; true if this is a write reference, otherwise false. All we do +;;; other than calling the constructor is add the reference to the +;;; TN's references. (defun reference-tn (tn write-p) (declare (type tn tn) (type boolean write-p)) (let ((res (make-tn-ref tn write-p))) @@ -278,10 +279,10 @@ (push-in tn-ref-next res (tn-reads tn))) res)) -;;; Make TN-Refs to reference each TN in TNs, linked together by -;;; TN-Ref-Across. Write-P is the Write-P value for the refs. More is -;;; stuck in the TN-Ref-Across of the ref for the last TN, or returned as the -;;; result if there are no TNs. +;;; Make TN-REFS to reference each TN in TNs, linked together by +;;; TN-REF-ACROSS. WRITE-P is the WRITE-P value for the refs. MORE is +;;; stuck in the TN-REF-ACROSS of the ref for the last TN, or returned +;;; as the result if there are no TNs. (defun reference-tn-list (tns write-p &optional more) (declare (list tns) (type boolean write-p) (type (or tn-ref null) more)) (if tns @@ -304,7 +305,7 @@ (values)) ;;; Do stuff to change the TN referenced by Ref. We remove Ref from its -;;; old TN's refs, add ref to TN's refs, and set the TN-Ref-TN. +;;; old TN's refs, add ref to TN's refs, and set the TN-REF-TN. (defun change-tn-ref-tn (ref tn) (declare (type tn-ref ref) (type tn tn)) (delete-tn-ref ref) @@ -404,7 +405,7 @@ (setf (ir2-block-start-vop block) first)))) (values)) -;;; Delete all of the TN-Refs associated with VOP and remove VOP from the IR2. +;;; Delete all of the TN-REFs associated with VOP and remove VOP from the IR2. (defun delete-vop (vop) (declare (type vop vop)) (do ((ref (vop-refs vop) (tn-ref-next-ref ref))) diff --git a/src/compiler/vop.lisp b/src/compiler/vop.lisp index 73d89c8..2c2e387 100644 --- a/src/compiler/vop.lisp +++ b/src/compiler/vop.lisp @@ -59,46 +59,46 @@ ;;;; IR1 annotations used for IR2 conversion -;;; Block-Info +;;; BLOCK-INFO ;;; Holds the IR2-BLOCK structure. If there are overflow blocks, ;;; then this points to the first IR2-BLOCK. The BLOCK-INFO of the ;;; dummy component head and tail are dummy IR2 blocks that begin ;;; and end the emission order thread. ;;; -;;; Component-Info +;;; COMPONENT-INFO ;;; Holds the IR2-COMPONENT structure. ;;; -;;; Continuation-Info -;;; Holds the IR2-Continuation structure. Continuations whose +;;; CONTINUATION-INFO +;;; Holds the IR2-CONTINUATION structure. Continuations whose ;;; values aren't used won't have any. ;;; -;;; Cleanup-Info +;;; CLEANUP-INFO ;;; If non-null, then a TN in which the affected dynamic ;;; environment pointer should be saved after the binding is ;;; instantiated. ;;; -;;; Physenv-Info -;;; Holds the Ir2-Physenv structure. +;;; PHYSENV-INFO +;;; Holds the IR2-PHYSENV structure. ;;; -;;; Tail-Set-Info -;;; Holds the Return-Info structure. +;;; TAIL-SET-INFO +;;; Holds the RETURN-INFO structure. ;;; -;;; NLX-Info-Info -;;; Holds the IR2-NLX-Info structure. +;;; NLX-INFO-INFO +;;; Holds the IR2-NLX-INFO structure. ;;; -;;; Leaf-Info +;;; LEAF-INFO ;;; If a non-set lexical variable, the TN that holds the value in ;;; the home environment. If a constant, then the corresponding ;;; constant TN. If an XEP lambda, then the corresponding ;;; Entry-Info structure. ;;; -;;; Basic-Combination-Info +;;; BASIC-COMBINATION-INFO ;;; The template chosen by LTN, or ;;; :FULL if this is definitely a full call. ;;; :FUNNY if this is an oddball thing with IR2-convert. ;;; :LOCAL if this is a local call. ;;; -;;; Node-Tail-P +;;; NODE-TAIL-P ;;; After LTN analysis, this is true only in combination nodes that are ;;; truly tail recursive. @@ -117,7 +117,7 @@ ;; Similarly, a continuation is POPPED if its DEST is in this block ;; but has its uses elsewhere. The continuations are in the order ;; that are pushed/popped in the block. Note that the args to a - ;; single MV-Combination appear reversed in POPPED, since we must + ;; single MV-COMBINATION appear reversed in POPPED, since we must ;; effectively pop the last argument first. All pops must come ;; before all pushes (although internal MV uses may be interleaved.) ;; POPPED is computed by LTN, and PUSHED is computed by stack @@ -422,7 +422,7 @@ (:copier nil)) ;; VOP-INFO structure containing static info about the operation (info nil :type (or vop-info null)) - ;; the IR2-Block this VOP is in + ;; the IR2-BLOCK this VOP is in (block (missing-arg) :type ir2-block) ;; VOPs evaluated after and before this one. Null at the ;; beginning/end of the block, and temporarily during IR2 @@ -546,11 +546,11 @@ (info-arg-count 0 :type index) ;; a function that emits the VOPs for this template. Arguments: ;; 1] Node for source context. - ;; 2] IR2-Block that we place the VOP in. + ;; 2] IR2-BLOCK that we place the VOP in. ;; 3] This structure. - ;; 4] Head of argument TN-Ref list. - ;; 5] Head of result TN-Ref list. - ;; 6] If Info-Arg-Count is non-zero, then a list of the magic + ;; 4] Head of argument TN-REF list. + ;; 5] Head of result TN-REF list. + ;; 6] If INFO-ARG-COUNT is non-zero, then a list of the magic ;; arguments. ;; ;; Two values are returned: the first and last VOP emitted. This vop @@ -883,7 +883,7 @@ (leaf nil :type (or leaf null)) ;; thread that links TNs together so that we can find them (next nil :type (or tn null)) - ;; head of TN-Ref lists for reads and writes of this TN + ;; head of TN-REF lists for reads and writes of this TN (reads nil :type (or tn-ref null)) (writes nil :type (or tn-ref null)) ;; a link we use when building various temporary TN lists diff --git a/src/compiler/x86/call.lisp b/src/compiler/x86/call.lisp index 2af3702..173e485 100644 --- a/src/compiler/x86/call.lisp +++ b/src/compiler/x86/call.lisp @@ -31,8 +31,8 @@ (make-wired-tn (primitive-type-or-lose 'system-area-pointer) sap-stack-sc-number return-pc-save-offset)) -;;; Similar to Make-Return-PC-Passing-Location, but makes a location -;;; to pass Old-FP in. +;;; This is similar to MAKE-RETURN-PC-PASSING-LOCATION, but makes a +;;; location to pass OLD-FP in. ;;; ;;; This is wired in both the standard and the local-call conventions, ;;; because we want to be able to assume it's always there. Besides, @@ -172,12 +172,12 @@ (inst sub esp-tn (* (max nargs 3) n-word-bytes)))) ;;; Emit code needed at the return-point from an unknown-values call -;;; for a fixed number of values. Values is the head of the TN-Ref +;;; for a fixed number of values. Values is the head of the TN-REF ;;; list for the locations that the values are to be received into. ;;; Nvals is the number of values that are to be received (should ;;; equal the length of Values). ;;; -;;; Move-Temp is a Descriptor-Reg TN used as a temporary. +;;; MOVE-TEMP is a DESCRIPTOR-REG TN used as a temporary. ;;; ;;; This code exploits the fact that in the unknown-values convention, ;;; a single value return returns at the return PC + 2, whereas a diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp index 72013e8..e8572ce 100644 --- a/tests/compiler.impure.lisp +++ b/tests/compiler.impure.lisp @@ -336,6 +336,18 @@ BUG 48c, not yet fixed: (if x t (if y t (dont-constrain-if-too-much x y)))) (assert (null (dont-constrain-if-too-much-aux nil nil))) + +;;; TYPE-ERROR confusion ca. sbcl-0.7.7.24, reported and fixed by +;;; APD sbcl-devel 2002-09-14 +(defun exercise-0-7-7-24-bug (x) + (declare (integer x)) + (let (y) + (setf y (the single-float (if (> x 0) x 3f0))) + (list y y))) +(multiple-value-bind (v e) (ignore-errors (exercise-0-7-7-24-bug 4)) + (assert (null v)) + (assert (typep e 'type-error))) +(assert (equal (exercise-0-7-7-24-bug -4) '(3f0 3f0))) ;;;; tests not in the problem domain, but of the consistency of the ;;;; compiler machinery itself diff --git a/version.lisp-expr b/version.lisp-expr index 0e50f7e..188e59a 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; internal versions off the main CVS branch, it gets hairier, e.g. ;;; "0.pre7.14.flaky4.13".) -"0.7.7.25" +"0.7.7.26" -- 1.7.10.4