Thu Aug 27 13:43:13 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Support the new smokegenerator (r1015073).

* support const correctness

* remove workarounds for the old smoke

The old smoke is no longer supported.

Thanks to Arno Rehn for making the smokegenerator work with cl-smoke.

--- old-smoke/src/clos.lisp 2014-10-30 08:11:24.000000000 +0100

+++ new-smoke/src/clos.lisp 2014-10-30 08:11:24.000000000 +0100

@@ -108,6 +108,8 @@

(defmethod print-object ((object smoke-standard-object) stream)

(if (slot-boundp object 'pointer)

(print-unreadable-object (object stream :type t)

+ (when (const-p object)

+ (princ "CONST " stream))

(princ (pointer object) stream))

(call-next-method)))

@@ -183,16 +185,22 @@

(add-id-class-map smoke)

(map-classes

#'(lambda (class)

- (unless (external-p class)

- (add-id class

- (closer-mop:ensure-class (lispify (name class))

- :direct-superclasses

- (mapcar #'smoke-class-symbol

- (smoke-class-direct-superclasses class))

- :id (id class)

- :smoke (smoke class)

- :metaclass 'smoke-standard-class))

- (export (lispify (name class)))))

+ (unless (or (external-p class)

+ (and (eq package :cl-smoke.qt)

+ (string/= (smoke-get-module-name

+ (smoke-module-pointer smoke))

+ "qt")

+ (string= (name class) "QGlobalSpace")))

+ (with-simple-restart (skip "Skip generating class ~A" (name class))

+ (add-id class

+ (closer-mop:ensure-class (lispify (name class))

+ :direct-superclasses

+ (mapcar #'smoke-class-symbol

+ (smoke-class-direct-superclasses class))

+ :id (id class)

+ :smoke (smoke class)

+ :metaclass 'smoke-standard-class))

+ (export (lispify (name class))))))

smoke)))

(defclass smoke-gf (cxx-generic-function)

@@ -256,7 +264,7 @@

(stack-to-args (inc-pointer stack

(foreign-type-size 'smoke-stack-item))

(next arg)

- (push (argument-to-lisp (mem-ref stack 'smoke-stack-item)

+ (cons (argument-to-lisp (mem-ref stack 'smoke-stack-item)

arg)

args))))

@@ -456,7 +464,8 @@

(defmethod instance-to-lisp (pointer class type)

(declare (type smoke-standard-class class)

(optimize (speed 3)))

- (let ((ret (make-instance class :pointer pointer)))

+ (let ((ret (make-instance class :pointer pointer

+ :const-p (const-p type))))

(when (stack-p type)

(take-ownership ret)

(add-object ret))