[Message Prev][Message Next][Thread Prev][Thread Next][Message Index][Thread Index]

[MD:7096] Lisp_Object 関連コード修正



藤井です。

From: "M.Fujii" <boochang@xxxxxxxxxxxx>
Subject: Re: [MD:7087] Lisp_Object の値の妥当性の判定方法について教えてください
Date: Fri, 09 Dec 2005 07:11:00 +0900 (JST)
> > > Lisp_Object に格納されているアドレスが妥当な値であるかどうかを調べる方
> > > 法について教えてください。
(snip)
> >  あと, LispObject を何か int と非互換な型にしてうまく隠蔽した上で
> > コンパイルすると変なものを代入しようとしたときにエラーになる..とか.
> > (無理)
> 
> いつ発生するか分からないものを動的に捉えるより、静的なチェックに頼った
> 方がいいのかもしれないですね。以下の推測が正しければそれで見付かるはず
> ですし。

という訳でやってみました。

USE_LISP_UNION_TYPE というマクロを定義すると、Lisp_Object が union にな
ります。したがって Lisp_Object が整数型であることを期待するコードは全部
コンパイルエラーになります。

これを利用して整数値が Lisp_Object に不適切な形で代入されるのを検知する
ことを試みました。

上記マクロを定義した状態で emacs 本体はほぼ問題なくコンパイルができてお
りますが、Meadow 部分はかなりのエラーが発生します。殆どは Emacs コーディ
ング作法的に宜しくない記述によるものだと思われますので、とりあえず直せ
る部分は直しました。そのパッチを末尾に貼り付けておきます。

修正における疑問点、修正を放置した場所、修正の概要について以下にまとめ
ました。疑問点への回答ならびに不審な修正への指摘など宜しくお願いします。

特に問題なければ commit しようと思っています。

# make_number や XSETINT の適用漏れなど、いくつか Cygwin 環境で危険とお
# もわれるコードも見付かったのですが、それらは使用頻度が低そうなところ
# にあったのでなので、まれに mark_object で落ちる原因が解消された気がし
# ないです。

<<修正に内容に関する質問>>

0. USE_LISP_UNION_TYPE 

Meadow は上記マクロを定義した状態でビルド/実行できる必要があるのでしょ
うか?

私は、時々上記マクロを定義してコンパイルを行なって Lisp_Object と int
を混同したコードをあぶりだした方が良いのではないかと思っています。
# でも、現状では現実的ではないですが。

1. mw32_set_encoding_byte_from_charset():(mw32font.c 1130 行)

マクロ CHAR_CHARSET の返す値は整数型だと思うのですが、変数 charset の型
を int にして宜しいでしょうか?また、int にして良い場合、1131 行の条件
式 NILP (charset) を !charset に変更するのは問題ないでしょうか?

2. IMMCONTEXTCAR(), IMECONTEXTCDR(), immcontext(),
   Fw32_ime_create_convert_agent(), Fw32_ime_get_composition_string()
   (mw32ime.c)

Lisp_Object に整数値をそのまま代入していましたので、make_number() を使
うようにしました。この変更自体は問題ないと思っているのですが、これらの
インタフェースはどうやって動作を確認すれば良いのでしょうか?

# これらのインタフェースは、かつて elisp で IME を操作するインタフェー
# スの作成を試みたが、完成していない or 結局使われていないといった印象
# を受けます。

3. EXFUN でビルトイン関数を宣言すべき場所はどこですか。

ビルトイン関数を extern 関数として外部から呼び出すためには EXFUN で宣言
する必要があります。なくても通常コンパイルエラーにはならないので、
Meadow の関連のコードにはそのような関数が幾つか見受けられました。

今は基本的に必要とされる C ソースの宣言部に挿入しているのですが、本来は
何処に置くべきでしょうか?grep したところ EXFUN による宣言の多くは
lisp.h にありますが、全てではなく、一部は C ソースの宣言部にありました。

4. x_rgb_names():mw32fns.c
一箇所 Qnil を返しているところがありますが、他は CLR_INVALID を返してい
ます。Qnil を返しているところも CLR_INVALID を返すのが正しいのではない
でしょうか?

5. x-show-tip():mw32fns.c
try_window の第 3 引数は 0 なのではないでしょうか。

<<コードに問題は見付かったが、直せなかった or 直さなかった部分>>

6. Portable dumper 

Portable dumper は Lisp_Object が整数型であることを前提にしていますので、
コンパイルが全く通りません。

また、sizeof (Lisp_Object) <= sizeof (long) であることを期待しているは
ずですが、USE_LISP_UNION_TYPE を定義すると sizeof (Lisp_Object) >
sizeof (int) となるので、データ構造的にも見直しが必要になります。

Portable dumper を変更するのは今回の主旨からはずれますし、そもそも私に
は出来ないので、ここはそのままにしています。

7. mw32menu.c: add_menu_item() と mw32_menu_display_help()

ヘルプ文字列を MENUITEMINFO 構造体の dwItemData メンバに格納するために、
Lisp_Object を DWORD にキャストしています(取り出す時にはその逆)。

USE_LISP_UNION_TYPE を定義すると Win32 では sizeof (Lisp_Object) >
sizeof (DWORD) となるので、dwItemData に格納することはできません。ヘル
プ文字列を C 文字列に複製し、それ格納することにしなければならないのです
が、今回そこまでする必要はないと思っています。

8. mw32dl.c: undefsubr()

これは使われていないはずなので、直していません。

<<修正の概要>>

以下の修正を施しました。

9. Lisp_Object への整数型の代入

これを行なうと、ガベージクレクタが単なる整数値を他のオブジェクト型だと
認識し、エラーの原因となり得ます。
XSETINT や make_number を使うように変更しました。

ex)
mw32_get_bdf_font_info():mw32bdf.c(line 52) XFASTINT -> make_number
これは値が 0 なので動作には影響はありません。

10. 値の間違いらしきもの

コンパイルエラーが出ていれば、その場で正しい値に修正されていたと思われ
ますが、出ないのでそのままといった感じのコードが見受けられました。
(質問 4, 5 など)

11. Lisp_Object と整数値の混乱

Lisp_Object への整数型の代入以外にも Lisp_Object と整数型の扱いで混乱が
見られます。値が化けたりする可能性がありますが、致命的な問題には直結し
ないと思われます。

XINT などを使うようにしました。

12. Lisp_Object 値の直接比較

Lisp_Object 値を直接比較しているコードがいくつかありました。EQ を使うよ
うに変更しています。

# 修正時に条件が逆になっている可能性がないとは言えませんので、ある意味
# 要注意な修正です。

13. Lisp_Object 値が真偽値として用いられている

Lisp_Object の変数が制御文の条件式にそのまま用いられています。
適宜 NILP() や !NILP を適用するよう変更しました。

# 修正時に条件が逆になっている可能性がないとは言えませんので、ある意味
# 要注意な修正です。

14. ビルトイン関数のプロトタイプ宣言漏れ

DEFUN で定義したビルトイン関数は、他のファイルから呼び出す場合には
EXFUN で宣言するようになっているのですが、宣言がなくてもコンパイルエラー
にはならないので、結構宣言漏れがあります。

なお、ビルトイン関数でないものでも宣言漏れがありました。

15. ビルトイン関数定義における仮引数の型の記述漏れ

仮引数の型が Lisp_Object であることが記述されていないビルトイン関数がか
なり見受けられました。

K&R なスタイルで引数が Lisp_Object であることを宣言しないといけないので
すが、宣言もれがかなりありました。

--
藤井 正行 / Masayuki FUJII

---- ここから
Index: sysdep.c
===================================================================
--- sysdep.c	(revision 4002)
+++ sysdep.c	(working copy)
@@ -2742,7 +2742,11 @@
 		buf[i] &= ~0x80;
 	    }
 
+#ifdef MEADOW
+	  e.code = buf[i];
+#else
 	  XSETINT (e.code, buf[i]);
+#endif
 	  kbd_buffer_store_event (&e);
 	  /* Don't look at input that follows a C-g too closely.
 	     This reduces lossage due to autorepeat on C-g.  */
Index: xfaces.c
===================================================================
--- xfaces.c	(revision 4002)
+++ xfaces.c	(working copy)
@@ -593,6 +593,16 @@
 extern void free_frame_menubar P_ ((struct frame *));
 #endif /* USE_X_TOOLKIT */
 
+#ifdef MEADOW
+extern Lisp_Object vga_stdcolor_name P_ ((int));
+extern Lisp_Object mw32_list_fonts P_ ((struct frame *, Lisp_Object, int,
+					int));
+					
+extern Lisp_Object display_x_get_resource P_ ((Display_Info *, Lisp_Object, 
+					       Lisp_Object, Lisp_Object,
+					       Lisp_Object));
+#endif
+
 #endif /* HAVE_WINDOW_SYSTEM */
 
 
Index: mw32term.c
===================================================================
--- mw32term.c	(revision 4002)
+++ mw32term.c	(working copy)
@@ -287,6 +287,10 @@
 /* If non-nil inhibit frame relocation in mw32_calc_absolute_position() */
 int mw32_restrict_frame_position = TRUE;
 
+extern Lisp_Object mw32_create_image_blob_from_icon P_((HICON hicon));
+
+EXFUN (Finternal_get_lisp_face_attribute, 3);
+EXFUN (Funix_to_dos_filename, 1);
 
 /* Flush message queue of frame F, or of all frames if F is null.  */
 
@@ -3616,7 +3620,8 @@
 CLASS-NAME is the window class name and WINDOW-NAME is the window's title.
 Returns the dimensions as (LEFT TOP RIGHT BOTTOM) in screen coordinates,
 or nil if specified window is not found, or failed to get the position. */)
-  (class_name, window_name)
+     (class_name, window_name)
+     Lisp_Object class_name, window_name;
 {
   HWND hwnd;
   RECT rc;
@@ -3647,7 +3652,8 @@
        doc: /* Get metrics of scroll bar for WINDOW.
 Nil means selected window.
 Return value is (MIN MAX PAGE POS TRACKPOS), or nil if window has no scroll-bar. */)
-  (window)
+     (window)
+     Lisp_Object window;
 {
   struct scroll_bar *bar;
   struct window *w;
@@ -4204,7 +4210,7 @@
 
       /* If the contents of the global variable help_echo
 	 has changed, generate a HELP_EVENT.  */
-      if (help_echo_string != previous_help_echo_string ||
+      if (!EQ (help_echo_string, previous_help_echo_string) ||
 	  (!NILP (help_echo_string) && !STRINGP (help_echo_string)
 	   && f->mouse_moved))
 	{
@@ -4267,7 +4273,7 @@
     }
 
   if (! last_timeout_obj_init_p
-      || last_timeout_obj != mw32_hide_mouse_timeout)
+      || !EQ (last_timeout_obj, mw32_hide_mouse_timeout))
     {
       last_timeout_obj = mw32_hide_mouse_timeout;
       last_timeout_obj_init_p = 1;
@@ -6297,7 +6303,8 @@
        Sw32_get_system_metrics,
        1, 1, 0,
        doc: /* Retrieve system metrics. This function only calls GetSystemMetrics.  */)
-  (index)
+     (index)
+     Lisp_Object index;
 {
   Lisp_Object ret;
   CHECK_NUMBER (index);
@@ -6316,6 +6323,7 @@
 'alt...alt modifier. 'super...super modifier.
 'hyper...hyper modifier.  */)
      (key, modifier)
+     Lisp_Object key, modifier;
 {
   int virtkey;
 
@@ -6392,7 +6400,8 @@
        1, 1, 0,
        doc: /* Retrieve a key state when the previous message was received;
 not the current state. KEY is a virtual key code to get a state.  */)
-  (key)
+     (key)
+     Lisp_Object key;
 {
   int state;
   Lisp_Object ret;
@@ -6408,7 +6417,8 @@
        Sw32_get_mouse_wheel_scroll_lines,
        1, 1, 0,
        doc: /* Retrieve a number of scroll lines from delta number of mouse wheel.  */)
-  (delta)
+     (delta)
+     Lisp_Object delta;
 {
 #ifdef W32_INTELLIMOUSE
   UINT lines;
@@ -6516,7 +6526,8 @@
        Smw32_get_device_capability,
        1, 2, 0,
        doc: /* Retrieve system metrics. This function only calls GetSystemMetrics.  */)
-  (item, target)
+     (item, target)
+     Lisp_Object item, target;
 {
   HDC hdc;
   Lisp_Object ret;
@@ -6642,6 +6653,7 @@
        doc: /* return the Meadow's version in string.
 The optional argument DUMMY is not currently used.  */)
      (dummy)
+     Lisp_Object dummy;
 {
   return (build_string (MEADOW_VERSION_STRING));
 }
@@ -6757,7 +6769,8 @@
 
 This function simply calls SHGetFileInfo().  Please refer to the
 specification of the function.  */)
-  (path, attrib, retrieve)
+    (path, attrib, retrieve)
+     Lisp_Object path, attrib, retrieve;
 {
   LPCTSTR path_string;
   DWORD attribute = 0;
Index: mw32ime.c
===================================================================
--- mw32ime.c	(revision 4002)
+++ mw32ime.c	(working copy)
@@ -23,6 +23,7 @@
 #include <windows.h>
 #include "config.h"
 #include "lisp.h"
+#include "intervals.h"
 #include <imm.h>
 #ifdef IME_RECONVERSION
 #include "buffer.h"
@@ -50,10 +51,10 @@
   if (!fIME) error ("System have no IME facility.")
 
 #define IMMCONTEXTCAR(imc) \
-  (XFASTINT ((((unsigned long) (imc)) >> 16) & 0xffff))
+  (make_number ((((unsigned long) (imc)) >> 16) & 0xffff))
 
 #define IMMCONTEXTCDR(imc) \
-  (XFASTINT (((unsigned long) (imc)) & 0xffff))
+  (make_number (((unsigned long) (imc)) & 0xffff))
 
 #ifdef IME_CONTROL
 
@@ -162,6 +163,9 @@
 static int last_ime_vkeycode;
 static int last_ime_vkeymod;
 
+EXFUN (Fsubstring_no_properties, 3);
+EXFUN (Ffep_get_mode, 0);
+
 int
 mw32_ime_get_virtual_key (HWND hwnd)
 {
@@ -626,8 +630,8 @@
   if (NUMBERP (context))
     return agent[XFASTINT (context)].himc;
   else
-    return ((HIMC)((((unsigned long) (XCONS (context)->car)) << 16) |
-		   (((unsigned long) (XCONS (context)->u.cdr)) & 0xffff)));
+    return ((HIMC)((((unsigned long) (XUINT (XCONS (context)->car))) << 16) |
+		   (((unsigned long) (XUINT (XCONS (context)->u.cdr))) & 0xffff)));
 }
 
 LRESULT CALLBACK
@@ -1374,7 +1378,7 @@
 
   SendMessage (hwnd, WM_MULE_IMM_SET_STATUS, 1, 0);
 
-  return XFASTINT (i);
+  return make_number (i);
 }
 
 DEFUN ("w32-ime-destroy-conversion-agent",
@@ -1635,8 +1639,8 @@
       end_idx = start_idx + LISPY_STRING_BYTES (str);
       result = concat2 (result, str);
 
-      Fput_text_property (start_idx, end_idx, Qim_info,
-			  get_attribute_lisp_object (*aa),
+      Fput_text_property (make_number (start_idx), make_number (end_idx),
+			  Qim_info, get_attribute_lisp_object (*aa),
 			  result);
     }
 
Index: mw32reg.c
===================================================================
--- mw32reg.c	(revision 4002)
+++ mw32reg.c	(working copy)
@@ -1141,6 +1141,7 @@
        doc: /*   */
 )
      (key, name, data)
+     Lisp_Object key, name, data;
 {
   registry_key regkey;
   Lisp_Object result;
Index: lisp.h
===================================================================
--- lisp.h	(revision 4002)
+++ lisp.h	(working copy)
@@ -3234,6 +3234,9 @@
 /* Defined in xfns.c, w32fns.c, or macfns.c */
 EXFUN (Fxw_display_color_p, 1);
 EXFUN (Fx_file_dialog, 5);
+#ifdef MEADOW
+EXFUN (Fmw32_file_dialog, 5);
+#endif
 #endif /* HAVE_WINDOW_SYSTEM */
 
 /* Defined in xsmfns.c */
Index: mw32menu.c
===================================================================
--- mw32menu.c	(revision 4002)
+++ mw32menu.c	(working copy)
@@ -175,6 +175,9 @@
    needed on Motif, according to Marcus Daniels <marcus@xxxxxxxxxxxx>.  */
 
 int pending_menu_activation;
+
+EXFUN (Fkeymapp, 1);
+
 
 #ifdef USE_X_TOOLKIT
 
Index: w32inevt.c
===================================================================
--- w32inevt.c	(revision 4002)
+++ w32inevt.c	(working copy)
@@ -491,7 +491,7 @@
 	return 0;
       if (key_flag < 0)
 	*isdead = 1;
-      XSETINT (emacs_ev->code, event->uChar.AsciiChar);
+      emacs_ev->code = event->uChar.AsciiChar;
     }
 #ifdef MULE
   /* for IME */
@@ -516,7 +516,7 @@
       emacs_ev->kind = NON_ASCII_KEYSTROKE_EVENT;
 #ifdef HAVE_NTGUI
       /* use Windows keysym map */
-      XSETINT (emacs_ev->code, event->wVirtualKeyCode);
+      emacs_ev->code = event->wVirtualKeyCode;
 #else
       /*
        * make_lispy_event () now requires non-ascii codes to have
Index: mw32bdf.c
===================================================================
--- mw32bdf.c	(revision 4002)
+++ mw32bdf.c	(working copy)
@@ -349,7 +349,7 @@
 		  make_number (bdffontp->ury - bdffontp->lly));
   store_in_alist (&ret, intern ("base"),
 		  make_number (bdffontp->ury));
-  store_in_alist (&ret, intern ("overhang"), XFASTINT(0));
+  store_in_alist (&ret, intern ("overhang"), make_number (0));
   store_in_alist (&ret, intern ("relative-compose"),
 		  make_number (bdffontp->relative_compose));
   store_in_alist (&ret, intern ("default-ascent"),
Index: buffer.c
===================================================================
--- buffer.c	(revision 4002)
+++ buffer.c	(working copy)
@@ -4934,7 +4934,7 @@
 int
 pdump_global_buffer_p (Lisp_Object obj)
 {
-  return (obj == Vbuffer_defaults || obj == Vbuffer_local_symbols);
+  return EQ (obj, Vbuffer_defaults) || EQ (obj, Vbuffer_local_symbols);
 }
 #endif
 
Index: mw32fns.c
===================================================================
--- mw32fns.c	(revision 4002)
+++ mw32fns.c	(working copy)
@@ -119,6 +119,9 @@
 #if GLYPH_DEBUG
 int image_cache_refcount, dpyinfo_refcount;
 #endif
+
+EXFUN (Funix_to_dos_filename, 1);
+EXFUN (Fdos_to_unix_filename, 1);
 
 /* Error if we are not connected to X.  */
 
@@ -445,7 +448,7 @@
   len -= 4;
   colstrend = memchr (colstr, '/', len);
   if (!colstrend)
-    return Qnil;
+    return CLR_INVALID;
   redchars = (int) (colstrend - colstr);
   red = color_radix_change (colstr, redchars);
   if (red == -1) return CLR_INVALID;
@@ -2433,7 +2436,7 @@
       /* f is not current selected frame because running thread here
 	 is main thread. Use selected_frame as target frame. */
 
-      if (selected_frame)
+      if (!NILP (selected_frame))
 	{
 	  struct frame *f = XFRAME (selected_frame);
 	  LOGFONT lf = f->output_data.mw32->ime_logfont;
@@ -4438,7 +4441,7 @@
   clear_glyph_matrix (w->desired_matrix);
   clear_glyph_matrix (w->current_matrix);
   SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
-  try_window (FRAME_ROOT_WINDOW (f), pos, Qnil);
+  try_window (FRAME_ROOT_WINDOW (f), pos, 0);
 
   /* Compute width and height of the tooltip.  */
   width = height = 0;
@@ -4627,7 +4630,7 @@
 specified.  Don't let the user enter a file name in the file
 selection dialog's entry field, if MUSTMATCH is non-nil.  */)
   (prompt, dir, default_filename, mustmatch, only_dir_p)
-     Lisp_Object prompt, dir, default_filename, mustmatch;
+     Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p;
 {
   struct frame *f = SELECTED_FRAME ();
   Lisp_Object file = Qnil;
Index: process.c
===================================================================
--- process.c	(revision 4002)
+++ process.c	(working copy)
@@ -2127,7 +2127,7 @@
    extern Lisp_Object Vmw32_process_under_setup;
    Vmw32_process_under_setup = process;
 
-   if (Vprocess_connection_type != Qnil)
+   if (!EQ (Vprocess_connection_type, Qnil))
      Vmw32_process_expects_pty = 1;
    else 
      Vmw32_process_expects_pty = 0;
Index: mw32font.c
===================================================================
--- mw32font.c	(revision 4002)
+++ mw32font.c	(working copy)
@@ -964,7 +964,7 @@
   if (noerror && !STRINGP (tmpcar)) return 0;
   else CHECK_STRING (tmpcar); /* name  or path */
 
-  if (type == Qw32_logfont)
+  if (EQ (type, Qw32_logfont))
     {
       encode_logfont_name (tmpcar, NULL);
       tmpcar = CAR (tmpcdr);
@@ -1021,7 +1021,7 @@
       if (noerror && !INTEGERP (tmpcar)) return 0;
       else CHECK_NUMBER (tmpcar); /* PitchAndFamily */
     }
-  else if (type != Qbdf_font)
+  else if (!EQ (type, Qbdf_font))
     {
       if (noerror) return 0;
       else error ("undefined type of logfont %s", SDATA (SYMBOL_NAME (type)));
@@ -1127,8 +1127,8 @@
 	}
       else
 	{
-	  Lisp_Object charset = CHAR_CHARSET (c);
-	  if (NILP (charset))
+	  int charset = CHAR_CHARSET (c);
+	  if (!charset)
 	    plf->encoding.font_unit_byte = 1;
 	  else
 	    plf->encoding.font_unit_byte = CHARSET_DIMENSION (charset);
@@ -2232,7 +2232,7 @@
 /* For MW32 implementation, we don't call choose_face_font () to obtain
    the default font name.  */
 
-void set_font_frame_param (frame, lface)
+void set_font_frame_param (Lisp_Object frame, Lisp_Object lface)
 {
   struct frame *f = XFRAME (frame);
 
@@ -2400,6 +2400,7 @@
        doc: /* Add a font. NAME is a name of the font.
 ALIST is parameters to use this font.  */)
      (name, alist)
+     Lisp_Object name, alist;
 {
   CHECK_STRING (name);
   CHECK_LIST (alist);
@@ -2460,6 +2461,7 @@
        doc: /* Get the font information you specified.
 NAME is a name of the font.  */)
      (name)
+     Lisp_Object name;
 {
   int idx;
   Lisp_Object ret = Qnil;
@@ -2731,7 +2733,7 @@
   int num;
   int i;
 
-  num = Flength (candidates);
+  num = XINT (Flength (candidates));
   plc = (logfont_candidates*) xmalloc (sizeof (logfont_candidates) * num);
   pscore = (int *) xmalloc (sizeof (int) * num);
   memset (pscore, 0, sizeof (int) * num);
----- ここまで