5 ;;; (c) 2009 Straylight/Edgeware
8 ;;;----- Licensing notice ---------------------------------------------------
10 ;;; This file is part of the Sensible Object Design, an object system for C.
12 ;;; SOD is free software; you can redistribute it and/or modify
13 ;;; it under the terms of the GNU General Public License as published by
14 ;;; the Free Software Foundation; either version 2 of the License, or
15 ;;; (at your option) any later version.
17 ;;; SOD is distributed in the hope that it will be useful,
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;;; GNU General Public License for more details.
22 ;;; You should have received a copy of the GNU General Public License
23 ;;; along with SOD; if not, write to the Free Software Foundation,
24 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
28 ;;;--------------------------------------------------------------------------
29 ;;; Walking the layout tree.
31 (defmethod hook-output progn ((class sod-class) reason sequencer)
32 (with-slots ((ilayout %ilayout) vtables methods effective-methods) class
33 (hook-output ilayout reason sequencer)
34 (dolist (method methods) (hook-output method reason sequencer))
35 (dolist (method effective-methods) (hook-output method reason sequencer))
36 (dolist (vtable vtables) (hook-output vtable reason sequencer))))
38 (defmethod hook-output progn ((ilayout ilayout) reason sequencer)
39 (with-slots (ichains) ilayout
40 (dolist (ichain ichains) (hook-output ichain reason sequencer))))
42 (defmethod hook-output progn ((ichain ichain) reason sequencer)
43 (dolist (item (ichain-body ichain))
44 (hook-output item reason sequencer)))
46 (defmethod hook-output progn ((islots islots) reason sequencer)
47 (dolist (slot (islots-slots islots))
48 (hook-output slot reason sequencer)))
50 (defmethod hook-output progn ((vtable vtable) reason sequencer)
51 (with-slots (body) vtable
52 (dolist (item body) (hook-output item reason sequencer))))
54 (defmethod hook-output progn ((vtmsgs vtmsgs) reason sequencer)
55 (with-slots (entries) vtmsgs
56 (dolist (entry entries) (hook-output entry reason sequencer))))
58 ;;;--------------------------------------------------------------------------
61 (defmethod hook-output progn ((class sod-class) (reason (eql :h)) sequencer)
63 ;; Main output sequencing.
64 (sequence-output (stream sequencer)
69 (class :islots :start) (class :islots :slots) (class :islots :end)
70 (class :vtmsgs :start) (class :vtmsgs :end)
71 (class :vtables :start) (class :vtables :end)
72 (class :vtable-externs) (class :vtable-externs-after)
73 (class :methods :start) (class :methods) (class :methods :end)
74 (class :ichains :start) (class :ichains :end)
75 (class :ilayout :start) (class :ilayout :slots) (class :ilayout :end)
77 (class :message-macros)
82 (format stream "typedef struct ~A ~A;~%"
83 (ichain-struct-tag class (sod-class-chain-head class)) class))
86 (banner (format nil "Class ~A" class) stream))
87 ((class :vtable-externs-after)
90 ((class :vtable-externs)
91 (format stream "/* Vtable structures. */~%"))
94 (let ((metaclass (sod-class-metaclass class))
95 (metaroot (find-root-metaclass class)))
96 (format stream "/* The class object. */~@
97 extern const struct ~A ~A__classobj;~@
98 #define ~:*~A__class (&~:*~A__classobj.~A.~A)~2%"
99 (ilayout-struct-tag metaclass) class
100 (sod-class-nickname (sod-class-chain-head metaroot))
101 (sod-class-nickname metaroot)))))
103 ;; Maybe generate an islots structure.
104 (when (sod-class-slots class)
105 (dolist (slot (sod-class-slots class))
106 (hook-output slot 'islots sequencer))
107 (sequence-output (stream sequencer)
108 ((class :islots :start)
109 (format stream "/* Instance slots. */~@
111 (islots-struct-tag class)))
112 ((class :islots :end)
113 (format stream "};~2%"))))
115 ;; Declare the direct methods.
116 (when (sod-class-methods class)
117 (sequence-output (stream sequencer)
118 ((class :methods :start)
119 (format stream "/* Direct methods. */~%"))
120 ((class :methods :end)
123 ;; Provide upcast macros which do the right thing.
124 (when (sod-class-direct-superclasses class)
125 (sequence-output (stream sequencer)
126 ((class :conversions)
127 (let ((chain-head (sod-class-chain-head class)))
128 (format stream "/* Conversion macros. */~%")
129 (dolist (super (cdr (sod-class-precedence-list class)))
130 (let ((super-head (sod-class-chain-head super)))
131 (format stream "#define ~:@(~A__CONV_~A~)(_obj) ((~A *)~
132 ~:[SOD_XCHAIN(~A, (_obj))~;(_obj)~])~%"
133 class (sod-class-nickname super) super
134 (eq chain-head super-head)
135 (sod-class-nickname super-head))))
138 ;; Provide convenience macros for sending the newly defined messages. (The
139 ;; macros work on all subclasses too.)
141 ;; We need each message's method entry type for this, so we need to dig it
142 ;; out of the vtmsgs structure. Indeed, the vtmsgs for this class contains
143 ;; entries for precisely the messages we want to make macros for.
144 (when (sod-class-messages class)
145 (sequence-output (stream sequencer)
146 ((class :message-macros)
147 (let* ((vtable (find (sod-class-chain-head class)
148 (sod-class-vtables class)
149 :key #'vtable-chain-head))
150 (vtmsgs (find-if (lambda (item)
151 (and (typep item 'vtmsgs)
152 (eql (vtmsgs-class item) class)))
153 (vtable-body vtable))))
154 (format stream "/* Message invocation macros. */~%")
155 (dolist (entry (vtmsgs-entries vtmsgs))
156 (let* ((type (method-entry-function-type entry))
157 (args (c-function-arguments type))
158 (in-names nil) (out-names nil) (varargsp nil) (me "me"))
159 (do ((args args (cdr args)))
161 (let* ((raw-name (princ-to-string (argument-name (car args))))
162 (name (if (find raw-name
164 (sod-class-nickname class)
165 (method-entry-slot-name entry))
167 (format nil "sod__a_~A" raw-name)
169 (cond ((and (cdr args) (eq (cadr args) :ellipsis))
171 (unless in-names (setf me "SOD__CAR(__VA_ARGS__)"))
172 (push (format nil "/*~A*/ ..." name) in-names)
173 (push "__VA_ARGS__" out-names)
177 (push name out-names)))))
179 (format stream "#if __STDC_VERSION__ >= 199901~%"))
180 (format stream "#define ~A(~{~A~^, ~}) ~
181 ~A->_vt->~A.~A(~{~A~^, ~})~%"
182 (message-macro-name class entry)
185 (sod-class-nickname class)
186 (method-entry-slot-name entry)
187 (nreverse out-names))
189 (format stream "#endif~%"))))
192 ;; Generate vtmsgs structure for all superclasses.
193 (hook-output (car (sod-class-vtables class)) 'vtmsgs sequencer))
195 ;;;--------------------------------------------------------------------------
196 ;;; Instance structure.
198 (defmethod hook-output progn ((slot sod-slot)
199 (reason (eql 'islots))
201 (sequence-output (stream sequencer)
202 (((sod-slot-class slot) :islots :slots)
203 (pprint-logical-block (stream nil :prefix " " :suffix ";")
204 (pprint-c-type (sod-slot-type slot) stream (sod-slot-name slot)))
207 (defmethod hook-output progn ((ilayout ilayout) (reason (eql :h)) sequencer)
208 (with-slots ((class %class) ichains) ilayout
209 (sequence-output (stream sequencer)
210 ((class :ilayout :start)
211 (format stream "/* Instance layout. */~@
213 (ilayout-struct-tag class)))
214 ((class :ilayout :end)
215 (format stream "};~2%")))
216 (dolist (ichain ichains)
217 (hook-output ichain 'ilayout sequencer))))
219 (defmethod hook-output progn ((ichain ichain) (reason (eql :h)) sequencer)
220 (with-slots ((class %class) chain-head chain-tail) ichain
221 (when (eq class chain-tail)
222 (sequence-output (stream sequencer)
223 :constraint ((class :ichains :start)
224 (class :ichain chain-head :start)
225 (class :ichain chain-head :slots)
226 (class :ichain chain-head :end)
227 (class :ichains :end))
228 ((class :ichain chain-head :start)
229 (format stream "/* Instance chain structure. */~@
231 (ichain-struct-tag chain-tail chain-head)))
232 ((class :ichain chain-head :end)
233 (format stream "};~2%")
234 (format stream "/* Union of equivalent superclass chains. */~@
236 ~:{ struct ~A ~A;~%~}~
238 (ichain-union-tag chain-tail chain-head)
240 ;; Make sure the most specific class is first: only the
241 ;; first element of a union can be statically initialized in
243 (mapcar (lambda (super)
244 (list (ichain-struct-tag super chain-head)
245 (sod-class-nickname super)))
246 (sod-class-chain chain-tail))))))))
248 (defmethod hook-output progn ((ichain ichain)
249 (reason (eql 'ilayout))
251 (with-slots ((class %class) chain-head chain-tail) ichain
252 (sequence-output (stream sequencer)
253 ((class :ilayout :slots)
254 (format stream " union ~A ~A;~%"
255 (ichain-union-tag chain-tail chain-head)
256 (sod-class-nickname chain-head))))))
258 (defmethod hook-output progn ((vtptr vtable-pointer)
261 (with-slots ((class %class) chain-head chain-tail) vtptr
262 (sequence-output (stream sequencer)
263 ((class :ichain chain-head :slots)
264 (format stream " const struct ~A *_vt;~%"
265 (vtable-struct-tag chain-tail chain-head))))))
267 (defmethod hook-output progn ((islots islots) (reason (eql :h)) sequencer)
268 (with-slots ((class %class) subclass slots) islots
269 (sequence-output (stream sequencer)
270 ((subclass :ichain (sod-class-chain-head class) :slots)
271 (format stream " struct ~A ~A;~%"
272 (islots-struct-tag class)
273 (sod-class-nickname class))))))
275 ;;;--------------------------------------------------------------------------
276 ;;; Vtable structure.
278 (defmethod hook-output progn ((method sod-method)
281 (with-slots ((class %class)) method
282 (sequence-output (stream sequencer)
284 (let ((type (sod-method-function-type method)))
285 (princ "extern " stream)
286 (pprint-c-type (commentify-function-type type) stream
287 (sod-method-function-name method))
288 (format stream ";~%"))))))
290 (defmethod hook-output progn ((vtable vtable) (reason (eql :h)) sequencer)
291 (with-slots ((class %class) chain-head chain-tail) vtable
292 (when (eq class chain-tail)
293 (sequence-output (stream sequencer)
294 :constraint ((class :vtables :start)
295 (class :vtable chain-head :start)
296 (class :vtable chain-head :slots)
297 (class :vtable chain-head :end)
298 (class :vtables :end))
299 ((class :vtable chain-head :start)
300 (format stream "/* Vtable structure. */~@
302 (vtable-struct-tag chain-tail chain-head)))
303 ((class :vtable chain-head :end)
304 (format stream "};~2%")
305 (format stream "/* Union of equivalent superclass vtables. */~@
307 ~:{ struct ~A ~A;~%~}~
309 (vtable-union-tag chain-tail chain-head)
311 ;; As for the ichain union, make sure the most specific
313 (mapcar (lambda (super)
314 (list (vtable-struct-tag super chain-head)
315 (sod-class-nickname super)))
316 (sod-class-chain chain-tail))))))
317 (sequence-output (stream sequencer)
318 ((class :vtable-externs)
319 (format stream "~@<extern const union ~A ~2I~_~A;~:>~%"
320 (vtable-union-tag chain-tail chain-head)
321 (vtable-name class chain-head))))))
323 (defmethod hook-output progn ((vtmsgs vtmsgs) (reason (eql :h)) sequencer)
324 (with-slots ((class %class) subclass chain-head chain-tail) vtmsgs
325 (sequence-output (stream sequencer)
326 ((subclass :vtable chain-head :slots)
327 (format stream " struct ~A ~A;~%"
328 (vtmsgs-struct-tag subclass class)
329 (sod-class-nickname class))))))
331 (defmethod hook-output progn ((vtmsgs vtmsgs)
332 (reason (eql 'vtmsgs))
334 (when (vtmsgs-entries vtmsgs)
335 (with-slots ((class %class) subclass) vtmsgs
336 (sequence-output (stream sequencer)
337 :constraint ((subclass :vtmsgs :start)
338 (subclass :vtmsgs class :start)
339 (subclass :vtmsgs class :slots)
340 (subclass :vtmsgs class :end)
341 (subclass :vtmsgs :end))
342 ((subclass :vtmsgs class :start)
343 (format stream "/* Messages protocol from class ~A */~@
346 (vtmsgs-struct-tag subclass class)))
347 ((subclass :vtmsgs class :end)
348 (format stream "};~2%"))))))
350 (defmethod hook-output progn ((entry method-entry)
351 (reason (eql 'vtmsgs))
353 (let* ((method (method-entry-effective-method entry))
354 (message (effective-method-message method))
355 (class (effective-method-class method))
356 (function-type (method-entry-function-type entry))
357 (commented-type (commentify-function-type function-type))
358 (pointer-type (make-pointer-type commented-type)))
359 (sequence-output (stream sequencer)
360 ((class :vtmsgs (sod-message-class message) :slots)
361 (pprint-logical-block (stream nil :prefix " " :suffix ";")
362 (pprint-c-type pointer-type stream (method-entry-slot-name entry)))
365 (defmethod hook-output progn ((cptr class-pointer)
368 (with-slots ((class %class) chain-head metaclass meta-chain-head) cptr
369 (sequence-output (stream sequencer)
370 ((class :vtable chain-head :slots)
371 (format stream " const ~A *~:[_class~;~:*_cls_~A~];~%"
373 (and (sod-class-direct-superclasses meta-chain-head)
374 (sod-class-nickname meta-chain-head)))))))
376 (defmethod hook-output progn ((boff base-offset) (reason (eql :h)) sequencer)
377 (with-slots ((class %class) chain-head) boff
378 (sequence-output (stream sequencer)
379 ((class :vtable chain-head :slots)
380 (write-line " size_t _base;" stream)))))
382 (defmethod hook-output progn ((choff chain-offset)
385 (with-slots ((class %class) chain-head target-head) choff
386 (sequence-output (stream sequencer)
387 ((class :vtable chain-head :slots)
388 (format stream " ptrdiff_t _off_~A;~%"
389 (sod-class-nickname target-head))))))
391 ;;;--------------------------------------------------------------------------
392 ;;; Implementation output.
394 (export '*instance-class*)
395 (defvar *instance-class* nil
396 "The class currently being output.
398 This is bound during the `hook-output' traversal of a class layout for
399 `:c' output, since some of the objects traversed actually `belong' to
400 superclasses and there's no other way to find out what the reference class
403 It may be bound at other times.")
405 (defmethod hook-output progn ((class sod-class) (reason (eql :c)) sequencer)
406 (sequence-output (stream sequencer)
411 (class :direct-methods :start) (class :direct-methods :end)
412 (class :effective-methods)
413 (class :vtables :start) (class :vtables :end)
414 (class :object :prepare) (class :object :start) (class :object :end)
418 (banner (format nil "Class ~A" class) stream))
420 ((class :object :start)
422 /* The class object. */
423 const struct ~A ~A__classobj = {~%"
424 (ilayout-struct-tag (sod-class-metaclass class))
426 ((class :object :end)
427 (format stream "};~2%")))
429 (let ((*instance-class* class))
430 (hook-output (sod-class-ilayout (sod-class-metaclass class))
433 ;;;--------------------------------------------------------------------------
434 ;;; Direct and effective methods.
436 (defmethod hook-output progn ((method delegating-direct-method)
439 (with-slots ((class %class) body) method
441 (return-from hook-output))
442 (sequence-output (stream sequencer)
443 ((class :direct-method method :start)
444 (format stream "#define CALL_NEXT_METHOD (next_method(~{~A~^, ~}))~%"
445 (mapcar #'argument-name
446 (c-function-arguments (sod-method-next-method-type
448 ((class :direct-method method :end)
449 (format stream "#undef CALL_NEXT_METHOD~%")))))
451 (defmethod hook-output progn ((method sod-method)
454 (with-slots ((class %class) body) method
456 (return-from hook-output))
457 (sequence-output (stream sequencer)
458 :constraint ((class :direct-methods :start)
459 (class :direct-method method :start)
460 (class :direct-method method :body)
461 (class :direct-method method :end)
462 (class :direct-methods :end))
463 ((class :direct-method method :body)
464 (pprint-c-type (sod-method-function-type method)
466 (sod-method-function-name method))
467 (format stream "~&{~%")
468 (write body :stream stream :pretty nil :escape nil)
469 (format stream "~&}~%"))
470 ((class :direct-method method :end)
473 (defmethod hook-output progn ((method basic-effective-method)
476 (with-slots ((class %class) functions) method
477 (sequence-output (stream sequencer)
478 ((class :effective-methods)
479 (dolist (func functions)
480 (write func :stream stream :escape nil :circle nil))))))
482 ;;;--------------------------------------------------------------------------
485 (defmethod hook-output progn ((vtable vtable) (reason (eql :c)) sequencer)
486 (with-slots ((class %class) chain-head chain-tail) vtable
487 (sequence-output (stream sequencer)
488 :constraint ((class :vtables :start)
489 (class :vtable chain-head :start)
490 (class :vtable chain-head :end)
491 (class :vtables :end))
492 ((class :vtable chain-head :start)
493 (format stream "/* Vtable for ~A chain. */~@
494 const union ~A ~A = { {~%"
496 (vtable-union-tag chain-tail chain-head)
497 (vtable-name class chain-head)))
498 ((class :vtable chain-head :end)
499 (format stream "} };~2%")))))
501 (defmethod hook-output progn ((cptr class-pointer)
504 (with-slots ((class %class) chain-head metaclass meta-chain-head) cptr
505 (sequence-output (stream sequencer)
506 :constraint ((class :vtable chain-head :start)
507 (class :vtable chain-head :class-pointer metaclass)
508 (class :vtable chain-head :end))
509 ((class :vtable chain-head :class-pointer metaclass)
510 (format stream " /* ~21@A = */ &~A__classobj.~A.~A,~%"
511 (if (sod-class-direct-superclasses meta-chain-head)
512 (format nil "_cls_~A"
513 (sod-class-nickname meta-chain-head))
516 (sod-class-nickname meta-chain-head)
517 (sod-class-nickname metaclass))))))
519 (defmethod hook-output progn ((boff base-offset) (reason (eql :c)) sequencer)
520 (with-slots ((class %class) chain-head) boff
521 (sequence-output (stream sequencer)
522 :constraint ((class :vtable chain-head :start)
523 (class :vtable chain-head :base-offset)
524 (class :vtable chain-head :end))
525 ((class :vtable chain-head :base-offset)
526 (format stream " /* ~21@A = */ offsetof(struct ~A, ~A),~%"
528 (ilayout-struct-tag class)
529 (sod-class-nickname chain-head))))))
531 (defmethod hook-output progn ((choff chain-offset)
534 (with-slots ((class %class) chain-head target-head) choff
535 (sequence-output (stream sequencer)
536 :constraint ((class :vtable chain-head :start)
537 (class :vtable chain-head :chain-offset target-head)
538 (class :vtable chain-head :end))
539 ((class :vtable chain-head :chain-offset target-head)
540 (format stream " /* ~21@A = */ SOD_OFFSETDIFF(struct ~A, ~A, ~A),~%"
541 (format nil "_off_~A" (sod-class-nickname target-head))
542 (ilayout-struct-tag class)
543 (sod-class-nickname chain-head)
544 (sod-class-nickname target-head))))))
546 (defmethod hook-output progn ((vtmsgs vtmsgs) (reason (eql :c)) sequencer)
547 (with-slots ((class %class) subclass chain-head) vtmsgs
548 (sequence-output (stream sequencer)
549 :constraint ((subclass :vtable chain-head :start)
550 (subclass :vtable chain-head :vtmsgs class :start)
551 (subclass :vtable chain-head :vtmsgs class :slots)
552 (subclass :vtable chain-head :vtmsgs class :end)
553 (subclass :vtable chain-head :end))
554 ((subclass :vtable chain-head :vtmsgs class :start)
555 (format stream " { /* Method entries for ~A messages. */~%"
557 ((subclass :vtable chain-head :vtmsgs class :end)
558 (format stream " },~%")))))
560 (defmethod hook-output progn ((entry method-entry)
563 (with-slots ((method %method) chain-head chain-tail role) entry
564 (let* ((message (effective-method-message method))
565 (class (effective-method-class method))
566 (super (sod-message-class message)))
567 (sequence-output (stream sequencer)
568 ((class :vtable chain-head :vtmsgs super :slots)
569 (format stream " /* ~19@A = */ ~A,~%"
570 (method-entry-slot-name entry)
571 (method-entry-function-name method chain-head role)))))))
573 ;;;--------------------------------------------------------------------------
574 ;;; Filling in the class object.
576 (defmethod hook-output progn ((ichain ichain)
577 (reason (eql 'class))
579 (with-slots ((class %class) chain-head) ichain
580 (sequence-output (stream sequencer)
581 :constraint ((*instance-class* :object :start)
582 (*instance-class* :object chain-head :ichain :start)
583 (*instance-class* :object chain-head :ichain :end)
584 (*instance-class* :object :end))
585 ((*instance-class* :object chain-head :ichain :start)
586 (format stream " { { /* ~A ichain */~%"
587 (sod-class-nickname chain-head)))
588 ((*instance-class* :object chain-head :ichain :end)
589 (format stream " } },~%")))))
591 (defmethod hook-output progn ((islots islots)
592 (reason (eql 'class))
594 (with-slots ((class %class)) islots
595 (let ((chain-head (sod-class-chain-head class)))
596 (sequence-output (stream sequencer)
597 :constraint ((*instance-class* :object chain-head :ichain :start)
598 (*instance-class* :object class :slots :start)
599 (*instance-class* :object class :slots)
600 (*instance-class* :object class :slots :end)
601 (*instance-class* :object chain-head :ichain :end))
602 ((*instance-class* :object class :slots :start)
603 (format stream " { /* Class ~A */~%" class))
604 ((*instance-class* :object class :slots :end)
605 (format stream " },~%"))))))
607 (defmethod hook-output progn ((vtptr vtable-pointer)
608 (reason (eql 'class))
610 (with-slots ((class %class) chain-head chain-tail) vtptr
611 (sequence-output (stream sequencer)
612 :constraint ((*instance-class* :object chain-head :ichain :start)
613 (*instance-class* :object chain-head :vtable)
614 (*instance-class* :object chain-head :ichain :end))
615 ((*instance-class* :object chain-head :vtable)
616 (format stream " /* ~17@A = */ &~A.~A,~%"
618 (vtable-name class chain-head)
619 (sod-class-nickname chain-tail))))))
621 (defgeneric find-class-initializer (slot class)
622 (:method ((slot effective-slot) (class sod-class))
623 (let ((dslot (effective-slot-direct-slot slot)))
624 (or (some (lambda (super)
625 (find dslot (sod-class-class-initializers super)
626 :test #'sod-initializer-slot))
627 (sod-class-precedence-list class))
628 (effective-slot-initializer slot)))))
630 (defgeneric output-class-initializer (slot instance stream)
631 (:method ((slot sod-class-effective-slot) (instance sod-class) stream)
632 (let ((func (effective-slot-initializer-function slot))
633 (direct-slot (effective-slot-direct-slot slot)))
635 (format stream " /* ~15@A = */ ~A,~%"
636 (sod-slot-name direct-slot)
637 (funcall func instance))
638 (call-next-method))))
639 (:method ((slot effective-slot) (instance sod-class) stream)
640 (let ((init (find-class-initializer slot instance))
641 (direct-slot (effective-slot-direct-slot slot)))
642 (ecase (sod-initializer-value-kind init)
643 (:simple (format stream " /* ~15@A = */ ~A,~%"
644 (sod-slot-name direct-slot)
645 (sod-initializer-value-form init)))
646 (:compound (format stream " /* ~15@A = */ ~@<{ ~;~A~; },~:>~%"
647 (sod-slot-name direct-slot)
648 (sod-initializer-value-form init)))))))
650 (defmethod hook-output progn ((slot sod-class-effective-slot)
651 (reason (eql 'class))
653 (let ((instance *instance-class*)
654 (func (effective-slot-prepare-function slot)))
656 (sequence-output (stream sequencer)
657 ((instance :object :prepare)
658 (funcall func instance stream))))))
660 (defmethod hook-output progn ((slot effective-slot)
661 (reason (eql 'class))
663 (with-slots ((class %class) (dslot slot)) slot
664 (let ((instance *instance-class*)
665 (super (sod-slot-class dslot)))
666 (sequence-output (stream sequencer)
667 ((instance :object super :slots)
668 (output-class-initializer slot instance stream))))))
670 ;;;----- That's all, folks --------------------------------------------------