X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/ea578bb4b9eb4a03b2eb4ed151e058d699c216ea..f1f17867ed7a610cc19c3c6378b165a65f35c320:/src/builtin.lisp

diff --git a/src/builtin.lisp b/src/builtin.lisp
index f219257..5aad5f5 100644
--- a/src/builtin.lisp
+++ b/src/builtin.lisp
@@ -61,7 +61,7 @@
       ',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)
@@ -95,7 +95,7 @@ static void *~A__imprint(void *p)
 {
   struct ~A *sod__obj = p;
 
-  ~:{sod__obj->~A.~A._vt = &~A;~:^~%  ~}
+  ~:{sod__obj->~A.~A._vt = &~A.~A;~:^~%  ~}
   return (p);
 }~2%"
 	    class
@@ -105,7 +105,8 @@ static void *~A__imprint(void *p)
 			     (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)
@@ -136,10 +137,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 +218,40 @@ 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)))
 			     (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.
@@ -289,14 +293,17 @@ static const SodClass *const ~A__cpl[] = {
       (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*'."
@@ -305,25 +312,27 @@ 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)))
 
+(define-clear-the-decks builtin-module
+  (unless *builtin-module* (make-builtin-module)))
+
 ;;;----- That's all, folks --------------------------------------------------