An actual running implementation, which makes code that compiles.
[sod] / src / builtin.lisp
index f219257..73de860 100644 (file)
@@ -136,10 +136,8 @@ static void *~A__init(void *p)~%{~%" class)
                   (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))
@@ -219,35 +217,41 @@ static const SodClass *const ~A__cpl[] = {
 };~:^~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)))
+                            (tail (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.
@@ -295,8 +299,9 @@ static const SodClass *const ~A__cpl[] = {
 (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*'."
@@ -305,25 +310,24 @@ static const SodClass *const ~A__cpl[] = {
                                                    :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"))
+       (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)))
 
 ;;;----- That's all, folks --------------------------------------------------