Merge chise-0_23-1-r21-4-18.

[chise/xemacs-chise.git.1] / src / concord.c

diff --git a/src/concord.c b/src/concord.c
index bc468f1..81c6469 100644 (file)
--- a/src/concord.c
+++ b/src/concord.c
@@ -35,6 +35,7 @@ EXFUN (Fread_from_string, 3);
 
 EXFUN (Fconcord_decode_object, 4);
 EXFUN (Fconcord_object_put, 3);
+EXFUN (Fconcord_object_get, 2);
 
 Lisp_Object Qconcord;
 Lisp_Object Qconcord_object;
@@ -42,6 +43,7 @@ Lisp_Object Qgenre, Q_id;
 
 Lisp_Object Vconcord_ds_hash_table;
 Lisp_Object Vconcord_genre_hash_table;
+Lisp_Object Vconcord_genre_object_hash_table;
 
 
 typedef struct Lisp_CONCORD_DS Lisp_CONCORD_DS;
@@ -417,6 +419,33 @@ DEFINE_LRECORD_IMPLEMENTATION ("concord_object", concord_object,
                               concord_object_description,
                               Lisp_CONCORD_Object);
 
+static Lisp_Object
+concord_genre_cache_get_object (Lisp_Object genre, Lisp_Object id)
+{
+  Lisp_Object obj_hash;
+  
+  obj_hash = Fgethash (genre, Vconcord_genre_object_hash_table, Qunbound);
+  if (UNBOUNDP (obj_hash))
+    return Qunbound;
+  return Fgethash (id, obj_hash, Qunbound);
+}
+
+static Lisp_Object
+concord_genre_cache_put_object (Lisp_Object genre, Lisp_Object id,
+                               Lisp_Object object)
+{
+  Lisp_Object obj_hash;
+
+  obj_hash = Fgethash (genre, Vconcord_genre_object_hash_table, Qunbound);
+  if (UNBOUNDP (obj_hash))
+    {
+      obj_hash
+       = make_lisp_hash_table (256, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
+      Fputhash (genre, obj_hash, Vconcord_genre_object_hash_table);
+    }
+  return Fputhash (id, object, obj_hash);
+}
+
 DEFUN ("concord-make-object", Fconcord_make_object, 1, 3, 0, /*
 Make and return a Concord-object from ID and GENRE.
 Optional argument DS specifies the data-source of the GENRE.
@@ -424,47 +453,52 @@ Optional argument DS specifies the data-source of the GENRE.
        (genre, id, ds))
 {
   Lisp_CONCORD_DS* lds;
-  char* genre_name;
+  Lisp_Object genre_string;
+  char* genre_name_str;
   CONCORD_Genre c_genre;
   Lisp_CONCORD_Object* lcobj;
   Lisp_Object retval;
 
+  if (!NILP (id))
+    {
+      retval = concord_genre_cache_get_object (genre, id);
+      if (!UNBOUNDP (retval))
+       {
+         return retval;
+       }
+    }
   if (NILP (ds))
     ds = Fconcord_genre_ds (genre);
   CHECK_CONCORD_DS (ds);
   lds = XCONCORD_DS (ds);
   if (lds->ds == NULL)
     return Qnil;
-  if ( !STRINGP(genre) )
-    genre = Fsymbol_name (genre);
-  TO_EXTERNAL_FORMAT (LISP_STRING, genre,
-                     C_STRING_ALLOCA, genre_name,
+  if ( STRINGP(genre) )
+    genre_string = genre;
+  else
+    genre_string = Fsymbol_name (genre);
+  TO_EXTERNAL_FORMAT (LISP_STRING, genre_string,
+                     C_STRING_ALLOCA, genre_name_str,
                      Qfile_name);
-  c_genre = concord_ds_get_genre (lds->ds, genre_name);
+  c_genre = concord_ds_get_genre (lds->ds, genre_name_str);
   if (c_genre == NULL)
     return Qnil;
-#if 0
-  if (!NILP (id))
-    {
-      retval = Fconcord_decode_object (Q_id, id, genre, ds);
-      if (!NILP (retval))
-       return retval;
-    }
-#endif
   lcobj = allocate_concord_object ();
   lcobj->genre = c_genre;
   lcobj->id = id;
   XSET_CONCORD_OBJECT (retval, lcobj);
-#if 0
   if (!NILP (id))
     {
       struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 
       GCPRO4 (retval, id, genre, ds);
-      Fconcord_object_put (retval, Q_id, id);
+      concord_genre_cache_put_object (genre, id, retval);
+#if 1
+      if (!EQ (Fconcord_object_get (retval, Q_id), id))
+       Fconcord_object_put (retval, Q_id, id);
+#endif
       UNGCPRO;
     }
-#endif
   return retval;
 }
 
@@ -545,7 +579,9 @@ Optional argument DS specifies the data-source of the GENRE.
   status = concord_index_strid_get_obj_string (c_index, strid, &st_id);
   if (!status)
     {
-      GCPRO3 (genre, ds, obj);
+      Lisp_Object retval;
+
+      GCPRO4 (genre, ds, obj, retval);
 #if 0
       obj = read_from_c_string (CONCORD_String_data (&st_id),
                                CONCORD_String_size (&st_id) );
@@ -556,8 +592,9 @@ Optional argument DS specifies the data-source of the GENRE.
                                      Qfile_name),
                                     Qnil, Qnil));
 #endif
+      retval = Fconcord_make_object (genre, obj, ds);
       UNGCPRO;
-      return Fconcord_make_object (genre, obj, ds);
+      return retval;
     }
   return Qnil;
 }
@@ -668,7 +705,8 @@ Store a VALUE of OBJECT's FEATURE.
       CONCORD_INDEX c_index
        = concord_genre_get_index (c_genre, feature_name);
 
-      status = concord_index_strid_put_obj (c_index, c_value, c_obj);
+      concord_index_strid_put_obj (c_index, c_value, c_obj);
+      concord_index_sync (c_index);
     }
   return Qt;
 }
@@ -754,6 +792,7 @@ func_for_each_object (CONCORD_String object_id,
                      CONCORD_Feature feature,
                      CONCORD_String value)
 {
+  struct gcpro gcpro1, gcpro2, gcpro3;
   Lisp_Object obj, val, ret;
 
 #if 0
@@ -766,9 +805,11 @@ func_for_each_object (CONCORD_String object_id,
                                  Qfile_name),
                                 Qnil, Qnil));
 #endif
+  GCPRO1 (obj);
   obj = Fconcord_make_object (for_each_object_closure->genre,
                              obj,
                              for_each_object_closure->ds);
+  UNGCPRO;
 #if 0
   val = read_from_c_string (CONCORD_String_data (value),
                            CONCORD_String_size (value) );
@@ -779,7 +820,9 @@ func_for_each_object (CONCORD_String object_id,
                                  Qfile_name),
                                 Qnil, Qnil));
 #endif
+  GCPRO3 (obj, val, ret);
   ret = call2 (for_each_object_closure->function, obj, val);
+  UNGCPRO;
   for_each_object_closure->ret = ret;
   return !NILP (ret);
 }
@@ -793,6 +836,7 @@ When the FUNCTION returns non-nil, it breaks the repeat.
 */
        (function, feature, genre, ds))
 {
+  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
   Lisp_CONCORD_DS* lds;
   char* genre_name;
   CONCORD_Genre c_genre;
@@ -829,7 +873,12 @@ When the FUNCTION returns non-nil, it breaks the repeat.
   for_each_object_closure->genre = genre;
   for_each_object_closure->ds = ds;
   for_each_object_closure->ret = Qnil;
+  GCPRO4 (for_each_object_closure->function,
+         for_each_object_closure->genre,
+         for_each_object_closure->ds,
+         for_each_object_closure->ret);
   concord_feature_foreach_obj_string (c_feature, func_for_each_object);
+  UNGCPRO;
   /* return Qt; */
   return for_each_object_closure->ret;
 }
@@ -851,6 +900,8 @@ concord_name_validate (Lisp_Object keyword, Lisp_Object value,
 static int
 concord_object_validate (Lisp_Object data, Error_behavior errb)
 {
+  struct gcpro gcpro1, gcpro2, gcpro3;
+  Lisp_Object retval;
   Lisp_Object valw = Qnil;
   Lisp_Object genre = Qnil;
   Lisp_Object oid = Qnil;
@@ -882,7 +933,10 @@ concord_object_validate (Lisp_Object data, Error_behavior errb)
       return 0;
     }
 
-  if (NILP (Fconcord_make_object (genre, oid, Qnil)))
+  GCPRO3 (genre, oid, retval);
+  retval = Fconcord_make_object (genre, oid, Qnil);
+  UNGCPRO;
+  if (NILP (retval))
     {
       maybe_signal_simple_error_2 ("No such Concord-object",
                                   oid, genre, Qconcord_object, errb);
@@ -965,4 +1019,8 @@ vars_of_concord (void)
   staticpro (&Vconcord_genre_hash_table);
   Vconcord_genre_hash_table
     = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
+
+  staticpro (&Vconcord_genre_object_hash_table);
+  Vconcord_genre_object_hash_table
+    = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
 }