Implementation of static slots for structures.

* share/txr/stdlib/struct.tl (sys:bad-slot-syntax): New helper function.
(defstruct): Macro revamped with new slot specifier syntax for
writing static slots as well as methods.

* struct.c (STATIC_SLOT_BASE): New preprocessor symbol.
(struct struct_type): New members, nstslots, stinitfun, stslot.
(make_struct_type_compat): New static function.
(struct_init): Register make-struct-type to make_struct_type_compat
if compatibility is 117 or lower.
Register new intrinsics static-slot, static-slot-set, call-super-method,
call-super-fun, slot-p and static-slot-p.
(call_stinitfun_chain): New static function.
(make_struct_type): Two new arguments for specifying static slots and
an initialization function for them. Logic added for setting
up static slots and handling inheritance.
(struct_type_destroy): New static function.
(struct_type_mark): Mark the new stinitfun member of struct type.
Also iterate over the static slots in the new stslot array and
mark them.
(lookup_slot): Altered to return a loc instead of a raw pointer,
and also to accept the instance object as a member.
Now resolves static slots: it can return a loc which references
a static slot in the structure type, or an instance slot in
the structure.
(lookup_static_slot): New static function.
(slot, slotset): Implementation adjusted due to new lookup_slot interface.
(static_slot, static_slot_set, slot_p, static_slot_p): New functions.
(call_super_method, call_super_fun): New static functions.
(struct_inst_print): This function can no longer assume that the slots
list lines up with the array of slots, since it contains a mixture of
static and instance slots. Earnest slot lookup has to be performed.
(struct_type_ops): Point the destroy function to struct_type_destroy
instead of cobj_destroy_free_op. A structure type now has an array
of static slots to free.

* struct.h (make_struct_type): Declaration updated.
(static_slot, static_slot_set, slot_p, static_slot_p): Declared.

* lib.c (time_init): Update call to make_struct_type with new
arguments.

* sysif.c (sysif_init): Likewise.

* tests/012/struct.tl: Update defstruct macro expansion test.

* txr.1: Documented static slots and new functions.

7 files changed, 704 insertions, 115 deletions

diff --git a/lib.c b/lib.c
index 6fd1be06..c54924fe 100644
--- a/lib.c
+++ b/lib.c
@@ -7865,9 +7865,9 @@ static void time_init(void)
   sec_s = intern(lit("sec"), user_package);
   dst_s = intern(lit("dst"), user_package);
 
-  make_struct_type(time_s, nil,
+  make_struct_type(time_s, nil, nil,
                    list(year_s, month_s, day_s,
-                        hour_s, min_s, sec_s, dst_s, nao), nil, nil);
+                        hour_s, min_s, sec_s, dst_s, nao), nil, nil, nil);
 }
 
 void init(const wchar_t *pn, mem_t *(*oom)(mem_t *, size_t),
diff --git a/share/txr/stdlib/struct.tl b/share/txr/stdlib/struct.tl
index f5d1cf15..6bef4919 100644
--- a/share/txr/stdlib/struct.tl
+++ b/share/txr/stdlib/struct.tl
@@ -23,6 +23,10 @@
 ;; AND UNDER ANY THEORY OF LIABILITY, ARISING IN ANY WAY OUT OF THE USE OF THIS
 ;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
+(macro-time
+  (defun sys:bad-slot-syntax (arg)
+    (throwf 'eval-error "~s: bad slot syntax: ~s" 'defstruct arg)))
+
 (defmacro defstruct (name-spec super . slot-specs)
   (tree-bind (name args) (tree-case name-spec
                            ((atom . args) (list atom args))
@@ -31,17 +35,54 @@
       (throwf 'eval-error "~s: ~s isn't a bindable symbol" 'defstruct name))
     (unless (proper-listp slot-specs)
       (throwf 'eval-error "~s: bad slot syntax" 'defstruct))
-    (let ((slot-init-forms (collect-each ((slot slot-specs))
-                             (tree-case slot
-                               ((sym init-form) slot)
-                               (sym (list sym nil))))))
-      (whenlet ((bad [find-if [notf bindable] slot-init-forms car]))
+    (let* ((slot-init-forms (collect-each ((slot slot-specs))
+                              (tree-case slot
+                                ((word name args . body)
+                                 (caseq word
+                                   (:method
+                                     (when (not args)
+                                       (throwf 'eval-error
+                                               "~s: method ~s needs \
+                                               \ at least one parameter"
+                                               'defstruct name))
+                                     ^(:static ,name (lambda ,args ,*body)))
+                                   (:function ^(:static ,name
+                                                        (lambda ,args ,*body)))
+                                   ((:static :instance)
+                                     (when body
+                                       (sys:bad-slot-syntax slot))
+                                     ^(,word ,name ,args))
+                                   (t (sys:bad-slot-syntax slot))))
+                                ((word name)
+                                   (caseq word
+                                     ((:static :instance)
+                                      ^(,word ,name nil))
+                                     (t ^(:instance ,word ,name))))
+                                ((name)
+                                  ^(:instance ,name nil))
+                                (name
+                                  ^(:instance ,name nil)))))
+           (stat-si-forms [keep-if (op eq :static) slot-init-forms car])
+           (inst-si-forms [keep-if (op eq :instance) slot-init-forms car])
+           (stat-slots [mapcar second stat-si-forms])
+           (inst-slots [mapcar second inst-si-forms]))
+      (whenlet ((bad [find-if [notf bindable]
+                              (append stat-slots inst-slots)]))
         (throwf 'eval-error "~s: slot name ~s isn't a bindable symbol"
-                'defstruct (car bad)))
-      (let ((arg-sym (gensym)))
-        ^(make-struct-type ',name ',super ',[mapcar car slot-init-forms]
+                'defstruct bad))
+      (let ((arg-sym (gensym))
+            (type-sym (gensym)))
+        ^(sys:make-struct-type
+           ',name ',super ',stat-slots ',inst-slots
+           (lambda (,arg-sym)
+             ,*(mapcar (aret ^(when (static-slot-p ,arg-sym ',@2)
+                                (static-slot-set ,arg-sym ',@2 ,@3)))
+                       stat-si-forms))
            (lambda (,arg-sym)
-             ,*(mapcar (aret ^(slotset ,arg-sym ',@1 ,@2)) slot-init-forms))
+             (let ((,type-sym (struct-type ,arg-sym)))
+               ,*(mapcar (aret ^(unless (static-slot-p ,type-sym ',@2)
+                                  (slotset ,arg-sym ',@2 ,@3)))
+                         inst-si-forms)))
            ,(if args
               (let ((gens (mapcar (ret (gensym)) args)))
                 ^(lambda (,arg-sym ,*gens)
diff --git a/struct.c b/struct.c
index 298eae0b..214cdf56 100644
--- a/struct.c
+++ b/struct.c
@@ -44,19 +44,25 @@
 #include "gc.h"
 #include "args.h"
 #include "cadr.h"
+#include "txr.h"
 #include "struct.h"
 
 #define max(a, b) ((a) > (b) ? (a) : (b))
 
+#define STATIC_SLOT_BASE 0x10000000
+
 struct struct_type {
   val name;
   cnum id;
   cnum nslots;
+  cnum nstslots;
   val super;
   struct struct_type *super_handle;
   val slots;
+  val stinitfun;
   val initfun;
   val boactor;
+  val *stslot;
 };
 
 struct struct_inst {
@@ -76,6 +82,11 @@ static val struct_type_finalize(val obj);
 static_forward(struct cobj_ops struct_type_ops);
 static_forward(struct cobj_ops struct_inst_ops);
 
+static val make_struct_type_compat(val name, val super, val slots,
+                                   val initfun, val boactor);
+static val call_super_method(val inst, val sym, struct args *);
+static val call_super_fun(val type, val sym, struct args *);
+
 void struct_init(void)
 {
   protect(&struct_type_hash, &slot_hash, &struct_type_finalize_f,
@@ -84,8 +95,16 @@ void struct_init(void)
   struct_type_hash = make_hash(nil, nil, nil);
   slot_hash = make_hash(nil, nil, t);
   struct_type_finalize_f = func_n1(struct_type_finalize);
-  reg_fun(intern(lit("make-struct-type"), user_package),
-          func_n5(make_struct_type));
+
+  if (opt_compat && opt_compat <= 117)
+    reg_fun(intern(lit("make-struct-type"), user_package),
+            func_n5(make_struct_type_compat));
+  else
+    reg_fun(intern(lit("make-struct-type"), user_package),
+            func_n7(make_struct_type));
+
+  reg_fun(intern(lit("make-struct-type"), system_package),
+          func_n7(make_struct_type));
   reg_fun(intern(lit("find-struct-type"), user_package),
           func_n1(find_struct_type));
   reg_fun(intern(lit("struct-type-p"), user_package), func_n1(struct_type_p));
@@ -94,6 +113,15 @@ void struct_init(void)
   reg_fun(intern(lit("copy-struct"), user_package), func_n1(copy_struct));
   reg_fun(intern(lit("slot"), user_package), func_n2(slot));
   reg_fun(intern(lit("slotset"), user_package), func_n3(slotset));
+  reg_fun(intern(lit("static-slot"), user_package), func_n2(static_slot));
+  reg_fun(intern(lit("static-slot-set"), user_package),
+          func_n3(static_slot_set));
+  reg_fun(intern(lit("call-super-method"), user_package),
+          func_n2v(call_super_method));
+  reg_fun(intern(lit("call-super-fun"), user_package),
+          func_n2v(call_super_fun));
+  reg_fun(intern(lit("slot-p"), user_package), func_n2(slot_p));
+  reg_fun(intern(lit("static-slot-p"), user_package), func_n2(static_slot_p));
   reg_fun(intern(lit("structp"), user_package), func_n1(structp));
   reg_fun(intern(lit("struct-type"), user_package), func_n1(struct_type));
   reg_fun(intern(lit("method"), user_package), func_n2(method));
@@ -117,7 +145,19 @@ static val struct_type_finalize(val obj)
   return nil;
 }
 
-val make_struct_type(val name, val super, val slots, val initfun, val boactor)
+static void call_stinitfun_chain(struct struct_type *st, val stype)
+{
+  if (st) {
+    if (st->super)
+      call_stinitfun_chain(st->super_handle, stype);
+    if (st->stinitfun)
+      funcall1(st->stinitfun, stype);
+  }
+}
+
+val make_struct_type(val name, val super,
+                     val static_slots, val slots,
+                     val static_initfun, val initfun, val boactor)
 {
   val self = lit("make-struct-type");
 
@@ -148,32 +188,64 @@ val make_struct_type(val name, val super, val slots, val initfun, val boactor)
                                  coerce(struct struct_type *,
                                         cobj_handle(super, struct_type_s)), 0);
     val super_slots = if2(su, su->slots);
-    val all_slots = uniq(append2(super_slots, slots));
+    val all_slots = uniq(append2(super_slots, append2(static_slots, slots)));
     val stype = cobj(coerce(mem_t *, st), struct_type_s, &struct_type_ops);
     val id = num_fast(++struct_id_counter);
-    val slot;
-    cnum sl;
+    val iter;
+    cnum sl, stsl;
 
     st->name = name;
     st->id = c_num(id);
-    st->nslots = c_num(length(all_slots));
+    st->nslots = st->nstslots = 0;
     st->slots = all_slots;
     st->super = super;
+    st->stslot = 0;
     st->super_handle = su;
+    st->stinitfun = static_initfun;
     st->initfun = initfun;
     st->boactor = boactor;
 
-    sethash(struct_type_hash, name, stype);
+    gc_finalize(stype, struct_type_finalize_f);
 
-    for (sl = 0, slot = all_slots; slot; sl++, slot = cdr(slot))
-      sethash(slot_hash, cons(car(slot), id), num_fast(sl));
+    for (sl = 0, stsl = STATIC_SLOT_BASE, iter = all_slots;
+         iter;
+         iter = cdr(iter))
+    {
+      val slot = car(iter);
+      val new_tslot_p = memq(slot, static_slots);
+      int inherited_p = !new_tslot_p && !memq(slot, slots);
+      val ts_p = if3(inherited_p,
+                     static_slot_p(super, slot),
+                     memq(slot, static_slots));
+
+      if (ts_p)
+        sethash(slot_hash, cons(slot, id), num(stsl++));
+      else
+        sethash(slot_hash, cons(slot, id), num_fast(sl++));
+
+      if (sl >= STATIC_SLOT_BASE)
+        uw_throwf(error_s, lit("~a: too many slots"), self, nao);
+    }
 
-    gc_finalize(stype, struct_type_finalize_f);
+    stsl -= STATIC_SLOT_BASE;
+    st->stslot = coerce(val *, chk_calloc(stsl, sizeof *st->stslot));
+    st->nslots = sl;
+    st->nstslots = stsl;
+
+    sethash(struct_type_hash, name, stype);
+
+    call_stinitfun_chain(st, stype);
 
     return stype;
   }
 }
 
+static val make_struct_type_compat(val name, val super, val slots,
+                                   val initfun, val boactor)
+{
+  return make_struct_type(name, super, nil, slots, nil, initfun, boactor);
+}
+
 val find_struct_type(val sym)
 {
   return gethash(struct_type_hash, sym);
@@ -204,14 +276,27 @@ static void struct_type_print(val obj, val out, val pretty)
   format(out, lit("#<struct-type ~s>"), st->name, nao);
 }
 
+static void struct_type_destroy(val obj)
+{
+  struct struct_type *st = coerce(struct struct_type *, obj->co.handle);
+  free(st->stslot);
+  free(st);
+}
+
 static void struct_type_mark(val obj)
 {
   struct struct_type *st = coerce(struct struct_type *, obj->co.handle);
+  cnum stsl;
+
   gc_mark(st->name);
   gc_mark(st->super);
   gc_mark(st->slots);
+  gc_mark(st->stinitfun);
   gc_mark(st->initfun);
   gc_mark(st->boactor);
+
+  for (stsl = 0; stsl < st->nstslots; stsl++)
+    gc_mark(st->stslot[stsl]);
 }
 
 static void call_initfun_chain(struct struct_type *st, val strct)
@@ -343,7 +428,7 @@ static void cache_set_insert(slot_cache_entry_t *set, cnum id, cnum slot)
   set[entry].slot = slot;
 }
 
-static val *lookup_slot(struct struct_inst *si, val sym)
+static loc lookup_slot(val inst, struct struct_inst *si, val sym)
 {
   slot_cache_t slot_cache = sym->s.slot_cache;
   cnum id = si->id;
@@ -352,15 +437,24 @@ static val *lookup_slot(struct struct_inst *si, val sym)
     slot_cache_set_t *set = &slot_cache[id % SLOT_CACHE_SIZE];
     cnum slot = cache_set_lookup(*set, id);
 
-    if (slot >= 0) {
-      return &si->slot[slot];
+    if (slot >= STATIC_SLOT_BASE) {
+      val type = si->type;
+      struct struct_type *st = coerce(struct struct_type *, type->co.handle);
+      return mkloc(st->stslot[slot - STATIC_SLOT_BASE], type);
+    } else if (slot >= 0) {
+      return mkloc(si->slot[slot], inst);
     } else {
       val key = cons(sym, num_fast(id));
       val sl = gethash(slot_hash, key);
       cnum slnum = coerce(cnum, sl) >> TAG_SHIFT;
       if (sl) {
         cache_set_insert(*set, id, slnum);
-        return &si->slot[slnum];
+        if (slnum >= STATIC_SLOT_BASE) {
+          val type = si->type;
+          struct struct_type *st = coerce(struct struct_type *, type->co.handle);
+          return mkloc(st->stslot[slnum - STATIC_SLOT_BASE], type);
+        }
+        return mkloc(si->slot[slnum], inst);
       }
     }
   } else {
@@ -376,11 +470,58 @@ static val *lookup_slot(struct struct_inst *si, val sym)
 
     if (sl) {
       cache_set_insert(*set, id, slnum);
-      return &si->slot[slnum];
+      if (slnum >= STATIC_SLOT_BASE) {
+        val type = si->type;
+        struct struct_type *st = coerce(struct struct_type *, type->co.handle);
+        return mkloc(st->stslot[slnum - STATIC_SLOT_BASE], type);
+      }
+      return mkloc(si->slot[slnum], inst);
     }
   }
 
-  return 0;
+  return nulloc;
+}
+
+static loc lookup_static_slot(val stype, struct struct_type *st, val sym)
+{
+  slot_cache_t slot_cache = sym->s.slot_cache;
+  cnum id = st->id;
+
+  if (slot_cache != 0) {
+    slot_cache_set_t *set = &slot_cache[id % SLOT_CACHE_SIZE];
+    cnum slot = cache_set_lookup(*set, id);
+
+    if (slot >= STATIC_SLOT_BASE) {
+      return mkloc(st->stslot[slot - STATIC_SLOT_BASE], stype);
+    } else if (slot < 0) {
+      val key = cons(sym, num_fast(id));
+      val sl = gethash(slot_hash, key);
+      cnum slnum = coerce(cnum, sl) >> TAG_SHIFT;
+      if (sl) {
+        cache_set_insert(*set, id, slnum);
+        if (slnum >= STATIC_SLOT_BASE)
+          return mkloc(st->stslot[slnum - STATIC_SLOT_BASE], stype);
+      }
+    }
+  } else {
+    slot_cache = coerce(slot_cache_t,
+                        chk_calloc(SLOT_CACHE_SIZE,
+                                   sizeof (slot_cache_set_t)));
+    slot_cache_set_t *set = &slot_cache[id % SLOT_CACHE_SIZE];
+    val key = cons(sym, num_fast(id));
+    val sl = gethash(slot_hash, key);
+    cnum slnum = coerce(cnum, sl) >> TAG_SHIFT;
+
+    sym->s.slot_cache = slot_cache;
+
+    if (sl) {
+      cache_set_insert(*set, id, slnum);
+      if (slnum >= STATIC_SLOT_BASE)
+        return mkloc(st->stslot[slnum - STATIC_SLOT_BASE], stype);
+    }
+  }
+
+  return nulloc;
 }
 
 static noreturn void no_such_slot(val ctx, val type, val slot)
@@ -395,9 +536,9 @@ val slot(val strct, val sym)
   struct struct_inst *si = struct_handle(strct, self);
 
   if (symbolp(sym)) {
-    val *ptr = lookup_slot(si, sym);
-    if (ptr)
-      return *ptr;
+    loc ptr = lookup_slot(strct, si, sym);
+    if (!nullocp(ptr))
+      return deref(ptr);
   }
 
   no_such_slot(self, si->type, sym);
@@ -409,16 +550,109 @@ val slotset(val strct, val sym, val newval)
   struct struct_inst *si = struct_handle(strct, self);
 
   if (symbolp(sym)) {
-    val *ptr = lookup_slot(si, sym);
-    if (ptr) {
-      set(mkloc(*ptr, strct), newval);
-      return newval;
-    }
+    loc ptr = lookup_slot(strct, si, sym);
+    if (!nullocp(ptr))
+      return set(ptr, newval);
   }
 
   no_such_slot(self, si->type, sym);
 }
 
+val static_slot(val stype, val sym)
+{
+  struct struct_type *st = coerce(struct struct_type *,
+                                  cobj_handle(stype, struct_type_s));
+
+  if (symbolp(sym)) {
+    loc ptr = lookup_static_slot(stype, st, sym);
+    if (!nullocp(ptr))
+      return deref(ptr);
+  }
+
+  no_such_slot(lit("static-slot"), stype, sym);
+}
+
+val static_slot_set(val stype, val sym, val newval)
+{
+  struct struct_type *st = coerce(struct struct_type *,
+                                  cobj_handle(stype, struct_type_s));
+
+  if (symbolp(sym)) {
+    loc ptr = lookup_static_slot(stype, st, sym);
+    if (!nullocp(ptr))
+      return set(ptr, newval);
+  }
+
+  no_such_slot(lit("static-slot-set"), stype, sym);
+}
+
+static val call_super_method(val inst, val sym, struct args *args)
+{
+  val type = struct_type(inst);
+  val suptype = super(type);
+
+  if (suptype) {
+    val meth = static_slot(suptype, sym);
+    args_decl(args_copy, max(args->fill + 1, ARGS_MIN));
+    args_add(args_copy, inst);
+    args_cat_zap(args_copy, args);
+    return generic_funcall(meth, args_copy);
+  }
+
+  uw_throwf(error_s, lit("call-super-method: ~s has no supertype"),
+            suptype, nao);
+}
+
+static val call_super_fun(val type, val sym, struct args *args)
+{
+  val suptype = super(type);
+
+  if (suptype) {
+    val fun = static_slot(suptype, sym);
+    return generic_funcall(fun, args);
+  }
+
+  uw_throwf(error_s, lit("call-super-fun: ~s has no supertype"),
+            type, nao);
+}
+
+val slot_p(val type, val sym)
+{
+  if (type && symbolp(type)) {
+    val stype = find_struct_type(type);
+    if (!stype)
+      no_such_struct(lit("slot-p"), type);
+    return slot_p(stype, sym);
+  } else {
+    struct struct_type *st = coerce(struct struct_type *,
+                                    cobj_handle(type, struct_type_s));
+    return tnil(memq(sym, st->slots));
+  }
+}
+
+val static_slot_p(val type, val sym)
+{
+  if (type && symbolp(type)) {
+    val stype = find_struct_type(type);
+    if (!stype)
+      no_such_struct(lit("type-slot-p"), type);
+    return static_slot_p(stype, sym);
+  } else {
+    struct struct_type *st = coerce(struct struct_type *,
+                                    cobj_handle(type, struct_type_s));
+    if (memq(sym, st->slots)) {
+      val key = cons(sym, num_fast(st->id));
+      val sl = gethash(slot_hash, key);
+      cnum slnum = coerce(cnum, sl) >> TAG_SHIFT;
+
+      if (sl && slnum >= STATIC_SLOT_BASE)
+        return t;
+    }
+
+    return nil;
+  }
+}
+
 val structp(val obj)
 {
   return tnil(cobjp(obj) && obj->co.ops == &struct_inst_ops);
@@ -451,21 +685,25 @@ static void struct_inst_print(val obj, val out, val pretty)
   struct struct_type *st = coerce(struct struct_type *, si->type->co.handle);
   val save_mode = test_set_indent_mode(out, num_fast(indent_off),
                                        num_fast(indent_data));
-  val save_indent, slots;
-  cnum sl, nslots = st->nslots;
+  val save_indent, iter, once;
 
   put_string(lit("#S("), out);
   obj_print_impl(st->name, out, pretty);
   save_indent = inc_indent(out, one);
 
-  for (slots = st->slots, sl = 0; sl < nslots; sl++, slots = cdr(slots)) {
-    if (sl == 0)
+  for (iter = st->slots, once = t; iter; iter = cdr(iter)) {
+    val sym = car(iter);
+    if (!static_slot_p(si->type, sym)) {
+      if (once) {
+        put_char(chr(' '), out);
+        once = nil;
+      } else {
+        width_check(out, chr(' '));
+      }
+      obj_print_impl(sym, out, pretty);
       put_char(chr(' '), out);
-    else
-      width_check(out, chr(' '));
-    obj_print_impl(car(slots), out, pretty);
-    put_char(chr(' '), out);
-    obj_print_impl(si->slot[sl], out, pretty);
+      obj_print_impl(slot(obj, sym), out, pretty);
+    }
   }
   put_char(chr(')'), out);
   set_indent_mode(out, save_mode);
@@ -518,7 +756,7 @@ static cnum struct_inst_hash(val obj)
 }
 
 static_def(struct cobj_ops struct_type_ops =
-           cobj_ops_init(eq, struct_type_print, cobj_destroy_free_op,
+           cobj_ops_init(eq, struct_type_print, struct_type_destroy,
                          struct_type_mark, cobj_hash_op))
 
 static_def(struct cobj_ops struct_inst_ops =
diff --git a/struct.h b/struct.h
index 193c605d..d0bc9c85 100644
--- a/struct.h
+++ b/struct.h
@@ -25,7 +25,9 @@
  */
 
 extern val struct_type_s;
-val make_struct_type(val name, val super, val slots, val initfun, val boactor);
+val make_struct_type(val name, val super,
+                     val static_slots, val slots,
+                     val static_initfun, val initfun, val boactor);
 val struct_type_p(val obj);
 val super(val type);
 val make_struct(val type, val plist, struct args *);
@@ -33,6 +35,10 @@ val copy_struct(val strct);
 val find_struct_type(val sym);
 val slot(val strct, val sym);
 val slotset(val strct, val sym, val newval);
+val static_slot(val stype, val sym);
+val static_slot_set(val stype, val sym, val newval);
+val slot_p(val type, val sym);
+val static_slot_p(val type, val sym);
 val structp(val obj);
 val struct_type(val strct);
 val method(val strct, val obj);
diff --git a/sysif.c b/sysif.c
index c8931895..1fe92471 100644
--- a/sysif.c
+++ b/sysif.c
@@ -1078,18 +1078,18 @@ void sysif_init(void)
   mem_s = intern(lit("mem"), user_package);
 #endif
 
-  make_struct_type(stat_s, nil,
+  make_struct_type(stat_s, nil, nil,
                    list(dev_s, ino_s, mode_s, nlink_s, uid_s, gid_s,
                         rdev_s, size_s, blksize_s, blocks_s, atime_s,
-                        mtime_s, ctime_s, nao), nil, nil);
+                        mtime_s, ctime_s, nao), nil, nil, nil);
 #if HAVE_PWUID
-  make_struct_type(passwd_s, nil,
+  make_struct_type(passwd_s, nil, nil,
                    list(name_s, passwd_s, uid_s, gid_s,
-                        gecos_s, dir_s, shell_s, nao), nil, nil);
+                        gecos_s, dir_s, shell_s, nao), nil, nil, nil);
 #endif
 #if HAVE_GRGID
-  make_struct_type(group_s, nil,
-                   list(name_s, passwd_s, gid_s, mem_s, nao), nil, nil);
+  make_struct_type(group_s, nil, nil,
+                   list(name_s, passwd_s, gid_s, mem_s, nao), nil, nil, nil);
 #endif
 
   reg_fun(intern(lit("errno"), user_package), func_n1o(errno_wrap, 0));
diff --git a/tests/012/struct.tl b/tests/012/struct.tl
index 5be89cab..3eb5563c 100644
--- a/tests/012/struct.tl
+++ b/tests/012/struct.tl
@@ -70,18 +70,23 @@
 (set *gensym-counter* 0)
 (stest (sys:expand '(defstruct (boa x y) nil
                       (x 0) (y 0)))
-       "(make-struct-type 'boa '() '(x y)\n             \
-       \                  (lambda (#:g0004)\n           \
-       \                    (slotset #:g0004 'x\n       \
-       \                             0)\n               \
-       \                    (slotset #:g0004 'y\n       \
-       \                             0))\n              \
-       \                  (lambda (#:g0004 #:g0005\n    \
-       \                           #:g0006)\n           \
-       \                    (slotset #:g0004 'x\n       \
-       \                             #:g0005)\n         \
-       \                    (slotset #:g0004 'y\n       \
-       \                             #:g0006)))")
+       "(sys:make-struct-type 'boa '() '()\n                            \
+       \                      '(x y) (lambda (#:g0004))\n               \
+       \                      (lambda (#:g0004)\n                       \
+       \                        (let ((#:g0005 (struct-type #:g0004)))\n\
+       \                          (if (static-slot-p #:g0005 'x)\n      \
+       \                            () (progn (slotset #:g0004 'x\n     \
+       \                                               0)))\n           \
+       \                          (if (static-slot-p #:g0005 'y)\n      \
+       \                            () (progn (slotset #:g0004 'y\n     \
+       \                                               0)))))\n         \
+       \                      (lambda (#:g0004 #:g0006\n                \
+       \                               #:g0007)\n                       \
+       \                        (slotset #:g0004 'x\n                   \
+       \                                 #:g0006)\n                     \
+       \                        (slotset #:g0004 'y\n                   \
+       \                                 #:g0007)))")
+
 
 (defstruct (boa x y) nil
   (x 0) (y 0))
diff --git a/txr.1 b/txr.1
index 95437fd0..02598449 100644
--- a/txr.1
+++ b/txr.1
@@ -17671,19 +17671,63 @@ the struct type. Effectively, struct names are types.
 The consequences are unspecified if an existing struct name is re-used for a
 different struct type, or an existing type name is used for a struct type.
 
+.NP* Static Slots
+
+Structure slots can be of two kinds: they can be the ordinary instance slots or
+they can be static slots.  The instances of a given structure type have their
+own instance of a given instance slot. However, they all share a single
+instance of a static slot.
+
+Static slots are allocated in a global area associated with a structure type
+and are initialized when the structure type is created. They are useful for
+efficiently representing properties which have the same value for all instances
+of a struct. These properties don't have to occupy space in each instance, and
+time doesn't have to be wasted initializing them each time a new instance is
+created.  Static slots are also useful for struct-specific global variables.
+Lastly, static slots are also useful for holding methods and functions.
+Although structures can have methods and functions in their instances, usually,
+all structures of the same type share the same functions. The
+.code defstruct
+macro supports a special syntax for defining methods and struct-specific
+functions.
+
+Static slots may be assigned just like instance slots. Changing a static
+slot, of course, changes that slot in every structure of the same type.
+
+Static slots are not listed in the
+.code #S(...)
+notation when a structure is printed. When the structure notation is
+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. However, when one
+structure type inherits a static slot from another, that structure type
+has its own storage location for that slot.
+
+The slot type can be overridden. A structure type deriving from another
+type can introduce slots which have the same names as the supertype,
+but are of a different kind: an instance slot in the supertype
+can be replaced by a static slot in the derived type or vice versa.
+
+A structure type is associated with a static initialization function
+which may be used to store initial values into static slots. It is
+invoked when the type is created.
+
+
 .coNP Macro @ defstruct
 .synb
 .mets (defstruct >> { name | >> ( name << arg *)} < super
-.mets \ \  >> { slot | >> ( slot << init-form )}*)
+.mets \ \  << slot-specifier *)
 .syne
 
 The
 .code defstruct
-macro defined a new structure type and registers it under
+macro defines a new structure type and registers it under
 .metn name ,
 which must be a bindable symbol, according to the
 .code bindable
-function. Likewise, every
+function. Likewise, the name of every
 .meta slot
 must also be a bindable symbol.
 
@@ -17699,55 +17743,138 @@ The
 .code defstruct
 macro is implemented using the
 .code make-struct-type
-function. It is less powerful than
-this function.
+function, which is more general. The macro analyzes the
+.code defstruct
+argument syntax, and synthesizes arguments which are then
+used to call the function. Some remarks in the description of
+.code defstruct
+only apply to structure types defined using that macro.
 
-Slots are specified using the
-.meta slot
-or
+Slots are specified using zero or more
+.IR "slot specifiers" .
+Slot specifiers come in the following variety:
+.RS
+.meIP < name
+The simplest slot specifier is just a name, which must be a bindable
+symbol, as defined by the
+.code bindable
+function. This form is a short form for the
 .cblk
-.meti >> ( slot << init-form )
+.meti (:instance < name nil)
 .cble
-arguments, where the simpler first form is
-.meta slot
-form is equivalent to the second form, with an
+syntax.
+
+.meIP >> ( symbol << init-form )
+This syntax is a short form for the
+.cblk
+.meti (:instance < name << init-form )
+.cble
+syntax.
+
+.meIP (:instance < name << init-form )
+This syntax specifies an instance slot called
+.meta name
+whose initial value is obtained by evaluating
 .meta init-form
-specified as
-.codn nil .
+whenever a new instance of the structure is created.
+This evaluation takes place in the original lexical environment in which the
+.code defstruct
+form occurs.
+
+.meIP (:static < name << init-form )
+This syntax specifies a static slot called
+.meta name
+whose initial value is obtained by evaluating
+.meta init-form
+once, during the evaluation of the
+.code defstruct
+form in which it occurs.
 
-whenever a structure of type
+.meIP (:method < name <> ( param +) << body-form *)
+This syntax creates a static slot called
 .meta name
-is instantiated, the slot
-.meta init-form -s
-are evaluated in the original lexical environment where the struct
-was defined, and their values are used to initialize the corresponding
-slots.
+which is initialized with an anonymous function.
+The anonymous function is created during the
+evaluation of the
+.code defstruct
+form. The function takes the arguments specified
+by the
+.meta param
+symbols, and its body consists of the
+.metn body-form -s.
+There must be at least one
+.metn param .
+When the function is invoked as a method, as intended,
+the leftmost
+.meta param
+receives the structure instance. Methods are invoked
+using the
+.code instance.(name arg ...)
+syntax, which implicitly inserts the instance into the argument list.
+
+.meIP (:function < name <> ( param *) << body-form *)
+This syntax creates a static slot called
+.meta name
+which is initialized with an anonymous function.
+The anonymous function is created during the
+evaluation of the
+.code defstruct
+form. The function takes the arguments specified
+by the
+.meta param
+symbols, and its body consists of the
+.metn body-form -s.
+This specifier differs from
+.code :method
+only in one respect: there may be zero
+parameters. A structure function defined this way is
+intended to be used as a utility function which doesn't
+receive the structure instance as an argument.
+Such functions are called using the
+.code instance.[name arg ...]
+syntax which doesn't insert the instance name into
+the argument list.
+
+.RE
+.PP
 
 The slot names given in a
 .code defstruct
 must all be unique among themselves, but they
 may match the names of existing slots in the
 .meta super
-base type. In this case, the effect is that those slots are (still) inherited
+base type.
+
+A given structure type can have only one slot under a given
+symbolic name.  If a newly specified  slot matches the name of an existing slot
+in the
 .meta super
-and not introduces as new slots. However, the newly specified
-.metn init-form -s
-apply to these inherited slots. When the a struct of type
-.meta name
-is instantiated, its inherited slots will be first initialized as if it
-were of type
-.metn super .
-Then its own
-.metn init-form -s
-take effect. Any of these forms which are specified for inherited slots
-simply overwrite the values of those inherited slots.
-Finally, regardless of how they are initialized, slots are overwritten with
-arguments from the initialization itself
-(passed via the
-.code new
-macro or the
-.code make-struct
-function).
+type or that type's chain of ancestors, it is called a
+.IR "repeated slot" .
+
+A repeated slot inherits initialization forms from all of its ancestors.
+
+The kind of the repeated slot (static or instance) is not inherited; it
+is established by the
+.code defstruct
+and may be different from the type of the same-named slot in the
+supertype or its ancestors.
+
+A repeated slot only inherits the initializations which correspond to
+its kind. If a repeated slot is introduced as a static slot, then
+all of the static initializations in the ancestry chain are performed
+on that slot, which takes place during the evaluation of the
+.code defstruct
+form. If that slot is an instance slot in any of the
+ancestor structure types, their initializations do not apply and are not
+evaluated.
+
+If a repeated slot is introduced as an instance slot then none of the static
+initializations in the ancestry chain are performed on it; none of the forms
+are evaluated. Those initializations target a static slot, which the derived
+type doesn't have.  When an instance of the structure is created, then the
+instance initializations are performed on that slot from all of the ancestor
+structure types in which that slot is also an instance slot.
 
 The structure name is specified using two forms, plain
 .meta name
@@ -18022,9 +18149,9 @@ in a function slot.
   (defstruct (counter key) nil
     key
     (count 0)
-    (increment (lambda (self key)
-                 (if (eq self.key key)
-                   (inc self.count)))))
+    (:method increment (self key)
+      (if (eq self.key key)
+        (inc self.count))))
 
   ;; pass all atoms in tree to func
   (defun map-tree (tree func)
@@ -18046,7 +18173,8 @@ in a function slot.
 
 .coNP Function @ make-struct-type
 .synb
-.meti (make-struct-type < name < super < slots < initfun << boactor )
+.meti (make-struct-type < name < super < static-slots < slots
+.meti \ \   < static-initfun < initfun << boactor )
 .syne
 .desc
 The
@@ -18071,13 +18199,25 @@ a symbol which names a struct type, or else
 indicating that the newly created struct type has no supertype.
 
 The
+.meta static-slots
+argument is a list of symbol which specify static slots.
+The symbols must be bindable and the list must not contain duplicates.
+
+The
 .meta slots
-argument is a list of symbols which specifies the slots.
-The symbols must be bindable and the list must not contain
-duplicates. The new struct type's effective list of slots is formed by appending
-.meta slots
-to the list of the supertype's slots, and de-duplicating the resulting list as
-if by the
+argument is a list of symbols which specifies the instance slots.
+The symbols must be bindable and there must not be any duplicates
+within the list, or against entries in the
+.meta static-slots
+list.
+
+The new struct type's effective list of slots is formed by appending
+together
+.meta static-slots
+and
+.metn slots,
+and then appending that to the list of the supertype's slots, and
+de-duplicating the resulting list as if by the
 .code uniq
 function. Thus, any slots which are already present in the supertype are
 removed. If the structure has no supertype, then the list of supertype
@@ -18091,10 +18231,26 @@ and
 .metn boactor .
 
 The
+.meta static-initfun
+argument either specifies an initialization function, or is
+.codn nil ,
+which is equivalent to specifying a function which does nothing.
+
+If specified, this function must
+accept one argument. When the structure type is created (before
+the
+.code make-struct-type
+function returns) all of the
+.meta static-initfun
+functions in the chain of supertype ancestry are invoked, in
+order of inheritance. Each is passed the structure type as an argument. The
+purpose is to initialize the static slots.
+
+The
 .meta initfun
 argument either specifies an initialization function, or is
 .codn nil ,
-which is equivalent to specifying a default function which does nothing.
+which is equivalent to specifying a function which does nothing.
 If specified, this function must
 accept one argument. When a structure is instantiated, every
 .meta initfun
@@ -18240,6 +18396,10 @@ and has the same slot values.
 The creation of a duplicate does not involve calling any of the
 struct type's initialization functions.
 
+Only instance slots participate in the duplication. Since
+the original structure and copy are of the same structure type,
+they already share static slots.
+
 .coNP Accessor @ slot
 .synb
 .mets (slot < struct-obj << slot-name )
@@ -18339,6 +18499,145 @@ Note: the
 macro is an alternative interface which is suitable if
 the slot name isn't a computed value.
 
+.coNP Function @ slot-p
+.synb
+.mets (slot-p < type << name )
+.syne
+.desc
+The
+.code slot-p
+function returns
+.code t
+if name
+.meta name
+is a symbol which names a slot in the structure type
+.metn type .
+Otherwise it returns
+.codn nil .
+
+The
+.meta type
+argument must be a structure type, or else a symbol
+which names a structure type.
+
+.coNP Function @ static-slot-p
+.synb
+.mets (static-slot-p < type << name )
+.syne
+.desc
+The
+.code static-slot-p
+function returns
+.code t
+if name
+.meta name
+is a symbol which names a slot in the structure type
+.metn type ,
+and if that slot is a static slot.
+Otherwise it returns
+.codn nil .
+
+The
+.meta type
+argument must be a structure type, or else a symbol
+which names a structure type.
+
+.coNP Function @ static-slot
+.synb
+.mets (static-slot < type << name )
+.syne
+.desc
+The
+.code static-slot
+function retrieves the value of the static slot
+named by symbol
+.meta name
+of the structure type
+.metn type .
+
+The
+.meta type
+argument must be a structure type, and
+.meta name
+must be a static slot of this type.
+
+.coNP Function @ static-slot-set
+.synb
+.mets (static-slot-set < type < name << new-value )
+.syne
+.desc
+The
+.code static-slot-set
+function stores
+.meta new-value
+into the static slot named by symbol
+.meta name
+of the structure type
+.metn type .
+
+It returns
+.metn new-value .
+
+The
+.meta type
+argument must be a structure type, and
+.meta name
+must be a static slot of this type.
+
+.coNP Function @ call-super-method
+.synb
+.mets (call-super-method < struct-obj < name << argument *)
+.syne
+.desc
+The
+.code call-super-method
+retrieves the function stored in the slot
+.meta name
+of the supertype of
+.meta struct-obj
+and invokes it, passing to that function
+.meta struct-obj
+as the leftmost argument, followed by the given
+.metn argument -s,
+if any.
+
+The
+.meta struct-obj
+argument must be of structure type. Moreover,
+that structure type must be derived from another structure type,
+and
+.meta name
+must name a static slot of that structure type.
+
+The object retrieved from that static slot must be
+callable as a function, and accept the arguments.
+
+.coNP Function @ call-super-fun
+.synb
+.mets (call-super-fun < type < name << argument *)
+.syne
+.desc
+The
+.code call-super-method
+retrieves the function stored in the slot
+.meta name
+of the supertype of
+.meta type
+and invokes it, passing to that function the given
+.metn argument -s,
+if any.
+
+The
+.meta type
+argument must be a structure type. Moreover,
+that structure type must be derived from another structure type,
+and
+.meta name
+must name a static slot of that structure type.
+
+The object retrieved from that static slot must be
+callable as a function, and accept the arguments.
+
 .SS* Sequence Manipulation
 .coNP Function @ seqp
 .synb