From be9eb6c67b5f43a095c3de17bea945c309d662e4 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Mon, 8 Oct 2001 02:34:15 +0000 Subject: [PATCH] 0.pre7.54: (Incidentally, I've pretty much given up on incrementing the fasl file version number on every renaming. Eventually I'll bump it, with a very high level summary comment.) back to standard abbrev. FUN for "object of type FUNCTION".. ..find . -name *.lisp | xargs egrep -i '[^a-z:]:function-' ..and 'function-end' ..and 'function-start' ..and 'FunctionEnd' and 'FunctionStart' and 'function.end' ..and 'function-type' ..but SB-EXT:*DERIVE-FUNCTION-TYPES* remains the same --- package-data-list.lisp-expr | 36 ++++----- src/code/cross-type.lisp | 2 +- src/code/debug-int.lisp | 140 ++++++++++++++++----------------- src/code/debug.lisp | 34 ++++---- src/code/describe.lisp | 2 +- src/code/early-type.lisp | 10 +-- src/code/fop.lisp | 2 +- src/code/host-alieneval.lisp | 26 +++--- src/code/kernel.lisp | 4 +- src/code/late-type.lisp | 35 ++++----- src/code/ntrace.lisp | 18 ++--- src/code/profile.lisp | 10 +-- src/code/target-alieneval.lisp | 14 ++-- src/code/target-type.lisp | 8 +- src/code/typep.lisp | 2 +- src/compiler/aliencomp.lisp | 12 +-- src/compiler/alpha/c-call.lisp | 4 +- src/compiler/alpha/parms.lisp | 4 +- src/compiler/checkgen.lisp | 4 +- src/compiler/ctype.lisp | 126 ++++++++++++++--------------- src/compiler/generic/genesis.lisp | 4 +- src/compiler/generic/objdef.lisp | 4 +- src/compiler/generic/primtype.lisp | 2 +- src/compiler/generic/target-core.lisp | 2 +- src/compiler/generic/vm-type.lisp | 2 +- src/compiler/globaldb.lisp | 4 +- src/compiler/ir1final.lisp | 2 +- src/compiler/ir1opt.lisp | 26 +++--- src/compiler/ir1tran.lisp | 4 +- src/compiler/ir1util.lisp | 2 +- src/compiler/knownfun.lisp | 8 +- src/compiler/main.lisp | 4 +- src/compiler/node.lisp | 2 +- src/compiler/srctran.lisp | 2 +- src/compiler/vop.lisp | 2 +- src/compiler/x86/c-call.lisp | 6 +- src/compiler/x86/insts.lisp | 2 +- src/compiler/x86/parms.lisp | 2 +- src/pcl/boot.lisp | 10 +-- src/pcl/combin.lisp | 16 ++-- src/runtime/alpha-arch.c | 4 +- src/runtime/alpha-assem.S | 20 ++--- src/runtime/breakpoint.c | 8 +- src/runtime/breakpoint.h | 4 +- src/runtime/x86-arch.c | 6 +- src/runtime/x86-assem.S | 16 ++-- tests/compiler-1.impure-cload.lisp | 2 +- tests/info.impure.lisp | 2 +- tests/interface.pure.lisp | 2 +- version.lisp-expr | 2 +- 50 files changed, 337 insertions(+), 328 deletions(-) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 4f41d33..70cbff2 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -54,9 +54,9 @@ "ALIEN-ARRAY-TYPE-P" "ALIEN-BOOLEAN-TYPE" "ALIEN-BOOLEAN-TYPE-P" "ALIEN-DOUBLE-FLOAT-TYPE" "ALIEN-DOUBLE-FLOAT-TYPE-P" "ALIEN-ENUM-TYPE" "ALIEN-ENUM-TYPE-P" "ALIEN-FLOAT-TYPE" - "ALIEN-FLOAT-TYPE-P" "ALIEN-FUNCTION-TYPE" - "ALIEN-FUNCTION-TYPE-ARG-TYPES" "ALIEN-FUNCTION-TYPE-P" - "ALIEN-FUNCTION-TYPE-RESULT-TYPE" "ALIEN-INTEGER-TYPE" + "ALIEN-FLOAT-TYPE-P" "ALIEN-FUN-TYPE" + "ALIEN-FUN-TYPE-ARG-TYPES" "ALIEN-FUN-TYPE-P" + "ALIEN-FUN-TYPE-RESULT-TYPE" "ALIEN-INTEGER-TYPE" "ALIEN-INTEGER-TYPE-P" "ALIEN-INTEGER-TYPE-SIGNED" "ALIEN-LONG-FLOAT-TYPE" "ALIEN-LONG-FLOAT-TYPE-P" "ALIEN-POINTER-TYPE" "ALIEN-POINTER-TYPE-P" @@ -81,7 +81,7 @@ "HEAP-ALIEN-INFO-TYPE" "INVOKE-ALIEN-TYPE-METHOD" "LOCAL-ALIEN" "LOCAL-ALIEN-INFO" "LOCAL-ALIEN-INFO-FORCE-TO-MEMORY-P" "LOCAL-ALIEN-INFO-P" "LOCAL-ALIEN-INFO-TYPE" - "MAKE-ALIEN-FUNCTION-TYPE" "MAKE-ALIEN-POINTER-TYPE" + "MAKE-ALIEN-FUN-TYPE" "MAKE-ALIEN-POINTER-TYPE" "MAKE-ALIEN-VALUE" "MAKE-LOCAL-ALIEN" "NATURALIZE" "NOTE-LOCAL-ALIEN-TYPE" @@ -428,7 +428,7 @@ like *STACK-TOP-HINT*" "FORM-NUMBER-TRANSLATIONS" "FRAME" "FRAME-CATCHES" "FRAME-CODE-LOCATION" "FRAME-DEBUG-FUN" "FRAME-DOWN" "FRAME-FUN-MISMATCH" "FRAME-NUMBER" "FRAME-P" "FRAME-UP" - "FUN-DEBUG-FUN" "FUNCTION-END-COOKIE-VALID-P" + "FUN-DEBUG-FUN" "FUN-END-COOKIE-VALID-P" "INVALID-CONTROL-STACK-POINTER" "INVALID-VALUE" "LAMBDA-LIST-UNAVAILABLE" "MAKE-BREAKPOINT" "NO-DEBUG-BLOCKS" "NO-DEBUG-FUN-RETURNS" "NO-DEBUG-INFO" "PREPROCESS-FOR-EVAL" @@ -939,8 +939,8 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "*EVAL-STACK*" "*EVAL-STACK-TOP*" "*GC-INHIBIT*" "*NEED-TO-COLLECT-GARBAGE*" "*PRETTY-PRINTER*" "*UNIVERSAL-TYPE*" - "*UNIVERSAL-FUNCTION-TYPE*" - "*UNPARSE-FUNCTION-TYPE-SIMPLIFY*" "*WILD-TYPE*" + "*UNIVERSAL-FUN-TYPE*" + "*UNPARSE-FUN-TYPE-SIMPLIFY*" "*WILD-TYPE*" "32BIT-LOGICAL-AND" "32BIT-LOGICAL-ANDC1" "32BIT-LOGICAL-ANDC2" "32BIT-LOGICAL-EQV" "32BIT-LOGICAL-NAND" @@ -1016,13 +1016,13 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "FLOAT-FORMAT-MAX" "FLOATING-POINT-EXCEPTION" "FORM" "*FREE-INTERRUPT-CONTEXT-INDEX*" "FUNCALLABLE-INSTANCE-P" "FUNCTION-CODE-HEADER" "FUNCTION-DOC" - "FUNCTION-TYPE" - "FUNCTION-TYPE-ALLOWP" - "FUNCTION-TYPE-KEYP" "FUNCTION-TYPE-KEYWORDS" - "FUNCTION-TYPE-NARGS" "FUNCTION-TYPE-OPTIONAL" - "FUNCTION-TYPE-P" - "FUNCTION-TYPE-REQUIRED" "FUNCTION-TYPE-REST" - "FUNCTION-TYPE-RETURNS" "FUNCTION-TYPE-WILD-ARGS" + "FUN-TYPE" + "FUN-TYPE-ALLOWP" + "FUN-TYPE-KEYP" "FUN-TYPE-KEYWORDS" + "FUN-TYPE-NARGS" "FUN-TYPE-OPTIONAL" + "FUN-TYPE-P" + "FUN-TYPE-REQUIRED" "FUN-TYPE-REST" + "FUN-TYPE-RETURNS" "FUN-TYPE-WILD-ARGS" "FUNCTION-WORD-OFFSET" "GET-CLOSURE-LENGTH" "GET-HEADER-DATA" "GET-LISP-OBJ-ADDRESS" "GET-LOWTAG" @@ -1064,7 +1064,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "LRA" "LRA-CODE-HEADER" "LRA-P" "MAKE-ALIEN-TYPE-TYPE" "MAKE-ARGS-TYPE" "MAKE-ARRAY-HEADER" "MAKE-ARRAY-TYPE" "MAKE-CONS-TYPE" - "MAKE-DOUBLE-FLOAT" "MAKE-FUNCTION-TYPE" + "MAKE-DOUBLE-FLOAT" "MAKE-FUN-TYPE" "MAKE-KEY-INFO" "MAKE-LISP-OBJ" "MAKE-LONG-FLOAT" "MAKE-MEMBER-TYPE" "MAKE-NAMED-TYPE" "MAKE-NULL-LEXENV" "MAKE-NUMERIC-TYPE" @@ -1246,7 +1246,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "LAYOUT-OF" "%FUNCTION-SELF" "%REALPART" "STRUCTURE-CLASS-P" "DSD-INDEX" "%INSTANCE-LAYOUT" "LAYOUT-CLOS-HASH" - "%FUNCTION-TYPE" "PROCLAIM-AS-FUNCTION-NAME" + "%FUN-TYPE" "PROCLAIM-AS-FUNCTION-NAME" "BECOME-DEFINED-FUNCTION-NAME" "%NUMERATOR" "CLASS-TYPEP" "STRUCTURE-CLASS-PRINT-FUNCTION" "DSD-READ-ONLY" @@ -1254,7 +1254,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "%DENOMINATOR" "MAKE-STANDARD-CLASS" "CLASS-CELL-TYPEP" - "FIND-CLASS-CELL" "EXTRACT-FUNCTION-TYPE" + "FIND-CLASS-CELL" "EXTRACT-FUN-TYPE" "FUNCALLABLE-STRUCTURE-CLASS" "%RANDOM-DOUBLE-FLOAT" "%RANDOM-LONG-FLOAT" "%RANDOM-SINGLE-FLOAT" @@ -1727,7 +1727,7 @@ structure representations" "FUNCALLABLE-INSTANCE-HEADER-TYPE" "FUNCALLABLE-INSTANCE-INFO-OFFSET" "FUNCTION-ARGLIST-SLOT" "FUNCTION-CODE-OFFSET" - "FUNCTION-END-BREAKPOINT-TRAP" + "FUN-END-BREAKPOINT-TRAP" "FUNCTION-HEADER-CODE-OFFSET" "FUNCTION-HEADER-NEXT-SLOT" "FUNCTION-HEADER-SELF-SLOT" "FUNCTION-HEADER-TYPE" "FUNCTION-HEADER-TYPE-SLOT" diff --git a/src/code/cross-type.lisp b/src/code/cross-type.lisp index 6af0388..8110183 100644 --- a/src/code/cross-type.lisp +++ b/src/code/cross-type.lisp @@ -349,7 +349,7 @@ ;; There's no ANSI way to find out what the function is ;; declared to be, so we just return the CTYPE for the ;; most-general function. - *universal-function-type*)) + *universal-fun-type*)) (symbol (make-member-type :members (list x))) (number diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 68e6925..6b49e82 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -302,7 +302,7 @@ (compiler-debug-fun nil :type sb!c::compiled-debug-fun) ;; code object (unexported). component - ;; the :FUNCTION-START breakpoint (if any) used to facilitate + ;; the :FUN-START breakpoint (if any) used to facilitate ;; function end breakpoints (end-starter nil :type (or null breakpoint))) @@ -395,17 +395,17 @@ (:copier nil)) ;; This is the function invoked when execution encounters the ;; breakpoint. It takes a frame, the breakpoint, and optionally a - ;; list of values. Values are supplied for :FUNCTION-END breakpoints + ;; list of values. Values are supplied for :FUN-END breakpoints ;; as values to return for the function containing the breakpoint. - ;; :FUNCTION-END breakpoint hook-functions also take a cookie + ;; :FUN-END breakpoint hook-functions also take a cookie ;; argument. See COOKIE-FUN slot. (hook-function nil :type function) ;; CODE-LOCATION or DEBUG-FUN (what nil :type (or code-location debug-fun)) - ;; :CODE-LOCATION, :FUNCTION-START, or :FUNCTION-END for that kind + ;; :CODE-LOCATION, :FUN-START, or :FUN-END for that kind ;; of breakpoint. :UNKNOWN-RETURN-PARTNER if this is the partner of ;; a :code-location breakpoint at an :UNKNOWN-RETURN code-location. - (kind nil :type (member :code-location :function-start :function-end + (kind nil :type (member :code-location :fun-start :fun-end :unknown-return-partner)) ;; Status helps the user and the implementation. (status :inactive :type (member :active :inactive :deleted)) @@ -417,7 +417,7 @@ ;; breakpoint for the other one, or NIL if this isn't at an ;; :UNKNOWN-RETURN code location. (unknown-return-partner nil :type (or null breakpoint)) - ;; :FUNCTION-END breakpoints use a breakpoint at the :FUNCTION-START + ;; :FUN-END breakpoints use a breakpoint at the :FUN-START ;; to establish the end breakpoint upon function entry. We do this ;; by frobbing the LRA to jump to a special piece of code that ;; breaks and provides the return values for the returnee. This slot @@ -425,8 +425,8 @@ ;; and delete it. (start-helper nil :type (or null breakpoint)) ;; This is a hook users supply to get a dynamically unique cookie - ;; for identifying :FUNCTION-END breakpoint executions. That is, if - ;; there is one :FUNCTION-END breakpoint, but there may be multiple + ;; for identifying :FUN-END breakpoint executions. That is, if + ;; there is one :FUN-END breakpoint, but there may be multiple ;; pending calls of its function on the stack. This function takes ;; the cookie, and the hook-function takes the cookie too. (cookie-fun nil :type (or null function)) @@ -504,8 +504,8 @@ ;;;; frames ;;; This is used in FIND-ESCAPED-FRAME and with the bogus components -;;; and LRAs used for :function-end breakpoints. When a components -;;; debug-info slot is :bogus-lra, then the real-lra-slot contains the +;;; and LRAs used for :FUN-END breakpoints. When a components +;;; debug-info slot is :BOGUS-LRA, then the REAL-LRA-SLOT contains the ;;; real component to continue executing, as opposed to the bogus ;;; component which appeared in some frame's LRA location. (defconstant real-lra-slot sb!vm:code-constants-offset) @@ -2752,30 +2752,30 @@ ;;; ;;; WHAT and KIND determine where in a function the system invokes ;;; HOOK-FUNCTION. WHAT is either a code-location or a DEBUG-FUN. -;;; KIND is one of :CODE-LOCATION, :FUNCTION-START, or :FUNCTION-END. +;;; KIND is one of :CODE-LOCATION, :FUN-START, or :FUN-END. ;;; Since the starts and ends of functions may not have code-locations ;;; representing them, designate these places by supplying WHAT as a -;;; DEBUG-FUN and KIND indicating the :FUNCTION-START or -;;; :FUNCTION-END. When WHAT is a DEBUG-FUN and kind is -;;; :FUNCTION-END, then hook-function must take two additional +;;; DEBUG-FUN and KIND indicating the :FUN-START or +;;; :FUN-END. When WHAT is a DEBUG-FUN and kind is +;;; :FUN-END, then hook-function must take two additional ;;; arguments, a list of values returned by the function and a -;;; FUNCTION-END-COOKIE. +;;; FUN-END-COOKIE. ;;; ;;; INFO is information supplied by and used by the user. ;;; -;;; FUNCTION-END-COOKIE is a function. To implement :FUNCTION-END +;;; FUN-END-COOKIE is a function. To implement :FUN-END ;;; breakpoints, the system uses starter breakpoints to establish the -;;; :FUNCTION-END breakpoint for each invocation of the function. Upon +;;; :FUN-END breakpoint for each invocation of the function. Upon ;;; each entry, the system creates a unique cookie to identify the ;;; invocation, and when the user supplies a function for this ;;; argument, the system invokes it on the frame and the cookie. The -;;; system later invokes the :FUNCTION-END breakpoint hook on the same +;;; system later invokes the :FUN-END breakpoint hook on the same ;;; cookie. The user may save the cookie for comparison in the hook ;;; function. ;;; ;;; Signal an error if WHAT is an unknown code-location. (defun make-breakpoint (hook-function what - &key (kind :code-location) info function-end-cookie) + &key (kind :code-location) info fun-end-cookie) (etypecase what (code-location (when (code-location-unknown-p what) @@ -2799,55 +2799,55 @@ bpt)) (compiled-debug-fun (ecase kind - (:function-start + (:fun-start (%make-breakpoint hook-function what kind info)) - (:function-end + (:fun-end (unless (eq (sb!c::compiled-debug-fun-returns (compiled-debug-fun-compiler-debug-fun what)) :standard) - (error ":FUNCTION-END breakpoints are currently unsupported ~ + (error ":FUN-END breakpoints are currently unsupported ~ for the known return convention.")) (let* ((bpt (%make-breakpoint hook-function what kind info)) (starter (compiled-debug-fun-end-starter what))) (unless starter - (setf starter (%make-breakpoint #'list what :function-start nil)) + (setf starter (%make-breakpoint #'list what :fun-start nil)) (setf (breakpoint-hook-function starter) - (function-end-starter-hook starter what)) + (fun-end-starter-hook starter what)) (setf (compiled-debug-fun-end-starter what) starter)) (setf (breakpoint-start-helper bpt) starter) (push bpt (breakpoint-%info starter)) - (setf (breakpoint-cookie-fun bpt) function-end-cookie) + (setf (breakpoint-cookie-fun bpt) fun-end-cookie) bpt)))))) ;;; These are unique objects created upon entry into a function by a -;;; :FUNCTION-END breakpoint's starter hook. These are only created -;;; when users supply :FUNCTION-END-COOKIE to MAKE-BREAKPOINT. Also, -;;; the :FUNCTION-END breakpoint's hook is called on the same cookie +;;; :FUN-END breakpoint's starter hook. These are only created +;;; when users supply :FUN-END-COOKIE to MAKE-BREAKPOINT. Also, +;;; the :FUN-END breakpoint's hook is called on the same cookie ;;; when it is created. -(defstruct (function-end-cookie +(defstruct (fun-end-cookie (:print-object (lambda (obj str) (print-unreadable-object (obj str :type t)))) - (:constructor make-function-end-cookie (bogus-lra debug-fun)) + (:constructor make-fun-end-cookie (bogus-lra debug-fun)) (:copier nil)) - ;; a pointer to the bogus-lra created for :FUNCTION-END breakpoints + ;; a pointer to the bogus-lra created for :FUN-END breakpoints bogus-lra ;; the DEBUG-FUN associated with this cookie debug-fun) ;;; This maps bogus-lra-components to cookies, so that -;;; HANDLE-FUNCTION-END-BREAKPOINT can find the appropriate cookie for the +;;; HANDLE-FUN-END-BREAKPOINT can find the appropriate cookie for the ;;; breakpoint hook. -(defvar *function-end-cookies* (make-hash-table :test 'eq)) +(defvar *fun-end-cookies* (make-hash-table :test 'eq)) ;;; This returns a hook function for the start helper breakpoint -;;; associated with a :FUNCTION-END breakpoint. The returned function +;;; associated with a :FUN-END breakpoint. The returned function ;;; makes a fake LRA that all returns go through, and this piece of ;;; fake code actually breaks. Upon return from the break, the code ;;; provides the returnee with any values. Since the returned function ;;; effectively activates FUN-END-BPT on each entry to DEBUG-FUN's ;;; function, we must establish breakpoint-data about FUN-END-BPT. -(defun function-end-starter-hook (starter-bpt debug-fun) +(defun fun-end-starter-hook (starter-bpt debug-fun) (declare (type breakpoint starter-bpt) (type compiled-debug-fun debug-fun)) #'(lambda (frame breakpoint) @@ -2870,27 +2870,27 @@ (setf (breakpoint-data-breakpoints data) end-bpts) (dolist (bpt end-bpts) (setf (breakpoint-internal-data bpt) data))) - (let ((cookie (make-function-end-cookie lra debug-fun))) - (setf (gethash component *function-end-cookies*) cookie) + (let ((cookie (make-fun-end-cookie lra debug-fun))) + (setf (gethash component *fun-end-cookies*) cookie) (dolist (bpt end-bpts) (let ((fun (breakpoint-cookie-fun bpt))) (when fun (funcall fun frame cookie)))))))))) -;;; This takes a FUNCTION-END-COOKIE and a frame, and it returns +;;; This takes a FUN-END-COOKIE and a frame, and it returns ;;; whether the cookie is still valid. A cookie becomes invalid when ;;; the frame that established the cookie has exited. Sometimes cookie ;;; holders are unaware of cookie invalidation because their -;;; :FUNCTION-END breakpoint hooks didn't run due to THROW'ing. +;;; :FUN-END breakpoint hooks didn't run due to THROW'ing. ;;; ;;; This takes a frame as an efficiency hack since the user probably ;;; has a frame object in hand when using this routine, and it saves ;;; repeated parsing of the stack and consing when asking whether a ;;; series of cookies is valid. -(defun function-end-cookie-valid-p (frame cookie) - (let ((lra (function-end-cookie-bogus-lra cookie)) +(defun fun-end-cookie-valid-p (frame cookie) + (let ((lra (fun-end-cookie-bogus-lra cookie)) (lra-sc-offset (sb!c::compiled-debug-fun-return-pc (compiled-debug-fun-compiler-debug-fun - (function-end-cookie-debug-fun cookie))))) + (fun-end-cookie-debug-fun cookie))))) (do ((frame frame (frame-down frame))) ((not frame) nil) (when (and (compiled-frame-p frame) @@ -2922,20 +2922,20 @@ ;; (There used to be more cases back before sbcl-0.7.0, when ;; we did special tricks to debug the IR1 interpreter.) ))) - (:function-start + (:fun-start (etypecase (breakpoint-what breakpoint) (compiled-debug-fun - (activate-compiled-function-start-breakpoint breakpoint)) + (activate-compiled-fun-start-breakpoint breakpoint)) ;; (There used to be more cases back before sbcl-0.7.0, when ;; we did special tricks to debug the IR1 interpreter.) )) - (:function-end + (:fun-end (etypecase (breakpoint-what breakpoint) (compiled-debug-fun (let ((starter (breakpoint-start-helper breakpoint))) (unless (eq (breakpoint-status starter) :active) - ;; may already be active by some other :FUNCTION-END breakpoint - (activate-compiled-function-start-breakpoint starter))) + ;; may already be active by some other :FUN-END breakpoint + (activate-compiled-fun-start-breakpoint starter))) (setf (breakpoint-status breakpoint) :active)) ;; (There used to be more cases back before sbcl-0.7.0, when ;; we did special tricks to debug the IR1 interpreter.) @@ -2958,7 +2958,7 @@ sb!vm:single-value-return-byte-offset 0)))))) -(defun activate-compiled-function-start-breakpoint (breakpoint) +(defun activate-compiled-fun-start-breakpoint (breakpoint) (declare (type breakpoint breakpoint)) (let ((debug-fun (breakpoint-what breakpoint))) (sub-activate-breakpoint @@ -3002,7 +3002,7 @@ breakpoint) (defun deactivate-compiled-breakpoint (breakpoint) - (if (eq (breakpoint-kind breakpoint) :function-end) + (if (eq (breakpoint-kind breakpoint) :fun-end) (let ((starter (breakpoint-start-helper breakpoint))) (unless (find-if #'(lambda (bpt) (and (not (eq bpt breakpoint)) @@ -3054,7 +3054,7 @@ (let ((other (breakpoint-unknown-return-partner breakpoint))) (when other (setf (breakpoint-status other) :deleted))) - (when (eq (breakpoint-kind breakpoint) :function-end) + (when (eq (breakpoint-kind breakpoint) :fun-end) (let* ((starter (breakpoint-start-helper breakpoint)) (breakpoints (delete breakpoint (the list (breakpoint-info starter))))) @@ -3134,20 +3134,20 @@ offset)) (let ((breakpoints (breakpoint-data-breakpoints data))) (if (or (null breakpoints) - (eq (breakpoint-kind (car breakpoints)) :function-end)) - (handle-function-end-breakpoint-aux breakpoints data signal-context) + (eq (breakpoint-kind (car breakpoints)) :fun-end)) + (handle-fun-end-breakpoint-aux breakpoints data signal-context) (handle-breakpoint-aux breakpoints data offset component signal-context))))) ;;; This holds breakpoint-datas while invoking the breakpoint hooks ;;; associated with that particular component and location. While they ;;; are executing, if we hit the location again, we ignore the -;;; breakpoint to avoid infinite recursion. Function-end breakpoints +;;; breakpoint to avoid infinite recursion. fun-end breakpoints ;;; must work differently since the breakpoint-data is unique for each ;;; invocation. (defvar *executing-breakpoint-hooks* nil) -;;; This handles code-location and DEBUG-FUN :FUNCTION-START +;;; This handles code-location and DEBUG-FUN :FUN-START ;;; breakpoints. (defun handle-breakpoint-aux (breakpoints data offset component signal-context) (/show0 "entering HANDLE-BREAKPOINT-AUX") @@ -3194,8 +3194,8 @@ (breakpoint-unknown-return-partner bpt) bpt))))) -(defun handle-function-end-breakpoint (offset component context) - (/show0 "entering HANDLE-FUNCTION-END-BREAKPOINT") +(defun handle-fun-end-breakpoint (offset component context) + (/show0 "entering HANDLE-FUN-END-BREAKPOINT") (let ((data (breakpoint-data component offset nil))) (unless data (error "unknown breakpoint in ~S at offset ~S" @@ -3203,14 +3203,14 @@ offset)) (let ((breakpoints (breakpoint-data-breakpoints data))) (when breakpoints - (aver (eq (breakpoint-kind (car breakpoints)) :function-end)) - (handle-function-end-breakpoint-aux breakpoints data context))))) + (aver (eq (breakpoint-kind (car breakpoints)) :fun-end)) + (handle-fun-end-breakpoint-aux breakpoints data context))))) -;;; Either HANDLE-BREAKPOINT calls this for :FUNCTION-END breakpoints -;;; [old C code] or HANDLE-FUNCTION-END-BREAKPOINT calls this directly +;;; Either HANDLE-BREAKPOINT calls this for :FUN-END breakpoints +;;; [old C code] or HANDLE-FUN-END-BREAKPOINT calls this directly ;;; [new C code]. -(defun handle-function-end-breakpoint-aux (breakpoints data signal-context) - (/show0 "entering HANDLE-FUNCTION-END-BREAKPOINT-AUX") +(defun handle-fun-end-breakpoint-aux (breakpoints data signal-context) + (/show0 "entering HANDLE-FUN-END-BREAKPOINT-AUX") (delete-breakpoint-data data) (let* ((scp (locally @@ -3221,15 +3221,15 @@ ((= cfp (sap-int (frame-pointer f))) f) (declare (type (unsigned-byte #.sb!vm:word-bits) cfp)))) (component (breakpoint-data-component data)) - (cookie (gethash component *function-end-cookies*))) - (remhash component *function-end-cookies*) + (cookie (gethash component *fun-end-cookies*))) + (remhash component *fun-end-cookies*) (dolist (bpt breakpoints) (funcall (breakpoint-hook-function bpt) frame bpt - (get-function-end-breakpoint-values scp) + (get-fun-end-breakpoint-values scp) cookie)))) -(defun get-function-end-breakpoint-values (scp) +(defun get-fun-end-breakpoint-values (scp) (let ((ocfp (int-sap (sb!vm:context-register scp #!-x86 sb!vm::ocfp-offset @@ -3247,7 +3247,7 @@ results))) (nreverse results))) -;;;; MAKE-BOGUS-LRA (used for :FUNCTION-END breakpoints) +;;;; MAKE-BOGUS-LRA (used for :FUN-END breakpoints) (defconstant bogus-lra-constants #!-x86 2 #!+x86 3) @@ -3261,9 +3261,9 @@ ;;; instruction. (defun make-bogus-lra (real-lra &optional known-return-p) (without-gcing - (let* ((src-start (foreign-symbol-address "function_end_breakpoint_guts")) - (src-end (foreign-symbol-address "function_end_breakpoint_end")) - (trap-loc (foreign-symbol-address "function_end_breakpoint_trap")) + (let* ((src-start (foreign-symbol-address "fun_end_breakpoint_guts")) + (src-end (foreign-symbol-address "fun_end_breakpoint_end")) + (trap-loc (foreign-symbol-address "fun_end_breakpoint_trap")) (length (sap- src-end src-start)) (code-object (%primitive diff --git a/src/code/debug.lisp b/src/code/debug.lisp index 083cb43..d95d1da 100644 --- a/src/code/debug.lisp +++ b/src/code/debug.lisp @@ -308,11 +308,11 @@ Function and macro commands: loc-number (sb!di:debug-fun-name (sb!di:code-location-debug-fun place)))) - (:function-start - (format t "~&~S: FUNCTION-START in ~S" bp-number + (:fun-start + (format t "~&~S: FUN-START in ~S" bp-number (sb!di:debug-fun-name place))) - (:function-end - (format t "~&~S: FUNCTION-END in ~S" bp-number + (:fun-end + (format t "~&~S: FUN-END in ~S" bp-number (sb!di:debug-fun-name place)))))) ;;;; MAIN-HOOK-FUNCTION for steps and breakpoints @@ -320,7 +320,7 @@ Function and macro commands: ;;; This must be passed as the hook function. It keeps track of where ;;; STEP breakpoints are. (defun main-hook-function (current-frame breakpoint &optional return-vals - function-end-cookie) + fun-end-cookie) (setf *default-breakpoint-debug-fun* (sb!di:frame-debug-fun current-frame)) (dolist (step-info *step-breakpoints*) @@ -346,7 +346,7 @@ Function and macro commands: (print-common-info () (build-string (with-output-to-string (*standard-output*) - (when function-end-cookie + (when fun-end-cookie (format t "~%Return values: ~S" return-vals)) (when condition (when (breakpoint-info-print bp-hit-info) @@ -417,7 +417,7 @@ Function and macro commands: (t (let* ((debug-fun (sb!di:frame-debug-fun *current-frame*)) (bp (sb!di:make-breakpoint #'main-hook-function debug-fun - :kind :function-end))) + :kind :fun-end))) (sb!di:activate-breakpoint bp) (push (create-breakpoint-info debug-fun bp 0) *step-breakpoints*)))))))) @@ -1386,12 +1386,12 @@ argument") (setf *possible-breakpoints* (possible-breakpoints df))) (let ((continue-at (sb!di:frame-code-location *current-frame*))) (let ((active (location-in-list *default-breakpoint-debug-fun* - *breakpoints* :function-start)) + *breakpoints* :fun-start)) (here (sb!di:code-location= (sb!di:debug-fun-start-location *default-breakpoint-debug-fun*) continue-at))) (when (or active here) - (format t "::FUNCTION-START ") + (format t "::FUN-START ") (when active (format t " *Active*")) (when here (format t " *Continue here*")))) @@ -1432,8 +1432,8 @@ argument") (when (location-in-list *default-breakpoint-debug-fun* *breakpoints* - :function-end) - (format t "~&::FUNCTION-END *Active* ")))) + :fun-end) + (format t "~&::FUN-END *Active* ")))) (!def-debug-command-alias "LL" "LIST-LOCATIONS") @@ -1470,21 +1470,21 @@ argument") (setf *possible-breakpoints* (possible-breakpoints *default-breakpoint-debug-fun*)))))) - (setup-function-start () + (setup-fun-start () (let ((code-loc (sb!di:debug-fun-start-location place))) (setf bp (sb!di:make-breakpoint #'main-hook-function place - :kind :function-start)) + :kind :fun-start)) (setf break (sb!di:preprocess-for-eval break code-loc)) (setf condition (sb!di:preprocess-for-eval condition code-loc)) (dolist (form print) (push (cons (sb!di:preprocess-for-eval form code-loc) form) print-functions)))) - (setup-function-end () + (setup-fun-end () (setf bp (sb!di:make-breakpoint #'main-hook-function place - :kind :function-end)) + :kind :fun-end)) (setf break ;; FIXME: These and any other old (COERCE `(LAMBDA ..) ..) ;; forms should be converted to shiny new (LAMBDA ..) forms. @@ -1516,9 +1516,9 @@ argument") (set-vars-from-command-line (get-command-line)) (cond ((or (eq index :start) (eq index :s)) - (setup-function-start)) + (setup-fun-start)) ((or (eq index :end) (eq index :e)) - (setup-function-end)) + (setup-fun-end)) (t (setup-code-location))) (sb!di:activate-breakpoint bp) diff --git a/src/code/describe.lisp b/src/code/describe.lisp index 2a4e6b6..d6098e4 100644 --- a/src/code/describe.lisp +++ b/src/code/describe.lisp @@ -179,7 +179,7 @@ (let ((name (or name (%function-name x)))) (%describe-doc name s 'function kind) (unless (eq kind :macro) - (%describe-function-name name s (%function-type x)))) + (%describe-function-name name s (%fun-type x)))) (%describe-compiled-from (sb-kernel:function-code-header x) s)) ;;; Describe a function with the specified kind and name. The latter diff --git a/src/code/early-type.lisp b/src/code/early-type.lisp index 2c19b75..c05ba96 100644 --- a/src/code/early-type.lisp +++ b/src/code/early-type.lisp @@ -134,12 +134,12 @@ (!define-type-class values) -(defstruct (function-type - (:include args-type - (class-info (type-class-or-lose 'function)))) - ;; True if the arguments are unrestrictive, i.e. *. +;;; (SPECIFIER-TYPE 'FUNCTION) and its subtypes +(defstruct (fun-type (:include args-type + (class-info (type-class-or-lose 'function)))) + ;; true if the arguments are unrestrictive, i.e. * (wild-args nil :type boolean) - ;; Type describing the return values. This is a values type + ;; type describing the return values. This is a values type ;; when multiple values were specified for the return. (returns (required-argument) :type ctype)) diff --git a/src/code/fop.lisp b/src/code/fop.lisp index f7d5098..96da12e 100644 --- a/src/code/fop.lisp +++ b/src/code/fop.lisp @@ -651,7 +651,7 @@ bug.~:@>") (setf (%code-entry-points code-object) fun) (setf (%function-name fun) name) (setf (%function-arglist fun) arglist) - (setf (%function-type fun) type) + (setf (%fun-type fun) type) ;; FIXME: See the comment about *LOAD-PRINT* in FOP-EVAL. #+nil (when *load-print* (load-fresh-line) diff --git a/src/code/host-alieneval.lisp b/src/code/host-alieneval.lisp index f2ac852..de1bd71 100644 --- a/src/code/host-alieneval.lisp +++ b/src/code/host-alieneval.lisp @@ -1063,36 +1063,36 @@ (record-fields-match (alien-record-type-fields type1) (alien-record-type-fields type2) 0))) -;;;; the FUNCTION and VALUES types +;;;; the FUNCTION and VALUES alien types (defvar *values-type-okay* nil) -(def-alien-type-class (function :include mem-block) +(def-alien-type-class (fun :include mem-block) (result-type (required-argument) :type alien-type) (arg-types (required-argument) :type list) (stub nil :type (or null function))) (def-alien-type-translator function (result-type &rest arg-types &environment env) - (make-alien-function-type + (make-alien-fun-type :result-type (let ((*values-type-okay* t)) (parse-alien-type result-type env)) :arg-types (mapcar (lambda (arg-type) (parse-alien-type arg-type env)) arg-types))) -(def-alien-type-method (function :unparse) (type) - `(function ,(%unparse-alien-type (alien-function-type-result-type type)) +(def-alien-type-method (fun :unparse) (type) + `(function ,(%unparse-alien-type (alien-fun-type-result-type type)) ,@(mapcar #'%unparse-alien-type - (alien-function-type-arg-types type)))) + (alien-fun-type-arg-types type)))) -(def-alien-type-method (function :type=) (type1 type2) - (and (alien-type-= (alien-function-type-result-type type1) - (alien-function-type-result-type type2)) - (= (length (alien-function-type-arg-types type1)) - (length (alien-function-type-arg-types type2))) +(def-alien-type-method (fun :type=) (type1 type2) + (and (alien-type-= (alien-fun-type-result-type type1) + (alien-fun-type-result-type type2)) + (= (length (alien-fun-type-arg-types type1)) + (length (alien-fun-type-arg-types type2))) (every #'alien-type-= - (alien-function-type-arg-types type1) - (alien-function-type-arg-types type2)))) + (alien-fun-type-arg-types type1) + (alien-fun-type-arg-types type2)))) (def-alien-type-class (values) (values (required-argument) :type list)) diff --git a/src/code/kernel.lisp b/src/code/kernel.lisp index 1654689..772a4e4 100644 --- a/src/code/kernel.lisp +++ b/src/code/kernel.lisp @@ -70,8 +70,8 @@ (%function-name func)) ;;; Extract the type from the function header FUNC. -(defun %function-type (func) - (%function-type func)) +(defun %fun-type (func) + (%fun-type func)) ;;; Extract the function from CLOSURE. (defun %closure-function (closure) diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index fc14309..b3c07fd 100644 --- a/src/code/late-type.lisp +++ b/src/code/late-type.lisp @@ -192,18 +192,18 @@ ;;; a flag that we can bind to cause complex function types to be ;;; unparsed as FUNCTION. This is useful when we want a type that we ;;; can pass to TYPEP. -(defvar *unparse-function-type-simplify*) -(!cold-init-forms (setq *unparse-function-type-simplify* nil)) +(defvar *unparse-fun-type-simplify*) +(!cold-init-forms (setq *unparse-fun-type-simplify* nil)) (!define-type-method (function :unparse) (type) - (if *unparse-function-type-simplify* + (if *unparse-fun-type-simplify* 'function (list 'function - (if (function-type-wild-args type) + (if (fun-type-wild-args type) '* (unparse-args-types type)) (type-specifier - (function-type-returns type))))) + (fun-type-returns type))))) ;;; Since all function types are equivalent to FUNCTION, they are all ;;; subtypes of each other. @@ -294,10 +294,9 @@ (result))) (!def-type-translator function (&optional (args '*) (result '*)) - (let ((res (make-function-type - :returns (values-specifier-type result)))) + (let ((res (make-fun-type :returns (values-specifier-type result)))) (if (eq args '*) - (setf (function-type-wild-args res) t) + (setf (fun-type-wild-args res) t) (parse-args-types args res)) res)) @@ -332,9 +331,9 @@ ;;; Return the minimum number of arguments that a function can be ;;; called with, and the maximum number or NIL. If not a function ;;; type, return NIL, NIL. -(defun function-type-nargs (type) +(defun fun-type-nargs (type) (declare (type ctype type)) - (if (function-type-p type) + (if (fun-type-p type) (let ((fixed (length (args-type-required type)))) (if (or (args-type-rest type) (args-type-keyp type) @@ -875,7 +874,7 @@ (defvar *wild-type*) (defvar *empty-type*) (defvar *universal-type*) -(defvar *universal-function-type*) +(defvar *universal-fun-type*) (!cold-init-forms (macrolet ((frob (name var) `(progn @@ -891,8 +890,8 @@ (frob * *wild-type*) (frob nil *empty-type*) (frob t *universal-type*)) - (setf *universal-function-type* - (make-function-type :wild-args t + (setf *universal-fun-type* + (make-fun-type :wild-args t :returns *wild-type*))) (!define-type-method (named :simple-=) (type1 type2) @@ -2156,7 +2155,7 @@ ;; that an object of type FUNCTION doesn't satisfy it, so ;; we return success no matter what. t) - (;; Otherwise both of them must be FUNCTION-TYPE objects. + (;; Otherwise both of them must be FUN-TYPE objects. t ;; FIXME: For now we only check compatibility of the return ;; type, not argument types, and we don't even check the @@ -2165,11 +2164,11 @@ ;; compatibility of the arguments, we should (1) redo ;; VALUES-TYPES-EQUAL-OR-INTERSECT as ;; ARGS-TYPES-EQUAL-OR-INTERSECT, and then (2) apply it to - ;; the ARGS-TYPE slices of the FUNCTION-TYPEs. (ARGS-TYPE - ;; is a base class both of VALUES-TYPE and of FUNCTION-TYPE.) + ;; the ARGS-TYPE slices of the FUN-TYPEs. (ARGS-TYPE + ;; is a base class both of VALUES-TYPE and of FUN-TYPE.) (values-types-equal-or-intersect - (function-type-returns defined-ftype) - (function-type-returns declared-ftype)))))) + (fun-type-returns defined-ftype) + (fun-type-returns declared-ftype)))))) ;;; This messy case of CTYPE for NUMBER is shared between the ;;; cross-compiler and the target system. diff --git a/src/code/ntrace.lisp b/src/code/ntrace.lisp index e775902..1b0540f 100644 --- a/src/code/ntrace.lisp +++ b/src/code/ntrace.lisp @@ -81,7 +81,7 @@ ;; list of null environment forms (print-after () :type list)) -;;; This is a list of conses (function-end-cookie . condition-satisfied), +;;; This is a list of conses (fun-end-cookie . condition-satisfied), ;;; which we use to note distinct dynamic entries into functions. When ;;; we enter a traced function, we add a entry to this list holding ;;; the new end-cookie and whether the trace condition was satisfied. @@ -91,8 +91,8 @@ ;;; ;;; This list also helps us synchronize the TRACE facility dynamically ;;; for detecting non-local flow of control. Whenever execution hits a -;;; :FUNCTION-END breakpoint used for TRACE'ing, we look for the -;;; FUNCTION-END-COOKIE at the top of *TRACED-ENTRIES*. If it is not +;;; :FUN-END breakpoint used for TRACE'ing, we look for the +;;; FUN-END-COOKIE at the top of *TRACED-ENTRIES*. If it is not ;;; there, we discard any entries that come before our cookie. ;;; ;;; When we trace using encapsulation, we bind this variable and add @@ -221,7 +221,7 @@ (when (or (null *traced-entries*) (let ((cookie (caar *traced-entries*))) (or (not cookie) - (sb-di:function-end-cookie-valid-p frame cookie)))) + (sb-di:fun-end-cookie-valid-p frame cookie)))) (return)) (pop *traced-entries*))) @@ -229,7 +229,7 @@ ;;; Return a closure that can be used for a function start breakpoint ;;; hook function and a closure that can be used as the -;;; FUNCTION-END-COOKIE function. The first communicates the sense of +;;; FUN-END-COOKIE function. The first communicates the sense of ;;; the Condition to the second via a closure variable. (defun trace-start-breakpoint-fun (info) (let (conditionp) @@ -380,16 +380,16 @@ (multiple-value-bind (start-fun cookie-fun) (trace-start-breakpoint-fun info) (let ((start (sb-di:make-breakpoint start-fun debug-fun - :kind :function-start)) + :kind :fun-start)) (end (sb-di:make-breakpoint (trace-end-breakpoint-fun info) - debug-fun :kind :function-end - :function-end-cookie cookie-fun))) + debug-fun :kind :fun-end + :fun-end-cookie cookie-fun))) (setf (trace-info-start-breakpoint info) start) (setf (trace-info-end-breakpoint info) end) ;; The next two forms must be in the order in which they ;; appear, since the start breakpoint must run before the - ;; function-end breakpoint's start helper (which calls the + ;; fun-end breakpoint's start helper (which calls the ;; cookie function.) One reason is that cookie function ;; requires that the CONDITIONP shared closure variable be ;; initialized. diff --git a/src/code/profile.lisp b/src/code/profile.lisp index 9653bd5..77edb58 100644 --- a/src/code/profile.lisp +++ b/src/code/profile.lisp @@ -33,13 +33,13 @@ (declaim (ftype (function ((or symbol cons)) (values fixnum t)) fun-signature)) (defun fun-signature (name) (let ((type (info :function :type name))) - (cond ((not (function-type-p type)) + (cond ((not (fun-type-p type)) (values 0 t)) (t - (values (length (function-type-required type)) - (or (function-type-optional type) - (function-type-keyp type) - (function-type-rest type))))))) + (values (length (fun-type-required type)) + (or (fun-type-optional type) + (fun-type-keyp type) + (fun-type-rest type))))))) |# ;;;; global data structures diff --git a/src/code/target-alieneval.lisp b/src/code/target-alieneval.lisp index 67daaec..935cf7f 100644 --- a/src/code/target-alieneval.lisp +++ b/src/code/target-alieneval.lisp @@ -495,11 +495,11 @@ (optimize (inhibit-warnings 3))) (if (or (alien-pointer-type-p target-type) (alien-array-type-p target-type) - (alien-function-type-p target-type)) + (alien-fun-type-p target-type)) (let ((alien-type (alien-value-type alien))) (if (or (alien-pointer-type-p alien-type) (alien-array-type-p alien-type) - (alien-function-type-p alien-type)) + (alien-fun-type-p alien-type)) (naturalize (alien-value-sap alien) target-type) (error "~S cannot be casted." alien))) (error "cannot cast to alien type ~S" (unparse-alien-type target-type)))) @@ -558,14 +558,14 @@ (typecase type (alien-pointer-type (apply #'alien-funcall (deref alien) args)) - (alien-function-type - (unless (= (length (alien-function-type-arg-types type)) + (alien-fun-type + (unless (= (length (alien-fun-type-arg-types type)) (length args)) (error "wrong number of arguments for ~S~%expected ~D, got ~D" type - (length (alien-function-type-arg-types type)) + (length (alien-fun-type-arg-types type)) (length args))) - (let ((stub (alien-function-type-stub type))) + (let ((stub (alien-fun-type-stub type))) (unless stub (setf stub (let ((fun (gensym)) @@ -574,7 +574,7 @@ `(lambda (,fun ,@parms) (declare (type (alien ,type) ,fun)) (alien-funcall ,fun ,@parms))))) - (setf (alien-function-type-stub type) stub)) + (setf (alien-fun-type-stub type) stub)) (apply stub alien args))) (t (error "~S is not an alien function." alien))))) diff --git a/src/code/target-type.lisp b/src/code/target-type.lisp index 1bd5d47..d08becc 100644 --- a/src/code/target-type.lisp +++ b/src/code/target-type.lisp @@ -63,7 +63,7 @@ #'ctypep obj (compound-type-types type))) - (function-type + (fun-type (values (functionp obj) t)) (unknown-type (values nil nil)) @@ -127,8 +127,8 @@ (layout-class (layout-of object))) ;;; Pull the type specifier out of a function object. -(defun extract-function-type (fun) - (specifier-type (%function-type (%closure-function fun)))) +(defun extract-fun-type (fun) + (specifier-type (%fun-type (%closure-function fun)))) ;;;; miscellaneous interfaces @@ -160,7 +160,7 @@ (function (if (funcallable-instance-p x) (sb!xc:class-of x) - (extract-function-type x))) + (extract-fun-type x))) (symbol (make-member-type :members (list x))) (number diff --git a/src/code/typep.lisp b/src/code/typep.lisp index c7d25a3..bec03ac 100644 --- a/src/code/typep.lisp +++ b/src/code/typep.lisp @@ -158,7 +158,7 @@ (values (funcall (symbol-function (cadr hairy-spec)) object)))))) (alien-type-type (sb!alien-internals:alien-typep object (alien-type-type-alien-type type))) - (function-type + (fun-type (error "Function types are not a legal argument to TYPEP:~% ~S" (type-specifier type))))) diff --git a/src/compiler/aliencomp.lisp b/src/compiler/aliencomp.lisp index 7c2fbc0..f586d86 100644 --- a/src/compiler/aliencomp.lisp +++ b/src/compiler/aliencomp.lisp @@ -459,7 +459,7 @@ (let ((target-type (continuation-value target-type))) (cond ((or (alien-pointer-type-p target-type) (alien-array-type-p target-type) - (alien-function-type-p target-type)) + (alien-fun-type-p target-type)) `(naturalize (alien-sap alien) ',target-type)) (t (abort-ir1-transform "cannot cast to alien type ~S" target-type))))) @@ -602,9 +602,9 @@ (give-up-ir1-transform "can't tell function type at compile time")) (/noshow "entering second DEFTRANSFORM ALIEN-FUNCALL" function) (let ((alien-type (alien-type-type-alien-type type))) - (unless (alien-function-type-p alien-type) + (unless (alien-fun-type-p alien-type) (give-up-ir1-transform)) - (let ((arg-types (alien-function-type-arg-types alien-type))) + (let ((arg-types (alien-fun-type-arg-types alien-type))) (unless (= (length args) (length arg-types)) (abort-ir1-transform "wrong number of arguments; expected ~D, got ~D" @@ -615,7 +615,7 @@ (let ((param (gensym))) (params param) (deports `(deport ,param ',arg-type)))) - (let ((return-type (alien-function-type-result-type alien-type)) + (let ((return-type (alien-fun-type-result-type alien-type)) (body `(%alien-funcall (deport function ',alien-type) ',alien-type ,@(deports)))) @@ -638,11 +638,11 @@ (unless (constant-continuation-p type) (error "Something is broken.")) (let ((type (continuation-value type))) - (unless (alien-function-type-p type) + (unless (alien-fun-type-p type) (error "Something is broken.")) (specifier-type (compute-alien-rep-type - (alien-function-type-result-type type))))) + (alien-fun-type-result-type type))))) (defoptimizer (%alien-funcall ltn-annotate) ((function type &rest args) node ltn-policy) diff --git a/src/compiler/alpha/c-call.lisp b/src/compiler/alpha/c-call.lisp index 5869da2..0e775a4 100644 --- a/src/compiler/alpha/c-call.lisp +++ b/src/compiler/alpha/c-call.lisp @@ -100,13 +100,13 @@ (!def-vm-support-routine make-call-out-tns (type) (let ((arg-state (make-arg-state))) (collect ((arg-tns)) - (dolist (arg-type (alien-function-type-arg-types type)) + (dolist (arg-type (alien-fun-type-arg-types type)) (arg-tns (invoke-alien-type-method :arg-tn arg-type arg-state))) (values (my-make-wired-tn 'positive-fixnum 'any-reg nsp-offset) (* (max (arg-state-stack-frame-size arg-state) 4) word-bytes) (arg-tns) (invoke-alien-type-method :result-tn - (alien-function-type-result-type type) + (alien-fun-type-result-type type) nil))))) (define-vop (foreign-symbol-address) diff --git a/src/compiler/alpha/parms.lisp b/src/compiler/alpha/parms.lisp index 710f789..1936ac9 100644 --- a/src/compiler/alpha/parms.lisp +++ b/src/compiler/alpha/parms.lisp @@ -140,7 +140,7 @@ error cerror breakpoint - function-end-breakpoint + fun-end-breakpoint single-step-breakpoint) (defenum (:prefix trace-table-) @@ -172,7 +172,7 @@ maybe-gc sb!kernel::internal-error sb!di::handle-breakpoint - sb!di::handle-function-end-breakpoint + sb!di::handle-fun-end-breakpoint ;; free Pointers *read-only-space-free-pointer* diff --git a/src/compiler/checkgen.lisp b/src/compiler/checkgen.lisp index 635960b..6f0dad4 100644 --- a/src/compiler/checkgen.lisp +++ b/src/compiler/checkgen.lisp @@ -114,7 +114,7 @@ (declare (type ctype type)) (multiple-value-bind (res count) (values-types type) (values (mapcar #'(lambda (type) - (if (function-type-p type) + (if (fun-type-p type) (specifier-type 'function) type)) res) @@ -301,7 +301,7 @@ `(multiple-value-bind ,temps 'dummy ,@(mapcar #'(lambda (temp type) (let* ((spec - (let ((*unparse-function-type-simplify* t)) + (let ((*unparse-fun-type-simplify* t)) (type-specifier (second type)))) (test (if (first type) `(not ,spec) spec))) `(unless (typep ,temp ',test) diff --git a/src/compiler/ctype.lisp b/src/compiler/ctype.lisp index 948c0df..043a52a 100644 --- a/src/compiler/ctype.lisp +++ b/src/compiler/ctype.lisp @@ -116,21 +116,21 @@ ((:error-function *error-function*)) ((:warning-function *warning-function*))) (declare (type function result-test) (type combination call) - (type function-type type)) + (type fun-type type)) (let* ((*lossage-detected* nil) (*slime-detected* nil) (*compiler-error-context* call) (args (combination-args call)) (nargs (length args)) - (required (function-type-required type)) + (required (fun-type-required type)) (min-args (length required)) - (optional (function-type-optional type)) + (optional (fun-type-optional type)) (max-args (+ min-args (length optional))) - (rest (function-type-rest type)) - (keyp (function-type-keyp type))) + (rest (fun-type-rest type)) + (keyp (fun-type-keyp type))) (cond - ((function-type-wild-args type) + ((fun-type-wild-args type) (do ((i 1 (1+ i)) (arg args (cdr arg))) ((null arg)) @@ -160,7 +160,7 @@ (check-key-args args max-args type)))) (let* ((dtype (node-derived-type call)) - (return-type (function-type-returns type)) + (return-type (fun-type-returns type)) (cont (node-cont call)) (out-type (if (or (not (continuation-type-check cont)) @@ -245,7 +245,7 @@ ;;; be known and the corresponding argument should be of the correct ;;; type. If the key isn't a constant, then we can't tell, so we note ;;; slime. -(declaim (ftype (function (list fixnum function-type) (values)) check-key-args)) +(declaim (ftype (function (list fixnum fun-type) (values)) check-key-args)) (defun check-key-args (args pre-key type) (do ((key (nthcdr pre-key args) (cddr key)) (n (1+ pre-key) (+ n 2))) @@ -259,10 +259,10 @@ n)) (t (let* ((name (continuation-value k)) - (info (find name (function-type-keywords type) + (info (find name (fun-type-keywords type) :key #'key-info-name))) (cond ((not info) - (unless (function-type-allowp type) + (unless (fun-type-allowp type) (note-lossage "~S is not a known argument keyword." name))) (t @@ -274,10 +274,10 @@ ;;; ;;; Due to the lack of a (LIST X) type specifier, we can't reconstruct ;;; the &REST type. -(declaim (ftype (function (functional) function-type) definition-type)) +(declaim (ftype (function (functional) fun-type) definition-type)) (defun definition-type (functional) (if (lambda-p functional) - (make-function-type + (make-fun-type :required (mapcar #'leaf-type (lambda-vars functional)) :returns (tail-set-type (lambda-tail-set functional))) (let ((rest nil)) @@ -299,7 +299,7 @@ (:more-count)) (req type)))) - (make-function-type + (make-fun-type :required (req) :optional (opt) :rest rest @@ -322,7 +322,7 @@ ;;;; proclamation, we can check the actual type for compatibity with the ;;;; previous uses. -(defstruct (approximate-function-type (:copier nil)) +(defstruct (approximate-fun-type (:copier nil)) ;; the smallest and largest numbers of arguments that this function ;; has been called with. (min-args sb!xc:call-arguments-limit :type fixnum) @@ -350,16 +350,16 @@ ;; :ALLOW-OTHER-KEYS (allowp nil :type (member t nil))) -;;; Return an APPROXIMATE-FUNCTION-TYPE representing the context of +;;; Return an APPROXIMATE-FUN-TYPE representing the context of ;;; CALL. If TYPE is supplied and not null, then we merge the ;;; information into the information already accumulated in TYPE. (declaim (ftype (function (combination - &optional (or approximate-function-type null)) - approximate-function-type) + &optional (or approximate-fun-type null)) + approximate-fun-type) note-function-use)) (defun note-function-use (call &optional type) - (let* ((type (or type (make-approximate-function-type))) - (types (approximate-function-type-types type)) + (let* ((type (or type (make-approximate-fun-type))) + (types (approximate-fun-type-types type)) (args (combination-args call)) (nargs (length args)) (allowp (some #'(lambda (x) @@ -367,15 +367,15 @@ (eq (continuation-value x) :allow-other-keys))) args))) - (setf (approximate-function-type-min-args type) - (min (approximate-function-type-min-args type) nargs)) - (setf (approximate-function-type-max-args type) - (max (approximate-function-type-max-args type) nargs)) + (setf (approximate-fun-type-min-args type) + (min (approximate-fun-type-min-args type) nargs)) + (setf (approximate-fun-type-max-args type) + (max (approximate-fun-type-max-args type) nargs)) (do ((old types (cdr old)) (arg args (cdr arg))) ((null old) - (setf (approximate-function-type-types type) + (setf (approximate-fun-type-types type) (nconc types (mapcar #'(lambda (x) (list (continuation-type x))) @@ -385,11 +385,11 @@ (car old) :test #'type=)) - (collect ((keys (approximate-function-type-keys type) cons)) + (collect ((keys (approximate-fun-type-keys type) cons)) (do ((arg args (cdr arg)) (pos 0 (1+ pos))) ((or (null arg) (null (cdr arg))) - (setf (approximate-function-type-keys type) (keys))) + (setf (approximate-fun-type-keys type) (keys))) (let ((key (first arg)) (val (second arg))) (when (constant-continuation-p key) @@ -417,8 +417,8 @@ type)) ;;; This is similar to VALID-FUNCTION-USE, but checks an -;;; APPROXIMATE-FUNCTION-TYPE against a real function type. -(declaim (ftype (function (approximate-function-type function-type +;;; APPROXIMATE-FUN-TYPE against a real function type. +(declaim (ftype (function (approximate-fun-type fun-type &optional function function function) (values boolean boolean)) valid-approximate-type)) @@ -430,24 +430,24 @@ (*warning-function* #'compiler-note)) (let* ((*lossage-detected* nil) (*slime-detected* nil) - (required (function-type-required type)) + (required (fun-type-required type)) (min-args (length required)) - (optional (function-type-optional type)) + (optional (fun-type-optional type)) (max-args (+ min-args (length optional))) - (rest (function-type-rest type)) - (keyp (function-type-keyp type))) + (rest (fun-type-rest type)) + (keyp (fun-type-keyp type))) - (when (function-type-wild-args type) + (when (fun-type-wild-args type) (return-from valid-approximate-type (values t t))) - (let ((call-min (approximate-function-type-min-args call-type))) + (let ((call-min (approximate-fun-type-min-args call-type))) (when (< call-min min-args) (note-lossage "~:@" call-min min-args))) - (let ((call-max (approximate-function-type-max-args call-type))) + (let ((call-max (approximate-fun-type-max-args call-type))) (cond ((<= call-max max-args)) ((not (or keyp rest)) (note-lossage @@ -471,11 +471,11 @@ ;;; Check that each of the types used at each arg position is ;;; compatible with the actual type. -(declaim (ftype (function (approximate-function-type list (or ctype null)) +(declaim (ftype (function (approximate-fun-type list (or ctype null)) (values)) check-approximate-fixed-and-rest)) (defun check-approximate-fixed-and-rest (call-type fixed rest) - (do ((types (approximate-function-type-types call-type) (cdr types)) + (do ((types (approximate-fun-type-types call-type) (cdr types)) (n 1 (1+ n)) (arg fixed (cdr arg))) ((null types)) @@ -508,12 +508,12 @@ ;;; argument position. Check the validity of all keys that appeared in ;;; valid keyword positions. ;;; -;;; ### We could check the APPROXIMATE-FUNCTION-TYPE-TYPES to make +;;; ### We could check the APPROXIMATE-FUN-TYPE-TYPES to make ;;; sure that all arguments in keyword positions were manifest ;;; keywords. (defun check-approximate-keywords (call-type max-args type) - (let ((call-keys (approximate-function-type-keys call-type)) - (keys (function-type-keywords type))) + (let ((call-keys (approximate-fun-type-keys call-type)) + (keys (fun-type-keywords type))) (dolist (key keys) (let ((name (key-info-name key))) (collect ((types nil append)) @@ -524,7 +524,7 @@ (types (approximate-key-info-types call-key))))) (check-approximate-arg-type (types) (key-info-type key) "~S" name)))) - (unless (function-type-allowp type) + (unless (fun-type-allowp type) (collect ((names () adjoin)) (dolist (call-key call-keys) (let ((pos (approximate-key-info-position call-key))) @@ -587,11 +587,12 @@ ;;; unioning in NULL, and not totally blow off doing any type ;;; assertion. (defun find-optional-dispatch-types (od type where) - (declare (type optional-dispatch od) (type function-type type) + (declare (type optional-dispatch od) + (type fun-type type) (string where)) (let* ((min (optional-dispatch-min-args od)) - (req (function-type-required type)) - (opt (function-type-optional type))) + (req (fun-type-required type)) + (opt (fun-type-optional type))) (flet ((frob (x y what) (unless (= x y) (note-lossage @@ -605,13 +606,13 @@ "The definition ~:[doesn't have~;has~] ~A, but ~ ~A ~:[doesn't~;does~]." x what where y)))) - (frob (optional-dispatch-keyp od) (function-type-keyp type) + (frob (optional-dispatch-keyp od) (fun-type-keyp type) "&KEY arguments") (unless (optional-dispatch-keyp od) (frob (not (null (optional-dispatch-more-entry od))) - (not (null (function-type-rest type))) + (not (null (fun-type-rest type))) "&REST arguments")) - (frob (optional-dispatch-allowp od) (function-type-allowp type) + (frob (optional-dispatch-allowp od) (fun-type-allowp type) "&ALLOW-OTHER-KEYS")) (when *lossage-detected* @@ -619,7 +620,7 @@ (collect ((res) (vars)) - (let ((keys (function-type-keywords type)) + (let ((keys (fun-type-keywords type)) (arglist (optional-dispatch-arglist od))) (dolist (arg arglist) (cond @@ -645,13 +646,13 @@ (:optional (res (type-union (pop opt) (or def-type *universal-type*)))) (:rest - (when (function-type-rest type) + (when (fun-type-rest type) (res (specifier-type 'list)))) (:more-context - (when (function-type-rest type) + (when (fun-type-rest type) (res *universal-type*))) (:more-count - (when (function-type-rest type) + (when (fun-type-rest type) (res (specifier-type 'fixnum))))) (vars arg) (when (arg-info-supplied-p info) @@ -676,18 +677,18 @@ ;;; Check that Type doesn't specify any funny args, and do the ;;; intersection. (defun find-lambda-types (lambda type where) - (declare (type clambda lambda) (type function-type type) (string where)) + (declare (type clambda lambda) (type fun-type type) (string where)) (flet ((frob (x what) (when x (note-lossage "The definition has no ~A, but the ~A did." what where)))) - (frob (function-type-optional type) "&OPTIONAL arguments") - (frob (function-type-keyp type) "&KEY arguments") - (frob (function-type-rest type) "&REST argument")) + (frob (fun-type-optional type) "&OPTIONAL arguments") + (frob (fun-type-keyp type) "&KEY arguments") + (frob (fun-type-rest type) "&REST argument")) (let* ((vars (lambda-vars lambda)) (nvars (length vars)) - (req (function-type-required type)) + (req (fun-type-required type)) (nreq (length req))) (unless (= nvars nreq) (note-lossage "The definition has ~R arg~:P, but the ~A has ~R." @@ -697,13 +698,13 @@ (try-type-intersections vars req where)))) ;;; Check for syntactic and type conformance between the definition -;;; FUNCTIONAL and the specified FUNCTION-TYPE. If they are compatible +;;; FUNCTIONAL and the specified FUN-TYPE. If they are compatible ;;; and REALLY-ASSERT is T, then add type assertions to the definition -;;; from the FUNCTION-TYPE. +;;; from the FUN-TYPE. ;;; ;;; If there is a syntactic or type problem, then we call ;;; ERROR-FUNCTION with an error message using WHERE as context -;;; describing where FUNCTION-TYPE came from. +;;; describing where FUN-TYPE came from. ;;; ;;; If there is no problem, we return T (even if REALLY-ASSERT was ;;; false). If there was a problem, we return NIL. @@ -716,17 +717,18 @@ (declare (type functional functional) (type function *error-function*) (string where)) - (unless (function-type-p type) (return-from assert-definition-type t)) + (unless (fun-type-p type) + (return-from assert-definition-type t)) (let ((*lossage-detected* nil)) (multiple-value-bind (vars types) - (if (function-type-wild-args type) + (if (fun-type-wild-args type) (values nil nil) (etypecase functional (optional-dispatch (find-optional-dispatch-types functional type where)) (clambda (find-lambda-types functional type where)))) - (let* ((type-returns (function-type-returns type)) + (let* ((type-returns (fun-type-returns type)) (return (lambda-return (main-entry functional))) (atype (when return (continuation-asserted-type (return-result return))))) diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index 6a7aae5..9cf61ef 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -1140,7 +1140,7 @@ ;; section at all? Is it because all the FDEFINITION stuff gets in ;; the way of reading function values and is too hairy to rely on at ;; cold boot? FIXME: Most of these are in *STATIC-SYMBOLS* in - ;; parms.lisp, but %HANDLE-FUNCTION-END-BREAKPOINT is not. Why? + ;; parms.lisp, but %HANDLE-FUN-END-BREAKPOINT is not. Why? ;; Explain. (macrolet ((frob (symbol) `(cold-set ',symbol @@ -1148,7 +1148,7 @@ (frob maybe-gc) (frob internal-error) (frob sb!di::handle-breakpoint) - (frob sb!di::handle-function-end-breakpoint)) + (frob sb!di::handle-fun-end-breakpoint)) (cold-set '*current-catch-block* (make-fixnum-descriptor 0)) (cold-set '*current-unwind-protect-block* (make-fixnum-descriptor 0)) diff --git a/src/compiler/generic/objdef.lisp b/src/compiler/generic/objdef.lisp index ef1aa30..3dfb2f8 100644 --- a/src/compiler/generic/objdef.lisp +++ b/src/compiler/generic/objdef.lisp @@ -171,9 +171,9 @@ :set-known (unsafe) :set-trans (setf %function-arglist)) (type :ref-known (flushable) - :ref-trans %function-type + :ref-trans %fun-type :set-known (unsafe) - :set-trans (setf %function-type)) + :set-trans (setf %fun-type)) (code :rest-p t :c-type "unsigned char")) (define-primitive-object (return-pc :lowtag other-pointer-type :header t) diff --git a/src/compiler/generic/primtype.lisp b/src/compiler/generic/primtype.lisp index b566b11..7310a2d 100644 --- a/src/compiler/generic/primtype.lisp +++ b/src/compiler/generic/primtype.lisp @@ -376,7 +376,7 @@ (part-of list)) (t (any)))) - (function-type + (fun-type (exactly function)) (sb!xc:class (if (csubtypep type (specifier-type 'function)) diff --git a/src/compiler/generic/target-core.lisp b/src/compiler/generic/target-core.lisp index b09a66f..b9f1c7b 100644 --- a/src/compiler/generic/target-core.lisp +++ b/src/compiler/generic/target-core.lisp @@ -29,7 +29,7 @@ (setf (%code-entry-points code-obj) res) (setf (%function-name res) (entry-info-name entry)) (setf (%function-arglist res) (entry-info-arguments entry)) - (setf (%function-type res) (entry-info-type entry)) + (setf (%fun-type res) (entry-info-type entry)) (note-function entry res object)))) diff --git a/src/compiler/generic/vm-type.lisp b/src/compiler/generic/vm-type.lisp index 4a1b4fa..338d0d2 100644 --- a/src/compiler/generic/vm-type.lisp +++ b/src/compiler/generic/vm-type.lisp @@ -176,7 +176,7 @@ ((type= type (specifier-type '(unsigned-byte 32))) 'sb!c:check-unsigned-byte-32) (t nil))) - (function-type + (fun-type 'sb!c:check-function) (t nil))) diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp index 60c4c96..b009be7 100644 --- a/src/compiler/globaldb.lisp +++ b/src/compiler/globaldb.lisp @@ -1022,7 +1022,7 @@ :default #+sb-xc-host (specifier-type 'function) #-sb-xc-host (if (fboundp name) - (extract-function-type (fdefinition name)) + (extract-fun-type (fdefinition name)) (specifier-type 'function))) ;;; the ASSUMED-TYPE for this function, if we have to infer the type @@ -1031,7 +1031,7 @@ :class :function :type :assumed-type ;; FIXME: The type-spec really should be - ;; (or approximate-function-type null)). + ;; (or approximate-fun-type null)). ;; It was changed to T as a hopefully-temporary hack while getting ;; cold init problems untangled. :type-spec t) diff --git a/src/compiler/ir1final.lisp b/src/compiler/ir1final.lisp index d6cf88c..6b0bcb6 100644 --- a/src/compiler/ir1final.lisp +++ b/src/compiler/ir1final.lisp @@ -71,7 +71,7 @@ (ecase where (:assumed (let ((approx-type (info :function :assumed-type name))) - (when (and approx-type (function-type-p defined-ftype)) + (when (and approx-type (fun-type-p defined-ftype)) (valid-approximate-type approx-type defined-ftype)) (setf (info :function :type name) defined-ftype) (setf (info :function :assumed-type name) nil)) diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp index 5bf475e..a38f2fb 100644 --- a/src/compiler/ir1opt.lisp +++ b/src/compiler/ir1opt.lisp @@ -189,24 +189,24 @@ ;;; assumed that the call is legal and has only constants in the ;;; keyword positions. (defun assert-call-type (call type) - (declare (type combination call) (type function-type type)) - (derive-node-type call (function-type-returns type)) + (declare (type combination call) (type fun-type type)) + (derive-node-type call (fun-type-returns type)) (let ((args (combination-args call))) - (dolist (req (function-type-required type)) + (dolist (req (fun-type-required type)) (when (null args) (return-from assert-call-type)) (let ((arg (pop args))) (assert-continuation-type arg req))) - (dolist (opt (function-type-optional type)) + (dolist (opt (fun-type-optional type)) (when (null args) (return-from assert-call-type)) (let ((arg (pop args))) (assert-continuation-type arg opt))) - (let ((rest (function-type-rest type))) + (let ((rest (fun-type-rest type))) (when rest (dolist (arg args) (assert-continuation-type arg rest)))) - (dolist (key (function-type-keywords type)) + (dolist (key (fun-type-keywords type)) (let ((name (key-info-name key))) (do ((arg args (cddr arg))) ((null arg)) @@ -841,7 +841,7 @@ ;;; and that checking is done by local call analysis. (defun validate-call-type (call type ir1-p) (declare (type combination call) (type ctype type)) - (cond ((not (function-type-p type)) + (cond ((not (fun-type-p type)) (aver (multiple-value-bind (val win) (csubtypep type (specifier-type 'function)) (or val (not win)))) @@ -922,7 +922,7 @@ ;;; replace it, otherwise add a new one. (defun record-optimization-failure (node transform args) (declare (type combination node) (type transform transform) - (type (or function-type list) args)) + (type (or fun-type list) args)) (let* ((table (component-failed-optimizations *component-being-compiled*)) (found (assoc transform (gethash node table)))) (if found @@ -941,7 +941,7 @@ (declare (type combination node) (type transform transform)) (let* ((type (transform-type transform)) (fun (transform-function transform)) - (constrained (function-type-p type)) + (constrained (fun-type-p type)) (table (component-failed-optimizations *component-being-compiled*)) (flame (if (transform-important transform) (policy node (>= speed inhibit-warnings)) @@ -1114,7 +1114,7 @@ (defun propagate-to-refs (leaf type) (declare (type leaf leaf) (type ctype type)) (let ((var-type (leaf-type leaf))) - (unless (function-type-p var-type) + (unless (fun-type-p var-type) (let ((int (type-approx-intersection2 var-type type))) (when (type/= int var-type) (setf (leaf-type leaf) int) @@ -1363,8 +1363,8 @@ (when fun-changed (setf (continuation-reoptimize fun) nil) (let ((type (continuation-type fun))) - (when (function-type-p type) - (derive-node-type node (function-type-returns type)))) + (when (fun-type-p type) + (derive-node-type node (fun-type-returns type)))) (maybe-terminate-block node nil) (let ((use (continuation-use fun))) (when (and (ref-p use) (functional-p (ref-leaf use))) @@ -1437,7 +1437,7 @@ (return-from ir1-optimize-mv-call)) (multiple-value-bind (min max) - (function-type-nargs (continuation-type fun)) + (fun-type-nargs (continuation-type fun)) (let ((total-nvals (multiple-value-bind (types nvals) (values-types (continuation-derived-type (first args))) diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index 13d61ed..6b332e4 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -809,8 +809,8 @@ (leaf (let* ((old-type (or (lexenv-find var type-restrictions) (leaf-type var))) - (int (if (or (function-type-p type) - (function-type-p old-type)) + (int (if (or (fun-type-p type) + (fun-type-p old-type)) type (type-approx-intersection2 old-type type)))) (cond ((eq int *empty-type*) diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp index c892d64..9585c63 100644 --- a/src/compiler/ir1util.lisp +++ b/src/compiler/ir1util.lisp @@ -1119,7 +1119,7 @@ (delete-ref ref) (setf (ref-leaf ref) leaf) (let ((ltype (leaf-type leaf))) - (if (function-type-p ltype) + (if (fun-type-p ltype) (setf (node-derived-type ref) ltype) (derive-node-type ref ltype))) (reoptimize-continuation (node-cont ref))) diff --git a/src/compiler/knownfun.lisp b/src/compiler/knownfun.lisp index f869ab8..ea4157d 100644 --- a/src/compiler/knownfun.lisp +++ b/src/compiler/knownfun.lisp @@ -115,7 +115,13 @@ ;;; an IR1 transform (defstruct (transform (:copier nil)) - ;; the function-type which enables this transform + ;; the function type which enables this transform. + ;; + ;; (Note that declaring this :TYPE FUN-TYPE probably wouldn't + ;; work because some function types, like (SPECIFIER-TYPE 'FUNCTION0 + ;; itself, are represented as BUILT-IN-TYPE, and at least as of + ;; sbcl-0.pre7.54 or so, that's inconsistent with being a + ;; FUN-TYPE.) (type (required-argument) :type ctype) ;; the transformation function. Takes the COMBINATION node and returns a ;; lambda, or throws out. diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index cf88b99..82c5e73 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -1114,8 +1114,8 @@ (values (fasl-dump-load-time-value-lambda lambda *compile-object*) (let ((type (leaf-type lambda))) - (if (function-type-p type) - (single-value-type (function-type-returns type)) + (if (fun-type-p type) + (single-value-type (fun-type-returns type)) *wild-type*))))) ;;; Compile the FORMS and arrange for them to be called (for effect, diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp index 1eb7ec0..a882a25 100644 --- a/src/compiler/node.lisp +++ b/src/compiler/node.lisp @@ -405,7 +405,7 @@ ;; optimization of the node failed. The description is an alist ;; (TRANSFORM . ARGS), where TRANSFORM is the structure describing ;; the transform that failed, and ARGS is either a list of format - ;; arguments for the note, or the FUNCTION-TYPE that would have + ;; arguments for the note, or the FUN-TYPE that would have ;; enabled the transformation but failed to match. (failed-optimizations (make-hash-table :test 'eq) :type hash-table) ;; This is similar to NEW-FUNCTIONS, but is used when a function has diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index ca49cc1..c736fe1 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -43,7 +43,7 @@ (deftransform complement ((fun) * * :node node :when :both) "open code" (multiple-value-bind (min max) - (function-type-nargs (continuation-type fun)) + (fun-type-nargs (continuation-type fun)) (cond ((and min (eql min max)) (let ((dums (make-gensym-list min))) diff --git a/src/compiler/vop.lisp b/src/compiler/vop.lisp index e78a376..57b2b1b 100644 --- a/src/compiler/vop.lisp +++ b/src/compiler/vop.lisp @@ -500,7 +500,7 @@ ;; the arg/result type restrictions. We compute this from the ;; PRIMITIVE-TYPE restrictions to make life easier for IR1 phases ;; that need to anticipate LTN's template selection. - (type (required-argument) :type function-type) + (type (required-argument) :type fun-type) ;; lists of restrictions on the argument and result types. A ;; restriction may take several forms: ;; -- The restriction * is no restriction at all. diff --git a/src/compiler/x86/c-call.lisp b/src/compiler/x86/c-call.lisp index 8cfd2e7..ac142f2 100644 --- a/src/compiler/x86/c-call.lisp +++ b/src/compiler/x86/c-call.lisp @@ -122,14 +122,14 @@ (let ((arg-state (make-arg-state))) (collect ((arg-tns)) (dolist #+nil ;; this reversed list seems to cause the alien botches!! - (arg-type (reverse (alien-function-type-arg-types type))) - (arg-type (alien-function-type-arg-types type)) + (arg-type (reverse (alien-fun-type-arg-types type))) + (arg-type (alien-fun-type-arg-types type)) (arg-tns (invoke-alien-type-method :arg-tn arg-type arg-state))) (values (my-make-wired-tn 'positive-fixnum 'any-reg esp-offset) (* (arg-state-stack-frame-size arg-state) word-bytes) (arg-tns) (invoke-alien-type-method :result-tn - (alien-function-type-result-type type) + (alien-fun-type-result-type type) (make-result-state)))))) (define-vop (foreign-symbol-address) diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp index dc79fef..5d864f6 100644 --- a/src/compiler/x86/insts.lisp +++ b/src/compiler/x86/insts.lisp @@ -1838,7 +1838,7 @@ (nt "pending interrupt trap")) (#.sb!vm:halt-trap (nt "halt trap")) - (#.sb!vm:function-end-breakpoint-trap + (#.sb!vm:fun-end-breakpoint-trap (nt "function end breakpoint trap"))))) (define-instruction break (segment code) diff --git a/src/compiler/x86/parms.lisp b/src/compiler/x86/parms.lisp index 81718ef..39f40e5 100644 --- a/src/compiler/x86/parms.lisp +++ b/src/compiler/x86/parms.lisp @@ -190,7 +190,7 @@ error cerror breakpoint - function-end-breakpoint + fun-end-breakpoint single-step-breakpoint) ;;; FIXME: It'd be nice to replace all the DEFENUMs with something like ;;; (WITH-DEF-ENUM (:START 8) diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp index 6c9c9d4..d85ca7d 100644 --- a/src/pcl/boot.lisp +++ b/src/pcl/boot.lisp @@ -1339,15 +1339,15 @@ bootstrapping. (analyze-lambda-list lambda-list) (declare (ignore keyword-parameters)) (let* ((old (info :function :type name)) ;FIXME:FDOCUMENTATION instead? - (old-ftype (if (sb-kernel:function-type-p old) old nil)) - (old-restp (and old-ftype (sb-kernel:function-type-rest old-ftype))) + (old-ftype (if (sb-kernel:fun-type-p old) old nil)) + (old-restp (and old-ftype (sb-kernel:fun-type-rest old-ftype))) (old-keys (and old-ftype (mapcar #'sb-kernel:key-info-name - (sb-kernel:function-type-keywords + (sb-kernel:fun-type-keywords old-ftype)))) - (old-keysp (and old-ftype (sb-kernel:function-type-keyp old-ftype))) + (old-keysp (and old-ftype (sb-kernel:fun-type-keyp old-ftype))) (old-allowp (and old-ftype - (sb-kernel:function-type-allowp old-ftype))) + (sb-kernel:fun-type-allowp old-ftype))) (keywords (union old-keys (mapcar #'keyword-spec-name keywords)))) `(function ,(append (make-list nrequired :initial-element t) (when (plusp noptional) diff --git a/src/pcl/combin.lisp b/src/pcl/combin.lisp index a28a1e4..1221782 100644 --- a/src/pcl/combin.lisp +++ b/src/pcl/combin.lisp @@ -64,8 +64,10 @@ (make-effective-method-function-internal generic-function form method-alist-p wrappers-p))) -(defun make-effective-method-function-type (generic-function form - method-alist-p wrappers-p) +(defun make-effective-method-fun-type (generic-function + form + method-alist-p + wrappers-p) (if (and (listp form) (eq (car form) 'call-method)) (let* ((cm-args (cdr form)) @@ -86,7 +88,7 @@ 'fast-method-call 'method-call)))) (if (and (consp method) (eq (car method) 'make-method)) - (make-effective-method-function-type + (make-effective-method-fun-type generic-function (cadr method) method-alist-p wrappers-p) (type-of method))))) 'fast-method-call)) @@ -186,7 +188,7 @@ (defun memf-test-converter (form generic-function method-alist-p wrappers-p) (cond ((and (consp form) (eq (car form) 'call-method)) - (case (make-effective-method-function-type + (case (make-effective-method-fun-type generic-function form method-alist-p wrappers-p) (fast-method-call '.fast-call-method.) @@ -195,7 +197,7 @@ ((and (consp form) (eq (car form) 'call-method-list)) (case (if (every #'(lambda (form) (eq 'fast-method-call - (make-effective-method-function-type + (make-effective-method-fun-type generic-function form method-alist-p wrappers-p))) (cdr form)) @@ -213,14 +215,14 @@ (cond ((and (consp form) (eq (car form) 'call-method)) (let ((gensym (get-effective-method-gensym))) (values (make-emf-call metatypes applyp gensym - (make-effective-method-function-type + (make-effective-method-fun-type generic-function form method-alist-p wrappers-p)) (list gensym)))) ((and (consp form) (eq (car form) 'call-method-list)) (let ((gensym (get-effective-method-gensym)) (type (if (every #'(lambda (form) (eq 'fast-method-call - (make-effective-method-function-type + (make-effective-method-fun-type generic-function form method-alist-p wrappers-p))) (cdr form)) diff --git a/src/runtime/alpha-arch.c b/src/runtime/alpha-arch.c index 066355f..e7cfd42 100644 --- a/src/runtime/alpha-arch.c +++ b/src/runtime/alpha-arch.c @@ -344,10 +344,10 @@ sigtrap_handler(int signal, siginfo_t *siginfo, os_context_t *context) handle_breakpoint(signal, siginfo, context); break; - case trap_FunctionEndBreakpoint: + case trap_FunEndBreakpoint: *os_context_pc_addr(context) -=4; *os_context_pc_addr(context) = - (int)handle_function_end_breakpoint(signal, siginfo, context); + (int)handle_fun_end_breakpoint(signal, siginfo, context); break; default: diff --git a/src/runtime/alpha-assem.S b/src/runtime/alpha-assem.S index ba97b81..a14d458 100644 --- a/src/runtime/alpha-assem.S +++ b/src/runtime/alpha-assem.S @@ -288,16 +288,16 @@ end_of_tramps: /* - * Function-end breakpoint magic. + * fun-end breakpoint magic. */ .text .align 2 .set noreorder - .globl function_end_breakpoint_guts -function_end_breakpoint_guts: + .globl fun_end_breakpoint_guts +fun_end_breakpoint_guts: .long type_ReturnPcHeader - br zero, function_end_breakpoint_trap + br zero, fun_end_breakpoint_trap nop mov reg_CSP, reg_OCFP addl reg_CSP, 4, reg_CSP @@ -309,13 +309,13 @@ function_end_breakpoint_guts: mov reg_NULL, reg_A5 1: - .globl function_end_breakpoint_trap -function_end_breakpoint_trap: + .globl fun_end_breakpoint_trap +fun_end_breakpoint_trap: call_pal PAL_bugchk - .long trap_FunctionEndBreakpoint - br zero, function_end_breakpoint_trap + .long trap_FunEndBreakpoint + br zero, fun_end_breakpoint_trap - .globl function_end_breakpoint_end -function_end_breakpoint_end: + .globl fun_end_breakpoint_end +fun_end_breakpoint_end: diff --git a/src/runtime/breakpoint.c b/src/runtime/breakpoint.c index 48f8aed..34a2bdf 100644 --- a/src/runtime/breakpoint.c +++ b/src/runtime/breakpoint.c @@ -173,8 +173,8 @@ void handle_breakpoint(int signal, siginfo_t* info, os_context_t *context) #endif #ifndef __i386__ -void *handle_function_end_breakpoint(int signal, siginfo_t *info, - os_context_t *context) +void *handle_fun_end_breakpoint(int signal, siginfo_t *info, + os_context_t *context) { lispobj code, lra; struct code *codeptr; @@ -199,8 +199,8 @@ void *handle_function_end_breakpoint(int signal, siginfo_t *info, return (void *)(lra-type_OtherPointer+sizeof(lispobj)); } #else -void *handle_function_end_breakpoint(int signal, siginfo_t *info, - os_context_t *context) +void *handle_fun_end_breakpoint(int signal, siginfo_t *info, + os_context_t *context) { lispobj code, context_sap = alloc_sap(context); struct code *codeptr; diff --git a/src/runtime/breakpoint.h b/src/runtime/breakpoint.h index 305fa38..7862c12 100644 --- a/src/runtime/breakpoint.h +++ b/src/runtime/breakpoint.h @@ -20,7 +20,7 @@ extern void breakpoint_do_displaced_inst(os_context_t *context, unsigned long orig_inst); extern void handle_breakpoint(int signal, siginfo_t *info, os_context_t *context); -extern void *handle_function_end_breakpoint(int signal, siginfo_t *info, - os_context_t *context); +extern void *handle_fun_end_breakpoint(int signal, siginfo_t *info, + os_context_t *context); #endif diff --git a/src/runtime/x86-arch.c b/src/runtime/x86-arch.c index eec4f32..96d3bcd 100644 --- a/src/runtime/x86-arch.c +++ b/src/runtime/x86-arch.c @@ -85,7 +85,7 @@ void arch_skip_instruction(os_context_t *context) break; case trap_Breakpoint: /* not tested */ - case trap_FunctionEndBreakpoint: /* not tested */ + case trap_FunEndBreakpoint: /* not tested */ break; case trap_PendingInterrupt: @@ -249,10 +249,10 @@ sigtrap_handler(int signal, siginfo_t *info, void *void_context) handle_breakpoint(signal, info, context); break; - case trap_FunctionEndBreakpoint: + case trap_FunEndBreakpoint: (char*)(*os_context_pc_addr(context)) -= 1; *os_context_pc_addr(context) = - (int)handle_function_end_breakpoint(signal, info, context); + (int)handle_fun_end_breakpoint(signal, info, context); break; default: diff --git a/src/runtime/x86-assem.S b/src/runtime/x86-assem.S index 5941e0a..b881daa 100644 --- a/src/runtime/x86-assem.S +++ b/src/runtime/x86-assem.S @@ -290,12 +290,12 @@ GNAME(closure_tramp): .size GNAME(closure_tramp), .-GNAME(closure_tramp) /* - * function-end breakpoint magic + * fun-end breakpoint magic */ .text - .global GNAME(function_end_breakpoint_guts) + .global GNAME(fun_end_breakpoint_guts) .align align_4byte -GNAME(function_end_breakpoint_guts): +GNAME(fun_end_breakpoint_guts): /* Multiple Value return */ jmp multiple_value_return /* Single value return: The eventual return will now use the @@ -309,14 +309,14 @@ GNAME(function_end_breakpoint_guts): multiple_value_return: - .global GNAME(function_end_breakpoint_trap) -GNAME(function_end_breakpoint_trap): + .global GNAME(fun_end_breakpoint_trap) +GNAME(fun_end_breakpoint_trap): int3 - .byte trap_FunctionEndBreakpoint + .byte trap_FunEndBreakpoint hlt # We should never return here. - .global GNAME(function_end_breakpoint_end) -GNAME(function_end_breakpoint_end): + .global GNAME(fun_end_breakpoint_end) +GNAME(fun_end_breakpoint_end): .global GNAME(do_pending_interrupt) diff --git a/tests/compiler-1.impure-cload.lisp b/tests/compiler-1.impure-cload.lisp index 75484ce..18df67c 100644 --- a/tests/compiler-1.impure-cload.lisp +++ b/tests/compiler-1.impure-cload.lisp @@ -62,7 +62,7 @@ ;;; against DECLAIMed FTYPEs blew up when an FTYPE was DECLAIMed ;;; to be pure FUNCTION, because the internal representation of ;;; FUNCTION itself (as opposed to subtypes of FUNCTION, such as -;;; (FUNCTION () T)) is a BUILT-IN-CLASS object, not a FUNCTION-TYPE +;;; (FUNCTION () T)) is a BUILT-IN-CLASS object, not a FUN-TYPE ;;; object. (declaim (ftype function i-am-just-a-function)) (defun i-am-just-a-function (x y) (+ x y 1)) diff --git a/tests/info.impure.lisp b/tests/info.impure.lisp index 8376d67..ffb3a06 100644 --- a/tests/info.impure.lisp +++ b/tests/info.impure.lisp @@ -41,7 +41,7 @@ (assert (equal (format nil "~A" (sb-int:info :function :type 'foo)) - "#")) + "#")) |# ;;; success diff --git a/tests/interface.pure.lisp b/tests/interface.pure.lisp index f349903..8c163b8 100644 --- a/tests/interface.pure.lisp +++ b/tests/interface.pure.lisp @@ -29,7 +29,7 @@ (#.sb-vm:closure-header-type (has-arglist-info-p (sb-kernel:%closure-function function))) - ;; in code/describe.lisp, ll. 227 (%describe-function), we use a scheme + ;; In code/describe.lisp, ll. 227 (%describe-function), we use a scheme ;; like above, and it seems to work. -- MNA 2001-06-12 ;; ;; (There might be other cases with arglist info also. diff --git a/version.lisp-expr b/version.lisp-expr index cbe8013..de792ec 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.53" +"0.pre7.54" -- 1.7.10.4