7

Common Lisp (64 ビット Debian GNU/Linux の SBCL 1.1.5) でマルチアーキテクチャ アセンブラ/逆アセンブラを作成しています。現在、アセンブラは x86-64 のサブセットに対して正しいコードを生成します。x86-64 アセンブリ コードをアセンブルするために、ハッシュ テーブルを使用します。このテーブルでは、"jc-rel8"およびなどのアセンブリ命令ニーモニック (文字列)"stosb"が、以下のような 1 つ以上のエンコーディング関数のリストを返すキーです。

(defparameter *emit-function-hash-table-x64* (make-hash-table :test 'equalp))
(setf (gethash "jc-rel8" *emit-function-hash-table-x64*) (リスト #'jc-rel8-x86))
(setf (gethash "stosb" *emit-function-hash-table-x64*) (リスト #'stosb-x86))

エンコーディング関数は次のようになります (ただし、一部はより複雑です)。

(defun jc-rel8-x86 (arg1 &rest args)
  (jcc-x64 #x72 arg1))

(defun stosb-x86 (&rest args)
  (リスト #xaa))

現在、 NASM (NASM 2.11.06) の命令エンコード データ (ファイルinsns.dat) を Common Lisp CLOS 構文に変換して、完全な x86-64 命令セットを取り込もうとしています。これは、バイナリコードを発行するために使用される通常の関数 (上記の関数など) をカスタムx86-asm-instructionクラスのインスタンス (これまでのところ非常に基本的なクラスで:initarg、:reader、:initformなどで 20 スロットほど) に置き換えることを意味しemit、引数を持つメソッドが使用されます。指定された命令 (ニーモニック) と引数のバイナリ コードを出力します。変換された命令データは次のようになります (ただし、40,000 行を超え、正確には 7193make-instanceと 7193setfです)。

;; 最初のニーモニック + オペランドの組み合わせインスタンス (:is-variant t)。
;; NASM の insns.dat から生成された x86-64 のインスタンスは 4928 あります。

(eval-when (:compile-toplevel :load-toplevel :execute)

(setf Jcc-imm-near (make-instance 'x86-asm-instruction
:name "Jcc"
:operands "imm|near"
:code-string "[i: odf 0f 80+c rel]"
:arch-flags (リスト "386" "BND")
:is-バリアント t))

(setf STOSB-void (make-instance 'x86-asm-instruction
:name "STOSB"
:オペランド「無効」
:code-string "[ aa]"
:arch-flags (リスト "8086")
:is-バリアント t))

;; 次に、コンテナ インスタンスを含む (または代わりに参照できる)
;; 各命令の可能なバリアント。
;; NASM の insns.dat から生成された x86-64 には、そのようなインスタンスが 2265 あります。

(setf Jcc (make-instance 'x86-asm-instruction
                         :name "Jcc"
                         :is-container t
                         :variants (リスト Jcc-imm-near
                                         Jcc-imm64-near
                                         Jcc-imm-ショート
                                         Jcc-imm
                                         Jcc-imm
                                         Jcc-imm
                                         Jcc-imm)))

(setf STOSB (make-instance 'x86-asm-instruction
                           :name "STOSB"
                           :is-container t
                           :variants (リスト STOSB-void)))

;; ここにはさらに何千ものオブジェクトが...

) ; このブラケットは閉じます (eval-when (:compile-toplevel :load-toplevel :execute)

insns.dat単純な Perl スクリプトを使用して (上記のように) NASM を Common Lisp 構文に変換しました (以下では、スクリプト自体に興味深いものはありません)。原則として、それは機能します。動作しますが、これらの 7193 オブジェクトのコンパイルは非常に遅く、一般的にヒープの枯渇を引き起こします。16G のメモリを搭載した Linux Core i7-2760QM ラップトップでは、(eval-when (:compile-toplevel :load-toplevel :execute)上記のような 7193 個のオブジェクトを含むコード ブロックのコンパイルに 7 分以上かかり、次のようなヒープの枯渇を引き起こすことがあります。

;; Swank はポート 4005 で開始されました。
* ガベージ コレクション中にヒープが使い果たされました: 0 バイトが使用可能で、32 バイトが要求されました。
 Gen StaPg UbSta LaSta LUbSt Boxed Unboxed LB LUB !move Alloc Waste Trig WP GCs Mem-age
   0: 0 0 0 0 0 0 0 0 0 0 41943040 0 0 0.0000
   1: 0 0 0 0 0 0 0 0 0 0 41943040 0 0 0.0000
   2: 0 0 0 0 0 0 0 0 0 0 41943040 0 0 0.0000
   3: 38805 38652 0 0 49474 15433 389 416 0 2144219760 9031056 1442579856 0 1 1.5255
   4: 127998 127996 0 0 45870 14828 106 143 199 1971682720 25428576 2000000 0 0 0.0000
   5: 0 0 0 0 0 0 0 0 0 0 2000000 0 0 0.0000
   6: 0 0 0 0 1178 163 0 0 0 43941888 0 2000000 985 0 0.0000
   割り当てられた合計バイト数 = 4159844368
   動的スペース サイズ バイト = 4194304000
GC 制御変数:
   *GC-INHIBIT* = true
   *GC-PENDING* = 進行中
   *STOP-FOR-GC-PENDING* = false
SBCL pid 9994 (tid 46912556431104) で致命的なエラーが発生しました:
ヒープが尽きた、ゲームオーバー。

Lisp ランタイム環境用の低レベル デバッガである LDB へようこそ。
ldb>

--dynamic-space-size 4000SBCL をコンパイルするにはパラメーターを追加する必要がありましたが、それでも 4 ギガバイトの動的スペース ヒープを割り当てた後でも、使い果たされることがあります。ヒープの枯渇が解決されたとしても、クラス (これらのインスタンスに使用されるクラス) にスロットを追加しただけで 7193 個のインスタンスをコンパイルするのに 7 分以上かかるのは'x86-asm-instruction、REPL での対話型開発には長すぎます (それが重要な場合はslimvを使用します)。 .

(time (compile-file出力は次のとおりです。

; キャッチされた 18636 警告状態


; insns.fasl 書かれた
; コンパイルは 0:07:11.329 で終了しました
評価にかかった時間:
  431.329 秒のリアルタイム
  238.317000 秒の合計実行時間 (234.972000 ユーザー、3.345000 システム)
  [実行時間は、6.073 秒の GC 時間と 232.244 秒の非 GC 時間で構成されます。]
  55.25% の CPU
  50,367 フォームを解釈
  784,044 個のラムダが変換されました
  1,031,842,900,608 プロセッサ サイクル
  19,402,921,376 バイトを消費

OOP (CLOS) を使用すると、命令ニーモニック (jcまたはstosb上記、など)、命令の:name許可されたオペランド ( :operands)、命令のバイナリ エンコーディング ( 、 など#xaa) stosb、:code-stringおよび命令の可能なアーキテクチャ制限 ( :arch-flags) を 1 つのオブジェクトに組み込むことができます。しかし、少なくとも私の 3 年前のコンピューターは、約 7000 個の CLOS オブジェクト インスタンスをすばやくコンパイルするには効率的ではないようです。

私の質問は: SBCL をmake-instance高速化する方法はありますか、それとも上記の例のように通常の関数でアセンブリ コードの生成を維持する必要がありますか? また、他の可能な解決策についても教えていただければ幸いです。

念のため、Perl スクリプトを次に示します。

#!/usr/bin/env perl
use strict;
use warnings;

# this program converts NASM's `insns.dat` to Common Lisp Object System (CLOS) syntax.

my $firstchar;
my $line_length;
my $are_there_square_brackets;
my $mnemonic_and_operands;
my $mnemonic;
my $operands;
my $code_string;
my $flags;
my $mnemonic_of_current_mnemonic_array;

my $clos_object_name;
my $clos_mnemonic;
my $clos_operands;
my $clos_code_string;
my $clos_flags;

my @object_name_array = ();
my @mnemonic_array = ();
my @operands_array = ();
my @code_string_array = ();
my @flags_array = ();

my @each_mnemonic_only_once_array = ();

my @instruction_variants_array = ();
my @instruction_variants_for_current_instruction_array = ();

open(FILE, 'insns.dat');

$mnemonic_of_current_mnemonic_array = "";

# read one line at once.
while (<FILE>)
{
    $firstchar = substr($_, 0, 1);
    $line_length = length($_);
    $are_there_square_brackets = ($_ =~ /\[.*\]/);
    chomp;
    if (($line_length > 1) && ($firstchar =~ /[^\t ;]/))
    {
        if ($are_there_square_brackets)
        {
            ($mnemonic_and_operands, $code_string, $flags) = split /[\[\]]+/, $_;
            $code_string = "[" . $code_string . "]";
            ($mnemonic, $operands) = split /[\t ]+/, $mnemonic_and_operands;
        }
        else
        {
            ($mnemonic, $operands, $code_string, $flags) = split /[\t ]+/, $_;
        }
        $mnemonic =~ s/[\t ]+/ /g;
        $operands =~ s/[\t ]+/ /g;
        $code_string =~ s/[\t ]+/ /g;
        $flags =~ s/[\t ]+//g;

        # we don't want non-x86-64 instructions here.
        unless ($flags =~ "NOLONG")
        {
            # ok, the content of each field is now filtered,
            # let's convert them to a suitable Common Lisp format.
            $clos_object_name = $mnemonic . "-" . $operands;

            # in Common Lisp object names `|`, `,`, and `:` must be escaped with a backslash `\`,
            # but that would get too complicated.
            # so we'll simply replace them:
            # `|` -> `-`.
            # `,` -> `.`.
            # `:` -> `.`.
            $clos_object_name =~ s/\|/-/g;              
            $clos_object_name =~ s/,/./g;              
            $clos_object_name =~ s/:/./g;              

            $clos_mnemonic    = "\"" . $mnemonic . "\"";
            $clos_operands    = "\"" . $operands . "\"";
            $clos_code_string = "\"" . $code_string . "\"";

            $clos_flags = "\"" . $flags . "\"";        # add first and last double quotes.
            $clos_flags =~ s/,/" "/g;                  # make each flag its own Common Lisp string.
            $clos_flags = "(list " . $clos_flags. ")"; # convert to `list` syntax.

            push @object_name_array, $clos_object_name;
            push @mnemonic_array, $clos_mnemonic;
            push @operands_array, $clos_operands;
            push @code_string_array, $clos_code_string;
            push @flags_array, $clos_flags;

            if ($mnemonic eq $mnemonic_of_current_mnemonic_array)
            {
                # ok, same mnemonic as the previous one,
                # so the current object name goes to the list.
                push @instruction_variants_for_current_instruction_array, $clos_object_name;
            }
            else
            {
                # ok, this is a new mnemonic.
                # so we'll mark this as current mnemonic.
                $mnemonic_of_current_mnemonic_array = $mnemonic;
                push @each_mnemonic_only_once_array, $mnemonic;

                # we first push the old array (unless it's empty), then clear it,
                # and then push the current object name to the cleared array.

                if (@instruction_variants_for_current_instruction_array)
                {
                    # push the variants array, unless it's empty.
                    push @instruction_variants_array, [ @instruction_variants_for_current_instruction_array ];
                }
                @instruction_variants_for_current_instruction_array = ();
                push @instruction_variants_for_current_instruction_array, $clos_object_name;
            }
        }
    }
}

# the last instruction's instruction variants must be pushed too.
if (@instruction_variants_for_current_instruction_array)
{
    # push the variants array, unless it's empty.
    push @instruction_variants_array, [ @instruction_variants_for_current_instruction_array ];
}

close(FILE);

# these objects need be created already during compilation.
printf("(eval-when (:compile-toplevel :load-toplevel :execute)\n");

# print the code to create each instruction + operands combination object.

for (my $i=0; $i <= $#mnemonic_array; $i++)
{
    $clos_object_name = $object_name_array[$i];
    $mnemonic         = $mnemonic_array[$i];
    $operands         = $operands_array[$i];
    $code_string      = $code_string_array[$i];
    $flags            = $flags_array[$i];

    # print the code to create a variant object.
    # each object here is a variant of a single instruction (or a single mnemonic).
    # actually printed as 6 lines to make it easier to read (for us humans, I mean), with an empty line in the end.
    printf("(setf %s (make-instance 'x86-asm-instruction\n:name %s\n:operands %s\n:code-string %s\n:arch-flags %s\n:is-variant t))",
        $clos_object_name,
        $mnemonic,
        $operands,
        $code_string,
        $flags);
    printf("\n\n");
}

# print the code to create each instruction + operands combination object.

# for (my $i=0; $i <= $#each_mnemonic_only_once_array; $i++)
for my $i (0 .. $#instruction_variants_array)
{
    $mnemonic = $each_mnemonic_only_once_array[$i];

    # print the code to create a container object.
    printf("(setf %s (make-instance 'x86-asm-instruction :name \"%s\" :is-container t :variants (list \n", $mnemonic, $mnemonic);
    @instruction_variants_for_current_instruction_array = $instruction_variants_array[$i];

    # for (my $j=0; $j <= $#instruction_variants_for_current_instruction_array; $j++)
    for my $j (0 .. $#{$instruction_variants_array[$i]} )
    {
        printf("%s", $instruction_variants_array[$i][$j]);

        # print 3 closing brackets if this is the last variant.
        if ($j == $#{$instruction_variants_array[$i]})
        {
            printf(")))");
        }
        else
        {
            printf(" ");
        }
    }

    # if this is not the last instruction, print two newlines.
    if ($i < $#instruction_variants_array)
    {
        printf("\n\n");
    }
}

# print the closing bracket to close `eval-when`.
print(")");

exit;
4

1 に答える 1

10

18636 警告は非常に悪いように見えます。すべての警告を取り除くことから始めます。

EVAL-WHEN私はその周りをすべて取り除くことから始めます。私にはあまり意味がありません。ファイルを直接ロードするか、ファイルをコンパイルしてロードします。

(setf STOSB-void ...)また、SBCL は変数が未定義の場合を好まないことに注意してください。新しい最上位変数はDEFVARまたはで導入されDEFPARAMETERます。SETFそれらを設定するだけで、定義はしません。それは警告を取り除くのに役立つはずです。

また:is-container t、:is-variant tこれらのプロパティは、継承元のクラスに変換する必要があるようです (たとえば、ミックスインとして)。コンテナにはバリアントがあります。バリアントにはバリアントがありません。

于 2014-11-24T00:26:19.130 に答える