{**************************************************************************************************}
{                                                                                                  }
{ Project JEDI Code Library (JCL)                                                                  }
{                                                                                                  }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
{ License at http://www.mozilla.org/MPL/                                                           }
{                                                                                                  }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
{ and limitations under the License.                                                               }
{                                                                                                  }
{ The Original Code is JclCIL.pas.                                                                 }
{                                                                                                  }
{ The Initial Developer of the Original Code is Flier Lu (<flier_lu att yahoo dott com dott cn>).  }
{ Portions created by Flier Lu are Copyright (C) Flier Lu. All Rights Reserved.                    }
{                                                                                                  }
{ Contributors:                                                                                    }
{   Flier Lu (flier)                                                                               }
{   Robert Marquardt (marquardt)                                                                   }
{   Robert Rossmair (rrossmair)                                                                    }
{   Olivier Sannier (obones)                                                                       }
{   Petr Vones (pvones)                                                                            }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ Microsoft .Net CIL Instruction Set information support routines and classes.                     }
{                                                                                                  }
{ Unit owner: Flier Lu                                                                             }
{                                                                                                  }
{**************************************************************************************************}

// Last modified: $Date: 2005/05/08 08:05:53 $
// For history see end of file

unit JclCIL;

interface

{$I jcl.inc}

uses
  {$IFDEF MSWINDOWS}
  Windows, 
  {$ENDIF MSWINDOWS}
  Classes, SysUtils,
  {$IFDEF RTL130_UP}
  Contnrs,
  {$ENDIF RTL130_UP}
  JclBase, JclSysUtils, JclCLR, JclMetadata;

type
  TJclOpCode =
   (opNop, opBreak,
    opLdArg_0, opLdArg_1, opLdArg_2, opLdArg_3,
    opLdLoc_0, opLdLoc_1, opLdLoc_2, opLdLoc_3,
    opStLoc_0, opStLoc_1, opStLoc_2, opStLoc_3,
    opldArg_s, opLdArga_s, opStArg_s,
    opLdLoc_s, opLdLoca_s, opStLoc_s,
    opLdNull, opLdc_I4_M1,
    opLdc_I4_0, opLdc_I4_1, opLdc_I4_2, opLdc_I4_3, opLdc_I4_4,
    opLdc_I4_5, opLdc_I4_6, opLdc_I4_7, opLdc_I4_8, opLdc_I4_s,
    opLdc_i4, opLdc_i8, opLdc_r4, opLdc_r8,
    opUnused49,
    opDup, opPop, opJmp, opCall, opCalli, opRet,
    opBr_s, opBrFalse_s, opBrTrue_s,
    opBeq_s, opBge_s, opBgt_s, opBle_s, opBlt_s,
    opBne_un_s, opBge_un_s, opBgt_un_s, opBle_un_s, opBlt_un_s,
    opBr, opBrFalse, opBrTrue,
    opBeq, opBge, opBgt, opBle, opBlt,
    opBne_un, opBge_un, opBgt_un, opBle_un, opBlt_un,
    opSwitch,
    opLdInd_i1, opLdInd_i2, opLdInd_u1, opLdInd_u2,
    opLdInd_i4, opLdInd_u4, opLdInd_i8, opLdInd_i,
    opLdInd_r4, opLdInd_r8, opLdInd_ref, opStInd_ref,
    opStInd_i1, opStInd_i2, opStInd_i4, opStInd_i8,
    opStInd_r4, opStInd_r8,
    opAdd, opSub, opMul, opDiv, opDiv_un, opRem, opRem_un,
    opAnd, opOr, opXor, opShl, opShr, opShr_un, opNeg, opNot,
    opConv_i1, opConv_i2, opConv_i4, opConv_i8,
    opConv_r4, opConv_r8, opConv_u4, opConv_u8,
    opCallVirt, opCpObj, opLdObj, opLdStr, opNewObj,
    opCastClass, opIsInst, opConv_r_un,
    opUnused58, opUnused1,
    opUnbox, opThrow,
    opLdFld, opLdFlda, opStFld, opLdsFld, opLdsFlda, opStsFld, opStObj,
    opConv_ovf_i1_un, opConv_ovf_i2_un, opConv_ovf_i4_un, opConv_ovf_i8_un,
    opConv_ovf_u1_un, opConv_ovf_u2_un, opConv_ovf_u4_un, opConv_ovf_u8_un,
    opConv_ovf_i_un, opConv_ovf_u_un,
    opBox, opNewArr, opLdLen,
    opLdElema, opLdElem_i1, opLdElem_u1, opLdElem_i2, opLdElem_u2,
    opLdElem_i4, opLdElem_u4, opLdElem_i8, opLdElem_i,
    opLdElem_r4, opLdElem_r8, opLdElem_ref,
    opStElem_i, opStElem_i1, opStElem_i2, opStElem_i4, opStElem_i8,
    opStElem_r4, opStElem_r8, opStElem_ref,
    opUnused2, opUnused3, opUnused4, opUnused5,
    opUnused6, opUnused7, opUnused8, opUnused9,
    opUnused10, opUnused11, opUnused12, opUnused13,
    opUnused14, opUnused15, opUnused16, opUnused17,
    opConv_ovf_i1, opConv_ovf_u1, opConv_ovf_i2, opConv_ovf_u2,
    opConv_ovf_i4, opConv_ovf_u4, opConv_ovf_i8, opConv_ovf_u8,
    opUnused50, opUnused18, opUnused19, opUnused20,
    opUnused21, opUnused22, opUnused23,
    opRefAnyVal, opCkFinite,
    opUnused24, opUnused25,
    opMkRefAny,
    opUnused59, opUnused60, opUnused61, opUnused62, opUnused63,
    opUnused64, opUnused65, opUnused66, opUnused67,
    opLdToken,
    opConv_u2, opConv_u1, opConv_i, opConv_ovf_i, opConv_ovf_u,
    opAdd_ovf, opAdd_ovf_un, opMul_ovf, opMul_ovf_un, opSub_ovf, opSub_ovf_un,
    opEndFinally, opLeave, opLeave_s, opStInd_i, opConv_u,
    opUnused26, opUnused27, opUnused28, opUnused29, opUnused30,
    opUnused31, opUnused32, opUnused33, opUnused34, opUnused35,
    opUnused36, opUnused37, opUnused38, opUnused39, opUnused40,
    opUnused41, opUnused42, opUnused43, opUnused44, opUnused45,
    opUnused46, opUnused47, opUnused48,
    opPrefix7, opPrefix6, opPrefix5, opPrefix4,
    opPrefix3, opPrefix2, opPrefix1, opPrefixRef,

    opArgLlist, opCeq, opCgt, opCgt_un, opClt, opClt_un,
    opLdFtn, opLdVirtFtn, optUnused56,
    opLdArg, opLdArga, opStArg, opLdLoc, opLdLoca, opStLoc,
    opLocalLoc, opUnused57, opEndFilter, opUnaligned, opVolatile,
    opTail, opInitObj, opUnused68, opCpBlk, opInitBlk, opUnused69,
    opRethrow, opUnused51, opSizeOf, opRefAnyType,
    opUnused52, opUnused53, opUnused54, opUnused55, opUnused70);

  TJclInstructionDumpILOption =
    (doLineNo, doRawBytes, doIL, doTokenValue, doComment);
  TJclInstructionDumpILOptions = set of TJclInstructionDumpILOption;

  TJclInstructionParamType =
   (ptVoid, ptI1, ptI2, ptI4, ptI8, ptU1, ptU2, ptU4, ptU8, ptR4, ptR8,
    ptToken, ptSOff, ptLOff, ptArray);

const
  InstructionDumpILAllOption =
    [doLineNo, doRawBytes, doIL, doTokenValue, doComment];

type
  TJclClrILGenerator = class;

  TJclInstruction = class(TObject)
  private
    FOpCode: TJclOpCode;
    FOffset: DWORD;
    FParam: Variant;
    FOwner: TJclClrILGenerator;
    function GetWideOpCode: Boolean;
    function GetRealOpCode: Byte;
    function GetName: string;
    function GetFullName: string;
    function GetDescription: string;
    function GetParamType: TJclInstructionParamType;
    function FormatLabel(Offset: Integer): string;
  protected
    function GetSize: DWORD; virtual;
    function DumpILOption(Option: TJclInstructionDumpILOption): string; virtual;
  public
    constructor Create(AOwner: TJclClrILGenerator; AOpCode: TJclOpCode);
    procedure Load(Stream: TStream); virtual;
    procedure Save(Stream: TStream); virtual;
    function DumpIL(Options: TJclInstructionDumpILOptions = [doIL]): string;
    property Owner: TJclClrILGenerator read FOwner;
    property OpCode: TJclOpCode read FOpCode;
    property WideOpCode: Boolean read GetWideOpCode;
    property RealOpCode: Byte read GetRealOpCode;
    property Param: Variant read FParam write FParam;
    property ParamType: TJclInstructionParamType read GetParamType;
    property Name: string read GetName;
    property FullName: string read GetFullName;
    property Description: string read GetDescription;
    property Size: DWORD read GetSize;
    property Offset: DWORD read FOffset;
  end;

  TJclUnaryInstruction = class(TJclInstruction);

  TJclBinaryInstruction = class(TJclInstruction);

  TJclClrILGenerator = class(TObject)
  private
    FMethod: TJclClrMethodBody;
    FInstructions: TObjectList;
    function GetInstructionCount: Integer;
    function GetInstruction(const Idx: Integer): TJclInstruction;
  public
    constructor Create(AMethod: TJclClrMethodBody = nil);
    destructor Destroy; override;
    function DumpIL(Options: TJclInstructionDumpILOptions): string;
    property Method: TJclClrMethodBody read FMethod;
    property Instructions[const Idx: Integer]: TJclInstruction read GetInstruction;
    property InstructionCount: Integer read GetInstructionCount;
  end;

  EJclCliInstructionError = class(EJclError);
  EJclCliInstructionStreamInvalid = class(EJclCliInstructionError);

implementation

uses
  {$IFDEF HAS_UNIT_VARIANTS}
  Variants,
  {$ENDIF HAS_UNIT_VARIANTS}
  JclStrings, JclResources;

type
  TJclOpCodeInfoType = (itName, itFullName, itDescription);

const
  STP1 = $FE;

  OpCodeInfos: array [TJclOpCode, TJclOpCodeInfoType] of string =
   (
    ('nop',            RsCILCmdnop,         RsCILDescrnop),
    ('break',          RsCILCmdbreak,       RsCILDescrbreak),
    ('ldarg.0',        RsCILCmdldarg0,      RsCILDescrldarg0),
    ('ldarg.1',        RsCILCmdldarg1,      RsCILDescrldarg1),
    ('ldarg.2',        RsCILCmdldarg2,      RsCILDescrldarg2),
    ('ldarg.3',        RsCILCmdldarg3,      RsCILDescrldarg3),
    ('ldloc.0',        RsCILCmdldloc0,      RsCILDescrldloc0),
    ('ldloc.1',        RsCILCmdldloc1,      RsCILDescrldloc1),
    ('ldloc.2',        RsCILCmdldloc2,      RsCILDescrldloc2),
    ('ldloc.3',        RsCILCmdldloc3,      RsCILDescrldloc3),
    ('stloc.0',        RsCILCmdstloc0,      RsCILDescrstloc0),
    ('stloc.1',        RsCILCmdstloc1,      RsCILDescrstloc1),
    ('stloc.2',        RsCILCmdstloc2,      RsCILDescrstloc2),
    ('stloc.3',        RsCILCmdstloc3,      RsCILDescrstloc3),
    ('ldarg.s',        RsCILCmdldargs,      RsCILDescrldargs),
    ('ldarga.s',       RsCILCmdldargas,     RsCILDescrldargas),
    ('starg.s',        RsCILCmdstargs,      RsCILDescrstargs),
    ('ldloc.s',        RsCILCmdldlocs,      RsCILDescrldlocs),
    ('ldloca.s',       RsCILCmdldlocas,     RsCILDescrldlocas),
    ('stloc.s',        RsCILCmdstlocs,      RsCILDescrstlocs),
    ('ldnull',         RsCILCmdldnull,      RsCILDescrldnull),
    ('ldc.i4.m1',      RsCILCmdldci4m1,     RsCILDescrldci4m1),
    ('ldc.i4.0',       RsCILCmdldci40,      RsCILDescrldci40),
    ('ldc.i4.1',       RsCILCmdldci41,      RsCILDescrldci41),
    ('ldc.i4.2',       RsCILCmdldci42,      RsCILDescrldci42),
    ('ldc.i4.3',       RsCILCmdldci43,      RsCILDescrldci43),
    ('ldc.i4.4',       RsCILCmdldci44,      RsCILDescrldci44),
    ('ldc.i4.5',       RsCILCmdldci45,      RsCILDescrldci45),
    ('ldc.i4.6',       RsCILCmdldci46,      RsCILDescrldci46),
    ('ldc.i4.7',       RsCILCmdldci47,      RsCILDescrldci47),
    ('ldc.i4.8',       RsCILCmdldci48,      RsCILDescrldci48),
    ('ldc.i4.s',       RsCILCmdldci4s,      RsCILDescrldci4s),
    ('ldc.i4',         RsCILCmdldci4,       RsCILDescrldci4),
    ('ldc.i8',         RsCILCmdldci8,       RsCILDescrldci8),
    ('ldc.r4',         RsCILCmdldcr4,       RsCILDescrldcr4),
    ('ldc.r8',         RsCILCmdldcr8,       RsCILDescrldcr8),
    ('unused',         RsCILCmdunused1,     RsCILDescrunused1),
    ('dup',            RsCILCmddup,         RsCILDescrdup),
    ('pop',            RsCILCmdpop,         RsCILDescrpop),
    ('jmp',            RsCILCmdjmp,         RsCILDescrjmp),
    ('call',           RsCILCmdcall,        RsCILDescrcall),
    ('calli',          RsCILCmdcalli,       RsCILDescrcalli),
    ('ret',            RsCILCmdret,         RsCILDescrret),
    ('br.s',           RsCILCmdbrs,         RsCILDescrbrs),
    ('brfalse.s',      RsCILCmdbrfalses,    RsCILDescrbrfalses),
    ('brtrue.s',       RsCILCmdbrtrues,     RsCILDescrbrtrues),
    ('beq.s',          RsCILCmdbeqs,        RsCILDescrbeqs),
    ('bge.s',          RsCILCmdbges,        RsCILDescrbges),
    ('bgt.s',          RsCILCmdbgts,        RsCILDescrbgts),
    ('ble.s',          RsCILCmdbles,        RsCILDescrbles),
    ('blt.s',          RsCILCmdblts,        RsCILDescrblts),
    ('bne.un.s',       RsCILCmdbneuns,      RsCILDescrbneuns),
    ('bge.un.s',       RsCILCmdbgeuns,      RsCILDescrbgeuns),
    ('bgt.un.s',       RsCILCmdbgtuns,      RsCILDescrbgtuns),
    ('ble.un.s',       RsCILCmdbleuns,      RsCILDescrbleuns),
    ('blt.un.s',       RsCILCmdbltuns,      RsCILDescrbltuns),
    ('br',             RsCILCmdbr,          RsCILDescrbr),
    ('brfalse',        RsCILCmdbrfalse,     RsCILDescrbrfalse),
    ('brtrue',         RsCILCmdbrtrue,      RsCILDescrbrtrue),
    ('beq',            RsCILCmdbeq,         RsCILDescrbeq),
    ('bge',            RsCILCmdbge,         RsCILDescrbge),
    ('bgt',            RsCILCmdbgt,         RsCILDescrbgt),
    ('ble',            RsCILCmdble,         RsCILDescrble),
    ('blt',            RsCILCmdblt,         RsCILDescrblt),
    ('bne.un',         RsCILCmdbneun,       RsCILDescrbneun),
    ('bge.un',         RsCILCmdbgeun,       RsCILDescrbgeun),
    ('bgt.un',         RsCILCmdbgtun,       RsCILDescrbgtun),
    ('ble.un',         RsCILCmdbleun,       RsCILDescrbleun),
    ('blt.un',         RsCILCmdbltun,       RsCILDescrbltun),
    ('switch',         RsCILCmdswitch,      RsCILDescrswitch),
    ('ldind.i1',       RsCILCmdldindi1,     RsCILDescrldindi1),
    ('ldind.u1',       RsCILCmdldindu1,     RsCILDescrldindu1),
    ('ldind.i2',       RsCILCmdldindi2,     RsCILDescrldindi2),
    ('ldind.u2',       RsCILCmdldindu2,     RsCILDescrldindu2),
    ('ldind.i4',       RsCILCmdldindi4,     RsCILDescrldindi4),
    ('ldind.u4',       RsCILCmdldindu4,     RsCILDescrldindu4),
    ('ldind.i8',       RsCILCmdldindi8,     RsCILDescrldindi8),
    ('ldind.i',        RsCILCmdldindi,      RsCILDescrldindi),
    ('ldind.r4',       RsCILCmdldindr4,     RsCILDescrldindr4),
    ('ldind.r8',       RsCILCmdldindr8,     RsCILDescrldindr8),
    ('ldind.ref',      RsCILCmdldindref,    RsCILDescrldindref),
    ('stind.ref',      RsCILCmdstindref,    RsCILDescrstindref),
    ('stind.i1',       RsCILCmdstindi1,     RsCILDescrstindi1),
    ('stind.i2',       RsCILCmdstindi2,     RsCILDescrstindi2),
    ('stind.i4',       RsCILCmdstindi4,     RsCILDescrstindi4),
    ('stind.i8',       RsCILCmdstindi8,     RsCILDescrstindi8),
    ('stind.r4',       RsCILCmdstindr4,     RsCILDescrstindr4),
    ('stind.r8',       RsCILCmdstindr8,     RsCILDescrstindr8),
    ('add',            RsCILCmdadd,         RsCILDescradd),
    ('sub',            RsCILCmdsub,         RsCILDescrsub),
    ('mul',            RsCILCmdmul,         RsCILDescrmul),
    ('div',            RsCILCmddiv,         RsCILDescrdiv),
    ('div.un',         RsCILCmddivun,       RsCILDescrdivun),
    ('rem',            RsCILCmdrem,         RsCILDescrrem),
    ('rem.un',         RsCILCmdremun,       RsCILDescrremun),
    ('and',            RsCILCmdand,         RsCILDescrand),
    ('or',             RsCILCmdor,          RsCILDescror),
    ('xor',            RsCILCmdxor,         RsCILDescrxor),
    ('shl',            RsCILCmdshl,         RsCILDescrshl),
    ('shr',            RsCILCmdshr,         RsCILDescrshr),
    ('shr.un',         RsCILCmdshrun,       RsCILDescrshrun),
    ('neg',            RsCILCmdneg,         RsCILDescrneg),
    ('not',            RsCILCmdnot,         RsCILDescrnot),
    ('conv.i1',        RsCILCmdconvi1,      RsCILDescrconvi1),
    ('conv.i2',        RsCILCmdconvi2,      RsCILDescrconvi2),
    ('conv.i4',        RsCILCmdconvi4,      RsCILDescrconvi4),
    ('conv.i8',        RsCILCmdconvi8,      RsCILDescrconvi8),
    ('conv.r4',        RsCILCmdconvr4,      RsCILDescrconvr4),
    ('conv.r8',        RsCILCmdconvr8,      RsCILDescrconvr8),
    ('conv.u4',        RsCILCmdconvu4,      RsCILDescrconvu4),
    ('conv.u8',        RsCILCmdconvu8,      RsCILDescrconvu8),
    ('callvirt',       RsCILCmdcallvirt,    RsCILDescrcallvirt),
    ('cpobj',          RsCILCmdcpobj,       RsCILDescrcpobj),
    ('ldobj',          RsCILCmdldobj,       RsCILDescrldobj),
    ('ldstr',          RsCILCmdldstr,       RsCILDescrldstr),
    ('newobj',         RsCILCmdnewobj,      RsCILDescrnewobj),
    ('castclass',      RsCILCmdcastclass,   RsCILDescrcastclass),
    ('isinst',         RsCILCmdisinst,      RsCILDescrisinst),
    ('conv.r.un',      RsCILCmdconvrun,     RsCILDescrconvrun),
    ('unused',         RsCILCmdunused2,     RsCILDescrunused2),
    ('unused',         RsCILCmdunused3,     RsCILDescrunused3),
    ('unbox',          RsCILCmdunbox,       RsCILDescrunbox),
    ('throw',          RsCILCmdthrow,       RsCILDescrthrow),
    ('ldfld',          RsCILCmdldfld,       RsCILDescrldfld),
    ('ldflda',         RsCILCmdldflda,      RsCILDescrldflda),
    ('stfld',          RsCILCmdstfld,       RsCILDescrstfld),
    ('ldsfld',         RsCILCmdldsfld,      RsCILDescrldsfld),
    ('ldsflda',        RsCILCmdldsflda,     RsCILDescrldsflda),
    ('stsfld',         RsCILCmdstsfld,      RsCILDescrstsfld),
    ('stobj',          RsCILCmdstobj,       RsCILDescrstobj),
    ('conv.ovf.i1.un', RsCILCmdconvovfi1un, RsCILDescrconvovfi1un),
    ('conv.ovf.i2.un', RsCILCmdconvovfi2un, RsCILDescrconvovfi2un),
    ('conv.ovf.i4.un', RsCILCmdconvovfi4un, RsCILDescrconvovfi4un),
    ('conv.ovf.i8.un', RsCILCmdconvovfi8un, RsCILDescrconvovfi8un),
    ('conv.ovf.u1.un', RsCILCmdconvovfu1un, RsCILDescrconvovfu1un),
    ('conv.ovf.u2.un', RsCILCmdconvovfu2un, RsCILDescrconvovfu2un),
    ('conv.ovf.u4.un', RsCILCmdconvovfu4un, RsCILDescrconvovfu4un),
    ('conv.ovf.u8.un', RsCILCmdconvovfu8un, RsCILDescrconvovfu8un),
    ('conv.ovf.i.un',  RsCILCmdconvovfiun,  RsCILDescrconvovfiun),
    ('conv.ovf.u.un',  RsCILCmdconvovfuun,  RsCILDescrconvovfuun),
    ('box',            RsCILCmdbox,         RsCILDescrbox),
    ('newarr',         RsCILCmdnewarr,      RsCILDescrnewarr),
    ('ldlen',          RsCILCmdldlen,       RsCILDescrldlen),
    ('ldelema',        RsCILCmdldelema,     RsCILDescrldelema),
    ('ldelem.i1',      RsCILCmdldelemi1,    RsCILDescrldelemi1),
    ('ldelem.u1',      RsCILCmdldelemu1,    RsCILDescrldelemu1),
    ('ldelem.i2',      RsCILCmdldelemi2,    RsCILDescrldelemi2),
    ('ldelem.u2',      RsCILCmdldelemu2,    RsCILDescrldelemu2),
    ('ldelem.i4',      RsCILCmdldelemi4,    RsCILDescrldelemi4),
    ('ldelem.u4',      RsCILCmdldelemu4,    RsCILDescrldelemu4),
    ('ldelem.i8',      RsCILCmdldelemi8,    RsCILDescrldelemi8),
    ('ldelem.i',       RsCILCmdldelemi,     RsCILDescrldelemi),
    ('ldelem.r4',      RsCILCmdldelemr4,    RsCILDescrldelemr4),
    ('ldelem.r8',      RsCILCmdldelemr8,    RsCILDescrldelemr8),
    ('ldelem.ref',     RsCILCmdldelemref,   RsCILDescrldelemref),
    ('stelem.i',       RsCILCmdstelemi,     RsCILDescrstelemi),
    ('stelem.i1',      RsCILCmdstelemi1,    RsCILDescrstelemi1),
    ('stelem.i2',      RsCILCmdstelemi2,    RsCILDescrstelemi2),
    ('stelem.i4',      RsCILCmdstelemi4,    RsCILDescrstelemi4),
    ('stelem.i8',      RsCILCmdstelemi8,    RsCILDescrstelemi8),
    ('stelem.r4',      RsCILCmdstelemr4,    RsCILDescrstelemr4),
    ('stelem.r8',      RsCILCmdstelemr8,    RsCILDescrstelemr8),
    ('stelem.ref',     RsCILCmdstelemref,   RsCILDescrstelemref),
    ('unused',         RsCILCmdunused4,     RsCILDescrunused4),
    ('unused',         RsCILCmdunused5,     RsCILDescrunused5),
    ('unused',         RsCILCmdunused6,     RsCILDescrunused6),
    ('unused',         RsCILCmdunused7,     RsCILDescrunused7),
    ('unused',         RsCILCmdunused8,     RsCILDescrunused8),
    ('unused',         RsCILCmdunused9,     RsCILDescrunused9),
    ('unused',         RsCILCmdunused10,    RsCILDescrunused10),
    ('unused',         RsCILCmdunused11,    RsCILDescrunused11),
    ('unused',         RsCILCmdunused12,    RsCILDescrunused12),
    ('unused',         RsCILCmdunused13,    RsCILDescrunused13),
    ('unused',         RsCILCmdunused14,    RsCILDescrunused14),
    ('unused',         RsCILCmdunused15,    RsCILDescrunused15),
    ('unused',         RsCILCmdunused16,    RsCILDescrunused16),
    ('unused',         RsCILCmdunused17,    RsCILDescrunused17),
    ('unused',         RsCILCmdunused18,    RsCILDescrunused18),
    ('unused',         RsCILCmdunused19,    RsCILDescrunused19),
    ('conv.ovf.i1',    RsCILCmdconvovfi1,   RsCILDescrconvovfi1),
    ('conv.ovf.u1',    RsCILCmdconvovfu1,   RsCILDescrconvovfu1),
    ('conv.ovf.i2',    RsCILCmdconvovfi2,   RsCILDescrconvovfi2),
    ('conv.ovf.u2',    RsCILCmdconvovfu2,   RsCILDescrconvovfu2),
    ('conv.ovf.i4',    RsCILCmdconvovfi4,   RsCILDescrconvovfi4),
    ('conv.ovf.u4',    RsCILCmdconvovfu4,   RsCILDescrconvovfu4),
    ('conv.ovf.i8',    RsCILCmdconvovfi8,   RsCILDescrconvovfi8),
    ('conv.ovf.u8',    RsCILCmdconvovfu8,   RsCILDescrconvovfu8),
    ('unused',         RsCILCmdunused20,    RsCILDescrunused20),
    ('unused',         RsCILCmdunused21,    RsCILDescrunused21),
    ('unused',         RsCILCmdunused22,    RsCILDescrunused22),
    ('unused',         RsCILCmdunused23,    RsCILDescrunused23),
    ('unused',         RsCILCmdunused24,    RsCILDescrunused24),
    ('unused',         RsCILCmdunused25,    RsCILDescrunused25),
    ('unused',         RsCILCmdunused26,    RsCILDescrunused26),
    ('refanyval',      RsCILCmdrefanyval,   RsCILDescrrefanyval),
    ('ckfinite',       RsCILCmdckfinite,    RsCILDescrckfinite),
    ('unused',         RsCILCmdunused27,    RsCILDescrunused27),
    ('unused',         RsCILCmdunused28,    RsCILDescrunused28),
    ('mkrefany',       RsCILCmdmkrefany,    RsCILDescrmkrefany),
    ('unused',         RsCILCmdunused29,    RsCILDescrunused29),
    ('unused',         RsCILCmdunused30,    RsCILDescrunused30),
    ('unused',         RsCILCmdunused31,    RsCILDescrunused31),
    ('unused',         RsCILCmdunused32,    RsCILDescrunused32),
    ('unused',         RsCILCmdunused33,    RsCILDescrunused33),
    ('unused',         RsCILCmdunused34,    RsCILDescrunused34),
    ('unused',         RsCILCmdunused35,    RsCILDescrunused35),
    ('unused',         RsCILCmdunused36,    RsCILDescrunused36),
    ('unused',         RsCILCmdunused37,    RsCILDescrunused37),
    ('ldtoken',        RsCILCmdldtoken,     RsCILDescrldtoken),
    ('conv.u2',        RsCILCmdconvu2,      RsCILDescrconvu2),
    ('conv.u1',        RsCILCmdconvu1,      RsCILDescrconvu1),
    ('conv.i',         RsCILCmdconvi,       RsCILDescrconvi),
    ('conv.ovf.i',     RsCILCmdconvovfi,    RsCILDescrconvovfi),
    ('conv.ovf.u',     RsCILCmdconvovfu,    RsCILDescrconvovfu),
    ('add.ovf',        RsCILCmdaddovf,      RsCILDescraddovf),
    ('add.ovf.un',     RsCILCmdaddovfun,    RsCILDescraddovfun),
    ('mul.ovf',        RsCILCmdmulovf,      RsCILDescrmulovf),
    ('mul.ovf.un',     RsCILCmdmulovfun,    RsCILDescrmulovfun),
    ('sub.ovf',        RsCILCmdsubovf,      RsCILDescrsubovf),
    ('sub.ovf.un',     RsCILCmdsubovfun,    RsCILDescrsubovfun),
    ('endfinally',     RsCILCmdendfinally,  RsCILDescrendfinally),
    ('leave',          RsCILCmdleave,       RsCILDescrleave),
    ('leave.s',        RsCILCmdleaves,      RsCILDescrleaves),
    ('stind.i',        RsCILCmdstindi,      RsCILDescrstindi),
    ('conv.u',         RsCILCmdconvu,       RsCILDescrconvu),
    ('unused',         RsCILCmdunused38,    RsCILDescrunused38),
    ('unused',         RsCILCmdunused39,    RsCILDescrunused39),
    ('unused',         RsCILCmdunused40,    RsCILDescrunused40),
    ('unused',         RsCILCmdunused41,    RsCILDescrunused41),
    ('unused',         RsCILCmdunused42,    RsCILDescrunused42),
    ('unused',         RsCILCmdunused43,    RsCILDescrunused43),
    ('unused',         RsCILCmdunused44,    RsCILDescrunused44),
    ('unused',         RsCILCmdunused45,    RsCILDescrunused45),
    ('unused',         RsCILCmdunused46,    RsCILDescrunused46),
    ('unused',         RsCILCmdunused47,    RsCILDescrunused47),
    ('unused',         RsCILCmdunused48,    RsCILDescrunused48),
    ('unused',         RsCILCmdunused49,    RsCILDescrunused49),
    ('unused',         RsCILCmdunused50,    RsCILDescrunused50),
    ('unused',         RsCILCmdunused51,    RsCILDescrunused51),
    ('unused',         RsCILCmdunused52,    RsCILDescrunused52),
    ('unused',         RsCILCmdunused53,    RsCILDescrunused53),
    ('unused',         RsCILCmdunused54,    RsCILDescrunused54),
    ('unused',         RsCILCmdunused55,    RsCILDescrunused55),
    ('unused',         RsCILCmdunused56,    RsCILDescrunused56),
    ('unused',         RsCILCmdunused57,    RsCILDescrunused57),
    ('unused',         RsCILCmdunused58,    RsCILDescrunused58),
    ('unused',         RsCILCmdunused59,    RsCILDescrunused59),
    ('unused',         RsCILCmdunused60,    RsCILDescrunused60),
    ('prefix7',        RsCILCmdprefix7,     RsCILDescrprefix7),
    ('prefix6',        RsCILCmdprefix6,     RsCILDescrprefix6),
    ('prefix5',        RsCILCmdprefix5,     RsCILDescrprefix5),
    ('prefix4',        RsCILCmdprefix4,     RsCILDescrprefix4),
    ('prefix3',        RsCILCmdprefix3,     RsCILDescrprefix3),
    ('prefix2',        RsCILCmdprefix2,     RsCILDescrprefix2),
    ('prefix1',        RsCILCmdprefix1,     RsCILDescrprefix1),
    ('prefixref',      RsCILCmdprefixref,   RsCILDescrprefixref),

    ('arglist',        RsCILCmdarglist,     RsCILDescrarglist),
    ('ceq',            RsCILCmdceq,         RsCILDescrceq),
    ('cgt',            RsCILCmdcgt,         RsCILDescrcgt),
    ('cgt.un',         RsCILCmdcgtun,       RsCILDescrcgtun),
    ('clt',            RsCILCmdclt,         RsCILDescrclt),
    ('clt.un',         RsCILCmdcltun,       RsCILDescrcltun),
    ('ldftn',          RsCILCmdldftn,       RsCILDescrldftn),
    ('ldvirtftn',      RsCILCmdldvirtftn,   RsCILDescrldvirtftn),
    ('unused',         RsCILCmdunused61,    RsCILDescrunused61),
    ('ldarg',          RsCILCmdldarg,       RsCILDescrldarg),
    ('ldarga',         RsCILCmdldarga,      RsCILDescrldarga),
    ('starg',          RsCILCmdstarg,       RsCILDescrstarg),
    ('ldloc',          RsCILCmdldloc,       RsCILDescrldloc),
    ('ldloca',         RsCILCmdldloca,      RsCILDescrldloca),
    ('stloc',          RsCILCmdstloc,       RsCILDescrstloc),
    ('localloc',       RsCILCmdlocalloc,    RsCILDescrlocalloc),
    ('unused',         RsCILCmdunused62,    RsCILDescrunused62),
    ('endfilter',      RsCILCmdendfilter,   RsCILDescrendfilter),
    ('unaligned.',     RsCILCmdunaligned,   RsCILDescrunaligned),
    ('volatile.',      RsCILCmdvolatile,    RsCILDescrvolatile),
    ('tail.',          RsCILCmdtail,        RsCILDescrtail),
    ('initobj',        RsCILCmdinitobj,     RsCILDescrinitobj),
    ('unused',         RsCILCmdunused63,    RsCILDescrunused63),
    ('cpblk',          RsCILCmdcpblk,       RsCILDescrcpblk),
    ('initblk',        RsCILCmdinitblk,     RsCILDescrinitblk),
    ('unused',         RsCILCmdunused64,    RsCILDescrunused64),
    ('rethrow',        RsCILCmdrethrow,     RsCILDescrrethrow),
    ('unused',         RsCILCmdunused65,    RsCILDescrunused65),
    ('sizeof',         RsCILCmdsizeof,      RsCILDescrsizeof),
    ('refanytype',     RsCILCmdrefanytype,  RsCILDescrrefanytype),
    ('unused',         RsCILCmdunused66,    RsCILDescrunused66),
    ('unused',         RsCILCmdunused67,    RsCILDescrunused67),
    ('unused',         RsCILCmdunused68,    RsCILDescrunused68),
    ('unused',         RsCILCmdunused69,    RsCILDescrunused69),
    ('unused',         RsCILCmdunused70,    RsCILDescrunused70)
   );

  OpCodeParamTypes: array [TJclOpCode] of TJclInstructionParamType =
   (ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {00}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptU1,     ptU1,    {08}
    ptU1,     ptU1,     ptU1,     ptU1,     ptVoid,   ptVoid,   ptVoid,   ptVoid,  {10}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptI1,    {18}
    ptI4,     ptI8,     ptR4,     ptR8,     ptVoid,   ptVoid,   ptVoid,   ptToken, {20}
    ptToken,  ptVoid,   ptVoid,   ptSOff,   ptSOff,   ptSOff,   ptSOff,   ptSOff,  {28}
    ptSOff,   ptSOff,   ptSOff,   ptSOff,   ptSOff,   ptSOff,   ptSOff,   ptSOff,  {30}
    ptLOff,   ptLOff,   ptLOff,   ptLOff,   ptLOff,   ptLOff,   ptLOff,   ptLOff,  {38}
    ptLOff,   ptLOff,   ptLOff,   ptLOff,   ptLOff,   ptVoid,   ptVoid,   ptVoid,  {40}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {48}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {50}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {58}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {60}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptToken, {68}
    ptToken,  ptToken,  ptToken,  ptToken,  ptToken,  ptToken,  ptVoid,   ptVoid,  {70}
    ptVoid,   ptToken,  ptVoid,   ptToken,  ptToken,  ptToken,  ptToken,  ptToken, {78}
    ptToken,  ptToken,  ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {80}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptToken,  ptToken,  ptVoid,   ptToken, {88}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {90}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {98}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {A0}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {A8}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {B0}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {B8}
    ptVoid,   ptVoid,   ptToken,  ptVoid,   ptVoid,   ptVoid,   ptToken,   ptVoid, {C0}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {C8}
    ptToken,  ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {D0}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptI4,     ptI1,     ptVoid,  {D8}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {E0}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {E8}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {F0}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {F8}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptToken,  ptToken, {00}
    ptVoid,   ptU2,     ptU2,     ptU2,     ptU2,     ptU2,     ptU2,     ptVoid,  {08}
    ptVoid,   ptVoid,   ptI1,     ptVoid,   ptVoid,   ptToken,  ptVoid,   ptVoid,  {10}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptToken,  ptVoid,   ptVoid,   ptVoid,  {18}
    ptVoid,   ptVoid,   ptVoid);                                                   {20}

//===  { TJclClrILGenerator } ================================================

constructor TJclClrILGenerator.Create(AMethod: TJclClrMethodBody = nil);
var
  OpCode: Byte;
  Stream: TMemoryStream;
  Instruction: TJclInstruction;
begin
  inherited Create;
  FMethod := AMethod;
  FInstructions := TObjectList.Create;
  if Assigned(AMethod) then
  begin
    Stream := TMemoryStream.Create;
    try
      Stream.Write(Method.Code^, Method.Size);
      Stream.Seek(0, soFromBeginning);
      while Stream.Position < Stream.Size do
      begin
        OpCode := PByte(Longint(Stream.Memory) + Stream.Position)^;
        if OpCode = STP1 then
        begin
          OpCode := PByte(Longint(Stream.Memory) + Stream.Position + 1)^;
          Instruction := TJclInstruction.Create(Self, TJclOpCode(MaxByte + 1 + OpCode));
        end
        else
          Instruction := TJclInstruction.Create(Self, TJclOpCode(OpCode));
        if Assigned(Instruction) then
        begin
          FInstructions.Add(Instruction);
          Instruction.Load(Stream);
        end;
      end;
    finally
      FreeAndNil(Stream);
    end;
  end;
end;

destructor TJclClrILGenerator.Destroy;
begin
  FreeAndNil(FInstructions);
  inherited Destroy;
end;

function TJclClrILGenerator.DumpIL(Options: TJclInstructionDumpILOptions): string;
var
  I, J, Indent: Integer;

  function FlagsToName(Flags: TJclClrExceptionClauseFlags): string;
  begin
    if cfFinally in Flags then
      Result := 'finally'
    else
    if cfFilter in Flags then
      Result := 'filter'
    else
    if cfFault in Flags then
      Result := 'fault'
    else
      Result := 'catch';
  end;

  function IndentStr: string;
  begin
    Result := StrRepeat('  ', Indent);
  end;

begin
  Indent := 0;
  with TStringList.Create do
  try
    for I := 0 to InstructionCount-1 do
    begin
      for J := 0 to Method.ExceptionHandlerCount-1 do
      with Method.ExceptionHandlers[J] do
      begin
        if Instructions[I].Offset = TryBlock.Offset then
        begin
          Add(IndentStr + '.try');
          Add(IndentStr + '{');
          Inc(Indent);
        end;
        if Instructions[I].Offset = (TryBlock.Offset + TryBlock.Length) then
        begin
          Dec(Indent);
          Add(IndentStr + '}  // end .try');
        end;
        if Instructions[I].Offset = HandlerBlock.Offset then
        begin
          Add(IndentStr + FlagsToName(Flags));
          Add(IndentStr + '{');
          Inc(Indent);
        end;
        if Instructions[I].Offset = (HandlerBlock.Offset + HandlerBlock.Length) then
        begin
          Dec(Indent);
          Add(IndentStr + '}  // end ' + FlagsToName(Flags));
        end;
      end;
      Add(IndentStr + Instructions[I].DumpIL(Options));
    end;
    Result := Text;
  finally
    Free;
  end;
end;

function TJclClrILGenerator.GetInstructionCount: Integer;
begin
  Result := FInstructions.Count;
end;

function TJclClrILGenerator.GetInstruction(const Idx: Integer): TJclInstruction;
begin
  Result := TJclInstruction(FInstructions[Idx]);
end;

//=== { TJclInstruction } ====================================================

constructor TJclInstruction.Create(AOwner :TJclClrILGenerator; AOpCode: TJclOpCode);
begin
  inherited Create;
  FOwner := AOwner;
  FOpCode := AOpCode;
end;

function TJclInstruction.GetWideOpCode: Boolean;
begin
  Result := Integer(OpCode) > MaxByte;
end;

function TJclInstruction.GetRealOpCode: Byte;
begin
  if WideOpCode then
    Result := Integer(OpCode) mod (MaxByte + 1)
  else
    Result := Integer(OpCode);
end;

function TJclInstruction.GetParamType: TJclInstructionParamType;
begin
  Result := OpCodeParamTypes[OpCode];
end;

function TJclInstruction.GetName: string;
begin
  Result := OpCodeInfos[OpCode, itName];
end;

function TJclInstruction.GetFullName: string;
begin
  Result := OpCodeInfos[OpCode, itFullName];
end;

function TJclInstruction.GetDescription: string;
begin
  Result := OpCodeInfos[OpCode, itDescription]
end;

function TJclInstruction.GetSize: DWORD;
const
  OpCodeSize: array [Boolean] of DWORD = (1, 2);
begin
  case ParamType of
    ptSOff, ptI1, ptU1:
      Result := SizeOf(Byte);
    ptI2, ptU2:
      Result := SizeOf(Word);
    ptLOff, ptI4, ptToken, ptU4, ptR4:
      Result := SizeOf(DWORD);
    ptI8, ptU8, ptR8:
      Result := SizeOf(Int64);
    ptArray:
      Result := (VarArrayHighBound(FParam, 1) - VarArrayLowBound(FParam, 1) + 1 + 1) * SizeOf(Integer);
  else
    Result := 0;
  end;
  Result := OpCodeSize[OpCode in [opNop..opPrefixRef]] + Result;
end;

procedure TJclInstruction.Load(Stream: TStream);
var
  Code: Byte;
  I, ArraySize: DWORD;   { TODO : I, ArraySize = DWORD create a serious problem }
  Value: Integer;
begin
  FOffset := Stream.Position;
  try
    Stream.Read(Code, SizeOf(Code));
    if WideOpCode then
    begin
      if Code <> STP1 then
        raise EJclCliInstructionStreamInvalid.CreateRes(@RsInstructionStreamInvalid);
      Stream.Read(Code, SizeOf(Code));
    end;

    if Code <> RealOpCode then
      raise EJclCliInstructionStreamInvalid.CreateRes(@RsInstructionStreamInvalid);

    with TVarData(FParam) do
    case ParamType of
      ptU1:
        begin
          Stream.Read(VByte, SizeOf(Byte));
          VType := varByte;
        end;
      ptI2:
        begin
          Stream.Read(VSmallInt, SizeOf(SmallInt));
          VType := varSmallInt;
        end;
      ptLOff, ptI4:
        begin
          Stream.Read(VInteger, SizeOf(Integer));
          VType := varInteger;
        end;
      ptR4:
        begin
          Stream.Read(VSingle, SizeOf(Single));
          VType := varSingle;
        end;
      ptR8:                                       
        begin
          Stream.Read(VDouble, SizeOf(Double));
          VType := varDouble;
        end;
      ptArray:
        begin
          Stream.Read(ArraySize, SizeOf(ArraySize));
          FParam := VarArrayCreate([0, ArraySize-1], varInteger);
          for I := 0 to ArraySize-1 do  { TODO : ArraySize = 0 and we have a nearly endless loop }
          begin
            Stream.Read(Value, SizeOf(Value));
            FParam[I] := Value;
          end;
        end;
      {$IFDEF RTL140_UP}  { TODO -cTest : since RTL 14.0 or 15.0? }
      ptSOff, ptI1:
        begin
          Stream.Read(VShortInt, SizeOf(ShortInt));
          VType := varShortInt;
        end;
      ptU2:
        begin
          Stream.Read(VWord, SizeOf(Word));
          VType := varWord;
        end;
      ptToken, ptU4:
        begin
          Stream.Read(VLongWord, SizeOf(LongWord));
          VType := varLongWord;
        end;
      ptI8, ptU8:
        begin
          Stream.Read(VInt64, SizeOf(Int64));
          VType := varInt64;
        end;
      {$ENDIF RTL140_UP}
    end;
  except
    Stream.Position := FOffset;
    raise;
  end;
end;

procedure TJclInstruction.Save(Stream: TStream);
var
  Code: Byte;
  {$IFDEF RTL140_UP}  { TODO -cTest : since RTL 14.0 or 15.0? }
  ArraySize: DWORD;
  I, Value: Integer;
  {$ENDIF RTL140_UP}
begin
  if WideOpCode then
  begin
    Code := STP1;
    Stream.Write(Code, SizeOf(Code));
  end;

  Code := RealOpCode;;
  Stream.Write(Code, SizeOf(Code));

  case ParamType of
    ptU1:
      Stream.Write(TVarData(FParam).VByte, SizeOf(Byte));
    ptI2:
      Stream.Write(TVarData(FParam).VSmallInt, SizeOf(SmallInt));
    ptLOff, ptI4:
      Stream.Write(TVarData(FParam).VInteger, SizeOf(Integer));
    ptR4:
      Stream.Write(TVarData(FParam).VSingle, SizeOf(Single));
    ptR8:
      Stream.Write(TVarData(FParam).VDouble, SizeOf(Double));
    {$IFDEF RTL140_UP}  { TODO -cTest : since RTL 14.0 or 15.0? }
    ptSOff, ptI1:
      Stream.Write(TVarData(FParam).VShortInt, SizeOf(ShortInt));
    ptU2:
      Stream.Write(TVarData(FParam).VWord, SizeOf(Word));
    ptToken, ptU4:
      Stream.Write(TVarData(FParam).VLongWord, SizeOf(LongWord));
    ptI8, ptU8:
      Stream.Write(TVarData(FParam).VInt64, SizeOf(Int64));
    ptArray:
      begin
        ArraySize := VarArrayHighBound(FParam, 1) - VarArrayLowBound(FParam, 1) + 1;
        Stream.Write(ArraySize, SizeOf(ArraySize));
        { TODO : VarArrayHighBound to VarArrayLowBound very likely wrong }
        for I := VarArrayHighBound(FParam, 1) to VarArrayLowBound(FParam, 1) do
        begin
          Value := VarArrayGet(FParam, [I]);
          Stream.Write(Value, SizeOf(Value));
        end;
      end;
    {$ENDIF RTL140_UP}
  end;
end;

function TJclInstruction.DumpIL(Options: TJclInstructionDumpILOptions): string;
var
  Opt: TJclInstructionDumpILOption;
begin
  if doLineNo in Options then
    Result := DumpILOption(doLineNo) + ': ';
  if doRawBytes in Options then
    Result := Result + Format(' /* %.24s */ ', [DumpILOption(doRawBytes)]);
  for Opt := doIL to doTokenValue do
    Result := Result + DumpILOption(Opt) + ' ';
  if (doComment in Options) and ((FullName <> '') or (Description <> '')) then
    Result := Result + ' // ' + DumpILOption(doComment);
end;

function TJclInstruction.FormatLabel(Offset: Integer): string;
begin
  Result := 'IL_' + IntToHex(Offset, 4);
end;

function TJclInstruction.DumpILOption(Option: TJclInstructionDumpILOption): string;

  function TokenToString(Token: DWORD): string;
  begin
    Result := '(' + IntToHex(Token shr 24, 2) + ')' + IntToHex(Token mod (1 shl 24), 6);
  end;

var
  {$IFDEF RTL140_UP}  { TODO -cTest : since RTL 14.0 or 15.0? }
  I: Integer;
  Row: TJclClrTableRow;
  {$ENDIF RTL140_UP}
  CodeStr, ParamStr: string;
begin
  case Option of
    doLineNo:
      Result := 'IL_' + IntToHex(Offset, 4);
    doRawBytes:
      begin
        if WideOpCode then
          CodeStr := IntToHex(STP1, 2);

        CodeStr := CodeStr + IntToHex(RealOpCode, 2);
        CodeStr := CodeStr + StrRepeat(' ', 4 - Length(CodeStr));

        case ParamType of
          ptSOff, ptI1, ptU1:
            ParamStr := IntToHex(TVarData(FParam).VByte, 2);
          ptArray:
            ParamStr := 'Array';
          {$IFDEF RTL140_UP}  { TODO -cTest : since RTL 14.0 or 15.0? }
          ptI2, ptU2:
            ParamStr := IntToHex(TVarData(FParam).VWord, 4);
          ptLOff, ptI4, ptU4, ptR4:
            ParamStr := IntToHex(TVarData(FParam).VLongWord, 8);
          ptI8, ptU8, ptR8:
            ParamStr := IntToHex(TVarData(FParam).VInt64, 16);
          ptToken:
            ParamStr := TokenToString(TVarData(FParam).VLongWord);
          {$ENDIF RTL140_UP}
        else
          ParamStr := '';
        end;
        ParamStr := ParamStr + StrRepeat(' ', 10 - Length(ParamStr));
        Result := CodeStr + ' | ' + ParamStr;
      end;
    doIL:
      begin
        case ParamType of
        ptVoid:
          ; // do nothing
        ptLOff:
          Result := FormatLabel(Integer(Offset + Size) + TVarData(Param).VInteger - 1);
        {$IFDEF RTL140_UP}  { TODO -cTest : since RTL 14.0 or 15.0? }
        ptToken:
          begin
            if Byte(TJclPeMetadata.TokenTable(TVarData(Param).VLongWord)) = $70 then
              Result := '"' + Owner.Method.Method.Table.Stream.Metadata.UserStringAt(TJclPeMetadata.TokenIndex(TVarData(Param).VLongWord)) + '"'
            else
            begin
              Row := Owner.Method.Method.Table.Stream.Metadata.Tokens[TVarData(Param).VLongWord];
              if Assigned(Row) then
              begin
                if Row is TJclClrTableTypeDefRow then
                  Result := TJclClrTableTypeDefRow(Row).FullName
                else
                if Row is TJclClrTableTypeRefRow then
                  with TJclClrTableTypeRefRow(Row) do
                    Result := FullName
                else
                if Row is TJclClrTableMethodDefRow then
                  with TJclClrTableMethodDefRow(Row) do
                    Result := ParentToken.FullName + '.' + Name
                else
                if Row is TJclClrTableMemberRefRow then
                  with TJclClrTableMemberRefRow(Row) do
                    Result := FullName
                else
                if Row is TJclClrTableFieldDefRow then
                  with TJclClrTableFieldDefRow(Row) do
                    Result := ParentToken.FullName + '.' + Name
                else
                  Result := Row.DumpIL;
              end
              else
                Result := '';
            end;
            Result := Result + ' /* ' + IntToHex(TVarData(FParam).VLongWord, 8) + ' */';
          end;
        ptSOff:
          Result := FormatLabel(Integer(Offset + Size) + TVarData(Param).VShortInt - 1);
        ptArray:
          begin
            for I := VarArrayHighBound(FParam, 1) to VarArrayLowBound(FParam, 1) do
            begin
              Result := Result + FormatLabel(Offset + Size + VarArrayGet(FParam, [I]));
              if I <> VarArrayLowBound(FParam, 1) then
                Result := Result + ', ';
            end;
            Result := ' (' + Result + ')';
          end;
        {$ENDIF RTL140_UP}
        else
          Result := VarToStr(Param);
        end;
        Result := GetName + StrRepeat(' ', 10 - Length(GetName)) + ' ' + Result;
        Result := Result + StrRepeat(' ', 20 - Length(Result));
      end;
    doTokenValue:
      Result := ''; // do nothing
    doComment:
      if FullName = '' then
        Result := Description
      else
      if Description = '' then
        Result := FullName
      else
        Result := FullName + ' - ' + Description;
  end;
end;

// History:

// $Log: JclCIL.pas,v $
// Revision 1.15  2005/05/08 08:05:53  outchy
// Warning suppression, DWORD (Cardinal) changed to Integer
//
// Revision 1.14  2005/03/14 02:13:13  rrossmair
// - fixed JclCLR identifier case
//
// Revision 1.13  2005/03/08 08:33:22  marquardt
// overhaul of exceptions and resourcestrings, minor style cleaning
//
// Revision 1.12  2005/03/07 17:27:58  marquardt
// reworked for resorucestrings
//
// Revision 1.11  2005/02/27 14:55:26  marquardt
// changed overloaded constructors to constructor with default parameter (BCB friendly)
//
// Revision 1.10  2005/02/24 16:34:52  marquardt
// remove divider lines, add section lines (unfinished)
//
// Revision 1.9  2004/10/17 21:00:14  mthoma
// cleaning
//
// Revision 1.8  2004/08/03 17:13:28  marquardt
// make duplicate string literals constants
//
// Revision 1.7  2004/06/14 13:05:21  marquardt
// style cleaning ENDIF, Tabs
//
// Revision 1.6  2004/05/05 07:33:49  rrossmair
// header updated according to new policy: initial developers & contributors listed
//
// Revision 1.5  2004/04/06 04:55:17
// adapt compiler conditions, add log entry
//

end.