From: William Harold Newman Date: Wed, 16 Jan 2002 15:40:14 +0000 (+0000) Subject: 0.pre7.137: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=0bca0cb1bf5ce5572ab5cd7ba59f87fed1f2edb0;p=sbcl.git 0.pre7.137: more ARGUMENT-to-ARG abbreviation, mostly from egrepping 'def[^ ]* \(*[^ ]*argument'... ...s/standard-argument/standard-arg/ ...s/char-argument/char-arg/ ...s/float-argument/float-arg/ ...s/move-argument/move-arg/ ...s/sap-argument/sap-arg/ ...s/argument-type/arg-type/ ...s/word-argument/word-arg/ ...s/with-argument/with-arg/ ...s/without-argument/without-arg/ ...s/arguments-option/args-option/ ...s/argument-precedence/arg-precedence/ renamed DEFSTRUCT ARGUMENT to DEFSTRUCT ARG removed BUGS 130 as per CSR sbcl-devel 2002-01-16 cut DB's slam.sh notes from CLiki SBCL internals slam.sh page, pasted them into slam.sh comments, and rewrote them some --- diff --git a/BUGS b/BUGS index 5934e31..081092a 100644 --- a/BUGS +++ b/BUGS @@ -1070,25 +1070,6 @@ Error in function C::GET-LAMBDA-TO-COMPILE: (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 diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index eef0d0a..3cf97ac 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -292,7 +292,7 @@ "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" @@ -425,7 +425,7 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*." "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" diff --git a/slam.sh b/slam.sh index 3cabacf..d62f0a1 100644 --- a/slam.sh +++ b/slam.sh @@ -1,20 +1,9 @@ #!/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. @@ -25,6 +14,49 @@ # 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 diff --git a/src/compiler/alpha/call.lisp b/src/compiler/alpha/call.lisp index bbc3d0a..2acd3cb 100644 --- a/src/compiler/alpha/call.lisp +++ b/src/compiler/alpha/call.lisp @@ -15,7 +15,7 @@ ;;; 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* diff --git a/src/compiler/alpha/char.lisp b/src/compiler/alpha/char.lisp index bb306f2..e3142c6 100644 --- a/src/compiler/alpha/char.lisp +++ b/src/compiler/alpha/char.lisp @@ -49,9 +49,8 @@ (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) @@ -64,14 +63,14 @@ (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)) ;;;; other operations diff --git a/src/compiler/alpha/float.lisp b/src/compiler/alpha/float.lisp index 2b0a2ea..dba65bd 100644 --- a/src/compiler/alpha/float.lisp +++ b/src/compiler/alpha/float.lisp @@ -118,10 +118,10 @@ ,@(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)) ;;;; complex float move functions @@ -306,9 +306,9 @@ (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)) @@ -329,10 +329,10 @@ (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)) @@ -353,11 +353,11 @@ (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)) diff --git a/src/compiler/alpha/insts.lisp b/src/compiler/alpha/insts.lisp index 54c79cc..f17f4a7 100644 --- a/src/compiler/alpha/insts.lisp +++ b/src/compiler/alpha/insts.lisp @@ -54,7 +54,7 @@ (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))) @@ -70,7 +70,7 @@ (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))) @@ -81,7 +81,7 @@ 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) diff --git a/src/compiler/alpha/move.lisp b/src/compiler/alpha/move.lisp index 0b76ace..ffe5885 100644 --- a/src/compiler/alpha/move.lisp +++ b/src/compiler/alpha/move.lisp @@ -97,14 +97,14 @@ (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) @@ -117,7 +117,7 @@ (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)) @@ -298,7 +298,7 @@ (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) @@ -312,11 +312,11 @@ ((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)) diff --git a/src/compiler/alpha/sap.lisp b/src/compiler/alpha/sap.lisp index 5290095..e6c39c5 100644 --- a/src/compiler/alpha/sap.lisp +++ b/src/compiler/alpha/sap.lisp @@ -52,7 +52,7 @@ (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) @@ -64,12 +64,12 @@ (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)) ;;;; SAP-INT and INT-SAP diff --git a/src/compiler/backend.lisp b/src/compiler/backend.lisp index 8b9abe1..5cba2ab 100644 --- a/src/compiler/backend.lisp +++ b/src/compiler/backend.lisp @@ -180,7 +180,7 @@ 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 diff --git a/src/compiler/disassem.lisp b/src/compiler/disassem.lisp index 00702e2..1477c4c 100644 --- a/src/compiler/disassem.lisp +++ b/src/compiler/disassem.lisp @@ -298,8 +298,8 @@ (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) @@ -584,7 +584,7 @@ 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 @@ -666,7 +666,7 @@ (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)))) @@ -816,39 +816,38 @@ (car (push (cons kind nil) (cdr this-arg-temps)))))) (setf (cdr this-kind-temps) (cons vars forms))))) -(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 diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp index 6738a47..32ab726 100644 --- a/src/compiler/ir2tran.lisp +++ b/src/compiler/ir2tran.lisp @@ -396,7 +396,7 @@ (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 @@ -869,7 +869,7 @@ (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 @@ -914,7 +914,7 @@ (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 @@ -1086,7 +1086,7 @@ (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) @@ -1478,7 +1478,7 @@ (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 diff --git a/src/compiler/meta-vmdef.lisp b/src/compiler/meta-vmdef.lisp index 1b8c5ae..e66ea67 100644 --- a/src/compiler/meta-vmdef.lisp +++ b/src/compiler/meta-vmdef.lisp @@ -226,16 +226,17 @@ (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*)) @@ -421,7 +422,7 @@ (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) diff --git a/src/compiler/represent.lisp b/src/compiler/represent.lisp index 7f4a169..ad0add7 100644 --- a/src/compiler/represent.lisp +++ b/src/compiler/represent.lisp @@ -175,7 +175,7 @@ (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)))) @@ -382,7 +382,7 @@ ;;; 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. ;;; diff --git a/src/compiler/vop.lisp b/src/compiler/vop.lisp index be4c40a..457616b 100644 --- a/src/compiler/vop.lisp +++ b/src/compiler/vop.lisp @@ -594,10 +594,10 @@ ;; 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: ;; diff --git a/src/compiler/x86/c-call.lisp b/src/compiler/x86/c-call.lisp index 04b73a8..ca820a6 100644 --- a/src/compiler/x86/c-call.lisp +++ b/src/compiler/x86/c-call.lisp @@ -12,7 +12,7 @@ (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. diff --git a/src/compiler/x86/call.lisp b/src/compiler/x86/call.lisp index 6caa160..a6d4697 100644 --- a/src/compiler/x86/call.lisp +++ b/src/compiler/x86/call.lisp @@ -15,7 +15,7 @@ ;;; 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 diff --git a/src/compiler/x86/char.lisp b/src/compiler/x86/char.lisp index 15a53a4..f5ca821 100644 --- a/src/compiler/x86/char.lisp +++ b/src/compiler/x86/char.lisp @@ -62,7 +62,7 @@ (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) @@ -77,12 +77,12 @@ (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)) ;;;; other operations diff --git a/src/compiler/x86/float.lisp b/src/compiler/x86/float.lisp index e879b5e..a091ef6 100644 --- a/src/compiler/x86/float.lisp +++ b/src/compiler/x86/float.lisp @@ -579,7 +579,7 @@ ;;;; 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) @@ -624,14 +624,14 @@ (: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) @@ -699,17 +699,17 @@ '((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)) diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp index b764f08..12cc5bf 100644 --- a/src/compiler/x86/insts.lisp +++ b/src/compiler/x86/insts.lisp @@ -189,64 +189,64 @@ ;;;; 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 @@ -255,20 +255,20 @@ (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) @@ -282,11 +282,11 @@ (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) @@ -330,7 +330,7 @@ (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) diff --git a/src/compiler/x86/move.lisp b/src/compiler/x86/move.lisp index 74ea38e..ad715a1 100644 --- a/src/compiler/x86/move.lisp +++ b/src/compiler/x86/move.lisp @@ -89,18 +89,18 @@ (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)))) @@ -155,7 +155,7 @@ ;; 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)) @@ -400,7 +400,7 @@ (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)) @@ -413,10 +413,10 @@ (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)) diff --git a/src/compiler/x86/sap.lisp b/src/compiler/x86/sap.lisp index ea4f7ba..c834de3 100644 --- a/src/compiler/x86/sap.lisp +++ b/src/compiler/x86/sap.lisp @@ -51,7 +51,7 @@ (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) @@ -66,12 +66,12 @@ (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)) ;;;; SAP-INT and INT-SAP diff --git a/src/pcl/defcombin.lisp b/src/pcl/defcombin.lisp index 0ca1521..8c4bd49 100644 --- a/src/pcl/defcombin.lisp +++ b/src/pcl/defcombin.lisp @@ -174,15 +174,15 @@ (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)))) @@ -225,7 +225,7 @@ 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) @@ -238,9 +238,8 @@ (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 @@ -365,16 +364,16 @@ ;;; ;;; 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)))) diff --git a/src/pcl/vector.lisp b/src/pcl/vector.lisp index 7008ec1..ef53775 100644 --- a/src/pcl/vector.lisp +++ b/src/pcl/vector.lisp @@ -920,11 +920,11 @@ '(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. @@ -956,10 +956,10 @@ (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) @@ -978,10 +978,9 @@ 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) diff --git a/version.lisp-expr b/version.lisp-expr index 5318318..d22c22c 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.pre7.136" +"0.pre7.137"