lib: access special methods via special slot mechanism.

* ffi.c (ffi_flex_struct_in): Use get_special_slot to obtain
length method.

* lib.c (nullify_s, from_list_s, lambda_set_s): Definitions
removed from here.
(seq_info, car, cdr,  rplaca, rplacd, make_like, nullify,
replace_obj, length, empty, sub, ref, refset, dwim_set): Use
get_special_slot to obtain special method from object,
rather than maybe_slot.
(obj_init): Remove initializations of nullify_s, from_list_s
and lambda_set_s from here.

* struct.c (enum special_slot): Definition removed from here.
(nullify_s, from_list_s, lambda_set_s): Definitions moved here
from lib.c.
(special_sym): New static array.
(struct_init): Initializations of nullify_s, from_list_s
and lambda_set_s moved here from lib.c.
(get_special_slot): New function.

* struct.h (lambda_set_s): Declared.
(enum special_slot): Definition moved here.
(get_special_slot): Declared.

* txr.1: Added compat note, since get_special_slot behaves
like maybe_slot under 224 compatibility.

5 files changed, 63 insertions, 32 deletions

diff --git a/ffi.c b/ffi.c
index 6891aac1..4f79dcc1 100644
--- a/ffi.c
+++ b/ffi.c
@@ -2050,7 +2050,7 @@ static void ffi_ptr_in_release(struct txr_ffi_type *tft, val obj, mem_t *dst)
 static val ffi_flex_struct_in(struct txr_ffi_type *tft, val strct, val self)
 {
   struct smemb *lastm = &tft->memb[tft->nelem - 1];
-  val length_meth = maybe_slot(strct, length_s);
+  val length_meth = get_special_slot(strct, length_m);
 
   if (length_meth) {
     val len = funcall1(length_meth, strct);
diff --git a/lib.c b/lib.c
index 743e6ff2..f4810a44 100644
--- a/lib.c
+++ b/lib.c
@@ -111,7 +111,7 @@ val query_error_s, file_error_s, process_error_s, syntax_error_s;
 val timeout_error_s, system_error_s, alloc_error_s;
 val path_not_found_s, path_exists_s, path_permission_s;
 val warning_s, defr_warning_s, restart_s, continue_s;
-val gensym_counter_s, nullify_s, from_list_s, lambda_set_s, length_s;
+val gensym_counter_s, length_s;
 val rplaca_s, rplacd_s, seq_iter_s;
 
 val nothrow_k, args_k, colon_k, auto_k, fun_k;
@@ -290,9 +290,9 @@ seq_info_t seq_info(val obj)
       } else if (sub != obj) {
         return seq_info(sub);
       } else {
-        if (maybe_slot(obj, length_s))
+        if (get_special_slot(obj, length_m))
           ret.kind = SEQ_VECLIKE;
-        if (maybe_slot(obj, car_s))
+        if (get_special_slot(obj, car_m))
           ret.kind = SEQ_LISTLIKE;
         else
           ret.kind = SEQ_NOTSEQ;
@@ -521,12 +521,12 @@ val car(val cons)
   case COBJ:
     if (obj_struct_p(cons)) {
       {
-        val car_meth = maybe_slot(cons, car_s);
+        val car_meth = get_special_slot(cons, car_m);
         if (car_meth)
           return funcall1(car_meth, cons);
       }
       {
-        val lambda_meth = maybe_slot(cons, lambda_s);
+        val lambda_meth = get_special_slot(cons, lambda_m);
         if (lambda_meth)
           return funcall2(lambda_meth, cons, zero);
       }
@@ -563,12 +563,12 @@ val cdr(val cons)
   case COBJ:
     if (obj_struct_p(cons)) {
       {
-        val cdr_meth = maybe_slot(cons, cdr_s);
+        val cdr_meth = get_special_slot(cons, cdr_m);
         if (cdr_meth)
           return funcall1(cdr_meth, cons);
       }
       {
-        val lambda_meth = maybe_slot(cons, lambda_s);
+        val lambda_meth = get_special_slot(cons, lambda_m);
         if (lambda_meth)
           return funcall2(lambda_meth, cons, rcons(one, t));
       }
@@ -595,14 +595,14 @@ val rplaca(val cons, val new_car)
   default:
     if (structp(cons)) {
       {
-        val rplaca_meth = maybe_slot(cons, rplaca_s);
+        val rplaca_meth = get_special_slot(cons, rplaca_m);
         if (rplaca_meth) {
           (void) funcall2(rplaca_meth, cons, new_car);
           return cons;
         }
       }
       {
-        val lambda_set_meth = maybe_slot(cons, lambda_set_s);
+        val lambda_set_meth = get_special_slot(cons, lambda_set_m);
         if (lambda_set_meth) {
           (void) funcall3(lambda_set_meth, cons, zero, new_car);
           return cons;
@@ -632,7 +632,7 @@ val rplacd(val cons, val new_cdr)
   default:
     if (structp(cons)) {
       {
-        val rplacd_meth = maybe_slot(cons, rplacd_s);
+        val rplacd_meth = get_special_slot(cons, rplacd_m);
         if (rplacd_meth) {
           (void) funcall2(rplacd_meth, cons, new_cdr);
           return cons;
@@ -959,7 +959,7 @@ val make_like(val list, val thatobj)
       break;
     case COBJ:
       if (obj_struct_p(thatobj)) {
-        val from_list_meth = maybe_slot(thatobj, from_list_s);
+        val from_list_meth = get_special_slot(thatobj, from_list_m);
         if (from_list_meth)
           return funcall1(from_list_meth, list);
       }
@@ -1019,7 +1019,7 @@ val nullify(val seq)
     if (seq->co.cls == hash_s)
       return if3(hash_count(seq) != zero, seq, nil);
     if (obj_struct_p(seq)) {
-      val nullify_meth = maybe_slot(seq, nullify_s);
+      val nullify_meth = get_special_slot(seq, nullify_m);
       if (nullify_meth)
         return funcall1(nullify_meth, seq);
     }
@@ -7378,7 +7378,7 @@ val replace_vec(val vec_in, val items, val from, val to)
 val replace_obj(val obj, val items, val from, val to)
 {
   val self = lit("replace");
-  val lambda_set_meth = maybe_slot(obj, lambda_set_s);
+  val lambda_set_meth = get_special_slot(obj, lambda_set_m);
 
   if (!lambda_set_meth)
     uw_throwf(error_s, lit("~a: object ~s lacks ~s method"),
@@ -10035,12 +10035,12 @@ val length(val seq)
     if (seq->co.cls == carray_s)
       return length_carray(seq);
     if (obj_struct_p(seq)) {
-      val length_meth = maybe_slot(seq, length_s);
+      val length_meth = get_special_slot(seq, length_m);
 
       if (length_meth)
         return funcall1(length_meth, seq);
 
-      if (maybe_slot(seq, car_s))
+      if (get_special_slot(seq, car_m))
         return length_proper_list(nullify(seq));
 
       type_mismatch(lit("length: ~s has no length or car method"), seq, nao);
@@ -10076,8 +10076,8 @@ val empty(val seq)
     if (seq->co.cls == carray_s)
       return eq(length_carray(seq), zero);
     if (obj_struct_p(seq)) {
-      val length_meth = maybe_slot(seq, length_s);
-      val nullify_meth = if2(nilp(length_meth), maybe_slot(seq, nullify_s));
+      val length_meth = get_special_slot(seq, length_m);
+      val nullify_meth = if2(nilp(length_meth), get_special_slot(seq, nullify_m));
       if (length_meth)
         return eq(funcall1(length_meth, seq), zero);
       return if3(nullify_meth && funcall1(nullify_meth, seq), nil, seq);
@@ -10107,7 +10107,7 @@ val sub(val seq, val from, val to)
     if (seq->co.cls == carray_s)
       return carray_sub(seq, from, to);
     if (structp(seq)) {
-      val lambda_meth = maybe_slot(seq, lambda_s);
+      val lambda_meth = get_special_slot(seq, lambda_m);
       if (lambda_meth)
         return funcall2(lambda_meth, seq, rcons(from, to));
       seq = nullify(seq);
@@ -10130,7 +10130,7 @@ val ref(val seq, val ind)
     if (seq->co.cls == carray_s)
       return carray_ref(seq, ind);
     if (obj_struct_p(seq)) {
-      val lambda_meth = maybe_slot(seq, lambda_s);
+      val lambda_meth = get_special_slot(seq, lambda_m);
       if (lambda_meth)
         return funcall2(lambda_meth, seq, ind);
     }
@@ -10181,14 +10181,14 @@ val refset(val seq, val ind, val newval)
       return carray_refset(seq, ind, newval);
     if (obj_struct_p(seq)) {
       {
-        val lambda_set_meth = maybe_slot(seq, lambda_set_s);
+        val lambda_set_meth = get_special_slot(seq, lambda_set_m);
         if (lambda_set_meth) {
           (void) funcall3(lambda_set_meth, seq, ind, newval);
           return newval;
         }
       }
       {
-        val car_meth = maybe_slot(seq, car_s);
+        val car_meth = get_special_slot(seq, car_m);
         if (car_meth)
           goto list;
       }
@@ -10257,13 +10257,13 @@ val dwim_set(val place_p, val seq, varg vargs)
       }
       if (obj_struct_p(seq)) {
         {
-          val lambda_set_meth = maybe_slot(seq, lambda_set_s);
+          val lambda_set_meth = get_special_slot(seq, lambda_set_m);
           if (lambda_set_meth) {
             (void) funcall(method_args(seq, lambda_set_s, vargs));
             return seq;
           }
         }
-        if (maybe_slot(seq, car_s))
+        if (get_special_slot(seq, car_m))
           goto list;
         type_mismatch(lit("~a: object ~s lacks "
                           "~s or ~s method"),
@@ -10970,9 +10970,6 @@ static void obj_init(void)
   restart_s = intern(lit("restart"), user_package);
   continue_s = intern(lit("continue"), user_package);
   name_s = intern(lit("name"), user_package);
-  nullify_s = intern(lit("nullify"), user_package);
-  from_list_s = intern(lit("from-list"), user_package);
-  lambda_set_s = intern(lit("lambda-set"), user_package);
   length_s = intern(lit("length"), user_package);
   rplaca_s = intern(lit("rplaca"), user_package);
   rplacd_s = intern(lit("rplacd"), user_package);
diff --git a/struct.c b/struct.c
index b38487c0..87ea9b96 100644
--- a/struct.c
+++ b/struct.c
@@ -72,11 +72,6 @@ struct stslot {
 #define stslot_loc(s) mkloc(*(s)->home, (s)->home_type)
 #define stslot_place(s) (*(s)->home)
 
-enum special_slot {
-  equal_meth,
-  num_special_slots
-};
-
 struct struct_type {
   val self;
   val name;
@@ -107,6 +102,13 @@ val struct_type_s, meth_s, print_s, make_struct_lit_s;
 val init_k, postinit_k;
 val slot_s, derived_s;
 
+val nullify_s, from_list_s, lambda_set_s;
+
+static val *special_sym[num_special_slots] = {
+  &equal_s, &nullify_s, &from_list_s, &lambda_s, &lambda_set_s,
+  &length_s, &car_s, &cdr_s, &rplaca_s, &rplacd_s
+};
+
 static val struct_type_hash;
 static val slot_hash;
 static val struct_type_finalize_f;
@@ -135,6 +137,9 @@ void struct_init(void)
   postinit_k = intern(lit("postinit"), keyword_package);
   slot_s = intern(lit("slot"), user_package);
   derived_s = intern(lit("derived"), user_package);
+  nullify_s = intern(lit("nullify"), user_package);
+  from_list_s = intern(lit("from-list"), user_package);
+  lambda_set_s = intern(lit("lambda-set"), user_package);
   struct_type_hash = make_hash(nil, nil, nil);
   slot_hash = make_hash(nil, nil, t);
   slot_type_hash = make_hash(nil, nil, nil);
@@ -1759,6 +1764,15 @@ val static_slot_type_reg(val slot, val strct)
   return slot;
 }
 
+val get_special_slot(val obj, enum special_slot spidx)
+{
+  val slot = *special_sym[spidx];
+  if (opt_compat && opt_compat <= 224)
+    return maybe_slot(obj, slot);
+  struct struct_inst *si = coerce(struct struct_inst *, obj->co.handle);
+  return get_special_static_slot(si->type, spidx, slot);
+}
+
 static_def(struct cobj_ops struct_type_ops =
            cobj_ops_init(eq, struct_type_print, struct_type_destroy,
                          struct_type_mark, cobj_eq_hash_op));
diff --git a/struct.h b/struct.h
index d67ce3d7..385d8dd4 100644
--- a/struct.h
+++ b/struct.h
@@ -28,7 +28,16 @@
 extern val struct_type_s, meth_s, print_s, make_struct_lit_s;
 extern val init_k, postinit_k;
 extern val slot_s, derived_s;
+extern val lambda_set_s;
+
 extern struct cobj_ops struct_inst_ops;
+
+enum special_slot {
+  equal_m, nullify_m, from_list_m, lambda_m, lambda_set_m,
+  length_m, car_m, cdr_m, rplaca_m, rplacd_m,
+  num_special_slots
+};
+
 val make_struct_type(val name, val super,
                      val static_slots, val slots,
                      val static_initfun, val initfun, val boactor,
@@ -77,5 +86,6 @@ val slot_types(val slot);
 val static_slot_types(val slot);
 val slot_type_reg(val slot, val strct);
 val static_slot_type_reg(val slot, val strct);
+val get_special_slot(val obj, enum special_slot spidx);
 INLINE int obj_struct_p(val obj) { return obj->co.ops == &struct_inst_ops; }
 void struct_init(void);
diff --git a/txr.1 b/txr.1
index 6bb2fc08..c2ee8823 100644
--- a/txr.1
+++ b/txr.1
@@ -69566,6 +69566,16 @@ of these version values, the described behaviors are provided if
 is given an argument which is equal or lower. For instance
 .code "-C 103"
 selects the behaviors described below for version 105, but not those for 102.
+.IP 224
+After \*(TX 224, the treatment of certain special structure functions
+has changed. Selecting 224 compatibility or lower restores that behavior.
+The specification given in the
+.B "Special Structure Functions"
+paragraph has always stated that special functions must be static slots,
+and that the behavior is unspecified if they are instance slots.
+The behavior of \*(TX 224 and earlier was that these functions worked anyway
+if they were instance slots; after \*(TX 224, they some special functions
+will no longer be recognized if bound to instance slots.
 .IP 222
 After \*(TX 222, the behavior of
 .code :vars