X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/blobdiff_plain/7c3bae74a11efeefafa38ea599409a69e2af5c4f..6e21a5d25bca57a78f052d6a24b97b88e83cc6fb:/src/class-output.lisp

diff --git a/src/class-output.lisp b/src/class-output.lisp
index 91dc0bf..f47bc7e 100644
--- a/src/class-output.lisp
+++ b/src/class-output.lisp
@@ -7,7 +7,7 @@
 
 ;;;----- 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
@@ -25,6 +25,36 @@
 
 (cl:in-package #:sod)
 
+;;;--------------------------------------------------------------------------
+;;; Walking the layout tree.
+
+(defmethod hook-output progn ((class sod-class) reason sequencer)
+  (with-slots ((ilayout %ilayout) vtables methods effective-methods) class
+    (hook-output ilayout reason sequencer)
+    (dolist (method methods) (hook-output method reason sequencer))
+    (dolist (method effective-methods) (hook-output method reason sequencer))
+    (dolist (vtable vtables) (hook-output vtable reason sequencer))))
+
+(defmethod hook-output progn ((ilayout ilayout) reason sequencer)
+  (with-slots (ichains) ilayout
+    (dolist (ichain ichains) (hook-output ichain reason sequencer))))
+
+(defmethod hook-output progn ((ichain ichain) reason sequencer)
+  (dolist (item (ichain-body ichain))
+    (hook-output item reason sequencer)))
+
+(defmethod hook-output progn ((islots islots) reason sequencer)
+  (dolist (slot (islots-slots islots))
+    (hook-output slot reason sequencer)))
+
+(defmethod hook-output progn ((vtable vtable) reason sequencer)
+  (with-slots (body) vtable
+    (dolist (item body) (hook-output item reason sequencer))))
+
+(defmethod hook-output progn ((vtmsgs vtmsgs) reason sequencer)
+  (with-slots (entries) vtmsgs
+    (dolist (entry entries) (hook-output entry reason sequencer))))
+
 ;;;--------------------------------------------------------------------------
 ;;; Classes.
 
@@ -138,7 +168,7 @@ (defmethod hook-output progn ((class sod-class) (reason (eql :h)) sequencer)
 				raw-name)))
 		 (cond ((and (cdr args) (eq (cadr args) :ellipsis))
 			(setf varargsp t)
-			(unless in-names (setf me "SOD_CAR(__VA_ARGS__)"))
+			(unless in-names (setf me "SOD__CAR(__VA_ARGS__)"))
 			(push (format nil "/*~A*/ ..." name) in-names)
 			(push "__VA_ARGS__" out-names)
 			(return))
@@ -160,16 +190,7 @@ (defmethod hook-output progn ((class sod-class) (reason (eql :h)) sequencer)
 	 (terpri stream)))))
 
   ;; Generate vtmsgs structure for all superclasses.
-  (hook-output (car (sod-class-vtables class))
-		    'vtmsgs
-		    sequencer))
-
-(defmethod hook-output progn ((class sod-class) reason sequencer)
-  (with-slots ((ilayout %ilayout) vtables methods effective-methods) class
-    (hook-output ilayout reason sequencer)
-    (dolist (method methods) (hook-output method reason sequencer))
-    (dolist (method effective-methods) (hook-output method reason sequencer))
-    (dolist (vtable vtables) (hook-output vtable reason sequencer))))
+  (hook-output (car (sod-class-vtables class)) 'vtmsgs sequencer))
 
 ;;;--------------------------------------------------------------------------
 ;;; Instance structure.
@@ -183,14 +204,6 @@ (defmethod hook-output progn ((slot sod-slot)
        (pprint-c-type (sod-slot-type slot) stream (sod-slot-name slot)))
      (terpri stream))))
 
-(defmethod hook-output progn ((ilayout ilayout) reason sequencer)
-  (with-slots (ichains) ilayout
-    (dolist (ichain ichains) (hook-output ichain reason sequencer))))
-
-(defmethod hook-output progn ((ichain ichain) reason sequencer)
-  (dolist (item (ichain-body ichain))
-    (hook-output item reason sequencer)))
-
 (defmethod hook-output progn ((ilayout ilayout) (reason (eql :h)) sequencer)
   (with-slots ((class %class) ichains) ilayout
     (sequence-output (stream sequencer)
@@ -251,10 +264,6 @@ (defmethod hook-output progn ((vtptr vtable-pointer)
        (format stream "  const struct ~A *_vt;~%"
 	       (vtable-struct-tag chain-tail chain-head))))))
 
-(defmethod hook-output progn ((islots islots) reason sequencer)
-  (dolist (slot (islots-slots islots))
-    (hook-output slot reason sequencer)))
-
 (defmethod hook-output progn ((islots islots) (reason (eql :h)) sequencer)
   (with-slots ((class %class) subclass slots) islots
     (sequence-output (stream sequencer)
@@ -266,10 +275,6 @@ (defmethod hook-output progn ((islots islots) (reason (eql :h)) sequencer)
 ;;;--------------------------------------------------------------------------
 ;;; Vtable structure.
 
-(defmethod hook-output progn ((vtable vtable) reason sequencer)
-  (with-slots (body) vtable
-    (dolist (item body) (hook-output item reason sequencer))))
-
 (defmethod hook-output progn ((method sod-method)
 			      (reason (eql :h))
 			      sequencer)
@@ -342,10 +347,6 @@ (defmethod hook-output progn ((vtmsgs vtmsgs)
 	((subclass :vtmsgs class :end)
 	 (format stream "};~2%"))))))
 
-(defmethod hook-output progn ((vtmsgs vtmsgs) reason sequencer)
-  (with-slots (entries) vtmsgs
-    (dolist (entry entries) (hook-output entry reason sequencer))))
-
 (defmethod hook-output progn ((entry method-entry)
 			      (reason (eql 'vtmsgs))
 			      sequencer)
@@ -390,7 +391,16 @@ (defmethod hook-output progn ((choff chain-offset)
 ;;;--------------------------------------------------------------------------
 ;;; Implementation output.
 
-(defvar *instance-class*)
+(export '*instance-class*)
+(defvar *instance-class* nil
+  "The class currently being output.
+
+   This is bound during the `hook-output' traversal of a class layout for
+   `:c' output, since some of the objects traversed actually `belong' to
+   superclasses and there's no other way to find out what the reference class
+   actually is.
+
+   It may be bound at other times.")
 
 (defmethod hook-output progn ((class sod-class) (reason (eql :c)) sequencer)
   (sequence-output (stream sequencer)
@@ -418,8 +428,7 @@ (defmethod hook-output progn ((class sod-class) (reason (eql :c)) sequencer)
 
   (let ((*instance-class* class))
     (hook-output (sod-class-ilayout (sod-class-metaclass class))
-		      'class
-		      sequencer)))
+		 'class sequencer)))
 
 ;;;--------------------------------------------------------------------------
 ;;; Direct and effective methods.