OOP: implementing multiple inheritance.

Multiple inheritance is too useful to ignore any longer.

* lib.c (subtypep): Perform subtypep calculation between two
struct types via the new struct_subtype_p function.
It's too complicated now to do with ad hoc code outside of
struct.c.

* share/txr/stdlib/struct.tl (defstruct): This macro now needs
to deal with the super argument being possibly a list of base
types instead of a single one.

* strut.c (struct struct_type): Member super and super_handle
are removed. New member nsupers, supers, and sus.
(struct_init): The super function re-registered; it has an
optional argument.
(call_stinitfun_chain): The compat code here must now access
the supertype differently. We don't bother dealing with
multiple inheritance in the compat case; programs requesting
compatibility with TXR 151 shoudn't be trying to use multiple
inheritance.
(get_struct_handles, count_super_stslots, get_super_slots,
find_super_for_slot): New static functions, to off-load some
new complexity from make_struct_type.
(make_struct_type): Handle the increased complexity due to
multiple inheritance.
(super): Takes an additional argument now, to request which
supertype to retrieve. Defaults to zero: the first one.
(struct_type_destroy): Free the sus array.
(struct_type_mark): Mark the supers slot.
(call_initfun_chain): Call init functions of all bases, in
right-to-left order.
(call_postinitfun_chain): Likewise for postinit functions.
(call_super_method, call_super_fun, super_method): Use the
first base as the supertype.  This requirement feels bad; it
needs to be revisited.
(do_struct_subtype_p): New static function.
(struct_subtype_p): New function.
(ancestor_with_static_slot): New static function.
(method_name): Revised for multiple inheritance; now relies on
ancestor_with_static_slot to find the original ancestor that
has brought in a method, so we can use that type in the
method name.

* struct.h (super): Declaration updated.
(struct_subtype_p): Declared.

* tests/012/oop-mi.expected: New file.

* tests/012/oop-mi.tl: New test cases.

* txr.1: Revised in order to document multiple inheritance.

7 files changed, 344 insertions, 94 deletions

diff --git a/lib.c b/lib.c
index feb911b4..dfacd646 100644
--- a/lib.c
+++ b/lib.c
@@ -267,14 +267,8 @@ val subtypep(val sub, val sup)
     val sub_struct = find_struct_type(sub);
     val sup_struct = find_struct_type(sup);
 
-    if (sub_struct && sup_struct) {
-      do {
-        sub_struct = super(sub_struct);
-        if (sub_struct == sup_struct)
-          return t;
-      } while (sub_struct);
-      return nil;
-    }
+    if (sub_struct && sup_struct)
+      return struct_subtype_p(sub_struct, sup_struct);
 
     return nil;
   }
diff --git a/share/txr/stdlib/struct.tl b/share/txr/stdlib/struct.tl
index 71bcf45b..0461cd05 100644
--- a/share/txr/stdlib/struct.tl
+++ b/share/txr/stdlib/struct.tl
@@ -33,7 +33,7 @@
                     (not init-form-present)))
              slot-init-forms))
 
-(defmacro defstruct (:form form name-spec super . slot-specs)
+(defmacro defstruct (:form form name-spec super-spec . slot-specs)
   (tree-bind (name args) (tree-case name-spec
                            ((atom . args) (list atom args))
                            (atom (list atom nil)))
@@ -111,12 +111,9 @@
                                   ^(:instance ,name nil))
                                 (name
                                   ^(:instance ,name nil)))))
-           (super-type (if super
-                         (or (find-struct-type super)
-                             (compile-defr-warning form ^(struct-type . ,super)
-                                                   "inheritance base ~s \
-                                                   \ does not name a struct type"
-                                                   super))))
+           (supers (if (and super-spec (atom super-spec))
+                     (list super-spec)
+                     super-spec))
            (stat-si-forms [keep-if (op member @1 '(:static :function))
                                    slot-init-forms car])
            (pruned-si-forms (sys:prune-missing-inits stat-si-forms))
@@ -132,6 +129,12 @@
                          "slot name ~s isn't a bindable symbol"
                          "invalid slot specifier syntax: ~s")
                        bad))
+      (each ((s supers))
+        (or (find-struct-type s)
+            (compile-defr-warning form ^(struct-type . ,s)
+                                  "inheritance base ~s \
+                                  \ does not name a struct type"
+                                  s)))
       (let ((arg-sym (gensym))
             (type-sym (gensym)))
         (register-tentative-def ^(struct-type . ,name))
@@ -140,7 +143,7 @@
         (each ((s inst-slots))
           (register-tentative-def ^(slot . ,s)))
         ^(sys:make-struct-type
-           ',name ',super ',stat-slots ',inst-slots
+           ',name ',supers ',stat-slots ',inst-slots
            ,(if (or func-si-forms val-si-forms)
                ^(lambda (,arg-sym)
                   ,*(mapcar (aret ^(when (static-slot-p ,arg-sym ',@2)
diff --git a/struct.c b/struct.c
index c44dbc7a..d549a869 100644
--- a/struct.c
+++ b/struct.c
@@ -78,8 +78,9 @@ struct struct_type {
   cnum id;
   cnum nslots;
   cnum nstslots;
-  val super;
-  struct struct_type *super_handle;
+  cnum nsupers;
+  val supers;
+  struct struct_type **sus;
   val slots;
   val stinitfun;
   val initfun;
@@ -163,7 +164,7 @@ void struct_init(void)
   reg_fun(intern(lit("struct-set-initfun"), user_package), func_n2(struct_set_initfun));
   reg_fun(intern(lit("struct-get-postinitfun"), user_package), func_n1(struct_get_postinitfun));
   reg_fun(intern(lit("struct-set-postinitfun"), user_package), func_n2(struct_set_postinitfun));
-  reg_fun(intern(lit("super"), user_package), func_n1(super));
+  reg_fun(intern(lit("super"), user_package), func_n2o(super, 1));
   reg_fun(intern(lit("make-struct"), user_package), func_n2v(make_struct));
   reg_fun(intern(lit("struct-from-plist"), user_package), func_n1v(struct_from_plist));
   reg_fun(intern(lit("struct-from-args"), user_package), func_n1v(struct_from_args));
@@ -241,8 +242,8 @@ static val struct_type_finalize(val obj)
 static void call_stinitfun_chain(struct struct_type *st, val stype)
 {
   if (st) {
-    if (st->super && opt_compat && opt_compat <= 151)
-      call_stinitfun_chain(st->super_handle, stype);
+    if (st->nsupers == 1 && opt_compat && opt_compat <= 151)
+      call_stinitfun_chain(st->sus[0], stype);
     if (st->stinitfun)
       funcall1(st->stinitfun, stype);
   }
@@ -288,20 +289,89 @@ static void static_slot_home_fixup(struct struct_type *st)
   }
 }
 
-val make_struct_type(val name, val super,
+static struct struct_type **get_struct_handles(cnum nsupers, val supers,
+                                               val self)
+{
+  cnum i;
+  struct struct_type **sus = coerce(struct struct_type **,
+                                    chk_malloc(nsupers * sizeof *sus));
+  for (i = 0; i < nsupers; i++, supers = us_cdr(supers)) {
+    val super = us_car(supers);
+    sus[i] = stype_handle(&super, self);
+  }
+
+  return sus;
+}
+
+static cnum count_super_stslots(cnum nsupers, struct struct_type **sus,
+                                val self)
+{
+  cnum c = 0, i;
+
+  for (i = 0; i < nsupers; i++) {
+    struct struct_type *s = sus[i];
+    if (c > INT_PTR_MAX - s->nstslots)
+      uw_throwf(error_s, lit("~a: too many static slots among supertypes"),
+                self, nao);
+    c += s->nstslots;
+  }
+
+  return c;
+}
+
+static val get_super_slots(cnum nsupers, struct struct_type **sus, val self)
+{
+  cnum i;
+  val slots = nil;
+
+  for (i = 0; i < nsupers; i++)
+    slots = append2(slots, sus[i]->slots);
+
+  return slots;
+}
+
+static struct struct_type *find_super_for_slot(cnum nsupers,
+                                               struct struct_type **sus,
+                                               val slot)
+{
+  cnum i;
+
+  for (i = 0; i < nsupers; i++) {
+    if (memq(slot, sus[i]->slots))
+      return sus[i];
+  }
+
+  return 0;
+}
+
+val make_struct_type(val name, val supers,
                      val static_slots, val slots,
                      val static_initfun, val initfun, val boactor,
                      val postinitfun)
 {
   val self = lit("make-struct-type");
+  val iter;
 
-  if (super && symbolp(super)) {
-    val supertype = find_struct_type(super);
-    if (!supertype)
-      no_such_struct(self, super);
-    super = supertype;
-  } else if (super) {
-    class_check(self, super, struct_type_s);
+  if (!listp(supers))
+    supers = cons(supers, nil);
+
+  {
+    list_collect_decl (stypes, ptail);
+
+    for (iter = supers; iter; iter = cdr(iter)) {
+      val super = car(iter);
+      if (symbolp(super)) {
+        val supertype = find_struct_type(super);
+        if (!supertype)
+          no_such_struct(self, super);
+        ptail = list_collect(ptail, supertype);
+      } else {
+        class_check(self, super, struct_type_s);
+        ptail = list_collect(ptail, super);
+      }
+    }
+
+    supers = stypes;
   }
 
   if (!bindable(name)) {
@@ -316,15 +386,16 @@ val make_struct_type(val name, val super,
   } else {
     struct struct_type *st = coerce(struct struct_type *,
                                     chk_malloc(sizeof *st));
-    struct struct_type *su = if3(super, stype_handle(&super, self), 0);
+    cnum nsupers = c_num(length(supers));
+    struct struct_type **sus = get_struct_handles(nsupers, supers, self);
     val id = num_fast(coerce(ucnum, st) / (uptopow2(sizeof *st) / 2));
-    val super_slots = if2(su, su->slots);
+    val super_slots = get_super_slots(nsupers, sus, self);
     val all_slots = uniq(append2(super_slots, append2(static_slots, slots)));
     cnum stsl_upb = c_num(plus(length(static_slots),
-                               num(if3(su, su->nstslots, 0))));
+                               num(count_super_stslots(nsupers, sus, self))));
     val stype = cobj(coerce(mem_t *, st), struct_type_s, &struct_type_ops);
     val iter;
-    cnum sl, stsl;
+    cnum sl, stsl, i;
     struct stslot null_ptr = { nil, 0, 0, nil };
 
     st->self = stype;
@@ -332,9 +403,10 @@ val make_struct_type(val name, val super,
     st->id = c_num(id);
     st->nslots = st->nstslots = 0;
     st->slots = all_slots;
-    st->super = super;
+    st->nsupers = nsupers;
+    st->supers = supers;
     st->stslot = 0;
-    st->super_handle = su;
+    st->sus = sus;
     st->stinitfun = static_initfun;
     st->initfun = initfun;
     st->boactor = boactor;
@@ -353,6 +425,8 @@ val make_struct_type(val name, val super,
          iter = cdr(iter))
     {
       val slot = car(iter);
+      struct struct_type *su = find_super_for_slot(nsupers, sus, slot);
+      val super = if2(su, su->self);
       val new_tslot_p = memq(slot, static_slots);
       int inherited_p = !new_tslot_p && !memq(slot, slots);
       val ts_p = if3(inherited_p,
@@ -400,14 +474,17 @@ val make_struct_type(val name, val super,
 
     sethash(struct_type_hash, name, stype);
 
-    if (super)
-      mpush(stype, mkloc(su->dvtypes, super));
+    for (i = 0; i < nsupers; i++) {
+      struct struct_type *su = sus[i];
+      mpush(stype, mkloc(su->dvtypes, su->self));
+    }
 
     call_stinitfun_chain(st, stype);
 
     uw_purge_deferred_warning(cons(struct_type_s, name));
 
-    if (su) {
+    for (i = 0; i < nsupers; i++) {
+      struct struct_type *su = sus[i];
       struct stslot *dvmeth = lookup_static_slot_desc(su, derived_s);
       if (dvmeth)
         funcall2(stslot_place(dvmeth), su->self, stype);
@@ -462,14 +539,27 @@ val struct_set_postinitfun(val type, val fun)
   return fun;
 }
 
-val super(val type)
+val super(val type, val idx)
 {
-  if (structp(type)) {
-    struct struct_inst *si = coerce(struct struct_inst *, type->co.handle);
-    return si->type->super;
-  } else {
-    struct struct_type *st = stype_handle(&type, lit("super"));
-    return st->super;
+  val self = lit("super");
+  cnum ix = c_num(default_arg(idx, zero));
+
+  if (ix < 0)
+    uw_throwf(error_s,
+              lit("~a: index must be non-negative, ~s given"),
+              self, idx, nao);
+
+  {
+    struct struct_type *st;
+
+    if (structp(type)) {
+      struct struct_inst *si = coerce(struct struct_inst *, type->co.handle);
+      st = si->type;
+    } else {
+      st = stype_handle(&type, self);
+    }
+
+    return if2(ix < st->nsupers, st->sus[ix]->self);
   }
 }
 
@@ -485,6 +575,7 @@ static void struct_type_destroy(val obj)
   struct struct_type *st = coerce(struct struct_type *, obj->co.handle);
   free(st->stslot);
   free(st->spslot);
+  free(st->sus);
   free(st);
 }
 
@@ -494,7 +585,7 @@ static void struct_type_mark(val obj)
   cnum stsl;
 
   gc_mark(st->name);
-  gc_mark(st->super);
+  gc_mark(st->supers);
   gc_mark(st->slots);
   gc_mark(st->stinitfun);
   gc_mark(st->initfun);
@@ -515,8 +606,10 @@ static void struct_type_mark(val obj)
 static void call_initfun_chain(struct struct_type *st, val strct)
 {
   if (st) {
-    if (st->super)
-      call_initfun_chain(st->super_handle, strct);
+    cnum i;
+
+    for (i = st->nsupers - 1; i >= 0; i--)
+      call_initfun_chain(st->sus[i], strct);
     if (st->initfun)
       funcall1(st->initfun, strct);
   }
@@ -526,11 +619,12 @@ static void call_postinitfun_chain(struct struct_type *st, val strct)
 {
   if (st) {
     int derived_first = (opt_compat && opt_compat <= 148);
+    cnum i;
 
     if (derived_first && st->postinitfun)
       funcall1(st->postinitfun, strct);
-    if (st->super)
-      call_postinitfun_chain(st->super_handle, strct);
+    for (i = st->nsupers - 1; i >= 0; i--)
+      call_postinitfun_chain(st->sus[i], strct);
     if (!derived_first && st->postinitfun)
       funcall1(st->postinitfun, strct);
   }
@@ -1305,7 +1399,7 @@ val static_slot_home(val stype, val sym)
 static val call_super_method(val inst, val sym, struct args *args)
 {
   val type = struct_type(inst);
-  val suptype = super(type);
+  val suptype = super(type, zero);
 
   if (suptype) {
     val meth = static_slot(suptype, sym);
@@ -1323,11 +1417,14 @@ static val call_super_fun(val type, val sym, struct args *args)
 {
   val self = lit("call-super-fun");
   struct struct_type *st = stype_handle(&type, self);
-  val suptype = st->super;
 
-  if (suptype) {
-    val fun = static_slot(suptype, sym);
-    return generic_funcall(fun, args);
+  if (st->nsupers) {
+    val suptype = st->sus[0]->self;
+
+    if (suptype) {
+      val fun = static_slot(suptype, sym);
+      return generic_funcall(fun, args);
+    }
   }
 
   uw_throwf(error_s, lit("~a: ~s has no supertype"),
@@ -1382,6 +1479,31 @@ val struct_type_name(val stype)
   return st->name;
 }
 
+static val do_struct_subtype_p(struct struct_type *sb,
+                               struct struct_type *su,
+                               val self)
+{
+  if (sb == su) {
+    return t;
+  } else {
+    cnum i;
+    for (i = 0; i < sb->nsupers; i++) {
+      if (do_struct_subtype_p(sb->sus[i], su, self))
+        return t;
+    }
+
+    return nil;
+  }
+}
+
+val struct_subtype_p(val sub, val sup)
+{
+  const val self = lit("struct-subtype-p");
+  struct struct_type *sb = stype_handle(&sub, self);
+  struct struct_type *su = stype_handle(&sup, self);
+  return do_struct_subtype_p(sb, su, self);
+}
+
 static val method_fun(val env, varg args)
 {
   cons_bind (fun, strct, env);
@@ -1421,7 +1543,7 @@ val method_args(val strct, val slotsym, struct args *args)
 
 val super_method(val strct, val slotsym)
 {
-  val super_slot = static_slot(super(struct_type(strct)), slotsym);
+  val super_slot = static_slot(super(struct_type(strct), zero), slotsym);
   return func_f0v(cons(super_slot, strct), method_fun);
 }
 
@@ -1647,6 +1769,25 @@ static val struct_inst_equalsub(val obj)
   return nil;
 }
 
+static struct struct_type *ancestor_with_static_slot(struct struct_type *st,
+                                                     val slot,
+                                                     val value)
+{
+  cnum i;
+  loc sptr = lookup_static_slot(st, slot);
+
+  if (nullocp(sptr) || deref(sptr) != value)
+    return 0;
+
+  for (i = 0; i < st->nsupers; i++) {
+    struct struct_type *sa = ancestor_with_static_slot(st->sus[i], slot, value);
+    if (sa)
+      return sa;
+  }
+
+  return st;
+}
+
 val method_name(val fun)
 {
   struct hash_iter sthi;
@@ -1662,26 +1803,9 @@ val method_name(val fun)
 
     for (sl_iter = st->slots; sl_iter; sl_iter = cdr(sl_iter)) {
       val slot = car(sl_iter);
-      loc ptr = lookup_static_slot(st, slot);
-
-      if (!nullocp(ptr) && deref(ptr) == fun) {
-        val sstype;
-
-        while ((sstype = super(stype)) != nil) {
-          struct struct_type *sst = coerce(struct struct_type *,
-                                           sstype->co.handle);
-          loc sptr = lookup_static_slot(sst, slot);
-          if (!nullocp(sptr) && deref(sptr) == fun) {
-            stype = sstype;
-            sym = sst->name;
-            continue;
-          }
-
-          break;
-        }
-
-        return list(meth_s, sym, slot, nao);
-      }
+      struct struct_type *sa = ancestor_with_static_slot(st, slot, fun);
+      if (sa)
+        return list(meth_s, sa->name, slot, nao);
     }
 
     if (st->initfun == fun)
diff --git a/struct.h b/struct.h
index 1850814e..78701270 100644
--- a/struct.h
+++ b/struct.h
@@ -47,7 +47,7 @@ val struct_get_initfun(val type);
 val struct_set_initfun(val type, val fun);
 val struct_get_postinitfun(val type);
 val struct_set_postinitfun(val type, val fun);
-val super(val type);
+val super(val type, val idx);
 val make_struct(val type, val plist, struct args *);
 val struct_from_plist(val type, struct args *plist);
 val struct_from_args(val type, struct args *boa);
@@ -75,6 +75,7 @@ val slots(val stype);
 val structp(val obj);
 val struct_type(val strct);
 val struct_type_name(val stype);
+val struct_subtype_p(val sub, val sup);
 val method(val strct, val slotsym);
 val method_args(val strct, val slotsym, struct args *);
 val super_method(val strct, val slotsym);
diff --git a/tests/012/oop-mi.expected b/tests/012/oop-mi.expected
new file mode 100644
index 00000000..91bc05df
--- /dev/null
+++ b/tests/012/oop-mi.expected
@@ -0,0 +1,8 @@
+#S(der0 gx gx gy dgy x dx y dy z dz)
+dgs0
+gs1-b1
+#S(der1 x b3x gx b3gx gy gy y b2y)
+gs0
+gs1-b1
+(meth base3 b3m0)
+(meth der1 b3m1)
diff --git a/tests/012/oop-mi.tl b/tests/012/oop-mi.tl
new file mode 100644
index 00000000..162c0243
--- /dev/null
+++ b/tests/012/oop-mi.tl
@@ -0,0 +1,47 @@
+(load "../common")
+
+(defstruct grand nil
+  (gx 'gx)
+  (gy 'gy)
+  (:static gs0 'gs0)
+  (:static gs1 'gs1))
+
+(defstruct base0 nil)
+
+(defstruct base1 grand
+  (x 'b1x)
+  (:static gs1 'gs1-b1))
+
+(defstruct base2 grand
+  (y 'b2y)
+  (:static gs1 'gs1-b2))
+
+(defstruct base3 nil
+  (x 'b3x)
+  (gx 'b3gx)
+  (:method b3m0 (me))
+  (:method b3m1 (me)))
+
+(defstruct der0 (base0 base1 base2 base3)
+  (x 'dx)
+  (y 'dy)
+  (z 'dz)
+  (gy 'dgy)
+  (:static gs0 'dgs0))
+
+(defstruct der1 (base3 base1 base2)
+  (:method b3m1 (me)))
+
+(defvarl d0 (new der0))
+(defvarl d1 (new der1))
+
+(prinl d0)
+(prinl d0.gs0)
+(prinl d0.gs1)
+
+(prinl d1)
+(prinl d1.gs0)
+(prinl d1.gs1)
+
+(prinl (func-get-name d0.b3m0))
+(prinl (func-get-name d1.b3m1))
diff --git a/txr.1 b/txr.1
index 450cbca7..1954eaf5 100644
--- a/txr.1
+++ b/txr.1
@@ -25133,9 +25133,10 @@ nonnegative.
 
 .SS* Structures
 
-\*(TX supports a structure data type. Structures are objects which
-hold multiple storage locations called slots, which are named by symbols.
-Structures can be related to each other by inheritance.
+\*(TX supports application-defined types in the form of structures. Structures
+are objects which hold multiple storage locations called slots, which are named
+by symbols.  Structures can be related to each other by inheritance. Multiple
+inheritance is permitted.
 
 The type of a structure is itself an object, of type
 .codn struct-type .
@@ -25144,7 +25145,8 @@ When the program defines a new structure type, it does so by creating a new
 .code struct-type
 instance, with properties which describe the new structure type: its
 name, its list of slots, its initialization and "boa constructor" functions,
-and the structure type it inherits from (the "super").
+and the structures type it inherits from (the
+.IR supertypes ).
 
 The
 .code struct-type
@@ -25214,7 +25216,10 @@ read from a stream, if static slots are present, they will be processed
 and their values stored in the static locations they represent, thus
 changing their values for all instances.
 
-Static slots are inherited just like instance slots. If a given structure
+Static slots are inherited just like instance slots. The following
+simplified discussion is restricted to single inheritance. A detailed
+description of multiple inheritance is given in the Multiple Inheritance
+section below.  If a given structure
 .meta B
 has some static slot
 .metn s ,
@@ -25304,6 +25309,61 @@ is invoked once in a type's life time, when the type is created.
 The function is also inherited by derived struct types and invoked when
 they are created.
 
+.NP* Multiple Inheritance
+When a structure type is defined, two or more supertypes may be specified.  The
+new structure type then potentially inherits instance and static slots from all
+of the specified supertypes, and is considered to be a subtype of all of them.
+This situation with two or more supertypes is called
+.IR "multiple inheritance" .
+The contrasting term is
+.IR "single inheritance" ,
+denoting the situation when a structure has exactly one supertype.
+The term
+.IR "strict single inheritance"
+refers to the situation when a structure has exactly one supertype;
+its supertype has at most one supertype; and, recursively, any additional
+indirect supertypes all have at most one supertype.
+Note: \*(TX 228 and older versions permitted only single inheritance,
+thus programs were restricted to strict single inheritance.
+\*(TL's multiple-inheritance is a straightforward extension of its
+single inheritance semantics.
+
+In the
+.code make-struct-type
+function and
+.code defstruct
+macro, a list of supertypes can be given instead of just one.
+The type then inherits slots from all of the specified types.
+If any conflicts arise among the supertypes due to slots having the same name,
+the leftmost supertype dominates: that type's slot will be inherited.
+If the leftmost slot is static, then that static slot will be inherited.
+Otherwise, the instance slot will be inherited.
+
+Of course, any slot which is specified in the newly defined type itself
+dominates over any same-named slots among the supertypes.
+
+The new structure type inherits all of the slot initializing expressions, as
+well as
+.code :init
+and
+.code :postinit
+methods of all of its supertypes.
+
+Each time the structure is instantiated, the
+.code :init
+initializing expressions inherited from the supertypes, together with the slot
+initializing expressions, are all evaluated, in right-to-left order:
+the initializations contributed by each supertype are performed before
+considering the next supertype to the left.
+The
+.code :postinit
+methods are similarly invoked in right-to-left order, before the
+.code :postinit
+methods of the new type itself.
+Thus the order is: supertype inits, own inits, supertype post-inits,
+own post-inits.  If a supertype is referenced, directly or indirectly, two or
+more times, then its initializing expressions are evaluated that many times.
+
 .NP* Dirty Flags
 All structure instances contain a Boolean flag called the
 .IR "dirty flag" .
@@ -25410,10 +25470,12 @@ must also be a bindable symbol.
 The
 .meta super
 argument must either be
-.code nil
-or a symbol which names an existing struct type.
+.codn nil ,
+or a symbol which names an existing struct type,
+or else a list of such symbols.
 The newly defined struct type will inherit all slots,
-as well as initialization behaviors from this type.
+as well as initialization behaviors from the specified
+struct types.
 
 The
 .code defstruct
@@ -25578,7 +25640,11 @@ is instantiated, the
 .code :init
 code of a base structure type, if any, is executed
 before any initializations specific to a derived
-structure type.
+structure type. Under multiple inheritance, the
+.code :init
+code of the rightmost base type is executed first,
+then that of the remaining bases in right-to-left
+order.
 
 The
 .code :init
@@ -25640,7 +25706,8 @@ actions,
 .code :postinit
 actions registered at different levels of the type's
 inheritance hierarchy are invoked in the base-to-derived
-order.
+order, and in right-to-left order among multiple bases
+at the same level.
 .meIP (:fini <> ( param ) << body-form *)
 The
 .code :fini
@@ -26710,6 +26777,9 @@ of
 .codn make-struct .
 Each function is passed the newly created structure
 object, and may alter its slots.
+If multiple inheritance occurs, the
+.meta initfun
+functions of multiple supertypes are called in right-to-left order.
 
 The
 .meta boactor
@@ -26750,7 +26820,9 @@ functions are called after all other initialization processing,
 rather than before. They are are also called in order of
 inheritance: the
 .meta postinitfun
-of a structure's supertype is called before its own.
+of a structure's supertype is called before its own,
+and in right-to-left order among multiple supertypes
+under multiple inheritance.
 
 .coNP Function @ find-struct-type
 .synb
@@ -28394,13 +28466,14 @@ The
 gives the new type that is inheriting from
 .metn supertype .
 
-The function is called at most once for the creation of a given
-.metn subtype ,
-only for its immediate supertype, if and only if that supertype
-has defined this function.
+When a new structure type is defined, its list of immediate
+supertypes is considered. For each of those supertypes which defines the
+.code derived
+function, the function is invoked.
 
-The function is not retroactively invoked if it is defined for
-a structure type from which subtypes have already been derived.
+The function is not retroactively invoked. If it is defined for
+a structure type from which subtypes have already been derived,
+it is not invoked for those existing subtypes.
 
 Note: the
 .meta supertype