From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Sun, 28 Jun 2009 21:21:04 +0000 (+0000)
Subject: 1.0.29.53: ...really this time...
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=485944b1d04b8f3381a04bc6291bc2e667442e45;p=sbcl.git

1.0.29.53: ...really this time...

 (Missed version.lisp-expr and tests/compiler-test-util.lisp)
---

diff --git a/tests/compiler-test-util.lisp b/tests/compiler-test-util.lisp
new file mode 100644
index 0000000..1ed4fa6
--- /dev/null
+++ b/tests/compiler-test-util.lisp
@@ -0,0 +1,48 @@
+;;;; Utilities for verifying features of compiled code
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
+(defpackage :compiler-test-util
+  (:nicknames :ctu)
+  (:use :cl :sb-c :sb-kernel)
+  (:export #:compiler-derived-type
+           #:find-value-cell-values
+           #:find-named-callees))
+
+(cl:in-package :ctu)
+
+(unless (fboundp 'compiler-derived-type)
+  (defknown compiler-derived-type (t) (values t t) (movable flushable unsafe))
+  (deftransform compiler-derived-type ((x) * * :node node)
+    (sb-c::delay-ir1-transform node :optimize)
+    `(values ',(type-specifier (sb-c::lvar-type x)) t))
+  (defun compiler-derived-type (x)
+    (declare (ignore x))
+    (values t nil)))
+
+(defun find-value-cell-values (fun)
+  (let ((code (fun-code-header (%fun-fun fun))))
+    (loop for i from sb-vm::code-constants-offset below (get-header-data code)
+          for c = (code-header-ref code i)
+          when (= sb-vm::value-cell-header-widetag (widetag-of c))
+          collect (sb-vm::value-cell-ref c))))
+
+(defun find-named-callees (fun &key (type t) (name nil namep))
+  (let ((code (sb-kernel:fun-code-header (sb-kernel:%fun-fun fun))))
+    (loop for i from sb-vm::code-constants-offset below (sb-kernel:get-header-data code)
+          for c = (sb-kernel:code-header-ref code i)
+          when (and (typep c 'sb-impl::fdefn)
+                    (let ((fun (sb-impl::fdefn-fun c)))
+                      (and (typep fun type)
+                           (or (not namep)
+                               (equal name (sb-impl::fdefn-name c))))))
+          collect (sb-impl::fdefn-fun c))))
diff --git a/version.lisp-expr b/version.lisp-expr
index 243108a..694ce09 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.29.52"
+"1.0.29.53"