class & type size (and some more exports)
Sat Jan 23 20:45:41 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* class & type size (and some more exports)
diff -rN -u old-smoke/src/objects/class.lisp new-smoke/src/objects/class.lisp
--- old-smoke/src/objects/class.lisp 2014-10-30 07:05:32.000000000 +0100
+++ new-smoke/src/objects/class.lisp 2014-10-30 07:05:32.000000000 +0100
@@ -30,6 +30,9 @@
(defmethod name ((class smoke-class))
(class-slot-value class 'name))
+(defun class-size (smoke-class)
+ (class-slot-value smoke-class 'size))
+
(defun map-classes (function smoke)
"Applies FUNCTION to the classes of SMOKE."
(declare (function function)
@@ -56,6 +59,9 @@
"Returns T when CLASS has a constructor; NIL otherwise."
(/= 0 (get-class-flag class :constructor)))
+(defun copy-constructor-p (class)
+ (/= 0 (get-class-flag class :copy-constructor)))
+
(defun virtual-destructor-p (class)
"Returns T when CLASS has a virtual destructor and NIL otherwise."
(/= 0 (get-class-flag class :virtual-destructor)))
diff -rN -u old-smoke/src/objects/stack.lisp new-smoke/src/objects/stack.lisp
--- old-smoke/src/objects/stack.lisp 2014-10-30 07:05:32.000000000 +0100
+++ new-smoke/src/objects/stack.lisp 2014-10-30 07:05:32.000000000 +0100
@@ -111,7 +111,9 @@
(prog1 (funcall (car translation) pointer)
(when (stack-p type)
(funcall (cdr translation) pointer))))
- (error "Do not know how to convert the type ~A to Lisp." type)))
+ (prog1 (foreign-slot-value stack-item 'smoke-stack-item 'voidp)
+ (cerror "Return the pointer"
+ "Do not know how to convert the type ~A to Lisp." type))))
(1 (foreign-slot-value stack-item 'smoke-stack-item 'bool))
(2 (code-char (foreign-slot-value stack-item 'smoke-stack-item 'char)))
(3 (code-char (foreign-slot-value stack-item 'smoke-stack-item 'uchar)))
diff -rN -u old-smoke/src/objects/type.lisp new-smoke/src/objects/type.lisp
--- old-smoke/src/objects/type.lisp 2014-10-30 07:05:32.000000000 +0100
+++ new-smoke/src/objects/type.lisp 2014-10-30 07:05:32.000000000 +0100
@@ -138,3 +138,13 @@
(type)
"The type ~S is not a smoke class." type)
(make-smoke-class-from-id (smoke type) (type-slot-value type 'class)))
+
+;; Return the cffi keyword for the type
+(defun type-foreign-keyword (smoke-type)
+ (intern (nsubstitute #\- #\ (nstring-upcase (name smoke-type)))
+ :keyword))
+
+(defun type-size (smoke-type)
+ (if (class-p smoke-type)
+ (class-size (get-class smoke-type))
+ (foreign-type-size (type-foreign-keyword smoke-type))))
diff -rN -u old-smoke/src/package.lisp new-smoke/src/package.lisp
--- old-smoke/src/package.lisp 2014-10-30 07:05:32.000000000 +0100
+++ new-smoke/src/package.lisp 2014-10-30 07:05:32.000000000 +0100
@@ -13,32 +13,56 @@
(defpackage #:smoke
(:use #:cl #:cffi #:trivial-garbage #:bordeaux-threads #:cxx-support
#:alexandria)
- (:export #:init
- #:get-smoke-variable-for-pointer
-
- #:make-smoke-classes
- #:eval-startup
-
- #:delete-object
- #:smoke-call
- #:call
+ (:export #:call
+ #:c-integer
- #:name
+ #:class-p
+ #:class-size
+ #:const-p
#:id
- #:smoke-type=
+ #:name
+ #:pointer
+ #:pointer-p
+ #:size
+ #:smoke
+ #:stack-p
+ #:type-foreign-keyword
+ #:type-id
+ #:type-size
+ #:virtual-destructor-p
+ #:convert-argument
#:cxx-bool
#:define-from-lisp-translation
#:define-to-lisp-translation
- #:define-pointer-typedef
- #:make-cleanup-pointer
- #:make-auto-pointer
+ #:*to-lisp-translations*
- #:const-p
- #:pointer
+ #:define-pointer-typedef
#:define-smoke-module
+
#:define-takes-ownership
+ #:delete-object
+ #:remove-object
+
+ #:eval-startup
+
+ #:get-smoke-variable-for-pointer
+ #:init
+ #:object-to-lisp
+
+ #:make-auto-pointer
+ #:make-cleanup-pointer
+
+ #:make-smoke-classes
+ #:make-smoke-type
+ #:no-applicable-cxx-method
+ #:smoke-call
+ #:upcast
+
+ #:smoke-standard-object
+ #:smoke-type
+ #:smoke-type=
#+sbcl #:save-bundle))
diff -rN -u old-smoke/src/smoke-to-clos.lisp new-smoke/src/smoke-to-clos.lisp
--- old-smoke/src/smoke-to-clos.lisp 2014-10-30 07:05:32.000000000 +0100
+++ new-smoke/src/smoke-to-clos.lisp 2014-10-30 07:05:32.000000000 +0100
@@ -166,8 +166,8 @@
`(progn (check-recompile ,smoke)
,@functions
(eval-startup (:compile-toplevel :load-toplevel :execute)
- ;; FIXME when loading the Lisp image we no longer need to
- ;; call #'ensure-class, but the class-map needs still
+ ;; FIXME when loading the Lisp image we no longer need
+ ;; to call #'ensure-class, but the class-map needs still
;; to be populated by #'add-id-class-map and #'add-id;
;; For now we ignore the negligible overhead.
(make-smoke-classes ,package ,smoke))