#28 copy-objectがgcで回収されない？

[Kei Okada]

話の始まりはhttps://sourceforge.net/p/jsk-ros-pkg/tickets/158/ですが調べてみると
https://sourceforge.net/p/jsk-ros-pkg/code/HEAD/tree/trunk/euslisp/test/coords.l
のようにmake-cascoordsを繰り返すだけでメモリが増えていきます．
さらに調べると，以下の用のcopy-objectを使わないとメモリは増えて行きません．

copy-objectがなにかまずいことになっていますでしょうか？

Index: jskeus/eus/lisp/l/coordinates.l
===================================================================
--- jskeus/eus/lisp/l/coordinates.l (リビジョン 642)
+++ jskeus/eus/lisp/l/coordinates.l (作業コピー)
@@ -547,8 +547,9 @@
     (setf manager self
      changed t ;safer
      worldcoords   ;prepare a world-coordinates holder
-     (instance coordinates :init :rot (copy-object rot)
-                     :pos (copy-object pos)))
+     (instance coordinates :init :rot (matrix (matrix-row rot 0) (matrix-row rot 1) (matrix-row rot 2)) ;(copy-object rot)
+                     :pos (float-vector (elt pos 0) (elt pos 1) (elt pos 2)) ; (copy-object pos)
+                                      ))
     (if par (send par :assoc self at)) 
     self)
 )

[Kei Okada]

やはりcopy-objectしたオブジェクトがちゃんと回収されていない気がします．euslisp/test/object.lにテストプログラムがありますので，腕に自信がある人は見てくれると助かります．

[Yohei Kakiuchi]

原因はわかりました。
copy-objectの中で、mark_lockしていて、
コピーの最中にメモリが足りなくなって、gc出来なくて、メモリを拡張する
という流れです。
対処療法的には、copy-objectがをする前にgcすると大丈夫だと思われます。

根本的な対処方法は、
作戦１：ロックしないようにする
gc用のマークを循環参照しないためのフラグのように使っているのが
コピー中にgcしてほしくない理由に見える。
コピー用のフラグを足すか、使っていないextraなどを使ってコピーすると
コピー中にgcが起きても問題ないかもしれない。

作戦２：コピー中にgcが起こるか事前に調べる
オブジェクトのサイズ等からgcが起こりそうか判定する。
単純にオブジェクトのサイズだけからgcするか決まるわけではなく、
スロット変数のコピーなども行われるのですべてのチェックは
結構複雑になると思われる。

pointer COPYOBJ(ctx,n,argv)
register context *ctx;
int n;
pointer argv[];
{ pointer a=argv[0],b;
  pointer *spsave=ctx->vsp;
  ckarg(1);
#if THREADED
  mutex_lock(&mark_lock);
#endif
  cpx=0;
  cpvec= ctx->vsp;
  //fprintf(stderr, "%lx %lx\n", a, cpvec[0]);                                                                   
  if ((b=(pointer)eussetjmp(cpyjmp))==0) b=copyobj(ctx,a); 
  copyunmark(a);
  ctx->vsp=spsave;
#if THREADED
  mutex_unlock(&mark_lock);
#endif
  ctx->vsp=spsave;
  if (b==(pointer)ERR) error(E_USER,(pointer)"too big to copy");
  else return(b);
  }

[Kei Okada]

なるほど．
一つ思うのは，テストプログラムでメモリがどんどん増加しますね．
以下で見ると内側のiのループ中はメモリがどんどん確保されていくのはよいとして，
jのループに入るとgcｄされて，j=0,1,2でもループの開始時にmarkされているメモリの数は
同じではないでしょうか？つまり，j=0でメモリが増やされるのはいいとして，そのときのi
のループがおわれば，無駄につくったオブジェクトは全部gcして解法されるので，
j=1のなかではj=0の最後につくられたメモリの容量で足りるんではないでしょうか？
なぜj!=0のループでもメモリが増えるのか？というのがどうなっているのでしょうか？

   (dotimes (j 5)                                                                                                  
    (dotimes (i i-max)                                                                                             
      (setq a (list 10 20 30 40 50 60 70 80 90 100))                                                               
      (setq b (copy-object a))                                                                                     
      (unless (equal a b)                                                                                          
        (assert nil (format nil "(equal ~A ~A) ~A" a b i))))                                                       
    (print (sys::gc) *error-output*)      

[Yohei Kakiuchi]

この場合は、iのループの中でgcが起っていないわけではないです。
iのループの中でゴミが溜まっていって、gcが起こるタイミングがcopy-object
の中だったらメモリの拡張が行われるので、確保されるメモリがiのループ全体分
よりも少なくなります。

以下のようにすると、jのループの中ではメモリの追加確保は行われないはずです。

(setq ret nil)
(dotimes (i i-max)
  (setq a (list 10 20 30 40 50 60 70 80 90 100))
  (setq b (copy-object a))
  (push a ret)
  (push b ret))
(setq ret nil)
(print (sys::gc) *error-output*)
(dotimes (j 10)
  (dotimes (i i-max)
    (setq a (list 10 20 30 40 50 60 70 80 90 100))
    (setq b (copy-object a))
    (unless (equal a b)
      (assert nil (format nil "(equal ~A ~A) ~A" a b i))))
  (print (sys::gc) *error-output*))

[tnakaoka]

copyobjの中ではh.pmarkを使ってmarkしていますが、
eus.hによるとgcが使用しているのはh.markのようです。

GCがpmarkを使っていない場合に、コピー中にGCしてほしくない理由としては、
完全にコピーできていないセルが勝手にGCされてしまうのを防ぎたい、という意図がありそうです。
これはコピー中のセルをどのタイミングでも誰かが必ず参照しているようにコピーできれば良さそうですが、できないでしょうか。
セルを作った瞬間にmarkが走るとGCされてしまうでしょうか。

[Yohei Kakiuchi]

pmarkだったら、gcとは競合しないですね。
未検証ですが、問題ありそうなところとしては、
スタックを巧みに使ってコピー元を更新しながら、循環参照を防いでいる。
コピー後にスタックから書き戻しているということをしています。
gcでスタックが変にならなければ（多分大丈夫）問題ないように思います。

スレッドセーフとかの問題もありそうですけど、そもそも、copy-objectはロックしなくても
スレッドセーフじゃないような気がする。
とりあえず、ロックを外して動くか確認するのかな。

[Kei Okada]

とりあえず簡単なスレッドのテストコードをeuslisp/test/object.lに追加しましたが，
mutex_lock(&mark_lock);
をコメントアウトするとやはりsegmentation faultしますね．
ところで，いまさらですが
(equal (make-cube 100 100 100) (make-cube 100 100 100))
するとsegmentation faultするんですが，これって常識でしょうか・

[Yohei Kakiuchi]

(equal (make-cube 100 100 100) (make-cube 100 100 100))
は循環参照のようです。equalは循環参照を考慮していないように見えます。
bodyのmanagerスロットが自身になっているので、ここで循環しているようです。

知りませんでしたが、最近の変更とは関係なさそうなので、
これまでもそうだったのだと思われます。

[tnakaoka]

pmarkとmarkは関係なく、copyobjの中でGCが動いてもよさそうなので、pmarkを使う関数同士だけがロックしあうように、
pmarkを使っていそうなところのロックをmark_lockからp_mark_lockに変更してみました。
ソースにはp_mark_lockを使っていた痕跡がありますが、現在はコメントアウトされているようです。

これでobject.lのテストは通るようになっていますが、デッドロックの危険などがあるかもしれません。
スレッドのテストなどありますでしょうか。

Index: leo.c
===================================================================
--- leo.c   (リビジョン 643)
+++ leo.c   (作業コピー)
@@ -636,7 +636,7 @@
   pointer *spsave=ctx->vsp;
   ckarg(1);
 #if THREADED
-  mutex_lock(&mark_lock);
+  mutex_lock(&p_mark_lock);
 #endif
   cpx=0;
   cpvec= ctx->vsp;
@@ -644,7 +644,7 @@
   copyunmark(a);
   ctx->vsp=spsave;
 #if THREADED
-  mutex_unlock(&mark_lock);
+  mutex_unlock(&p_mark_lock);
 #endif
   ctx->vsp=spsave;
   if (b==(pointer)ERR) error(E_USER,(pointer)"too big to copy");
Index: printer.c
===================================================================
--- printer.c   (リビジョン 643)
+++ printer.c   (作業コピー)
@@ -618,14 +618,14 @@
   if (Spevalof(PRCIRCLE)!=NIL) {
     ixvec=ctx->vsp; ix=0; vpush(0);
 #if THREADED
-    mutex_lock(&mark_lock);
+    mutex_lock(&p_mark_lock);
     mark_locking="prinx";
 #endif
     printmark(ctx,obj);
     prin1(ctx,obj,stream,iprlevel);
     printunmark(obj);
 #if THREADED
-    mutex_unlock(&mark_lock);
+    mutex_unlock(&p_mark_lock);
 #endif
     }
   else prin1(ctx,obj,stream,iprlevel);
Index: sysfunc.c
===================================================================
--- sysfunc.c   (リビジョン 643)
+++ sysfunc.c   (作業コピー)
@@ -293,13 +293,13 @@
   if (n==2) count_symbol=(argv[1]!=NIL); else count_symbol=0;
   cell_count=object_size=cell_size=0;
 #if THREADED
-  mutex_lock(&mark_lock);
+  mutex_lock(&p_mark_lock);
   mark_locking="OBJSIZE";
 #endif
   objsize1(a);
   objsize2(a);
 #if THREADED
-  mutex_unlock(&mark_lock);
+  mutex_unlock(&p_mark_lock);
 #endif
   return(cons(ctx,makeint(cell_count),
          cons(ctx,makeint(object_size),
Index: mthread_posix.c
===================================================================
--- mthread_posix.c (リビジョン 643)
+++ mthread_posix.c (作業コピー)
@@ -484,6 +484,7 @@
     thread_table[0].using = 1;

     pthread_mutex_init(&mark_lock, NULL);
+    pthread_mutex_init(&p_mark_lock, NULL);
     pthread_mutex_init(&alloc_lock, NULL);
     pthread_mutex_init(&free_thread_lock, NULL);
     pthread_mutex_init(&qthread_lock, NULL);
Index: eus_thr.h
===================================================================
--- eus_thr.h   (リビジョン 643)
+++ eus_thr.h   (作業コピー)
@@ -144,7 +144,7 @@
 extern mutex_t  mark_lock;
 extern char     *mark_locking;
 extern int      mark_lock_thread;
-//extern mutex_t  p_mark_lock;
+extern mutex_t  p_mark_lock;
 extern rwlock_t gc_lock;

 extern mutex_t  alloc_lock;
Index: mthread.c
===================================================================
--- mthread.c   (リビジョン 643)
+++ mthread.c   (作業コピー)
@@ -25,6 +25,7 @@
 mutex_t mark_lock;
 char *mark_locking;
 int mark_lock_thread;
+mutex_t p_mark_lock;

 pointer get_free_thread()

[Kei Okada]

奥が深そうなので，とりあえず，cascoods の:init メソッドはcopy-matrix, copy-seqを使って書き直しました．
https://sourceforge.net/p/euslisp/code/644/