2011年10月27日木曜日

自力で末尾再帰をループにしてみた ver C

コールスタックについて理解するためにスタックをいじって遊んでみました。

C言語で末尾再帰関数を呼び出す際にスタックを使い果たさないようにしてみます。もっとも、gccだと-O2を付けてコンパイルすると最適化がかかって勝手にループになるみたいではありますが。

関数呼び出し後のスタックに積まれている値とesp,ebpの値は以下のようになるらしいです。

...
ebp + 8 : 第1引数
ebp + 4 : リターンアドレス
ebp + 0 : 呼び出し元でのebpの値
ebp - 4 : ローカル変数
...
ebp - x : ローカル変数
このへん <- ESP

バッファオーバーフローやoff-by-oneエラーではreturn時に復帰するリターンアドレス(returnする際に移るアドレスを変える)や呼び出し元のebp(呼び出し元関数がreturnする際に移るアドレスを変える)を書き換えることでexploitしたりするようです。

#include <stdio.h>

void recur(void (*fn)(unsigned int n), unsigned int n){
unsigned int ebp = 0;
unsigned int old_ebp = 0;

__asm__("movl %%ebp, %0" : "=r" (ebp) :);

// 現在のebpが指す値が、呼び出し元関数のebpである
old_ebp = *((unsigned int *)ebp);

// fn の引き数
*((unsigned int *)(old_ebp + 8)) = n;
// fnからESPの退避などの分をずらしたアドレス
*((unsigned int *)(ebp + 4)) = (unsigned int)fn + 9;
}

void dec(unsigned int n){
char buf[256];
if(n == 0){
printf("done\n");
}else{
printf("n = %d\n", n);
recur(dec, n - 1);
}
return;
}

void dec2(unsigned int n){
char buf[256];
if(n == 0){
printf("done\n");
}else{
printf("n = %d\n", n);
dec2(n - 1);
}
return;
}

int main(void){
// decは正常終了する
dec(100000);
p// dec2はスタックを使い果たしてSEGVる
// dec2(100000);
return 0;
}

recur関数はリターンアドレスを書き換えることでreturnするときに第一引数に渡した関数へ制御を移します。

fn + 9としているのはebpのpushとespの減算分の処理を飛ばすためです。

// objdump の結果(一部)
08048480 <dec>:
8048480: 55 push %ebp
8048481: 89 e5 mov %esp,%ebp
8048483: 81 ec 28 01 00 00 sub $0x128,%esp
この定数はローカル変数の領域のサイズによって変わると思われるので、汎用性は無いです。

2011年10月20日木曜日

Emacsのヘルプ

Emacsに助けを求めるためのコマンド。

apropos,find-functionあたりはよく使ってます。

情報を表示する

describe-ほげほげコマンド。色々な情報を表示してくれます。

たくさんありそうなのでEmacsLispを書くときに使いそうなものを列挙。

- describe-bindings キーシーケンスのコマンド(Anythingが入ってると一覧表示してくれる) - describe-function 指定した関数の情報 - describe-variable 指定した変数の情報 - describe-char カーソル位置にある文字の情報(文字コードなど)

定義場所を探す

Emacs Lispの関数や変数が定義された場所を探すコマンド。

- find-function 指定した関数の定義された場所に飛ぶ - find-function-at-point カーソル位置にある関数の定義された場所に飛ぶ - find-function-other-frame find-functionの結果を別フレームに表示 - find-funciton-on-key 入力したキーシーケンスが表すコマンドの定義された場所に飛ぶ - find-variable 指定した変数の定義された場所に飛ぶ - find-variable-at-point カーソル位置にある変数の定義された場所に飛ぶ - find-variable-other-frame find-variableの結果を別フレームに表示

質問する

apropos系コマンド。

前置引数を指定すると動作を変えられるらしい。変数apropos-do-allをnil以外にセットしていると前置引数を指定したのと同じ動作になるそうです。

- apropos - apropos-command - apropos-documentation - apropos-library - apropos-variable - apropos-value

apropos-valueの検索対象は評価"後"の変数の値。

キーシーケンス

コマンドがどのキーシーケンスに割り当てられているかを探すコマンド。

- where-is

2011年10月19日水曜日

同じ単語(シンボル)をハイライト表示する(マイナーモード版)

最近LispといえばEmacsLispしか触っていません。

この間書いたカーソル位置の単語と同じ単語をハイライト表示する機能をマイナーモードにしてみました。

コードはgithubに置きました。

(require 'hl-same-symbol-mode)

;; emacs-lisp-modeで有効にしたい場合
(add-hook 'emacs-lisp-mode-hook 'hl-same-symbol-mode)

;; ハイライトするまでのアイドル時間を変更する
(setf hl-same-symbol-delay 0.10)

;; ハイライトの表示を変更する
(setf hl-same-symbol-face '何か)

2011年10月13日木曜日

同じ単語(シンボル)をハイライト表示する

EmacsのOverlayを使ってみるテスト。カーソル位置にある単語(symbol-at-pointで取得できるもの)と同じ単語をハイライト表示させます。

show-paren-modeみたいにタイマーを使ったほうが良いかも。

(eval-when-compile (require 'cl))

(defvar *hl-same-symbol::text* "")
(defvar *hl-same-symbol::list* nil)
(defvar hl-same-symbol-face 'highlight)

(defun hl-same-symbol::highlight (text)
(setf *hl-same-symbol::text* text)
;; (highlight-regexp (regexp-quote text) hl-same-symbol-face)
(let ((len (length text)))
(save-excursion
(dolist (win (window-list))
(with-current-buffer (window-buffer win)
(goto-char (window-start win))
(while (let ((pos (search-forward text nil t)))
(and pos (< (- pos len) (window-end win))))
(hl-same-symbol::highlight-internal text len)))))))

(defun hl-same-symbol::highlight-internal (text len)
(let ((sym (symbol-at-point)))
(when (and sym (equal (symbol-name sym) text))
(let ((overlay (make-overlay (- (point) len) (point))))
(overlay-put overlay 'face hl-same-symbol-face)
(push overlay *hl-same-symbol::list*)
overlay))))

(defun hl-same-symbol::unhighlight ()
;; (unhighlight-regexp (regexp-quote *hl-same-symbol::text*))
(mapcar 'delete-overlay *hl-same-symbol::list*)
(setf *hl-same-symbol::list* nil))

(defun hl-same-symbol::post-command-hook ()
(let ((sym (symbol-at-point)))
(cond
((and sym (equal (symbol-name sym) *hl-same-symbol::text*))
'nothing-to-do)
(sym
(hl-same-symbol::unhighlight)
(hl-same-symbol::highlight (symbol-name sym)))
(t
(hl-same-symbol::unhighlight)))
t))

(defun hl-same-symbol ()
(interactive)
(if (find 'hl-samey-symbol::post-command-hook post-command-hook)
(remove-hook 'post-command-hook 'hl-same-symbol::post-command-hook)
(add-hook 'post-command-hook 'hl-same-symbol::post-command-hook)))

2011年10月5日水曜日

popup.elで右クリックのようななにか

popup.elでコマンドメニューを表示させてみます。

(require 'popup)

(defvar *rclick-command-tree*)

(setf *rclick-command-tree*
`(
[org-capture "org-capture" (lambda () (featurep 'org))]
("Erlang"
[:major-mode erlang-mode]
[run-erlang "run-erlang-shell"])
("Org"
[:feature org]
[org-sparse-tree "org-sparse-tree"]
[org-schedule "org-schedule"]
[org-deadline "org-deadline"]
[org-time-stamp "org-time-stamp"])
("VC"
;; vc-annotate (C-x v g) 注釈を表示
[vc-annotate "vc-annotate"]
;; vc-diff (C-x v =) 差分を表示
[vc-diff "vc-diff"]
;; vc-dir (C-x v d) 状態を表示
[vc-dir "vc-dir"]
;; vc-print-log (C-x v l) 履歴を表示
[vc-print-log "vc-print-log"]
;; vc-register (C-x v i) ファイルを追加
[vc-register "vc-register"]
;; vc-revert (C-x v u) 修正を破棄
[vc-revert "vc-revert"]
;; vc-update (C-x v +) 後進
[vc-update "vc-update"]
;; vc-next-action (C-x v v) コミット
[vc-next-action "vc-next-action(commit)"]
;; vc-revision-other-window (C-x v ~) 過去のバージョンを表示
[vc-revision-other-window "vc-revision-other-window"])))

(defun rclick-tree-normalize (tree)
(mapcar
(lambda (s)
(typecase s
(cons (rclick-tree-normalize s))
(symbol [s (format "%s" s)])
(string s)
(vector (if (>= (length s) 2) s
[(aref s 0) (format "%s" (aref s 1))]))
(t (error "invalid tree"))))
tree))

(defun rclick-collect-test (tree)
(remove-if-not
(lambda (c)
(and (typep c 'vector)
(keywordp (aref c 0))))
tree))

(defun rclick-tree-collect (tree)
(let ((tests (rclick-collect-test tree)))
(when (every 'rclick-test tests)
(let ((result nil))
(dolist (c tree)
(cond
((and (typep c 'vector)
(not (keywordp (aref c 0))))
(when (or (<= (length c) 2)
(funcall (aref c 2)))
(push c result)))
((listp c)
(let ((children (rclick-tree-collect c)))
(when children
(push children result))))
((stringp c)
(push c result))
(t 'nothing-to-do)))
(nreverse result)))))

(defun rclick-tree->cascade-menu (tree)
(mapcar
(lambda (c)
(typecase c
(vector (format "%s" (aref c 1)))
(cons (rclick-tree->cascade-menu c))
(t c)))
tree))

(defun rclick-find (desc tree)
(dolist (c tree)
(when (and (typep c 'vector)
(string-equal desc (aref c 1)))
(return c))
(when (listp c)
(let ((tmp (rclick-find desc c)))
(when tmp
(return tmp))))))

(defun rclick-test (vec)
(apply (get (aref vec 0) 'rclick-test-function)
(cdr (coerce vec 'list))))

(defmacro define-rclick-test (key args &rest body)
`(setf (get ',key 'rclick-test-function) (lambda ,args ,@body)))

(define-rclick-test :major-mode (mode)
(eq mode major-mode))
(define-rclick-test :feature (feature)
(featurep feature))

(defun rclick-menu ()
(interactive)
(let ((tree (rclick-tree-collect
(rclick-tree-normalize *rclick-command-tree*))))
(let ((result (popup-cascade-menu (rclick-tree->cascade-menu tree))))
(when result
(let ((c (rclick-find result tree)))
(when c
(call-interactively (aref c 0))))))))

おまけ。コマンドのキーバインドを文字列で取得する方法。

(defun one-of-bindings (command)
(key-description (car (where-is-internal command))))