[prev in list] [next in list] [prev in thread] [next in thread]
List: sbcl-commits
Subject: [Sbcl-commits] master: Move FIND-FDEFINITION to where it properly belongs
From: "Douglas Katzman" <snuglas () users ! sourceforge ! net>
Date: 2014-04-19 19:37:37
Message-ID: E1Wbb52-0005Dv-Ra () sfs-ml-4 ! v29 ! ch3 ! sourceforge ! com
[Download RAW message or body]
The branch "master" has been updated in SBCL:
via 7297d4392990e746809907cd98d91b8a5fd0fe7b (commit)
from dd417c3ef2b65d9cafd895add5cd96e7e8e3f958 (commit)
- Log -----------------------------------------------------------------
commit 7297d4392990e746809907cd98d91b8a5fd0fe7b
Author: Douglas Katzman <dougk@google.com>
Date: Sat Apr 19 15:37:15 2014 -0400
Move FIND-FDEFINITION to where it properly belongs
Also removed unused function FDEFINITION-OBJECT
---
package-data-list.lisp-expr | 14 +++++++---
src/code/fdefinition.lisp | 53 ++++++++++++++++++++++++++++----------
src/compiler/generic/parms.lisp | 1 -
src/compiler/globaldb.lisp | 44 --------------------------------
4 files changed, 49 insertions(+), 63 deletions(-)
diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 5658bf3..fc1e353 100644
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -945,13 +945,20 @@ possibly temporarily, because it might be used internally."
;; INFO stuff doesn't belong in a user-visible package, we
;; should be able to change it without apology.
"*INFO-ENVIRONMENT*"
+ "+INFOS-PER-WORD+"
+ "+FDEFN-TYPE-NUM+"
"CLEAR-INFO"
"DEFINE-INFO-TYPE"
- "INFO"
+ "FIND-FDEFINITION"
"GET-INFO-VALUE-INITIALIZING"
- "UPDATE-SYMBOL-INFO"
+ "INFO"
+ "INFO-FIND-AUX-KEY/PACKED"
+ "INFO-GETHASH"
+ "INFO-VECTOR-FDEFINITION"
"MAKE-INFO-ENVIRONMENT"
- "FIND-FDEFINITION"
+ "PACKED-INFO-FIELD"
+ "UPDATE-SYMBOL-INFO"
+ "WITH-GLOBALDB-NAME"
;; Calling a list of hook functions, plus error handling.
"CALL-HOOKS"
@@ -1516,7 +1523,6 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
"ENSURE-SYMBOL-TLS-INDEX"
"ERROR-NUMBER-OR-LOSE"
"EXTENDED-CHAR-P" "EXTERNAL-FORMAT-DESIGNATOR"
- "FDEFINITION-OBJECT"
"FDOCUMENTATION" "FILENAME"
"FIND-AND-INIT-OR-CHECK-LAYOUT"
"FIND-DEFSTRUCT-DESCRIPTION"
diff --git a/src/code/fdefinition.lisp b/src/code/fdefinition.lisp
index 5e3828b..22e8f37 100644
--- a/src/code/fdefinition.lisp
+++ b/src/code/fdefinition.lisp
@@ -50,20 +50,45 @@
(dolist (fdefn *!initial-fdefn-objects*)
(setf (info :function :definition (fdefn-name fdefn)) fdefn)))
-;;; Return the fdefn object for NAME. If it doesn't already exist and
-;;; CREATE is non-NIL, create a new (unbound) one.
-;;; There is really no need for this function, but I kept it for 2 reasons:
-;;; 1. it's listed in *C-CALLABLE-STATIC-SYMBOLS* in compiler/generic/params
-;;; 2. it's an external symbol, so perhaps people thought they should use it
-;;; However in every use within the system's Lisp code, the second argument
-;;; is constantly T or NIL, and I feel that 'find-or-create-' is a better
-;;; name for what it does when create=T than is 'fdefinition-object'.
-(defun fdefinition-object (name create)
- (declare (values (or fdefn null)))
- (legal-fun-name-or-type-error name)
- (if create
- (find-or-create-fdefinition name)
- (find-fdefinition name)))
+;; Return the fdefn object for NAME, or NIL if there is no fdefn.
+;; Signal an error if name isn't valid.
+;; Assume that exists-p implies LEGAL-FUN-NAME-P.
+;;
+(declaim (ftype (sfunction ((or symbol list)) (or fdefn null))
+ find-fdefinition))
+(defun find-fdefinition (name0)
+ ;; Since this emulates GET-INFO-VALUE, we have to uncross the name.
+ (let ((name (uncross name0)))
+ (declare (optimize (safety 0)))
+ (when (symbolp name) ; Don't need LEGAL-FUN-NAME-P check
+ (return-from find-fdefinition (sb!impl::symbol-fdefinition name)))
+ ;; Technically the ALLOW-ATOM argument of NIL isn't needed, but
+ ;; the compiler isn't figuring out not to test SYMBOLP twice in a row.
+ (with-globaldb-name (key1 key2 nil) name
+ :hairy
+ ;; INFO-GETHASH returns NIL or a vector. INFO-VECTOR-FDEFINITION accepts
+ ;; either. If fdefn isn't found, fall through to the legality test.
+ (awhen (info-vector-fdefinition (info-gethash name *info-environment*))
+ (return-from find-fdefinition it))
+ :simple
+ (progn
+ (awhen (symbol-info-vector key1)
+ (multiple-value-bind (data-idx descriptor-idx field-idx)
+ (info-find-aux-key/packed it key2)
+ (declare (type index descriptor-idx)
+ (type (integer 0 #.+infos-per-word+) field-idx))
+ ;; Secondary names must have at least one info, so if a descriptor
+ ;; exists, there's no need to extract the n-infos field.
+ (when data-idx
+ (when (eql (incf field-idx) +infos-per-word+)
+ (setq field-idx 0 descriptor-idx (1+ descriptor-idx)))
+ (when (eql (packed-info-field it descriptor-idx field-idx)
+ +fdefn-type-num+)
+ (return-from find-fdefinition
+ (aref it (1- (the index data-idx))))))))
+ (when (eq key1 'setf) ; bypass the legality test
+ (return-from find-fdefinition nil))))
+ (legal-fun-name-or-type-error name)))
(declaim (ftype (sfunction (t) fdefn) find-or-create-fdefinition))
(defun find-or-create-fdefinition (name)
diff --git a/src/compiler/generic/parms.lisp b/src/compiler/generic/parms.lisp
index 0737fea..e085824 100644
--- a/src/compiler/generic/parms.lisp
+++ b/src/compiler/generic/parms.lisp
@@ -122,7 +122,6 @@
#!-x86-64 undefined-alien-fun-error
sb!di::handle-breakpoint
sb!di::handle-single-step-trap
- fdefinition-object
#!+win32 sb!kernel::handle-win32-exception
#!+sb-thruption sb!thread::run-interruption
#!+sb-safepoint sb!thread::enter-foreign-callback
diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp
index 115e3bc..22df709 100644
--- a/src/compiler/globaldb.lisp
+++ b/src/compiler/globaldb.lisp
@@ -415,50 +415,6 @@
(dx-flet ((,proc () ,creation-form))
(%get-info-value-initializing ,name ,type-number #',proc)))))
-;; Return the fdefn object for NAME, or NIL if there is no fdefn.
-;; Signal an error if name isn't valid.
-;; Trying to get this to work properly in file 'fdefinition.lisp'
-;; was an exercise in futility.
-;; Creation of new fdefinitions is still defined there though.
-;; Assume that exists-p implies LEGAL-FUN-NAME-P.
-;;
-#-sb-xc-host
-(declaim (ftype (sfunction ((or symbol list)) (or fdefn null))
- find-fdefinition))
-(defun find-fdefinition (name0)
- ;; Since this emulates GET-INFO-VALUE, we have to uncross the name.
- (let ((name (uncross name0)))
- (declare (optimize (safety 0)))
- (when (symbolp name) ; Don't need LEGAL-FUN-NAME-P check
- (return-from find-fdefinition (sb!impl::symbol-fdefinition name)))
- ;; Technically the ALLOW-ATOM argument of NIL isn't needed, but
- ;; the compiler isn't figuring out not to test SYMBOLP twice in a row.
- (with-globaldb-name (key1 key2 nil) name
- :hairy
- ;; INFO-GETHASH returns NIL or a vector. INFO-VECTOR-FDEFINITION accepts
- ;; either. If fdefn isn't found, fall through to the legality test.
- (awhen (info-vector-fdefinition (info-gethash name *info-environment*))
- (return-from find-fdefinition it))
- :simple
- (progn
- (awhen (symbol-info-vector key1)
- (multiple-value-bind (data-idx descriptor-idx field-idx)
- (info-find-aux-key/packed it key2)
- (declare (type index descriptor-idx)
- (type (integer 0 #.+infos-per-word+) field-idx))
- ;; Secondary names must have at least one info, so if a descriptor
- ;; exists, there's no need to extract the n-infos field.
- (when data-idx
- (when (eql (incf field-idx) +infos-per-word+)
- (setq field-idx 0 descriptor-idx (1+ descriptor-idx)))
- (when (eql (packed-info-field it descriptor-idx field-idx)
- +fdefn-type-num+)
- (return-from find-fdefinition
- (aref it (1- (the index data-idx))))))))
- (when (eq key1 'setf) ; bypass the legality test
- (return-from find-fdefinition nil))))
- (legal-fun-name-or-type-error name)))
-
;; Call FUNCTION once for each Name in globaldb that has information associated
;; with it, passing the function the Name as its only argument.
;;
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL
------------------------------------------------------------------------------
Learn Graph Databases - Download FREE O'Reilly Book
"Graph Databases" is the definitive new guide to graph databases and their
applications. Written by three acclaimed leaders in the field,
this first edition is now available. Download your free book today!
http://p.sf.net/sfu/NeoTech
_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic