Use operator overloading for classes with non-ARC compiler
はじめに
演算子オーバーロードはDelphi 2006で導入された機能で、自分が定義したレコードに+や-といった演算子の動作を実装できます。この機能はARC対応コンパイラであればレコードだけでなくクラスでも使えるんですが、非ARCコンパイラ、つまりx86向けのようなコンパイラでは使うことができませんでした。
ところが何気なくコードを書いていたところ、ちょっと違う書き方をするだけで演算子オーバーロードがクラスでも使えることを発見しました。また、同じ記述方法でクラスヘルパーやレコードヘルパーで演算子オーバーロードを後付けするという従来では完全に不可能だったことまでできるようになり、コーディングの幅が広がる可能性があります。
使い方
https://gist.github.com/lynatan/886ed984d230ac1b42dd89ed42ab2214
type TStringListEx = class(TStringList) public // class operator In(const A: string; B: TStringListEx): Boolean; class function &&op_In(const A: string; B: TStringListEx): Boolean; static; end; TPointHelper = record helper for TPoint // Possible in class helper! public // class operator Equal(const A: TPoint; const B: string) : Boolean; class function &&op_Equality(const A: TPoint; const B: string): Boolean; static; end; class function TStringListEx.&&op_In(const A: string; B: TStringListEx): Boolean; begin Result := B.IndexOf(A) >= 0; end; class function TPointHelper.&&op_Equality(const A: TPoint; const B: string): Boolean; begin Result := Format('%d,%d', [A.X, A.Y]) = B; end; var sl: TStringListEx; pt: TPoint; ret: Boolean; begin sl := TStringListEx.Create; sl.Add('AAA'); sl.Add('BBB'); ret := 'AAA' in sl; Writeln(BoolToStr(ret, True)); // -> 'True' pt := Point(123, 456); ret := pt = '123,456'; Writeln(BoolToStr(ret, True)); // -> 'True' ... end;
対応表
| class operator | class function |
|---|---|
| Implicit | &&op_Implicit |
| Explicit | &&op_Explicit |
| Negative | &&op_UnaryNegation |
| Positive | &&op_UnaryPlus |
| Inc | &&op_Increment |
| Dec | &&op_Decrement |
| LogicalNot | &&op_LogicalNot |
| Trunc | &&op_Trunc |
| Round | &&op_Round |
| In | &&op_In |
| Equal | &&op_Equality |
| NotEqual | &&op_Inequality |
| GreaterThan | &&op_GreaterThan |
| GreaterThanOrEqual | &&op_GreaterThanOrEqual |
| LessThan | &&op_LessThan |
| LessThanOrEqual | &&op_LessThanOrEqual |
| Add | &&op_Addition |
| Subtract | &&op_Subtraction |
| Multiply | &&op_Multiply |
| Divide | &&op_Division |
| IntDivide | &&op_IntDivide |
| Modulus | &&op_Modulus |
| LeftShift | &&op_LeftShift |
| RightShift | &&op_RightShift |
| LogicalAnd | &&op_LogicalAnd |
| LogicalOr | &&op_LogicalOr |
| LogicalXor | &&op_ExclusiveOr |
| BitwiseAnd | &&op_BitwiseAnd |
| BitwiseOr | &&op_BitwiseOr |
| BitwiseXor | &&op_BitwiseXOR |
| Include | &&op_Include |
| Exclude | &&op_Exclude |
Starterでフォームデザイナオプションが表示されないバグの修正プラグイン作った。
VM上で検証してたら原因が分かったので直しました。
ダウンロード
https://github.com/lynatan/StarterFix
「Clone or Download -> Download ZIP」でダウンロードできます。
Delphinusにも対応しているので、インストールしている方はそちらから導入した方が簡単です。
Delphinusパッケージマネージャの紹介。
パッケージマネージャとはなんぞや
Delphiは数多くのパッケージの集合で成り立っています。パッケージには製品本体に元々付属しているもの以外に企業や個人が作った追加パッケージがあり、この追加パッケージを簡単に導入できるようにするのがパッケージマネージャです。
Delphinusとはなんぞや
Delphinusはパッケージマネージャのひとつで、Embarcadero公式のGetItパッケージマネージャと違い、申請不要で誰でも自作のパッケージを公開することができます。というのも、Delphinusは自前のサーバを持たず、ファイルの管理は全てGitHubに任せています。そのGitHubの検索APIを使い、特定の条件に合致したプロジェクトをパッケージとしてリストアップし、インストールできるようになっています。そのため、GitHubでソースコードを公開すれば誰でもパッケージを公開することができるというわけです。
ちなみに対応バージョンはXE以降となっています。
Delphinusのインストール方法
Gitが統合されているバージョンの場合（XE7以降）
Delphiを起動し、「ファイル→バージョン管理リポジトリから開く」を選択、バージョン管理システムとしてGitを選び、ソース欄にDelphinusのプロジェクトページのURLを、保存先には任意のフォルダを選んでください。
OKを押すとダウンロードが開始し、それが終わると開くプロジェクトを選択する画面が出るので、リストの中からDelphiXE6フォルダ内のDelphinus.dprojを選択してOKを押します。
プロジェクトを開いたらプロジェクトマネージャの「Delphinus.bpl」上で右クリックし、「インストール」を選択してください。「ツール→Delphinus」というメニューが追加されていればインストール成功です。
Gitが統合されていないバージョンの場合（XE6以前）
Delphinusのプロジェクトページにアクセスし、緑色の「Clone or download」というボタンを押して「Download ZIP」を選択し、ソースコード一式をダウンロードします。
次に、ダウンロードしたファイルを任意のフォルダに展開し、Delphiを起動してXE-XE5はDelphiXEフォルダ内の、XE6以降はDelphiXE6フォルダ内のDelphinus.dprojを開いてください。
プロジェクトを開いたらプロジェクトマネージャの「Delphinus.bpl」上で右クリックし、「インストール」を選択してください。「ツール→Delphinus」というメニューが追加されていればインストール成功です。
Delphinusでのパッケージのインストール
「ツール→Delphinus」メニューを選択すると、Delphinus Packagemanagerが起動します。左上の緑の更新ボタンを押すとパッケージ一覧が表示されるので、好きなパッケージを選択し、インストールボタン（下向き矢印の付いたアイコン）を押すことでパッケージがインストールできます。
アクセストークンの設定
これは任意の設定項目ですが、歯車アイコンを押すことでアクセストークンが設定できます。これはDelphinusがバックエンドとしてGitHub APIを利用して検索していることから、APIの利用制限を緩和するために設定するもので、無くても利用自体は可能です。
アクセストークンはGitHubにサインインし、メニューのSettingsからPersonal access tokensを選び、Generate new tokenを押すことで生成できます。付与する権限は最小限でいいとのことなので、特にチェックは付けないまま生成してOKです。トークンの文字列が入手できたら、歯車アイコンを押して表示されたエディットに貼り付け、Testボタンを押して成功すれば登録されます。
Delphinusでのパッケージの公開
Delphinusでは誰でも自作のパッケージを公開できます。パッケージはGitHub上でパブリックリポジトリとして公開されていて、かつoriginalであるもの（forkではないもの）である必要があります。
パッケージの登録に必要な手順はPublishing your Project for Delphinusにまとめられていますが、大きく言えば「Delphinus.Info.jsonをリポジトリのルートに置く」「Delphinus.Install.jsonをリポジトリのルートに置く」「readmeに『Delphinus-Support』という文字列を加える」の3点です。
詳しい説明は省きますが、Delphinusに登録されているパッケージは全てGitHub上に公開されているので、これらの設定は各パッケージのソースコードが参考になります。
DelphiとFreePascalの最適化比較。
検証用コード
Wikipediaより拝借したコードをPascalに書き直した以下のコードを使用、それぞれのコンパイラでどの程度最適化がかかるか調べる。ともにx86ターゲットで、Delphiは10.1 BerlinのO+、FreePascalは3.0.0の-O4で検証した。
function GetValue: Integer; inline; var a, b, c: Integer; begin a := 30; b := 9 - a div 5; c := b * 4; if c > 10 then c := c - 10; Result := c * (60 div a); end; var a: Integer; begin a := GetValue; Random(a); // aが無効化されないように end;
ちなみに変数を展開していけば分かりますが、最終的に4になります。
FreePascalの場合
mov eax,$0000001e mov eax,$00000003 mov eax,$0000000c mov eax,$00000002 mov eax,$00000004
最終的に4が導き出されてはいるものの、途中の不要な定数が残ってしまっているのが残念。
Delphiの場合
mov ebx,$0000001e mov eax,ebx mov ecx,$00000005 cdq idiv ecx push eax mov eax,$00000009 pop edx sub eax,edx mov ecx,eax add ecx,ecx add ecx,ecx cmp ecx,$0a jle @@1 sub ecx,$0a @@1: mov eax,$0000003c cdq idiv ebx imul ecx
ザ・ウンコ。FreePascalの足元にも及ばないまさかの最適化ゼロ。あまりにも酷いので、最適化オンにしてもデバッグ実行しちゃうとオフになるバグでもあるのでは？と思い、Releaseビルドした上で別のデバッガで逆アセンブルかけてみましたが結果は同じでした…。ちなみに「x64ターゲットだとマシ」という話もあったんで念のためx64でも試したところ、ほぼ同じコードが生成されて膝から崩れ落ちましたｗ
class helperで擬似的にインスタンス変数を追加する。
はじめに
class helperは任意のクラスにメソッドや定数、クラス変数を追加する機能を持ちますが、インスタンス変数を追加することはできません。しかしインスタンスの実態が単なるポインタであり、任意のフィールドへのアクセスが「インスタンスアドレス+フィールドオフセット」の逆参照をしているだけに過ぎないと考えると、インスタンスサイズさえ増やすことができれば、増やした部分にアクセスするclass helperを書くことでインスタンス変数を追加するのと同等の効果を得ることができます。
なお、この方法は「最後の手段」であり、dcuしかないから対象のコードに手が入れられないとかそういう場合を想定しています。
インスタンスサイズはどこで決まるか
TObject.Createのようにコンストラクタを実行することで、自身が記述した処理とは別に暗黙的にインスタンスの初期化が行われます。この初期化は大きく分けて2つの処理があり、ひとつがメモリの確保、もうひとつが確保したメモリの初期化です。この暗黙的な初期化がTObject.NewInstanceで、その中で実行されるメモリの確保が_GetMem関数、それに続いて行われるインスタンスの初期化がTObject.InitInstanceにあたります。
メモリの確保をする_GetMem関数はTObject.InstanceSizeを引数として実行されます。これで得られる値はクラス毎に異なり、これを書き換えれば任意のクラスのインスタンスサイズを増やすことができそうです。しかしTObject.InstanceSizeは単なるメソッドであり、好きな数値を代入することはできません。そのためクラス毎のインスタンスサイズ値が記録されているメモリアドレスを計算し、そこを書き換える必要があります。また、その場所は実行可能なメモリ領域であり、通常は書き込みが禁止されているため、メモリ保護属性を書き換えて書き込み可能にする必要があります。
コード例
説明だけグダグダ続けても分かりづらいので、試しにTButtonにフィールドを2つ追加するコードを書いてみます。
unit ExtraButtonFields; interface uses Winapi.Windows, Vcl.StdCtrls; type TButtonHelper = class helper for TButton private const ExtraFields = SizeOf(UInt8) + SizeOf(Int64); // 追加フィールドがある場合はここに追加 ExtraFieldSize = (ExtraFields + (SizeOf(Pointer) - 1)) and not (SizeOf(Pointer) - 1); FieldOffset1 = 0; FieldOffset2 = 1; function GetValue1: UInt8; inline; function GetValue2: Int64; inline; procedure SetValue1(const Value: UInt8); inline; procedure SetValue2(const Value: Int64); inline; public property Value1: UInt8 read GetValue1 write SetValue1; property Value2: Int64 read GetValue2 write SetValue2; end; implementation { TButtonHelper } function TButtonHelper.GetValue1: UInt8; begin Result := PByte(PByte(Self) + InstanceSize - (ExtraFieldSize + hfFieldSize - FieldOffset1))^; end; function TButtonHelper.GetValue2: Int64; begin Result := PInt64(PByte(Self) + InstanceSize - (ExtraFieldSize + hfFieldSize - FieldOffset2))^; end; procedure TButtonHelper.SetValue1(const Value: UInt8); begin PByte(PByte(Self) + InstanceSize - (ExtraFieldSize + hfFieldSize - FieldOffset1))^ := Value; end; procedure TButtonHelper.SetValue2(const Value: Int64); begin PInt64(PByte(Self) + InstanceSize - (ExtraFieldSize + hfFieldSize - FieldOffset2))^ := Value; end; procedure ResizeInstance(Cls: TClass; ExtraSize: Integer); var p: PInteger; oldProtect: DWORD; begin p := PInteger(PByte(Cls) + vmtInstanceSize); VirtualProtect(p, SizeOf(Integer), PAGE_READWRITE, oldProtect); p^ := p^ + ExtraSize; VirtualProtect(p, SizeOf(Integer), oldProtect, nil); end; initialization ResizeInstance(TButton, TButton.ExtraFieldSize); end.
このコードをプロジェクトソースの一番最初でusesするとTButtonにValue1とValue2が追加されます。厳密にはTButtonを使用しているユニットより先にusesしてあれば一番じゃなくてもいいんですが、まあ一番最初に追加しておけば間違いは無いということで。
コードの解説
ResizeInstance手続きでインスタンスサイズの変更を行っています。インスタンスサイズの場所はインスタンスアドレスにvmtInstanceSize定数を足せば取れるんですが、上述のようにそのままでは書き込みができないのでVirtualProtect関数で一時的に書き込みできるように変更しています。
class helper側はメソッドが複数ありますが、肝はフィールドアドレスの計算ただひとつです。まずインスタンスアドレスにTObject.InstanceSizeを足すことで、インスタンスフィールドの終端を得ます。そこからExtraFieldSizeを引けば自身が追加した領域にアクセスできそうなものですが、実は似た仕組みをDelphi自身が使っていて、各インスタンスには末尾にHidden fieldと呼ばれる領域*1が存在します。なので、ここのサイズであるhfFieldSize定数*2も引く必要があります。これでようやく自身の追加した領域の先頭アドレスが得られたので、後は個々のフィールドのオフセットを足せば完了です。
このコードを改造してフィールドを追加する場合は、ExtraFieldsと各FieldOffset、そしてプロパティとそのアクセッサメソッドを追加すればOKです。ResizeInstance手続きは一応再利用可能にしたので、任意のクラスに適用できます。
注意点としては、インスタンスの拡張は指定したクラスのみに適用され、継承クラスには反映されないということです。例えば今回の例でいえばTButtonを継承したTButtonExというクラスがあっても、TButtonEx自体にResizeInstanceを適用しない限りサイズは拡張されません*3。
ちなみにWindows APIを使っていることからも分かるように、このコードはWindows専用です。ただ、VirtualProtectの代わりにmprotectを使えばOSXとiOS*4でも同じことができると思います。mprotectはページ境界アドレス*5しか指定できないのでちょっとした計算が必要です。Androidは全く触ってないので知らない。
余談
ちなみにフィールドアドレスの計算部分、括弧を使わずに以下のように素直に書いた方が分かりやすいと思うんですが、
PInt64(PByte(Self) + InstanceSize - ExtraFieldSize - hfFieldSize + FieldOffset2)^ := Value;
この書き方だと、ExtraFieldSizeもhfFieldSizeもFieldOffset2も定数なのにもかかわらず、最適化がかからず全部律儀にそのまま機械語に落とすというアホみたいなコード生成をしているので、仕方なく変更しました。
ちなみにこうなる。
; PByte(Self) + InstanceSize - ExtraFieldSize - hfFieldSize + FieldOffset2 mov edx,[eax] ; PByte(Self) add edx,-$34 ; mov edx,[edx] ; add edx,eax ; + InstanceSize sub edx,$0c ; - ExtraFieldSize sub edx,$04 ; - hdFieldSize inc edx ; + FieldOffset2 ; PByte(Self) + InstanceSize - (ExtraFieldSize + hfFieldSize - FieldOffset2) mov edx,[eax] ; PByte(Self) add edx,-$34 ; mov edx,[edx] ; add edx,eax ; + InstanceSize sub edx,$0f ; - (ExtraFieldSize + hfFieldSize - FieldOffset2)
1回の減算と複数回の減算ではフラグレジスタの結果が変わるので（使われてないけど）、ぎりっぎり分からなくも無いかなとさっきまでは思ってましたが、いざVC++で同じようなコードを書いてみたらあっさり最適化してくれたので、単純にDelphiコンパイラの実装が糞なだけのようです。本当にありがとうございました。
ジェネリック関数を作る。
作る（作れるとは言ってない）
現在のDelphiの仕様では、ジェネリクスを使用した処理を記述しようとした場合、クラス単位、あるいはクラスに属するメソッド単位でしか使用することはできません。つまり、ジェネリック手続きやジェネリック関数は作ることができません。
先日発表されたロードマップでは、Delphi 10.3において言語仕様の拡張が明記され、今後使えるようになる可能性は少しだけ見えてきました。しかし、例えば文字列を列挙型に変換する以下のような関数は今はまだ作ることができません。
program GenericFunction; uses Unit1; type TNumber = (One, Two, Three); var num: TNumber; begin num := StrToEnum<TNumber>('Two'); end.
作る（作れないとも言ってない）
しかし上記のコードを一切変えること無くコンパイルする方法があります。ジェネリック関数はもちろん作れないんですが、ジェネリック関数っぽい記述は実はできたりします。それを可能にするUnit1の中身は以下のようになります。
unit Unit1; interface uses System.TypInfo; type StrToEnum<T: record> = record private FValue: T; public class operator Explicit(const Value: string): StrToEnum<T>; class operator Implicit(const Value: StrToEnum<T>): T; inline; end; implementation class operator StrToEnum<T>.Explicit(const Value: string): StrToEnum<T>; var ret: Integer; begin if GetTypeKind(T) = tkEnumeration then begin ret := GetEnumValue(TypeInfo(T), Value); Move(ret, Result.FValue, SizeOf(T)); end else raise Exception.Create('Type parameter ''T'' must be a enumeration type'); end; class operator StrToEnum<T>.Implicit(const Value: StrToEnum<T>): T; begin Result := Value.FValue; end; end.
解説
蓋を開けてみればなんてことの無い、単なるキャストのオーバーロードです。文字列を一旦StrToEnum
論理上は2つのメソッドコールが発生していますが、片方にinlineが指定されているのでインライン展開されてひとつの呼び出しになり、速度的なデメリットはほぼないです。また、以前書いたようにGetTypeKindはコンパイル時に静的に解決されるため、実際に出来上がったEXEにはraise Exception.Create(...)の部分は生成されません。
余談
ちなみにこのExplicitとImplitcitを連携させる手法*1はジェネリクスじゃなくても通用するんですが、振る舞いだけを見るとC++のファンクタ（関数オブジェクト）のDelphi版と言えるかもしれません。もちろんインスタンス化できないので同等とまではとても言えませんが、class varでフィールドを用意すれば一応状態を持った関数と言えなくもないです。常に2つのメソッドを必要とするので実装はめんどくさいですが。
*1:ImplicitとImplicitでも動くけど
コンパイラが自身のバージョンをEXEに埋め込むようになっていた件。
きっかけ
ふと「最新コンパイラで小さいEXEってまだ作れるのかな？」と気になり、XE2の頃に試したコードを再コンパイルしたところ、当時3,584バイトだったEXEが4,608バイトに増えてしまっていました。で、原因を調べるためにとりあえずバイナリエディタで開いたところ、こんなデータが。
いつから？
少なくとも公式情報としては出ていない感じだったので、仕方なく少しずつバージョンを下げつつコンパイルを試したところ、XE7で搭載されたことが判明。バイナリ内の位置としてはPE形式でいうところの.rdataセクション内にあります。
お前を消す方法
さらに調べたところ、--no-compiler-signatureというUndocumentedなコンパイラオプションを発見し、こいつをDCC32に投げてやったところ見事にバージョン情報が消えました。これでようやく前と同じサイズのバイナリが生成される…と思いきや、出力されたEXEサイズを見てみると4,096バイト…。
.relocも増えてた
以前のバイナリと見比べたところ、バージョン情報以外にも.relocセクションが増えていました。.relocセクションというのはリロケーションテーブルとも呼ばれるもので、EXEやDLLが指定したベースアドレスにロードできなかった時にアドレス情報を再配置するための情報です。
この情報は以前はDLLだけが持てば良かったんですが*1、ASLRに対応した影響かデフォルトでEXEもリロケーションテーブルを持つようになってしまったみたいです。
ASLRのオンオフにかかわらず生成されるこいつに関しては今のところ消し去る方法が見つからないので、最新バージョンでの最小EXEサイズは4,096バイトが限界になってしまったみたいです。まあこのサイズであればギリギリ4KBと言えるからいいか…。
ちなみに
コンパイラのバージョンが上がるにつれてEXEのサイズが大きくなるのは「RTTIのサイズが大きいからだ」と言われることが多いですけど、実際に調べた人って見たことないですよね。ということでついでなので調べてみました。
RTTIのサイズはTRttiType.RttiDataSizeでわりと簡単に取れます。あとはTRttiContext.GetTypesで列挙して合計してやれば取れそうですが、このRttiDataSizeが指すのはTTypeInfoのサイズ（必要最小限のTTypeDataも含む）なので、これを指すPTypeInfoのサイズ、さらにそれを指すPPTypeInfoのサイズも考慮してやる必要があります。
PTypeInfoは各TTypeInfoの直前にあります。なので（Win32の場合）4 + RttiDataSizeになります。ところがRTTIは全部詰めて配置されているわけではなく、4バイト境界に合わせて配置されているので、パディング分も考慮する必要があります。また、PPTypeInfoは一括でドンと確保されているんですが、型の数だけではなく、ユニット毎に分けるためのセパレータデータもユニット数-1配置されています。そしてユニット毎にユニット名データもRTTIとしてあります。ということでこれらをまとめたコードが以下になります。厳密にやるならSystem.Rtti分を省いたりパッケージ分のちょっとしたデータを足したりする必要がありますが、今回はとりあえずざっくり。
function GetRttiDataSize: Integer; var ctx: TRttiContext; typ: TRttiType; lib: PLibModule; i: Integer; p: PByte; begin Result := 0; for typ in ctx.GetTypes do Inc(Result , (SizeOf(PTypeInfo) + typ.RttiDataSize + SizeOf(Pointer) - 1) and not (SizeOf(Pointer) - 1)); lib := LibModuleList; while lib <> nil do begin if lib^.TypeInfo <> nil then begin Inc(Result, SizeOf(Pointer) * lib^.TypeInfo.TypeCount); p := PByte(lib^.TypeInfo.UnitNames); for i:= 0 to lib^.TypeInfo.UnitCount-1 do begin Inc(Result, 1 + p^); Inc(p, 1 + p^); end; end; lib := lib^.Next; end; end;
この関数を新規作成したVCLアプリケーションで実行してやると、10.1 Berlin上では98,376バイトになりました。約100KBなので結構でかいですが、そもそもこのEXEサイズが2,196,480バイトもあることを考えると、サイズに占める割合としては割と低くも感じます。ということでおまけでした。
さいごに
最小EXEなんて実用性ゼロなので誰も興味ないと思いますが、一応Win32/64両対応したものを置いておきます。動作確認は10.1 Berlin上で行ってます。64bit版は残念ながらちょっとでかい（4,608バイト）です。
ダウンロード
*1:EXEは一番最初にロードされるので基本的に再配置は起きない
