[Openmcl-cvs-notifications] r13873 - in /trunk/source/lib: ccl-export-syms.lisp misc.lisp

[gb at clozure.com]

Author: gb
Date: Wed Jun 23 17:04:02 2010
New Revision: 13873

Log:
Define and export OBJECT-DIRECT-SIZE, which is basically the SIZEOF
function from openmcl-devel a few months ago.

Modified:
    trunk/source/lib/ccl-export-syms.lisp
    trunk/source/lib/misc.lisp

Modified: trunk/source/lib/ccl-export-syms.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lib/ccl-export-syms.lisp (original)
+++ trunk/source/lib/ccl-export-syms.lisp Wed Jun 23 17:04:02 2010
@@ -726,6 +726,7 @@
      get-output-stream-vector  =

      *vector-output-stream-default-initial-allocation*   =

      external-process-creation-failure
+     object-direct-size
 =

      ) "CCL"
    )

Modified: trunk/source/lib/misc.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lib/misc.lisp (original)
+++ trunk/source/lib/misc.lisp Wed Jun 23 17:04:02 2010
@@ -1216,7 +1216,28 @@
                 100.0d0))))
   (values))
 =

-
+(defun object-direct-size (thing)
+  "Returns the size of THING (in bytes), including any headers and
+   alignment overhead.  Does not descend an object's components."
+  (cond ((consp thing) #+64-bit-target 16 #+32-bit-target 8)
+        #+x8664-target ((symbolp thing)
+                        (object-direct-size (%symptr->symvector thing)))
+        #+x8664-target ((functionp thing)
+                        (object-direct-size (function-to-function-vector t=
hing)))
+        ((uvectorp thing)
+         (let* ((typecode (ccl::typecode thing))
+                (element-count (ccl::uvsize thing))
+                (sizeof-content-in-octets
+                 ;; Call the architecture-specific backend function.
+                 (funcall (arch::target-array-data-size-function
+                           (backend-target-arch *host-backend*))
+                          typecode element-count)))
+           (logandc2 (+ sizeof-content-in-octets
+                           #+64-bit-target (+ 8 15)
+                           #+32-bit-target (+ 4 7))
+                     #+64-bit-target 15
+                     #+32-bit-target 7)))
+        (t 0)))
 =

 (defun static-cons (car-value cdr-value)
   "Allocates a cons cell that doesn't move on garbage collection,