Wed Jul 8 22:41:19 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Speedup overload resolution and some other stuff for faster C++ method calling.

--- old-smoke/src/objects/class.lisp 2014-10-30 08:12:56.000000000 +0100

+++ new-smoke/src/objects/class.lisp 2014-10-30 08:12:56.000000000 +0100

@@ -1,42 +1,28 @@

(in-package #:smoke)

(defclass smoke-class ()

- ;; FXIME maybe change back to id

- ((pointer ;:type foreign-pointer

- :initarg :pointer

- :reader pointer)

- (smoke :type smoke-module

- :initarg :smoke

- :reader smoke))

- (:documentation "A class"))

+ ((id :initform 0 :type smoke-index :reader id :initarg :id)

+ (smoke :type smoke-module :reader smoke :initarg :smoke)))

(defun make-smoke-class-from-id (smoke id)

- (make-instance 'smoke-class

- :pointer (mem-aref (smoke-array-pointer (smoke-module-classes

- smoke))

- 'smoke-class

- id)

- :smoke smoke))

+ (make-instance 'smoke-class :id id :smoke smoke))

-(defmethod id ((class smoke-class))

- (declare (values (smoke-index 0))

- (optimize (speed 3)))

- (values

- (floor

- (the (integer 0)

- (- (pointer-address (pointer class))

- (pointer-address (smoke-array-pointer (smoke-module-classes

- (smoke class))))))

- #.(cffi:foreign-type-size 'smoke-class))))

+

+(declaim (inline smoke-class-pointer))

+(defun smoke-class-pointer (class)

+ (mem-aref (the foreign-pointer (smoke-array-pointer (smoke-module-classes

+ (smoke class))))

+ 'smoke-class

+ (the smoke-index (id class))))

(declaim (inline class-slot-value))

(defun class-slot-value (class slot-name)

- (foreign-slot-value (pointer class)

+ (foreign-slot-value (smoke-class-pointer class)

'smoke-class slot-name))

(define-compiler-macro class-slot-value (&whole form class slot-name)

(if (constantp slot-name)

- `(foreign-slot-value (pointer ,class)

+ `(foreign-slot-value (smoke-class-pointer ,class)

'smoke-class ,slot-name)

form))

@@ -50,10 +36,8 @@

(let ((class (make-instance 'smoke-class

:smoke smoke)))

(loop for id from 1 to (smoke-array-length (smoke-module-classes smoke)) do

- (setf (slot-value class 'pointer)

- (mem-aref (smoke-array-pointer (smoke-module-classes smoke))

- 'smoke-class

- id))

+ (setf (slot-value class 'id)

+ id)

(funcall function class))))

(defun external-p (class)

@@ -100,9 +84,7 @@

:interactive read-new-value

(setf name new-name))))

(make-instance 'smoke-class

- :pointer (smoke-get-class

- (foreign-slot-value c 'smoke-module-index 'smoke)

- (foreign-slot-value c 'smoke-module-index 'index))

+ :id (foreign-slot-value c 'smoke-module-index 'index)

:smoke (gethash (pointer-address (foreign-slot-value c 'smoke-module-index 'smoke)) *smoke-modules*))))

(defun real-class (class)