(bar x)))
shouldn't compile without error (because of the extra DEFMACRO symbol).
-130:
- reported by Alexey Dejneka on sbcl-devel 2001-11-03
- (defun x (x)
- "Return X if X is a non-negative integer."
- (let ((step (lambda (%funcall)
- (lambda (n)
- (cond ((= n 0) 0)
- (t (1+ (funcall %funcall (1- n)))))))))
- (funcall
- ((lambda (a)
- (funcall step (lambda (n)
- (funcall (funcall a a) n))))
- (lambda (a)
- (funcall step (lambda (n)
- (funcall (funcall a a) n)))))
- x)))
- This function returns its argument. But after removing percents it
- does not work: "Result of (1- n) is not a function".
-
131:
As of sbcl-0.pre7.86.flaky7.3, the cross-compiler, and probably
the CL:COMPILE function (which is based on the same %COMPILE
"VM-SUPPORT-ROUTINES-PRIMITIVE-TYPE-OF"
"VM-SUPPORT-ROUTINES-PRIMITIVE-TYPE"
"VM-SUPPORT-ROUTINES-MAKE-CALL-OUT-TNS"
- "VM-SUPPORT-ROUTINES-STANDARD-ARGUMENT-LOCATION"
+ "VM-SUPPORT-ROUTINES-STANDARD-ARG-LOCATION"
"VM-SUPPORT-ROUTINES-MAKE-RETURN-PC-PASSING-LOCATION"
"VM-SUPPORT-ROUTINES-MAKE-OLD-FP-PASSING-LOCATION"
"VM-SUPPORT-ROUTINES-MAKE-OLD-FP-SAVE-LOCATION"
"SET-ADDRESS-PRINTING-RANGE" "SET-DISASSEM-PARAMS"
"SET-DSTATE-SEGMENT" "SIGN-EXTEND" "SPECIALIZE"
"GEN-PRINTER-DEF-FORMS-DEF-FORM" "MAKE-DSTATE"
- "DEFINE-ARGUMENT-TYPE" "GEN-ARG-TYPE-DEF-FORM"
+ "DEFINE-ARG-TYPE" "GEN-ARG-TYPE-DEF-FORM"
"READ-SIGNED-SUFFIX" "ADD-OFFS-HOOK"
"MAKE-MEMORY-SEGMENT" "GEN-PREAMBLE-FORM"
"MAKE-SEGMENT" "SEGMENT-OVERFLOW"
#!/bin/sh
-# ("smooth duct tape: the mark of a true craftsman":-)
-
# a quick and dirty way of partially rebuilding the system after a
# change
#
-# This script is not a reliable way to build the system, but it is
-# fast.:-| It can be useful if you are trying to debug a low-level
-# problem, e.g. a problem in src/runtime/*.c or in
-# src/code/cold-init.lisp, and you find yourself wanting to make a
-# small change and test it without going through the entire
-# build-the-system-from-scratch cycle.
-#
-# You probably don't want to be using this script unless you
-# understand the system build process well enough to be able to guess
-# when it won't work.
+# ("smooth duct tape: the mark of a true craftsman":-)
# This software is part of the SBCL system. See the README file for
# more information.
# provided with absolutely no warranty. See the COPYING and CREDITS
# files for more information.
+#######################################################################
+# You probably don't want to be using this script unless you
+# understand the ordinary system build process pretty well already.
+#
+# This script is not a reliable way to build the system, but it is
+# fast.:-| It can be useful if you are trying to debug a low-level
+# problem, e.g. a problem in src/runtime/*.c or in
+# src/code/cold-init.lisp. Soon, you'll find yourself wanting to
+# test a small change in a file compiled into cold-sbcl.core without
+# redoing the entire rebuild-the-system-from-scratch process. You may be
+# able to avoid a complete make-host-2.sh by just letting this script
+# rebuild only files that have changed. On the other hand, it might
+# not work...
+#
+# It's not anywhere rigorously correct for all small changes, much
+# less for all large changes. It can't be, unless we either solve the
+# halting problem or totally rearchitect the SBCL sources to support
+# incremental recompilation. Beyond that fundamental limitation, even
+# an easy special case might not work unless someone's paid attention
+# to making it work. Here are some highlights to help you understand
+# when it will work:
+# * It will rebuild a .fasl file when the corresponding
+# .lisp file is out of date.
+# * It rebuilds the src/runtime/ files completely, since that
+# doesn't take very long anyway.
+# * Apparently it will not rebuild assembly-code-in-.lisp files
+# even when the sources are out of date. This is probably not a
+# fundamental limitation, it's just that I (WHN 2002-01-16)
+# have made vanishingly nontrivial changes to assembler files,
+# so I'm not motivated. If you're motivated, please send a patch.
+# * It will not notice when you change something in one .lisp file
+# which should affect the compilation of code in another .lisp
+# file. E.g.
+# ** changing the definition of a macro used in another file (or a
+# function or a variable which is used at macroexpansion time)
+# ** changing the value of a DEFCONSTANT used in another file
+# ** changing the layout of a structure used in another file
+# ** changing the PROCLAIMed type of something used in another
+# file
+# Mostly it looks as though such limitations aren't fixable without
+# the aforementioned rearchitecting or solving the halting problem.
+#######################################################################
+
if [ "" != "$*" ]; then
echo no command line arguments supported in this version of slam
exit 1
;;; Return a wired TN describing the N'th full call argument passing
;;; location.
-(!def-vm-support-routine standard-argument-location (n)
+(!def-vm-support-routine standard-arg-location (n)
(declare (type unsigned-byte n))
(if (< n register-arg-count)
(make-wired-tn *backend-t-primitive-type*
(define-move-vop base-char-move :move
(base-char-reg) (base-char-reg))
-
;;; Move untagged base-char arguments/return-values.
-(define-vop (move-base-char-argument)
+(define-vop (move-base-char-arg)
(:args (x :target y
:scs (base-char-reg))
(fp :scs (any-reg)
(base-char-stack
(storew x fp (tn-offset y))))))
;;;
-(define-move-vop move-base-char-argument :move-argument
+(define-move-vop move-base-char-arg :move-arg
(any-reg base-char-reg) (base-char-reg))
-;;; Use standard MOVE-ARGUMENT + coercion to move an untagged base-char
+;;; Use standard MOVE-ARG + coercion to move an untagged base-char
;;; to a descriptor passing location.
;;;
-(define-move-vop move-argument :move-argument
+(define-move-vop move-arg :move-arg
(base-char-reg) (any-reg descriptor-reg))
\f
;;;; other operations
,@(if double-p
'((inst stt x offset nfp))
'((inst sts x offset nfp))))))))
- (define-move-vop ,name :move-argument
+ (define-move-vop ,name :move-arg
(,sc descriptor-reg) (,sc)))))
- (frob move-single-float-argument single-reg single-stack nil)
- (frob move-double-float-argument double-reg double-stack t))
+ (frob move-single-float-arg single-reg single-stack nil)
+ (frob move-double-float-arg double-reg double-stack t))
\f
;;;; complex float move functions
(descriptor-reg) (complex-double-reg))
;;;
-;;; complex float move-argument vop
+;;; complex float MOVE-ARG VOP
;;;
-(define-vop (move-complex-single-float-argument)
+(define-vop (move-complex-single-float-arg)
(:args (x :scs (complex-single-reg) :target y)
(nfp :scs (any-reg) :load-if (not (sc-is y complex-single-reg))))
(:results (y))
(inst sts real-tn offset nfp))
(let ((imag-tn (complex-single-reg-imag-tn x)))
(inst sts imag-tn (+ offset n-word-bytes) nfp)))))))
-(define-move-vop move-complex-single-float-argument :move-argument
+(define-move-vop move-complex-single-float-arg :move-arg
(complex-single-reg descriptor-reg) (complex-single-reg))
-(define-vop (move-complex-double-float-argument)
+(define-vop (move-complex-double-float-arg)
(:args (x :scs (complex-double-reg) :target y)
(nfp :scs (any-reg) :load-if (not (sc-is y complex-double-reg))))
(:results (y))
(inst stt real-tn offset nfp))
(let ((imag-tn (complex-double-reg-imag-tn x)))
(inst stt imag-tn (+ offset (* 2 n-word-bytes)) nfp)))))))
-(define-move-vop move-complex-double-float-argument :move-argument
+(define-move-vop move-complex-double-float-arg :move-arg
(complex-double-reg descriptor-reg) (complex-double-reg))
-(define-move-vop move-argument :move-argument
+(define-move-vop move-arg :move-arg
(single-reg double-reg complex-single-reg complex-double-reg)
(descriptor-reg))
(t (make-symbol (concatenate 'string "$" name)))))
*register-names*))
-(sb!disassem:define-argument-type reg
+(sb!disassem:define-arg-type reg
:printer (lambda (value stream dstate)
(declare (stream stream) (fixnum value))
(let ((regname (aref reg-symbols value)))
(loop for n from 0 to 31 collect (make-symbol (format nil "~D" n)))
'vector))
-(sb!disassem:define-argument-type fp-reg
+(sb!disassem:define-arg-type fp-reg
:printer (lambda (value stream dstate)
(declare (stream stream) (fixnum value))
(let ((regname (aref float-reg-symbols value)))
regname
dstate))))
-(sb!disassem:define-argument-type relative-label
+(sb!disassem:define-arg-type relative-label
:sign-extend t
:use-label (lambda (value dstate)
(declare (type (signed-byte 21) value)
(any-reg descriptor-reg zero null)
(any-reg descriptor-reg))
-;;; Make Move the check VOP for T so that type check generation
+;;; Make MOVE the check VOP for T so that type check generation
;;; doesn't think it is a hairy type. This also allows checking of a
;;; few of the values in a continuation to fall out.
(primitive-type-vop move (:check) t)
-;;; The Move-Argument VOP is used for moving descriptor values into
+;;; The MOVE-ARG VOP is used for moving descriptor values into
;;; another frame for argument or known value passing.
-(define-vop (move-argument)
+(define-vop (move-arg)
(:args (x :target y
:scs (any-reg descriptor-reg null zero))
(fp :scs (any-reg)
(control-stack
(storew x fp (tn-offset y))))))
;;;
-(define-move-vop move-argument :move-argument
+(define-move-vop move-arg :move-arg
(any-reg descriptor-reg null zero)
(any-reg descriptor-reg))
\f
(signed-reg unsigned-reg) (signed-reg unsigned-reg))
;;; Move untagged number arguments/return-values.
-(define-vop (move-word-argument)
+(define-vop (move-word-arg)
(:args (x :target y
:scs (signed-reg unsigned-reg))
(fp :scs (any-reg)
((signed-stack unsigned-stack)
(storeq x fp (tn-offset y))))))
;;;
-(define-move-vop move-word-argument :move-argument
+(define-move-vop move-word-arg :move-arg
(descriptor-reg any-reg signed-reg unsigned-reg) (signed-reg unsigned-reg))
-;;; Use standard MOVE-ARGUMENT + coercion to move an untagged number
+;;; Use standard MOVE-ARG + coercion to move an untagged number
;;; to a descriptor passing location.
-(define-move-vop move-argument :move-argument
+(define-move-vop move-arg :move-arg
(signed-reg unsigned-reg) (any-reg descriptor-reg))
(sap-reg) (sap-reg))
;;; Move untagged SAP arguments/return-values.
-(define-vop (move-sap-argument)
+(define-vop (move-sap-arg)
(:args (x :target y
:scs (sap-reg))
(fp :scs (any-reg)
(move x y))
(sap-stack
(storeq x fp (tn-offset y))))))
-(define-move-vop move-sap-argument :move-argument
+(define-move-vop move-sap-arg :move-arg
(descriptor-reg sap-reg) (sap-reg))
-;;; Use standard MOVE-ARGUMENT + coercion to move an untagged sap to a
+;;; Use standard MOVE-ARG + coercion to move an untagged sap to a
;;; descriptor passing location.
-(define-move-vop move-argument :move-argument
+(define-move-vop move-arg :move-arg
(sap-reg) (descriptor-reg))
\f
;;;; SAP-INT and INT-SAP
make-call-out-tns
;; from call.lisp
- standard-argument-location
+ standard-arg-location
make-return-pc-passing-location
make-old-fp-passing-location
make-old-fp-save-location
(defvar *disassem-arg-types* nil)
(defvar *disassem-fun-cache* (make-fun-cache))
-(defstruct (argument (:conc-name arg-)
- (:copier nil))
+(defstruct (arg (:copier nil)
+ (:predicate nil))
(name nil :type symbol)
(fields nil :type list)
fields, they are all sign-extended.
:TYPE arg-type-name
- Inherit any properties of the given argument-type.
+ Inherit any properties of the given argument type.
:PREFILTER function
A function which is called (along with all other prefilters, in the
(let* ((arg-pos (position arg-name args :key #'arg-name))
(arg
(if (null arg-pos)
- (let ((arg (make-argument :name arg-name)))
+ (let ((arg (make-arg :name arg-name)))
(if (null args)
(setf args (list arg))
(push arg (cdr (last args))))
(car (push (cons kind nil) (cdr this-arg-temps))))))
(setf (cdr this-kind-temps) (cons vars forms)))))
\f
-(defmacro define-argument-type (name &rest args)
- #!+sb-doc
- "DEFINE-ARGUMENT-TYPE Name {Key Value}*
- Define a disassembler argument type NAME (which can then be referenced in
- another argument definition using the :TYPE argument). &KEY args are:
-
- :SIGN-EXTEND boolean
- If non-NIL, the raw value of this argument is sign-extended.
-
- :TYPE arg-type-name
- Inherit any properties of given argument-type.
-
- :PREFILTER function
- A function which is called (along with all other prefilters, in the
- order that their arguments appear in the instruction- format) before
- any printing is done, to filter the raw value. Any uses of READ-SUFFIX
- must be done inside a prefilter.
-
- :PRINTER function-string-or-vector
- A function, string, or vector which is used to print an argument of
- this type.
-
- :USE-LABEL
- If non-NIL, the value of an argument of this type is used as an
- address, and if that address occurs inside the disassembled code, it is
- replaced by a label. If this is a function, it is called to filter the
- value."
+;;; DEFINE-ARG-TYPE Name {Key Value}*
+;;;
+;;; Define a disassembler argument type NAME (which can then be referenced in
+;;; another argument definition using the :TYPE argument). &KEY args are:
+;;;
+;;; :SIGN-EXTEND boolean
+;;; If non-NIL, the raw value of this argument is sign-extended.
+;;;
+;;; :TYPE arg-type-name
+;;; Inherit any properties of given arg-type.
+;;;
+;;; :PREFILTER function
+;;; A function which is called (along with all other prefilters,
+;;; in the order that their arguments appear in the instruction-
+;;; format) before any printing is done, to filter the raw value.
+;;; Any uses of READ-SUFFIX must be done inside a prefilter.
+;;;
+;;; :PRINTER function-string-or-vector
+;;; A function, string, or vector which is used to print an argument of
+;;; this type.
+;;;
+;;; :USE-LABEL
+;;; If non-NIL, the value of an argument of this type is used as
+;;; an address, and if that address occurs inside the disassembled
+;;; code, it is replaced by a label. If this is a function, it is
+;;; called to filter the value.
+(defmacro define-arg-type (name &rest args)
(gen-arg-type-def-form name args))
+;;; Generate a form to define a disassembler argument type. See
+;;; DEFINE-ARG-TYPE for more information.
(defun gen-arg-type-def-form (name args &optional (evalp t))
- #!+sb-doc
- "Generate a form to define a disassembler argument type. See
- DEFINE-ARGUMENT-TYPE for more info."
(multiple-value-bind (args wrapper-defs)
(munge-fun-refs args evalp t name)
`(progn
(declare (type unsigned-byte n))
(collect ((res))
(dotimes (i n)
- (res (standard-argument-location i)))
+ (res (standard-arg-location i)))
(res)))
;;; Return a list of TNs wired to the standard value passing
(last nil)
(first nil))
(dotimes (num (length args))
- (let ((loc (standard-argument-location num)))
+ (let ((loc (standard-arg-location num)))
(emit-move node block (continuation-tn node block (elt args num)) loc)
(let ((ref (reference-tn loc nil)))
(if last
(let ((last nil)
(first nil))
(dotimes (num nargs)
- (locs (standard-argument-location num))
+ (locs (standard-arg-location num))
(let ((ref (reference-tn (continuation-tn node block (elt args num))
nil)))
(if last
(leaf-info (first vars))))
(dolist (arg (rest vars))
(when (leaf-refs arg)
- (let ((pass (standard-argument-location n))
+ (let ((pass (standard-arg-location n))
(home (leaf-info arg)))
(if (lambda-var-indirect arg)
(do-make-value-cell node block pass home)
(length locs))
(move-continuation-result node block locs cont))))
(:unwind-protect
- (let ((block-loc (standard-argument-location 0)))
+ (let ((block-loc (standard-arg-location 0)))
(vop uwp-entry node block target block-loc start-loc count-loc)
(move-continuation-result
node block
(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter *sc-vop-slots*
'((:move . sc-move-vops)
- (:move-argument . sc-move-arg-vops))))
+ (:move-arg . sc-move-arg-vops))))
+;;; Make NAME be the VOP used to move values in the specified FROM-SCs
+;;; to the representation of the TO-SCs of each SC pair in SCS.
+;;;
+;;; If KIND is :MOVE-ARG, then the VOP takes an extra argument,
+;;; which is the frame pointer of the frame to move into.
+;;;
;;; We record the VOP and costs for all SCs that we can move between
;;; (including implicit loading).
(defmacro define-move-vop (name kind &rest scs)
- #!+sb-doc
- "Define-Move-VOP Name {:Move | :Move-Argument} {(From-SC*) (To-SC*)}*
- Make Name be the VOP used to move values in the specified From-SCs to the
- representation of the To-SCs. If kind is :Move-Argument, then the VOP takes
- an extra argument, which is the frame pointer of the frame to move into."
(when (or (oddp (length scs)) (null scs))
(error "malformed SCs spec: ~S" scs))
(let ((accessor (or (cdr (assoc kind *sc-vop-slots*))
(ltn-policy :fast :type ltn-policy)
;; stuff used by life analysis
(save-p nil :type (member t nil :compute-only :force-to-stack))
- ;; info about how to emit move-argument VOPs for the more operand in
+ ;; info about how to emit MOVE-ARG VOPs for the &MORE operand in
;; call/return VOPs
(move-args nil :type (member nil :local-call :full-call :known-return)))
(defprinter (vop-parse)
(defun bad-move-arg-error (val pass)
(declare (type tn val pass))
- (error "no :MOVE-ARGUMENT VOP defined to move ~S (SC ~S) to ~
+ (error "no :MOVE-ARG VOP defined to move ~S (SC ~S) to ~
~S (SC ~S)"
val (sc-name (tn-sc val))
pass (sc-name (tn-sc pass))))
;;; Find a move VOP to move from the operand OP-TN to some other
;;; representation corresponding to OTHER-SC and OTHER-PTYPE. SLOT is
-;;; the SC slot that we grab from (move or move-argument). WRITE-P
+;;; the SC slot that we grab from (move or move-arg). WRITE-P
;;; indicates that OP is a VOP result, so OP is the move result and
;;; other is the arg, otherwise OP is the arg and other is the result.
;;;
;; info for automatic emission of move-arg VOPs by representation
;; selection. If NIL, then do nothing special. If non-null, then
;; there must be a more arg. Each more arg is moved to its passing
- ;; location using the appropriate representation-specific
- ;; move-argument VOP. The first (fixed) argument must be the
- ;; control-stack frame pointer for the frame to move into. The first
- ;; info arg is the list of passing locations.
+ ;; location using the appropriate representation-specific MOVE-ARG
+ ;; VOP. The first (fixed) argument must be the control-stack frame
+ ;; pointer for the frame to move into. The first info arg is the
+ ;; list of passing locations.
;;
;; Additional constraints depend on the value:
;;
(in-package "SB!VM")
-;; The MOVE-ARGUMENT vop is going to store args on the stack for
+;; The MOVE-ARG vop is going to store args on the stack for
;; call-out. These tn's will be used for that. move-arg is normally
;; used for things going down the stack but C wants to have args
;; indexed in the positive direction.
;;; Return a wired TN describing the N'th full call argument passing
;;; location.
-(!def-vm-support-routine standard-argument-location (n)
+(!def-vm-support-routine standard-arg-location (n)
(declare (type unsigned-byte n))
(if (< n register-arg-count)
(make-wired-tn *backend-t-primitive-type* descriptor-reg-sc-number
(base-char-reg) (base-char-reg base-char-stack))
;;; Move untagged base-char arguments/return-values.
-(define-vop (move-base-char-argument)
+(define-vop (move-base-char-arg)
(:args (x :target y
:scs (base-char-reg))
(fp :scs (any-reg)
(inst mov
(make-ea :byte :base fp :disp (- (* (1+ (tn-offset y)) 4)))
x)))))
-(define-move-vop move-base-char-argument :move-argument
+(define-move-vop move-base-char-arg :move-arg
(any-reg base-char-reg) (base-char-reg))
-;;; Use standard MOVE-ARGUMENT + coercion to move an untagged base-char
+;;; Use standard MOVE-ARG + coercion to move an untagged base-char
;;; to a descriptor passing location.
-(define-move-vop move-argument :move-argument
+(define-move-vop move-arg :move-arg
(base-char-reg) (any-reg descriptor-reg))
\f
;;;; other operations
;;;; Note these are also used to stuff fp numbers onto the c-call
;;;; stack so the order is different than the lisp-stack.
-;;; the general move-argument vop
+;;; the general MOVE-ARG VOP
(macrolet ((frob (name sc stack-sc format)
`(progn
(define-vop (,name)
(:double '((inst fstd ea)))
#!+long-float
(:long '((store-long-float ea)))))))))))
- (define-move-vop ,name :move-argument
+ (define-move-vop ,name :move-arg
(,sc descriptor-reg) (,sc)))))
- (frob move-single-float-argument single-reg single-stack :single)
- (frob move-double-float-argument double-reg double-stack :double)
+ (frob move-single-float-arg single-reg single-stack :single)
+ (frob move-double-float-arg double-reg double-stack :double)
#!+long-float
- (frob move-long-float-argument long-reg long-stack :long))
+ (frob move-long-float-arg long-reg long-stack :long))
-;;;; complex float move-argument vop
+;;;; complex float MOVE-ARG VOP
(macrolet ((frob (name sc stack-sc format)
`(progn
(define-vop (,name)
'((store-long-float
(ea-for-clf-imag-stack y fp)))))
(inst fxch imag-tn))))))
- (define-move-vop ,name :move-argument
+ (define-move-vop ,name :move-arg
(,sc descriptor-reg) (,sc)))))
- (frob move-complex-single-float-argument
+ (frob move-complex-single-float-arg
complex-single-reg complex-single-stack :single)
- (frob move-complex-double-float-argument
+ (frob move-complex-double-float-arg
complex-double-reg complex-double-stack :double)
#!+long-float
- (frob move-complex-long-float-argument
+ (frob move-complex-long-float-arg
complex-long-reg complex-long-stack :long))
-(define-move-vop move-argument :move-argument
+(define-move-vop move-arg :move-arg
(single-reg double-reg #!+long-float long-reg
complex-single-reg complex-double-reg #!+long-float complex-long-reg)
(descriptor-reg))
\f
;;;; disassembler argument types
-(sb!disassem:define-argument-type displacement
+(sb!disassem:define-arg-type displacement
:sign-extend t
:use-label #'offset-next
:printer (lambda (value stream dstate)
(sb!disassem:maybe-note-assembler-routine value nil dstate)
(print-label value stream dstate)))
-(sb!disassem:define-argument-type accum
+(sb!disassem:define-arg-type accum
:printer (lambda (value stream dstate)
(declare (ignore value)
(type stream stream)
(type sb!disassem:disassem-state dstate))
(print-reg 0 stream dstate)))
-(sb!disassem:define-argument-type word-accum
+(sb!disassem:define-arg-type word-accum
:printer (lambda (value stream dstate)
(declare (ignore value)
(type stream stream)
(type sb!disassem:disassem-state dstate))
(print-word-reg 0 stream dstate)))
-(sb!disassem:define-argument-type reg
+(sb!disassem:define-arg-type reg
:printer #'print-reg)
-(sb!disassem:define-argument-type addr-reg
+(sb!disassem:define-arg-type addr-reg
:printer #'print-addr-reg)
-(sb!disassem:define-argument-type word-reg
+(sb!disassem:define-arg-type word-reg
:printer #'print-word-reg)
-(sb!disassem:define-argument-type imm-addr
+(sb!disassem:define-arg-type imm-addr
:prefilter #'read-address
:printer #'print-label)
-(sb!disassem:define-argument-type imm-data
+(sb!disassem:define-arg-type imm-data
:prefilter (lambda (value dstate)
(declare (ignore value)) ; always nil anyway
(sb!disassem:read-suffix
(width-bits (sb!disassem:dstate-get-prop dstate 'width))
dstate)))
-(sb!disassem:define-argument-type signed-imm-data
+(sb!disassem:define-arg-type signed-imm-data
:prefilter (lambda (value dstate)
(declare (ignore value)) ; always nil anyway
(let ((width (sb!disassem:dstate-get-prop dstate 'width)))
(sb!disassem:read-signed-suffix (width-bits width) dstate))))
-(sb!disassem:define-argument-type signed-imm-byte
+(sb!disassem:define-arg-type signed-imm-byte
:prefilter (lambda (value dstate)
(declare (ignore value)) ; always nil anyway
(sb!disassem:read-signed-suffix 8 dstate)))
-(sb!disassem:define-argument-type signed-imm-dword
+(sb!disassem:define-arg-type signed-imm-dword
:prefilter (lambda (value dstate)
(declare (ignore value)) ; always nil anyway
(sb!disassem:read-signed-suffix 32 dstate)))
-(sb!disassem:define-argument-type imm-word
+(sb!disassem:define-arg-type imm-word
:prefilter (lambda (value dstate)
(declare (ignore value)) ; always nil anyway
(let ((width
(sb!disassem:read-suffix (width-bits width) dstate))))
;;; needed for the ret imm16 instruction
-(sb!disassem:define-argument-type imm-word-16
+(sb!disassem:define-arg-type imm-word-16
:prefilter (lambda (value dstate)
(declare (ignore value)) ; always nil anyway
(sb!disassem:read-suffix 16 dstate)))
-(sb!disassem:define-argument-type reg/mem
+(sb!disassem:define-arg-type reg/mem
:prefilter #'prefilter-reg/mem
:printer #'print-reg/mem)
-(sb!disassem:define-argument-type sized-reg/mem
+(sb!disassem:define-arg-type sized-reg/mem
;; Same as reg/mem, but prints an explicit size indicator for
;; memory references.
:prefilter #'prefilter-reg/mem
:printer #'print-sized-reg/mem)
-(sb!disassem:define-argument-type byte-reg/mem
+(sb!disassem:define-arg-type byte-reg/mem
:prefilter #'prefilter-reg/mem
:printer #'print-byte-reg/mem)
(declare (ignore dstate))
value)
) ; EVAL-WHEN
-(sb!disassem:define-argument-type fp-reg
- :prefilter #'prefilter-fp-reg
- :printer #'print-fp-reg)
+(sb!disassem:define-arg-type fp-reg
+ :prefilter #'prefilter-fp-reg
+ :printer #'print-fp-reg)
-(sb!disassem:define-argument-type width
+(sb!disassem:define-arg-type width
:prefilter #'prefilter-width
:printer (lambda (value stream dstate)
(if;; (zerop value)
(eval-when (:compile-toplevel :load-toplevel :execute)
(setf sb!assem:*assem-scheduler-p* nil))
-(sb!disassem:define-argument-type condition-code
+(sb!disassem:define-arg-type condition-code
:printer *condition-name-vec*)
(defun conditional-opcode (condition)
(any-reg descriptor-reg immediate)
(any-reg descriptor-reg))
-;;; Make Move the check VOP for T so that type check generation
+;;; Make MOVE the check VOP for T so that type check generation
;;; doesn't think it is a hairy type. This also allows checking of a
;;; few of the values in a continuation to fall out.
(primitive-type-vop move (:check) t)
-;;; The Move-Argument VOP is used for moving descriptor values into
+;;; The MOVE-ARG VOP is used for moving descriptor values into
;;; another frame for argument or known value passing.
;;;
;;; Note: It is not going to be possible to move a constant directly
;;; to another frame, except if the destination is a register and in
;;; this case the loading works out.
-(define-vop (move-argument)
+(define-vop (move-arg)
(:args (x :scs (any-reg descriptor-reg immediate) :target y
:load-if (not (and (sc-is y any-reg descriptor-reg)
(sc-is x control-stack))))
;; Lisp stack
(storew x fp (- (1+ (tn-offset y))))))))))
-(define-move-vop move-argument :move-argument
+(define-move-vop move-arg :move-arg
(any-reg descriptor-reg)
(any-reg descriptor-reg))
\f
(signed-reg unsigned-reg) (signed-reg unsigned-reg))
;;; Move untagged number arguments/return-values.
-(define-vop (move-word-argument)
+(define-vop (move-word-arg)
(:args (x :scs (signed-reg unsigned-reg) :target y)
(fp :scs (any-reg) :load-if (not (sc-is y sap-reg))))
(:results (y))
(if (= (tn-offset fp) esp-offset)
(storew x fp (tn-offset y)) ; c-call
(storew x fp (- (1+ (tn-offset y)))))))))
-(define-move-vop move-word-argument :move-argument
+(define-move-vop move-word-arg :move-arg
(descriptor-reg any-reg signed-reg unsigned-reg) (signed-reg unsigned-reg))
-;;; Use standard MOVE-ARGUMENT and coercion to move an untagged number
+;;; Use standard MOVE-ARG and coercion to move an untagged number
;;; to a descriptor passing location.
-(define-move-vop move-argument :move-argument
+(define-move-vop move-arg :move-arg
(signed-reg unsigned-reg) (any-reg descriptor-reg))
(sap-reg) (sap-reg))
;;; Move untagged sap arguments/return-values.
-(define-vop (move-sap-argument)
+(define-vop (move-sap-arg)
(:args (x :target y
:scs (sap-reg))
(fp :scs (any-reg)
(if (= (tn-offset fp) esp-offset)
(storew x fp (tn-offset y)) ; c-call
(storew x fp (- (1+ (tn-offset y)))))))))
-(define-move-vop move-sap-argument :move-argument
+(define-move-vop move-sap-arg :move-arg
(descriptor-reg sap-reg) (sap-reg))
-;;; Use standard MOVE-ARGUMENT + coercion to move an untagged sap to a
+;;; Use standard MOVE-ARG + coercion to move an untagged sap to a
;;; descriptor passing location.
-(define-move-vop move-argument :move-argument
+(define-move-vop move-arg :move-arg
(sap-reg) (descriptor-reg))
\f
;;;; SAP-INT and INT-SAP
(lambda-list (caddr form))
(method-group-specifiers (cadddr form))
(body (cddddr form))
- (arguments-option ())
+ (args-option ())
(gf-var nil))
(when (and (consp (car body)) (eq (caar body) :arguments))
- (setq arguments-option (cdr (pop body))))
+ (setq args-option (cdr (pop body))))
(when (and (consp (car body)) (eq (caar body) :generic-function))
(setq gf-var (cadr (pop body))))
(multiple-value-bind (documentation function)
(make-long-method-combination-function
- type lambda-list method-group-specifiers arguments-option gf-var
+ type lambda-list method-group-specifiers args-option gf-var
body)
`(load-long-defcombin ',type ',documentation #',function))))
applicable-methods))
(defun make-long-method-combination-function
- (type ll method-group-specifiers arguments-option gf-var body)
+ (type ll method-group-specifiers args-option gf-var body)
;;(declare (values documentation function))
(declare (ignore type))
(multiple-value-bind (documentation declarations real-body)
(when gf-var
(push `(,gf-var .generic-function.) (cadr wrapped-body)))
- (when arguments-option
- (setq wrapped-body (deal-with-arguments-option wrapped-body
- arguments-option)))
+ (when args-option
+ (setq wrapped-body (deal-with-args-option wrapped-body args-option)))
(when ll
(setq wrapped-body
;;;
;;; At compute-effective-method time, the symbols in the :arguments
;;; option are bound to the symbols in the intercept lambda list.
-(defun deal-with-arguments-option (wrapped-body arguments-option)
+(defun deal-with-args-option (wrapped-body args-option)
(let* ((intercept-lambda-list
(let (collect)
- (dolist (arg arguments-option)
+ (dolist (arg args-option)
(if (memq arg lambda-list-keywords)
(push arg collect)
(push (gensym) collect)))
(nreverse collect)))
(intercept-rebindings
- (loop for arg in arguments-option
+ (loop for arg in args-option
for int in intercept-lambda-list
unless (memq arg lambda-list-keywords)
collect `(,arg ',int))))
'(values %method-name %method-lambda-list
optimize ftype inline notinline))
-(defvar *var-declarations-with-argument*
+(defvar *var-declarations-with-arg*
'(%class
type))
-(defvar *var-declarations-without-argument*
+(defvar *var-declarations-without-arg*
'(ignore
ignorable special dynamic-extent
;; FIXME: Possibly this entire list and variable could go away.
(push `(declare ,form) outer-decls)
(let ((arg-p
(member declaration-name
- *var-declarations-with-argument*))
+ *var-declarations-with-arg*))
(non-arg-p
(member declaration-name
- *var-declarations-without-argument*))
+ *var-declarations-without-arg*))
(dname (list (pop form)))
(inners nil) (outers nil))
(unless (or arg-p non-arg-p)
declaration-name 'split-declarations
declaration-name
'*non-var-declarations*
- '*var-declarations-with-argument*
- '*var-declarations-without-argument*)
- (push declaration-name
- *var-declarations-without-argument*))
+ '*var-declarations-with-arg*
+ '*var-declarations-without-arg*)
+ (push declaration-name *var-declarations-without-arg*))
(when arg-p
(setq dname (append dname (list (pop form)))))
(dolist (var form)
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.pre7.136"
+"0.pre7.137"
projects / sbcl.git / commitdiff