[librep] Implements 'subr-structure'. Each subr now remembers the module it belongs to, and the new function

[Christopher Bratusek <chrisb src gnome org>]

commit 97b29cc7d8f87b1c29aaf04add6b5c37eb7d28c7
Author: Teika kazura <teika lavabit com>
Date:   Tue Sep 7 09:51:14 2010 +0900

    Implements 'subr-structure'.
    Each subr now remembers the module it belongs to, and the new function
    'subr-structure' returns it.
    This change is ABI incompatible. After this, you have to re-compile
    rep-gtk and sawfish in this order.
    
    It seems that struct rep_subr and rep_xsubr have to have the (almost)
    same members, because the subr lisp object is cast to both, depending
    on the need. So I added 'repv structure' to both, though one of rep_subr
    is never referred to.

 src/rep_lisp.h   |   13 ++++++++++---
 src/structures.c |    1 +
 src/symbols.c    |   27 ++++++++++++++++++++++++++-
 3 files changed, 37 insertions(+), 4 deletions(-)
---
diff --git a/src/rep_lisp.h b/src/rep_lisp.h
index 33fb8c5..0f33893 100644
--- a/src/rep_lisp.h
+++ b/src/rep_lisp.h
@@ -550,7 +550,11 @@ typedef struct rep_file_struct {
    exit (i.e. an error or throw, or ..?), should be treated as
    rep_INTERRUPTP defined below is */
 
-/* C subroutine, can take from zero to five arguments.  */
+/* C subroutine, can take from zero to five arguments.
+ * (Teika writes) it seems that `subr' lisp object is cast into
+ * pointer to both struct rep_subr and rep_xsubr, depending on the need,
+ * so they have to have the (almost) same members.
+ */
 typedef struct {
     repv car;
     union {
@@ -564,6 +568,7 @@ typedef struct {
     } fun;
     repv name;
     repv int_spec;
+    repv structure;
 } rep_subr;
 
 typedef struct {
@@ -571,6 +576,7 @@ typedef struct {
     repv (*fun)();
     repv name;
     repv int_spec;			/* put this in plist? */
+    repv structure;
 } rep_xsubr;
 
 /* If set in rep_SubrN types, it'll be passed a vector of args,
@@ -775,7 +781,7 @@ typedef struct rep_gc_n_roots {
     extern repv fsym args;						\
     rep_ALIGN_CELL(rep_xsubr ssym) = { type, (repv (*)()) fsym,		\
 				       rep_VAL(&rep_CONCAT(ssym, __name)), \
-				       rep_NULL };			\
+				       rep_NULL, rep_NULL };		\
     repv fsym args
 
 /* Same as above but with an extra arg -- an interactive-spec string. */
@@ -785,7 +791,8 @@ typedef struct rep_gc_n_roots {
     extern repv fsym args;						\
     rep_ALIGN_CELL(rep_xsubr ssym) = { type, (repv (*)()) fsym,		\
 				       rep_VAL(&rep_CONCAT(ssym, __name)), \
-				       rep_VAL(&rep_CONCAT(ssym, __int)) };\
+				       rep_VAL(&rep_CONCAT(ssym, __int)), \
+				       rep_NULL};			\
     repv fsym args
 
 /* Add a subroutine */    
diff --git a/src/structures.c b/src/structures.c
index c4d83f4..6631df6 100644
--- a/src/structures.c
+++ b/src/structures.c
@@ -1542,6 +1542,7 @@ rep_add_subr(rep_xsubr *subr, rep_bool export)
 	rep_struct_node *n = lookup_or_add (s, sym);
 	n->binding = rep_VAL (subr);
 	n->is_exported = export;
+	subr->structure = rep_structure;
     }
     return sym;
 }
diff --git a/src/symbols.c b/src/symbols.c
index 9b879d2..ad9eea7 100644
--- a/src/symbols.c
+++ b/src/symbols.c
@@ -417,7 +417,7 @@ Set the function value in the closure FUNARG to FUNCTION.
 DEFUN("closure-structure", Fclosure_structure,
       Sclosure_structure, (repv funarg), rep_Subr1) /*
 ::doc:rep.structures#closure-function::
-closure-function FUNARG
+closure-structure FUNARG
 
 Return the structure associated with the closure FUNARG.
 ::end:: */
@@ -426,6 +426,30 @@ Return the structure associated with the closure FUNARG.
     return rep_FUNARG(funarg)->structure;
 }
 
+DEFUN("subr-structure", Fsubr_structure,
+      Ssubr_structure, (repv arg), rep_Subr1) /*
+::doc:rep.structures#closure-function::
+subr-structure SUBR
+
+Return the structure associated with the subr SUBR.
+::end:: */
+{
+  /* Simple rep_DECLARE1 can't be used. Borrow rep_DECLARE1 macro
+     definition. */
+  do{
+    if(Fsubrp(arg) == Qnil){
+      rep_signal_arg_error(arg, 1);
+      return rep_NULL;
+    }
+  }while(0);
+
+  if(rep_XSUBR(arg)->structure != rep_NULL){
+    return rep_XSUBR(arg)->structure;
+  }else{
+    return Qnil;
+  }
+}
+
 DEFUN ("set-closure-structure", Fset_closure_structure,
        Sset_closure_structure, (repv closure, repv structure), rep_Subr2)
 {
@@ -1494,6 +1518,7 @@ rep_symbols_init(void)
     rep_ADD_SUBR(Sset_closure_function);
     rep_ADD_SUBR(Sclosure_name);
     rep_ADD_SUBR(Sclosurep);
+    rep_ADD_SUBR(Ssubr_structure);
     rep_pop_structure (tem);
 
     tem = rep_push_structure ("rep.structures");