calling setq in action server callback never returns

[furushchev]

I created a server written in euslisp:

;; test-ac.l                                                                                                     
;; Author: Yuki Furuta <[email protected]>                                                      

(ros::load-ros-manifest "actionlib_tutorials")

(defparameter *init-pos* nil)

(defun ac-cb (server goal)
  (let ((res (send server :result)))
    (ros::ros-warn "callback")
    (setq *init-pos* 1)
    (ros::ros-warn "callback end")
    (return-from ac-cb
      (send server :set-succeeded res))))

(ros::roseus "ac_server")

(setq *server*
      (instance ros::simple-action-server :init
                "/fibonacci"
                actionlib_tutorials::FibonacciAction
                :execute-cb #'ac-cb)))
(ros::rate 10)
(while
 (ros::ok)
 (send *server* :worker)
 (ros::spin-once)
 (ros::sleep))

and called the server:

(ros::load-ros-manifest "actionlib_tutorials")
(ros::roseus "fibonacci_client")
(setq *c* (instance ros::simple-action-client :init
                            "fibonacci" actionlib_tutorials::FibonacciAction)))
(send *c* :wait-for-server)
(setq goal (instance actionlib_tutorials::FibonacciActionGoal :init))
(send goal :goal :order order)
(send *c* :send-goal goal)
(send *c* :wait-for-result)

But the server never return the result.

$ roseus ~/test-ac.l 
configuring by "/opt/ros/indigo/share/euslisp/jskeus/eus//lib/eusrt.l"
;; readmacro ;; object ;; packsym ;; common ;; constants ;; stream ;; string ;; loader ;; pprint ;; process ;; hashtab ;; array ;; mathtran ;; eusdebug ;; eusforeign ;; coordinates ;; tty ;; history ;; toplevel ;; trans ;; comp ;; builtins ;; par ;; intersection ;; geoclasses ;; geopack ;; geobody ;; primt ;; compose ;; polygon ;; viewing ;; viewport ;; viewsurface ;; hid ;; shadow ;; bodyrel ;; dda ;; helpsub ;; eushelp ;; xforeign ;; Xdecl ;; Xgraphics ;; Xcolor ;; Xeus ;; Xevent ;; Xpanel ;; Xitem ;; Xtext ;; Xmenu ;; Xscroll ;; Xcanvas ;; Xtop ;; Xapplwin 
;; pixword ;; RGBHLS ;; convolve ;; piximage ;; pbmfile ;; image_correlation ;; oglforeign ;; gldecl ;; glconst ;; glforeign ;; gluconst ;; gluforeign ;; glxconst ;; glxforeign ;; eglforeign ;; eglfunc ;; glutil ;; gltexture ;; glprim ;; gleus ;; glview ;; toiv-undefined ;; fstringdouble irtmath irtutil irtc irtgeoc irtgraph pgsql irtgeo euspqp pqp irtscene irtmodel irtdyna irtrobot irtsensor irtbvh irtcollada irtpointcloud irtx eusjpeg euspng png irtimage irtglrgb 
;; extending gcstack 0x6585dc0[16374] --> 0x69baa50[32748] top=3d1c
irtgl irtglc irtviewer 
EusLisp 9.23( 1.1.0) for Linux64 created on ip-172-31-23-158(Mon Mar 13 06:38:31 PDT 2017)
roseus ;; loading roseus("1.6.3") on euslisp((9.23 ip-172-31-23-158 Mon Mar 13 06:38:31 PDT 2017  1.1.0))
eustf roseus_c_util [ INFO] [1511711974.773332333]: ;; Received Goal 1511711974722640640_/fibonacci_client_1511711974401044576_23702_fibonacci_0
[ WARN] [1511711974.872933055]: callback
# Here "callback end" is never displayed
^C^Z

Is it a bug or a right behavior?
@k-okada @YoheiKakiuchi

(The code for server works if (setq *init-pos* 1) is removed.)

[furushchev]

I found a workaround of this problem just by changing #' to ', though I completely do not have any idea why it works.:

(setq *server*
      (instance ros::simple-action-server :init
                "/fibonacci"
                actionlib_tutorials::FibonacciAction
-                :execute-cb #'ac-cb)))
+                :execute-cb 'ac-cb)))

Do you know the reason?

[furushchev]

related? #251

[Naoki-Hiraoka]

同様の症状が出ました。

action serverは使っていませんが、

setqを使う関数かlambdaに、
#'をつけて、
別のファイルやクラス内で、
シンボルにsetqしたものに対し、
funcallをすると
Segmentation Faultになりました。
再現性はありませんが、letを使ったりPCを再起動したりするうちに、Segmentation Faultになる代わりにnever returnになったこともありました。

simple-action-serverのコード内でも上記と同じ処理をしているので、

jsk_roseus/roseus/euslisp/actionlib.l

Line 268 in 35a5042

(if (and goal execute-cb) (funcall execute-cb self goal))

(funcall execute-cb self goal)が怪しいと思います。

↓エラーにならない例

(print "1")

(setq func1 #'(lambda (x) (setq *a* 1)))
(funcall func1 1)

(print "2")

(defun func2 (x) (setq *a* x))
(setq function #'func2)
(funcall function 1)

(print "3")

結果

mech-user@test1-pc:~/catkin_ws/src/jisyupro/memo$ roseus ./temp8.l
configuring by "/opt/ros/kinetic/share/euslisp/jskeus/eus//lib/eusrt.l"
;; readmacro ;; object ;; packsym ;; common ;; constants ;; stream ;; string ;;\
loader ;; pprint ;; process ;; hashtab ;; array ;; mathtran ;; eusdebug ;; eus\
foreign ;; coordinates ;; tty ;; history ;; toplevel ;; trans ;; comp ;; builti\
ns ;; par ;; intersection ;; geoclasses ;; geopack ;; geobody ;; primt ;; compo\
se ;; polygon ;; viewing ;; viewport ;; viewsurface ;; hid ;; shadow ;; bodyrel\
;; dda ;; helpsub ;; eushelp ;; xforeign ;; Xdecl ;; Xgraphics ;; Xcolor ;; Xe\
us ;; Xevent ;; Xpanel ;; Xitem ;; Xtext ;; Xmenu ;; Xscroll ;; Xcanvas ;; Xtop\
;; Xapplwin
connected to Xserver DISPLAY=:0
X events are being asynchronously monitored.
;; pixword ;; RGBHLS ;; convolve ;; piximage ;; pbmfile ;; image_correlation ;;\
oglforeign ;; gldecl ;; glconst ;; glforeign ;; gluconst ;; gluforeign ;; glxc\
onst ;; glxforeign ;; eglforeign ;; eglfunc ;; glutil ;; gltexture ;; glprim ;;\
gleus ;; glview ;; toiv-undefined ;; fstringdouble irtmath irtutil irtc irtgeo\
c irtgraph pgsql irtgeo euspqp pqp irtscene irtmodel irtdyna irtrobot irtsensor\
irtbvh irtcollada irtpointcloud irtx eusjpeg euspng png irtimage irtglrgb
;; extending gcstack 0x4dea9d0[16374] --> 0x5265760[32748] top=3d1c
irtgl irtglc irtviewer
EusLisp 9.23( 1.1.0) for Linux64 created on ip-172-30-1-103(Sat Nov 4 18:28:33 \
								PST 2017)
roseus ;; loading roseus("1.6.3") on euslisp((9.23 ip-172-30-1-103 Sat Nov 4 18\
:28:33 PST 2017  1.1.0))
eustf roseus_c_util "1"
"2"
"3"
1.irteusgl$

↓Segmentation Faultになる例

(defclass tempclass1
  :super ros::object
  :slots (function))
(defmethod tempclass1
  (:init (x)
	 (setq function x))
  (:cb (x)
       (print function)
       (funcall function x)))

(defun func (x) (setq *a* 1))
(setq test (instance tempclass1 :init #'func))

(print "(send b :cb 1)")
(send test :cb 1)

結果

       mech-user@test1-pc:~/catkin_ws/src/jisyupro/memo$ roseus ./temp6.l
       configuring by "/opt/ros/kinetic/share/euslisp/jskeus/eus//lib/eusrt.l"
       ;; readmacro ;; object ;; packsym ;; common ;; constants ;; stream ;; string ;;\
       loader ;; pprint ;; process ;; hashtab ;; array ;; mathtran ;; eusdebug ;; eus\
       foreign ;; coordinates ;; tty ;; history ;; toplevel ;; trans ;; comp ;; builti\
       ns ;; par ;; intersection ;; geoclasses ;; geopack ;; geobody ;; primt ;; compo\
       se ;; polygon ;; viewing ;; viewport ;; viewsurface ;; hid ;; shadow ;; bodyrel\
       ;; dda ;; helpsub ;; eushelp ;; xforeign ;; Xdecl ;; Xgraphics ;; Xcolor ;; Xe\
       us ;; Xevent ;; Xpanel ;; Xitem ;; Xtext ;; Xmenu ;; Xscroll ;; Xcanvas ;; Xtop\
       ;; Xapplwin
       connected to Xserver DISPLAY=:0
       X events are being asynchronously monitored.
       ;; pixword ;; RGBHLS ;; convolve ;; piximage ;; pbmfile ;; image_correlation ;;\
       oglforeign ;; gldecl ;; glconst ;; glforeign ;; gluconst ;; gluforeign ;; glxc\
       onst ;; glxforeign ;; eglforeign ;; eglfunc ;; glutil ;; gltexture ;; glprim ;;\
       gleus ;; glview ;; toiv-undefined ;; fstringdouble irtmath irtutil irtc irtgeo\
       c irtgraph pgsql irtgeo euspqp pqp irtscene irtmodel irtdyna irtrobot irtsensor\
       irtbvh irtcollada irtpointcloud irtx eusjpeg euspng png irtimage irtglrgb
       ;; extending gcstack 0x55ac9d0[16374] --> 0x5a27760[32748] top=3d1c
       irtgl irtglc irtviewer
       EusLisp 9.23( 1.1.0) for Linux64 created on ip-172-30-1-103(Sat Nov 4 18:28:33 \
								       PST 2017)
       roseus ;; loading roseus("1.6.3") on euslisp((9.23 ip-172-30-1-103 Sat Nov 4 18\
       :28:33 PST 2017  1.1.0))
eustf roseus_c_util "(send b :cb 1)"
(lambda-closure func 22356272 0 (x) (setq *a* 1))
;; Segmentation Fault.
;; in (setq *a* 1)
;; You are still in a signal handler.
;;Try reset or throw to upper level as soon as possible.
;; code=1892612784 x=70cef980 addr=4
Fatal:

↓Segmentation Faultになる例

;;temp7_2.l
(setq func #'(lambda (x) (setq *a* x)))

;;temp7.l
(load "temp7_2.l")
(funcall func 1)

結果

mech-user@test1-pc:~/catkin_ws/src/jisyupro/memo$ mech-user@test1-pc:~/catkin_w\
s/src/jisyupro/memo$ roseus ./temp7.l
configuring by "/opt/ros/kinetic/share/euslisp/jskeus/eus//lib/eusrt.l"
;; readmacro ;; object ;; packsym ;; common ;; constants ;; stream ;; string ;;\
loader ;; pprint ;; process ;; hashtab ;; array ;; mathtran ;; eusdebug ;; eus\
foreign ;; coordinates ;; tty ;; history ;; toplevel ;; trans ;; comp ;; builti\
ns ;; par ;; intersection ;; geoclasses ;; geopack ;; geobody ;; primt ;; compo\
se ;; polygon ;; viewing ;; viewport ;; viewsurface ;; hid ;; shadow ;; bodyrel\
;; dda ;; helpsub ;; eushelp ;; xforeign ;; Xdecl ;; Xgraphics ;; Xcolor ;; Xe\
us ;; Xevent ;; Xpanel ;; Xitem ;; Xtext ;; Xmenu ;; Xscroll ;; Xcanvas ;; Xtop\
;; Xapplwin
connected to Xserver DISPLAY=:0
X events are being asynchronously monitored.
;; pixword ;; RGBHLS ;; convolve ;; piximage ;; pbmfile ;; image_correlation ;;\
oglforeign ;; gldecl ;; glconst ;; glforeign ;; gluconst ;; gluforeign ;; glxc\
onst ;; glxforeign ;; eglforeign ;; eglfunc ;; glutil ;; gltexture ;; glprim ;;\
gleus ;; glview ;; toiv-undefined ;; fstringdouble irtmath irtutil irtc irtgeo\
c irtgraph pgsql irtgeo euspqp pqp irtscene irtmodel irtdyna irtrobot irtsensor\
irtbvh irtcollada irtpointcloud irtx eusjpeg euspng png irtimage irtglrgb
;; extending gcstack 0x62159d0[16374] --> 0x6690760[32748] top=3d1c
irtgl irtglc irtviewer
EusLisp 9.23( 1.1.0) for Linux64 created on ip-172-30-1-103(Sat Nov 4 18:28:33 \
								PST 2017)
roseus ;; loading roseus("1.6.3") on euslisp((9.23 ip-172-30-1-103 Sat Nov 4 18\
:28:33 PST 2017  1.1.0))
eustf roseus_c_util ;; Segmentation Fault.
;; in (setq *a* x)
;; You are still in a signal handler.
;;Try reset or throw to upper level as soon as possible.
;; code=-865146832 x=cc6ee700 addr=4
Fatal

[YoheiKakiuchi]

以下のテストコードで問題の有り無しがはっきりするかと思います。

(defclass tempclass1
  :super ros::object
  :slots (function))

(defmethod tempclass1
  (:init (x) (setq function x))
  (:cb (x)
       (print function)
       (funcall function x))
  )
(defun func (x) (setq *a* 1))

;;
(setq test (instantiate tempclass1))
(send test :init #'func)
(print (test . function)) ;; return / (lambda-closure func 0 0 (x) (setq *a* 1))
;;
(setq test-let (let ((a (instantiate tempclass1))) (send a :init #'func) a))
(print (test-let . function)) ;; return / (lambda-closure func 30372568 0 (x) (setq *a* 1))
;;
(setq test-org (instance tempclass1 :init #'func))
(print (test-let . function)) ;; return / (lambda-closure func 30372568 0 (x) (setq *a* 1))
;;
(setq fc #'func)
(setq test-org2 (instance tempclass1 :init fc))
(print (test-org2 . function))  ;; return / (lambda-closure func 0 0 (x) (setq *a* 1))
;;

(send test :cb 1) ;; may be safe
(send test-org2 :cb 1) ;; may be safe
(send test-let :cb 1) ;; may fault
(send test-org :cb 1) ;; may fault

ここからはeusの実装の話なのですが、lambdaは以下のような構造の表現で扱われます。

(lambda-closure func xx yy args forms)

xxとyyはローレベルのポインタを表していて、xxはlet内の変数フレームを表し、
yyは。。。として、クロージャーを構成しようとしています。
ですが、letから抜けた時にxxの指している先は破棄されているようです。
なので、let内で作ったlambda式はlet内では使えますが、letの外では使えていません。
eusのバグです。何回か、違った場所で問題が起きていますが、基本はlet内で使った
#'やlambdaを外に出さないことです。

今回はinstance関数がletを使ってマクロで定義されていることが問題です。
https://github.com/euslisp/EusLisp/blob/master/lisp/l/common.l#L701-L705

(defmacro instance (cls &rest message)
  (if message
      (let ((v (gensym "INST")))
        `(let ((,v (instantiate ,cls))) (send ,v ,@message) ,v))
    `(instantiate ,cls)))

上のテストコードのtest-letのように展開されます。
マクロでの注意事項は、引数が評価されないことです。
#'funcがそのまま渡されて、instanceのlet内で評価されていて、
let内で#'を使っていることになっています。

(setq test-let (let ((a (instantiate tempclass1))) (send a :init #'func) a))
(print (test-let . function)) ;; return / (lambda-closure func 30372568 0 (x) (setq *a* 1))

なので、先に評価しておけば、問題ありません。

(setq fc #'func)
(setq test-org2 (instance tempclass1 :init fc))
(print (test-org2 . function))  ;; return / (lambda-closure func 0 0 (x) (setq *a* 1))

setqが気持ち悪い場合は、以下のように。let内のfcはfuncallの引数に渡るときに評価が終わっているので問題なし。

(funcall #'(lambda (fc) (let ((a (instantiate tempclass1))) (send a :init fc) a)) #'func)

jsk-ros-pkg/jsk_pr2eus#33
#251