Revision of static slot inheritance.

Fixing the broken static slot handling in TXR Lisp's
"OOP structs" object system. Inherited static slots
are now shared with the base type; only static slots
explicitly defined in a derived type have a distinct
global instance in that type.

* share/txr/stdlib/struct.tl (sys:prune-nil-inits):
Function removed.
(sys:prune-missing-inits): New function. We now handle
static slot forms with missing inits specially, not
those with nil or missing inits.
(defstruct): Translate a (word name) form to (word name)
rather than (word name nil) if word is :static, because we
need this nuance for non-shared static slots, so they can
inherit the value from the base struct.  For the purposes of
generating the static init function, prune away all the static
slot forms that do not have an initializer; we let those
default.

* struct.c (struct stslot): New struct for representing
a static slot.
(stslot_loc, stslot_place): New macros.
(struct struct_type): Member eqmslot changes to a pointer
to a struct stslot. The stslot dynamic array is no longer
an array of val, but an array of stslot structs.
(call_stinitfun_chain): The superclass chain of static
init functions is now called only in compatibility mode.
Otherwise only the type's own static init fun is called,
which defclass uses to initialize just the new or repeated
static slots. Inherited static slots are completely left
alone; they do not require initialization.
(static_slot_home_fixup): New static function; needed to
fix some internal pointers within the static slot arrays
if they are realloc'ed.
(make_struct_type): Considerably revised to implement
new scheme, while providing backward compatibility
switching. New slots live in the struct stslot in which
they are allocated. Inherited slots have home pointers
to within the array in the base.
(struct_type_mark): When walking the static slots,
mark only the store cells of those which live in
this array. Those that live elsewhere should have store
cells that are nil; let's assert on it.
(lookup_slot): Static slot lookup code has to retrieve
slots in the new way, indirecting through the home
pointer, which is hidden behind the stslot_loc
macro.
(lookup_static_slot_desc): New function, like
lookup_static_slot, but returning a pointer to the
struct stslot. Formed from the guts of lookup_static_slot.
(lookup_static_slot): Gutted and turned into a wrappar
around lookup_static_slot_desc.
(static_slot_set): Simple change here: add cast
because of the pointer type of eqmslot.
(static_slot_home_fixup_rec): New static function.
Fixes up the cached home in slot arrays in an entire
type hierarchy rooted at a given type, which has to be
done when its static slot has been reallocated, so all those
inherited static slot pointers in the derived types
are invalid.
(static_slot_rewrite_rec): New static function:
rewrites a particular inherited static slot in an inheritance
hierarchy to point to a different slot.
(static_slot_ens_rec): New static function: factored out
recursive logic of static_slot_ensure. Substantially rewritten
to handle new static slot scheme, plus support backward
compatibility. There is a bug fixed here: if an instance slot
is encountered in the no_error_p mode, it looks like we were
dereferencing through an invalid ptr through the
set(ptr, newval) line.
(static_slot_ensure): A wrapper now for static_slot_ens_rec.
(get_equal_method): Rework the logic related to the eqmslot
member of the struct_type structure, in terms of it being
a pointer now rather than an integer. The value -1 cast
to a pointer serves the previous -1 sentinel value which
indicates that it is confirmed (for the time being) that this
type doesn't have an equal method.

* txr.1: All documentation related to static slots updated,
and compatibility notes added.

* tests/012/oop.tl, tests/012/oop.expected: New files.

2 files changed, 83 insertions, 0 deletions

diff --git a/tests/012/oop.expected b/tests/012/oop.expected
new file mode 100644
index 00000000..f0bb554f
--- /dev/null
+++ b/tests/012/oop.expected
@@ -0,0 +1,17 @@
+n/a
+dog
+collie
+animal
+dog
+collie
+animal
+canine
+collie
+animal
+canine
+collie
+poodle
+#S(b a 1 b 2 c 3)
+#S(d a nil b -2 c 3)
+(10 20 300 42 42)
+(10 -20 300 42 0)
diff --git a/tests/012/oop.tl b/tests/012/oop.tl
new file mode 100644
index 00000000..24cf2726
--- /dev/null
+++ b/tests/012/oop.tl
@@ -0,0 +1,66 @@
+(load "../common")
+
+(defstruct animal nil
+  (:function whoami () "n/a")
+  (:method print (self stream) (put-string self.[whoami] stream)))
+
+(defstruct dog animal
+  (:function whoami () "dog"))
+
+(defstruct collie dog
+  (:function whoami () "collie"))
+
+(defstruct poodle dog)
+
+(defvarl a (new animal))
+(defvarl d (new dog))
+(defvarl c (new collie))
+
+(defun print-all ()
+  (pprinl a)
+  (pprinl d)
+  (pprinl c))
+
+(print-all)
+
+(defmeth animal whoami ()
+  "animal")
+
+(print-all)
+
+(defmeth dog whoami ()
+  "canine")
+
+(print-all)
+
+(defmeth poodle whoami ()
+  "poodle")
+
+(print-all)
+
+(pprinl (new poodle))
+
+(defstruct b nil
+  (:instance a 1)
+  (:instance b 2)
+  (:instance c 3)
+  (:static sa 10)
+  (:static sb 20)
+  (:static sc 30))
+
+(defstruct d b
+  (a)
+  (b -2)
+  (:static sa)
+  (:static sb -20)
+  (:static y 0))
+
+(static-slot-ensure 'b 'x 42)
+(static-slot-ensure 'b 'y 42)
+
+(let ((b (new b sc 300))
+      (d (new d)))
+  (prinl b)
+  (prinl d)
+  (prinl (list b.sa b.sb b.sc b.x b.y))
+  (prinl (list d.sa d.sb d.sc d.x d.y)))