2015年6月25日木曜日

[Emacs] org-modeの inline evaluation of named code blocks のシンタックスを無効化する

;; org-modeのバッファ中に call_XXX(...) という文字列があると
;; インラインのコードブロック実行命令として扱われるので、
;; 正規表現を置き換えることで call_XXXにマッチしないようにする。
;; http://orgmode.org/manual/Evaluating-code-blocks.html#Evaluating-code-blocks
(setq org-babel-inline-lob-one-liner-regexp "^^"
      org-babel-lob-one-liner-regexp
       (concat "\\(" org-babel-block-lob-one-liner-regexp "\\)")) 

正しい無効化の方法がわからなかったので、むりやり修正しました。

2015年6月10日水曜日

[CommonLisp]ABCLでクラスファイルを作る

jnew-runtime-classを参考にしました。
(in-package :jvm)

(defun make-empty-class-file (class-name &optional (super-name "java.lang.Object"))
  (make-class-file (make-jvm-class-name class-name)
                   (make-jvm-class-name super-name)
                   '(:public)))

(defun create-class-bytes (class-file)
  (let ((stream (sys::%make-byte-array-output-stream)))
    (write-class-file class-file stream)
    (finish-output stream)
    (sys::%get-output-stream-bytes stream)))

(defun write-class-bytes (fname bytes)
  (with-open-file (f fname :direction :output :element-type '(unsigned-byte 8))
    (let ((n (java:jarray-length bytes)))
      (dotimes (i n)
        (write-byte (mod (java:jarray-ref bytes i) 256) f)))))

(defun create-helloworld-class (class-name fname)
  (let ((class-file (make-empty-class-file class-name)))
    (let* ((string-array-class (class-array (make-jvm-class-name "java.lang.String")))
           (method (make-jvm-method "main" :void `(,string-array-class) :flags '(:public :static))))
      (class-add-method class-file method)
      (with-code-to-method (class-file method)
        (emit-getstatic "java.lang.System" "out" (make-jvm-class-name "java.io.PrintStream"))
        (emit 'ldc (pool-string "Hello,World"))
        (emit-invokevirtual "java.io.PrintStream"
                            "println"
                            `(,(make-jvm-class-name "java.lang.String"))
                            :void)
        (emit 'return))
      (finalize-class-file class-file)
      (write-class-bytes fname (create-class-bytes class-file)))))


(create-helloworld-class "AbclHelloWorld" "AbclHelloWorld.class")
> java AbclHelloWorld
Hello,World

2014年7月17日木曜日

[Common Lisp] 多次元配列に対するmap

多次元配列の各要素に対して関数を適用した結果を返すmap系関数を作成する場合、 make-arrayに:displaced-toキーワードを指定して作成したベクターに対してmap-intoを使うと簡潔に書けそうです。

(defun map-array! (fn array)
  (let ((v (make-array (array-total-size array) :displaced-to array)))
    (map-into v fn v))
  array)

(asdf:load-system :alexandria)
(map-array! #'1+ (alexandria:copy-array #2A((1 2) (3 4))))
;; => #2A((2 3) (4 5))

以下、初めて知った多次元配列関連の関数

  • row-major-aref
  • array-row-major-index

2013年12月21日土曜日

ABCLでApache POIを使う

ABCLはJVM上で動作するCommon Lisp処理系なので、Javaのライブラリが利用できます。

(require :abcl-contrib)
(require :abcl-asdf)

(asdf:defsystem apache-poi
  :components ((:mvn "org.apache.poi/poi/3.8")
               (:mvn "org.apache.poi/poi-ooxml/3.8")))

(asdf:load-system 'apache-poi)

(defpackage :test-poi
  (:use :cl :jss))

(in-package :test-poi)

(defun create-9x9 (path)
  (let* ((wb (new 'xssfworkbook))
         (sh (#"createSheet" wb)))
    (dotimes (i 9)
      (#"createRow" sh i))
    (dotimes (i 9)
      (dotimes (j 9)
        (#"setCellValue" (#"createCell" (#"getRow" sh j) i)
                         (format nil "~A" (* (1+ i) (1+ j))))))
    (#"write" wb (new 'fileoutputstream path))))

(create-9x9 "test.xlsx")

2013年12月20日金曜日

ABCLでClojureっぽい記法でJavaと連携


gistに書きました。

ABCLはJVM上で動作するCommon Lisp処理系ですが、Javaの機能を呼び出す方法が面倒くさいかんじなのでClojure風の記法でアクセスできるようにするリーダマクロを書いてみました。


2013年12月3日火曜日

はじめてのアセンブリ(Lisp編)

1 はじめに

( Lisp Advent Calendar 2013 3日目の記事です )
FortranやLispが誕生して50年以上の月日が経過した現在では、 世の大半のプログラムがCやJavaやExcel VBAといった高級言語で作られています。
多くのプログラマにとっては、もはやアセンブリは直接書く必要のないものなのかもしれません。
しかし、(たとえあまり使うことがなくても)Lispを学ぶことで悟りを得られる(らしい)ように、 アセンブリを学ぶことで普段使っているOSやコンパイラやVMが一体何をしているのかを学ぶ手助けとなるのではないかと思います。
低レイヤーもカバーするプログラマを目指して、アセンブリ言語をアセンブラでアセンブルして実行してみましょう。

2 足し算

最初にアセンブラを用意しましょう。ここ(http://ccl.clozure.com/)からダウンロードできます。
現在の最新リリースバージョンは1.9なので、以降の内容は Clozure CL 1.9 (Linux X8664) を前提とします。
アセンブリを書くための作業環境として、パッケージを作成しておきます。
(defpackage asm
  (:use :cl :ccl)
  (:import-from :ccl defx86lapfunction))

(in-package :asm)
まずは2つの整数を加算する関数を書いてみます。
1行ずつ解説もつけてみました。
;; add2という関数を定義します。
;; 引数はaとbで、それぞれレジスタarg_yとarg_zを使って渡します。
;; arg_yとarg_zはそれぞれRDIとRSIの別名です。
(defx86lapfunction add2 ((a arg_y) (b arg_z))
  ;; 引数が2つかどうかチェックします。(lapmacro)
  (check-nargs 2)
  ;; RBPをスタックに積みます(スタックフレーム作成その1)
  (pushq (% rbp))
  ;; RSPをRBPに設定(代入)します(スタックフレーム作成その2)
  (movq (% rsp) (% rbp))
  ;; 引数同士を加算してbに保存します。
  (addq (% a) (% b))
  ;; スタックフレームを復元します(BPをSPにコピー,スタックからpopした値をBPにコピー)
  (leave)
  ;; b(arg_z)に保存した値を戻り値として関数を終了します。
  (single-value-return))

;; 実行します。
(add2 1 2)
;; => 3

3 分岐

条件分岐のサンプルとして、引数が1のときに1を、それ以外の時に0を返す関数を作成します。
アセンブリの条件分岐は、cmp命令やtest命令で比較処理時に設定されるフラグを使った条件付きのジャンプ命令で行います。
(defx86lapfunction one? ((n arg_z))
  (check-nargs 1)
  (pushq (% rbp))
  (movq (% rsp) (% rbp))
  (movq (% n) (% rax))
  ;; 戻り値のデフォルト値として1(1である)を設定します。
  (movq ($ '1) (% arg_z))
  ;; RAXと測値1を比較します。
  (cmpq ($ '1) (% rax))
  ;; RAX==1の時, ENDラベルまでジャンプします。
  (je END)
  ;; (RAX!=1の時) 戻り値に0(1でない)を設定します。
  (movq ($ '0) (% arg_z))
  ;; ENDラベル
  END
  (leave)
  (single-value-return))

;; 実行
(one? 0)
;; => 0
(one? 1)
;; => 1
(one? 2)
;; => 0

4 CPUID

最後にCPUID命令を実行して情報を取得する関数を作成します。
CPUIDはEAXレジスタに取得したい情報の種類を指定して呼び出すと、EAX、EBX、ECX、EDXに情報を格納してくれる命令です。 CPUID(Wikipedia)
引数に取得する情報の種類を取り、4つのレジスタの値を返す関数を作成してみます。
なお、自由に使えるレジスタが少ないっぽいので一旦スタックに積んだりしてます。
(defx86lapfunction cpuid ((operation arg_z))
  ;; 引数の数をチェック
  (check-nargs 1)
  ;; スタックフレーム作成
  (pushq (% rbp))
  (movq (% rsp) (% rbp))
  ;; CPUIDで上書きされてしまうRBXを保存
  (pushq (% rbx))
  ;; CPUIDで取得する情報の種類をRAX(EAX)に保存
  (unbox-fixnum operation rax)
  ;; CPUID命令実行
  (cpuid)
  ;; 呼び出し結果をlispのfixnumに変換
  (box-fixnum rbx rbx)
  ;; 多値で返すためにスタックに積む(2つ目)
  (pushq (% rbx))
  ;; 退避していたRBXの値を復元
  (movq (@ 8 (% rsp)) (% rbx))
  (box-fixnum rax rax)
  ;; 多値で返すためにスタックに積む(1つ目)
  (movq (% rax) (@ 8 (% rsp)))
  (box-fixnum rcx rcx)
  ;; 多値で返すためにスタックに積む(3つ目)
  (pushq (% rcx))
  (box-fixnum rdx rdx)
  ;; 多値で返すためにスタックに積む(4つ目)
  (pushq (% rdx))
  ;; 戻り値の数を設定
  (set-nargs 4)
  ;; 関数を終了して多値を返す
  (jmp-subprim .SPnvalret))
(defun u32->str (n)
  (map 'string
       (lambda (byte) (code-char (ldb byte n)))
       (list (byte 8 0)
             (byte 8 8)
             (byte 8 16)
             (byte 8 24))))

;; 実行
(multiple-value-bind (_ ebx ecx edx) (cpuid 0)
  (format nil "~A~A~A"
          (u32->str ebx)
          (u32->str edx)
          (u32->str ecx)))
;; => "GenuineIntel"
Lisp Advent Calendar 2日目でタグの話題がありましたが、CCLはポインタにタグが付いてるタイプのLispです。 なので、Lisp側から整数の1を渡したつもりでも機械語としてはタグの分(ここでは3bit)ずれた値になってしまいます。 box/unboxはこのずれを補正するための処理で、実際には掛け算やシフトが行われています。

5 おわりに

あせんぶりとりすぷがあわさりさいきょうにみえる

6 メモ書き

  • 測値を指定する際にクオートをつけるとlispのfixnum、付けないと機械語の整数になるっぽい
  • 引数が4つ以上になるとスタックを使わなければならない
  • レジスタの別名は compiler/X86/X8664/x8664-arch.lisp で定義されている
  • (:^ lab) : label address expression
  • sar: Shift Arithmetic Right
  • lea: load effective address
  • leave: high level procedure exit (BPをSPにコピー,スタックからpopした値をBPにコピー)
  • disassembleすると出てくる (lea (@ disp (% rip)) (% fn))は、関数のポインタに関数を表すタグ(7)をつけた値をfnレジスタに設定する処理らしい。この命令のバイト数が7になることを利用しているっぽい。

2013年9月29日日曜日

[Common Lisp] 破壊的な関数

Common Lispには、戻り値を作り出すために元々の構造を破壊する関数があります。

sort、stable-sort を除く破壊的な関数には対応する非破壊的な関数があるので、基本的には非破壊版を利用しておいたほうが良さそうです。

なお、破壊的関数の先頭に付く n は non-consing の略だそうです。

詳しくは 実践Common Lispの12章 あたりを見ると良いでしょう。

非破壊的破壊的概要
sortソート
stable-sort安定ソート
reversenreverseリストの反転
appendnconcリストの結合
revappendnreconcリストの結合
butlastnbutlastリストの末尾以外取得
removedeleteシーケンスの要素削除
remove-ifdelete-if条件に一致する要素削除
remove-if-notdelete-if-not条件に一致しない要素削除
remove-duplicatesdelete-duplicates重複を削除
unionnunion和集合
intersectionnintersection積集合
set-differencenset-difference差集合
set-exclusive-ornset-exclusive-or対称差
string-capitalizenstring-capitalize単語の先頭を大文字、それ以外を小文字に変換
string-downcasenstring-downcase文字列を小文字に変換
string-upcasenstring-upcase文字列を大文字に変換
substnsubst木構造(リスト)の要素を変更
subst-ifnsubst-if木構造(リスト)の要素を変更
subst-if-notnsubst-if-not木構造(リスト)の要素を変更
sublisnsublis木構造(リスト)の要素を変更
substitutensubstituteシーケンスの要素を変更
substitute-ifnsubstitute-ifシーケンスの要素を変更
substitute-if-notnsubstitute-if-notシーケンスの要素を変更