;;;----- Licensing notice ---------------------------------------------------
;;;
-;;; This file is part of the Sensble Object Design, an object system for C.
+;;; This file is part of the Sensible Object Design, an object system for C.
;;;
;;; SOD is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
',name
(lambda (,classvar)
(make-sod-slot ,classvar ,name (c-type ,type)
- (make-property-set :lisp-class 'sod-class-slot
+ (make-property-set :slot-class 'sod-class-slot
:initializer-function
(lambda (,class)
,init)
{
struct ~A *sod__obj = p;
- ~:{sod__obj->~A.~A._vt = &~A;~:^~% ~}
+ ~:{sod__obj->~A.~A._vt = &~A.~A;~:^~% ~}
return (p);
}~2%"
class
(tail (ichain-tail ichain)))
(list (sod-class-nickname head)
(sod-class-nickname tail)
- (vtable-name class head))))
+ (vtable-name class head)
+ (sod-class-nickname tail))))
(ilayout-ichains ilayout)))))
(define-class-slot "init" (class stream)
(when init
(unless used
(format stream
- " struct ~A *sod__obj = ~
- ~0@*~A__imprint(p);~2%"
- class
- (ilayout-struct-tag class))
+ " struct ~A *sod__obj = ~A__imprint(p);~2%"
+ (ilayout-struct-tag class) class)
(setf used t))
- (format stream " ~A.~A =" isl
- (sod-slot-name dslot))
+ (format stream " {~% ")
+ (pprint-c-type (sod-slot-type dslot) stream
+ *sod-tmp-val*)
+ (format stream " =")
(ecase (sod-initializer-value-kind init)
(:simple (write (sod-initializer-value-form init)
:stream stream
:pretty nil :escape nil)
(format stream ";~%"))
- (:compound (format stream " (~A) {"
- (sod-slot-type dslot))
+ (:compound (format stream " {")
(write (sod-initializer-value-form init)
:stream stream
:pretty nil :escape nil)
- (format stream "};~%"))))))))))))
+ (format stream " };~%")))
+ (format stream " ~A.~A = ~A;~% }~%"
+ isl (sod-slot-name dslot)
+ *sod-tmp-val*))))))))))
(unless used
(format stream " ~A__imprint(p);~%" class))
(format stream "~&~:
};~:^~2%~}
~0@*static const struct sod_chain ~A__chains[] = {
-~:{ { ~3@*~A,
- ~0@*&~A__chain_~A,
- ~4@*offsetof(struct ~A, ~A),
- (const struct sod_vtable *)&~A,
- sizeof(struct ~A) }~:^,~%~}
+~:{ { ~
+ /* n_classes = */ ~3@*~A,
+ /* classes = */ ~0@*~A__chain_~A,
+ /* off_ichain = */ ~4@*offsetof(struct ~A, ~A),
+ /* vt = */ (const struct sod_vtable *)&~A,
+ /* ichainsz = */ sizeof(struct ~A) }~:^,~%~}
};~2%"
class ;0
(mapcar (lambda (chain) ;1
(let* ((head (sod-class-chain-head (car chain)))
(chain-nick (sod-class-nickname head)))
- (list class chain-nick ;0 1
- (reverse chain) ;2
- (length chain) ;3
- (ilayout-struct-tag class) chain-nick ;4 5
- (vtable-name class head) ;6
- (ichain-struct-tag class head)))) ;7
+ (list class chain-nick ;0 1
+ (reverse chain) ;2
+ (length chain) ;3
+ (ilayout-struct-tag class) chain-nick ;4 5
+ (vtable-name class head) ;6
+ (ichain-struct-tag (car chain) head)))) ;7
chains))))
;;;--------------------------------------------------------------------------
;;; Class-specific layout.
(define-class-slot "off_islots" (class) size-t
- (format nil "offsetof(struct ~A, ~A)"
- (ichain-struct-tag class (sod-class-chain-head class))
- (sod-class-nickname class)))
+ (if (sod-class-slots class)
+ (format nil "offsetof(struct ~A, ~A)"
+ (ichain-struct-tag class (sod-class-chain-head class))
+ (sod-class-nickname class))
+ "0"))
(define-class-slot "islotsz" (class) size-t
- (format nil "sizeof(struct ~A)"
- (islots-struct-tag class)))
+ (if (sod-class-slots class)
+ (format nil "sizeof(struct ~A)"
+ (islots-struct-tag class))
+ "0"))
;;;--------------------------------------------------------------------------
;;; Bootstrapping the class graph.
(finalize-sod-class class)
(add-to-module module class))))
+(export '*builtin-module*)
(defvar *builtin-module* nil
"The builtin module.")
+(export 'make-builtin-module)
(defun make-builtin-module ()
"Construct the builtin module.
- This involves constructing the braid (which is done in `bootstrap-classes'
- and defining a few obvious type names which users will find handy.
+ This involves constructing the braid (which is done in
+ `bootstrap-classes') and defining a few obvious type names which users
+ will find handy.
Returns the newly constructed module, and stores it in the variable
`*builtin-module*'."
:type "SOD"
:case :common)
:state nil)))
- (call-with-module-environment
- (lambda ()
- (dolist (name '("va_list" "size_t" "ptrdiff_t"))
- (add-to-module module (make-instance 'type-item :name name)))
- (flet ((header-name (name)
- (concatenate 'string "\"" (string-downcase name) ".h\""))
- (add-includes (reason &rest names)
- (let ((text (with-output-to-string (out)
- (dolist (name names)
- (format out "#include ~A~%" name)))))
- (add-to-module module
- (make-instance 'code-fragment-item
- :reason reason
- :constraints nil
- :name :includes
- :fragment text)))))
- (add-includes :c (header-name "sod"))
- (add-includes :h "<stddef.h>"))
- (bootstrap-classes module)))
+ (with-module-environment (module)
+ (dolist (name '("va_list" "size_t" "ptrdiff_t" "wchar_t"))
+ (add-to-module module (make-instance 'type-item :name name)))
+ (flet ((header-name (name)
+ (concatenate 'string "\"" (string-downcase name) ".h\""))
+ (add-includes (reason &rest names)
+ (let ((text (with-output-to-string (out)
+ (dolist (name names)
+ (format out "#include ~A~%" name)))))
+ (add-to-module module
+ (make-instance 'code-fragment-item
+ :reason reason
+ :constraints nil
+ :name :includes
+ :fragment text)))))
+ (add-includes :c (header-name "sod"))
+ (add-includes :h "<stddef.h>"))
+ (bootstrap-classes module))
(setf *builtin-module* module)))
+(define-clear-the-decks builtin-module
+ (unless *builtin-module* (make-builtin-module)))
+
;;;----- That's all, folks --------------------------------------------------
~mdw / sod / blobdiff