(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
;;; ...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)
;; 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
"HPPA")
\f
-;;; 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))
#!-little-endian "big-endian")
\f
-;;; 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))
(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)
\f
-;;; 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))
(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))
(res (compute-one-setter sym type))))))
`(progn ,@(res))))
-); eval-when (compile eval)
+) ; EVAL-WHEN
(define-setters ("COMMON-LISP")
;; Semantically silly...
(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).
(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*))
;;;
;;; 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.
;;; -- 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
;;; 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)
(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)
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
(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)
(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)
(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)))
(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
\f
;;;; 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)
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)
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)
\f
;;;; 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))
(inst addi (* nargs n-word-bytes) csp-tn csp-tn))))
\f
-;;; 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
\f
;;;; 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.
;;;
;;; 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.
;;;
\f
;;;; 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))
(sc-case stack
((control-stack)
(loadw reg cfp-tn offset))))))
-
(defmacro store-stack-tn (stack reg)
`(let ((stack ,stack)
(reg ,reg))
(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))
;;; 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*))
(load-stack-tn cur-nfp nfp-save))
,@(moves (temp-names) (result-names))))))))
-) ; eval-when (compile load eval)
+) ; EVAL-WHEN
(macrolet
((foo ()
:offset 0))
\f
-;;; 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)
;;;
(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.
:offset n))
*register-arg-offsets*))
-;;; SINGLE-VALUE-RETURN-BYTE-OFFSET
-;;;
;;; This is used by the debugger.
-;;;
(defconstant single-value-return-byte-offset 4)
-
\f
-;;; 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))))
;;;; 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
\f
;;;; 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
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))
;; 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.
(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
;;; 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
(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
(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
(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.
;;;
(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*)
(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)
,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))
(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))
;;;; 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)
(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)
(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
;;; 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.
;;;; 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)
;;;
;;; 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.
;;;
(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)
,@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))
\f
;;;; 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)
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)
\f
-;;; 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
\f
;;;; 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.
;;;
;;; 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.
;;;
\f
;;;; 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))
(sc-case stack
((control-stack)
(loadw reg cfp-tn offset))))))
-
(defmacro store-stack-tn (stack reg)
`(let ((stack ,stack)
(reg ,reg))
(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 ()
\f
;;; 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
;;; 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*))
,@(moves (result-names) (temp-names))))))))
-) ; eval-when (compile load eval)
+) ; EVAL-WHEN
(expand
(defregtn nsp any-reg)
(defregtn nfp any-reg))
\f
-;;;
-;;; 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)
;;;
(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.
:offset n))
*register-arg-offsets*))
-;;; SINGLE-VALUE-RETURN-BYTE-OFFSET
-;;;
;;; This is used by the debugger.
-;;;
(defconstant single-value-return-byte-offset 8)
-
\f
-;;; 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))))
;; 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
;;; 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
;;; 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
;;; 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)
(!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)
;;; 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
\f
;;;; 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.
;;;
;;; 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
\f
;;;; 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))
(sc-case stack
((control-stack)
(loadw reg cfp-tn offset))))))
-
(defmacro store-stack-tn (stack reg)
`(let ((stack ,stack)
(reg ,reg))
\f
;;;; 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))
;;;
(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))
\f
-;;; 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*))
\f
-;;; 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"
,@(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))))
(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
(defregtn cfp any-reg)
(defregtn ocfp any-reg)
(defregtn nsp any-reg))
-
-
\f
-;;; 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)
(if (static-symbol-p value)
(sc-number-or-lose 'immediate)
nil))))
-
\f
-;;;; 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.
(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)
-
\f
-;;; 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))))
(immediate-constant "Immed"))))
\f
;;; 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))
(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)
(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))
\f
;;; 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).
(values))
\f
-;;; Receive-Unknown-Values -- Internal
-;;;
;;; Emit code needed at the return point for an unknown-values call
;;; for an arbitrary number of values.
;;;
;;; 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))
(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)
\f
-;;;; 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))
;; A catch or unwind block.
(catch-block control-stack :element-size sb!vm::kludge-nondeterministic-catch-block-size))
-
-
\f
-;;;; 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")))
(defregtn cfp any-reg)
(defregtn ocfp any-reg)
(defregtn nsp any-reg))
-
-
\f
-;;; 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
(if (static-symbol-p value)
(sc-number-or-lose 'immediate)
nil))))
-
\f
;;;; function call parameters
(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
;;; This is used by the debugger.
(def!constant single-value-return-byte-offset 8)
-
\f
;;; 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
;;; 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)))
\f
;;;; 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)))
(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
(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)
(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)))
\f
;;;; 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.
;; 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
(: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
(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
(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
(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,
(inst sub esp-tn (* (max nargs 3) n-word-bytes))))
\f
;;; 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
(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)))
\f
;;;; tests not in the problem domain, but of the consistency of the
;;;; compiler machinery itself
;;; 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"
projects / sbcl.git / commitdiff