[prev in list] [next in list] [prev in thread] [next in thread] 

List:       sbcl-commits
Subject:    [Sbcl-commits] master: Workaround a problem in building SBCL under ABCL.
From:       "Douglas Katzman" <snuglas () users ! sourceforge ! net>
Date:       2014-03-23 19:18:21
Message-ID: E1WRnub-0006Wf-RI () sfs-ml-4 ! v29 ! ch3 ! sourceforge ! com
[Download RAW message or body]

The branch "master" has been updated in SBCL:
       via  fee12928aef599561997572667e96e1dd0fe2dad (commit)
      from  6e0340a25a38ad4add57e5f5f178ab2b6cf3f4e9 (commit)

- Log -----------------------------------------------------------------
commit fee12928aef599561997572667e96e1dd0fe2dad
Author: Douglas Katzman <dougk@google.com>
Date:   Sun Mar 23 15:16:20 2014 -0400

    Workaround a problem in building SBCL under ABCL.
    
    This issue is logged as http://abcl.org/trac/ticket/351
---
 src/compiler/globaldb.lisp |   39 +++++++++++++++++++++------------------
 1 files changed, 21 insertions(+), 18 deletions(-)

diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp
index 9c642ae..b2c5182 100644
--- a/src/compiler/globaldb.lisp
+++ b/src/compiler/globaldb.lisp
@@ -165,18 +165,21 @@
 
 (defconstant +info-metainfo-type-num+ 63)
 
-;; GET-INFO-VALUE can't be used, so hand-roll it for the next two functions.
-(macrolet ((get-type-info-metadata (sym)
-             `(let* ((info-vector (symbol-info-vector ,sym))
-                     (index (if info-vector
-                                (packed-info-value-index
-                                 info-vector +no-auxilliary-key+
-                                 +info-metainfo-type-num+))))
-                (if index (svref info-vector index)))))
-  ;; Find or create a TYPE-INFO object designated by CLASS- and TYPE-KEYWORD.
-  ;; If not found, the specified TYPE-NUM and TYPE-SPEC are used to
-  ;; initialize it. Return the new type-num.
-  (defun register-info-metadata (type-num class-keyword type-keyword type-spec)
+;; Perform the equivalent of (GET-INFO-VALUE sym +INFO-METAINFO-TYPE-NUM+)
+;; but without the AVER that metadata already exists, and bypassing the
+;; defaulting logic.
+(defun %get-type-info-metadata (sym)
+  (let* ((info-vector (symbol-info-vector sym))
+         (index (if info-vector
+                    (packed-info-value-index info-vector +no-auxilliary-key+
+                                             +info-metainfo-type-num+))))
+    (if index (svref info-vector index))))
+
+;; Find or create a TYPE-INFO object designated by CLASS- and TYPE-KEYWORD.
+;; If not found, the specified TYPE-NUM and TYPE-SPEC are used to
+;; initialize it. If TYPE-NUM is -1, the next available number is assigned.
+;; Return the new type-num.
+(defun register-info-metadata (type-num class-keyword type-keyword type-spec)
     (let ((metainfo (find-type-info class-keyword type-keyword)))
       (cond (metainfo) ; Do absolutely positively nothing.
             (t
@@ -192,7 +195,7 @@
              (setf metainfo (make-globaldb-info-metadata
                              type-num class-keyword type-keyword type-spec)
                    (aref *info-types* type-num) metainfo)
-             (let ((list (get-type-info-metadata type-keyword)))
+             (let ((list (%get-type-info-metadata type-keyword)))
                (set-info-value
                 type-keyword +info-metainfo-type-num+
                 (cond ((not list) metainfo) ; unique, just store it
@@ -200,11 +203,11 @@
                       (t (list metainfo list))))))) ; convert atom to a list
       (type-info-number metainfo)))
 
-  ;; If CLASS-KEYWORD/TYPE-KEYWORD designate an info-type,
-  ;; return the corresponding TYPE-INFO object, otherwise NIL.
-  (defun find-type-info (class-keyword type-keyword)
+;; If CLASS-KEYWORD/TYPE-KEYWORD designate an info-type,
+;; return the corresponding TYPE-INFO object, otherwise NIL.
+(defun find-type-info (class-keyword type-keyword)
     (declare (type keyword class-keyword type-keyword))
-    (let ((metadata (get-type-info-metadata type-keyword)))
+    (let ((metadata (%get-type-info-metadata type-keyword)))
       ;; Most TYPE-KEYWORDs uniquely designate an object, so we store only that.
       ;; Otherwise we store a list which has a small handful of (<= 4) items.
       (cond ((listp metadata)
@@ -215,7 +218,7 @@
                          class-keyword)
                  (return info))))
             ((eq (type-info-class (truly-the type-info metadata)) class-keyword)
-             metadata)))))
+             metadata))))
 
 (declaim (ftype (function (keyword keyword) type-info) type-info-or-lose))
 (defun type-info-or-lose (class type)

-----------------------------------------------------------------------


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/13534_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]