compilecomplex_hss.pas

编译类_Hss VC版_源代码支持表达式的编译执行,速度超快,支持实数和复数,并附带一个复数函数库你还可以同时找到VB和VC版和Delphi版

       11. 更强大的功能请参看类的接口函数


     *)


  (*
  {定义复数类型}
  {$ALIGN 8}
  type TComplex=record   {复数类型}
      x   : CmxFloat;        {实部}
      y   : CmxFloat;        {虚部}
  end;
  type PTComplex=^TComplex;
  *)

  type TFunctionList =record
    FName     :string;     //函数名称
    FAddress  :Pointer;    //函数地址入口
    FCCount   :0..2;       //函数所需参数个数
  end;

  type TParameterListCmCx =record
    CName     :String;     //参数名称
    CAddress  :PTComplex;  //参数地址
    CIndex    :integer;    //参数地址序号
    IsConst   :boolean;    //是否为常数;  false:变量 true:常数
    IsExterior:boolean;    //是否是外部变量 false:内部变量 true:外部变量
  end;
  const SizeofTParameterListCmCx = sizeof(TParameterListCmCx);

  type TUserParameterListCmCx =record  //用户使用 (系统用 TParameterListCmCx)
    CName     :String;     //参数名称
    CAddress  :PTComplex;  //参数地址
  end;

  type TT_PTrueCmCx=record
    IsConst   :boolean;    //编译优化常数时  参数性质  是否为常数
    ifCx      :Boolean;
    dValue    :TComplex;   //编译优化常数时  参数性质  值
  end;

  type TExeAddressPMListCmCx=record
    ExeIndex  :integer;     //插入ExeCode的当前位置序号
    PName     :string;      //参数名称
    //PMXorY    :boolean;     //是否实部  true 实部 false 虚部
  end;

  const ExendedFormatLength=16; //Extended类型(10字节)的存储长度, 设为16是为了数据对齐
  const SYS_EFLength=ExendedFormatLength;

const
  // 版本
  csTCompileComplex_Version :double =1.00;  //2002.7-2002.12

  
type
  // <<复数函数动态编译器TCompileComplex类,简写:TCmCx>> //
  TCompileComplex=class

  protected  {私有}

    FEnabledOptimizeDiv :boolean;
    FEnabledOptimizeStack  :boolean;
    FEnabledOptimizeConst  :boolean;
    FEnabledNote: Boolean;
    procedure SetEnabledNote(Value:boolean);  //是否允许使用注释 私有
    procedure SetEnabledOptimizeDiv(Value:boolean);  //是否要优化常数浮点除法运算 私有
    procedure SetEnabledOptimizeStack(Value:boolean);  //是否要优化堆栈 私有
    procedure SetEnabledOptimizeConst(Value:boolean);  //是否要优化常数运算 私有

  public

    //>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>//
    //    <<对外可见成员 即 接口部分>>    //
    //<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<//

    //返回表达式的值
    GetValue : function  ():TComplex;register;  //(编译后才能调用)
    // 调用函数返回表达式的值(实参数值列表); //等价于 SetFunctionParameter + GetValue 
    function  GetFunctionValue(const PList: array of TComplex): TComplex; register; //(编译后才能调用)
    // 按当前设置的参数表传入参数值(实参数值列表)
    procedure SetFunctionParameter(const PList: array of TComplex); register;  //(编译前后都能调用)


    // 设置需要编译的字符串(要编译的字符串,虚参数列表字符串,是否自动编译);
    //    比如：Value:='Sqr(x)+Sqr(y)'; ParameterList:='x,y' ;
    function  SetText(const Value:string;const ParameterList : string='';const IfComple:boolean=true):boolean;//(编译前调用，这是最先要做的)
    // 编译当前字符串
    function  Compile():boolean; //编译

    // 处理预定义宏(要代换的标识符,代换为的描述字符串); // 可以用来处理常数,甚至定义新的函数!
    //   如 Key:='a'; Value:='-0.5' , 或 Key:='f(x,y)',Value:='Max(x,Sin(y))' 等;
    function  Define(const Key,Value : string):boolean;  //(编译前调用)

    // 处理常数定义(要代换的标识符,代换的值)  // 常数定义, Value必须是一个可计算的值
    //   如 Key:='a'; Value:='2' , 或 Key:='b' , Value:='2*sin(PI/2)' 等;
    //   该功能完全可以用预定义宏(Define)来代替，
    //   但当值为常数时这样处理有可能使最后得到的编译函数速度更快，并加快编译速度
    function  DefineConst(const Key,Value: string):boolean;  //(编译前调用)

    // 测试是否使用了未定义的变量
    function  IfHaveUnDefineParameter():boolean;  //(编译后才能调用)

    // 获得版本号
    class function GetVersion(): double;

    //获得当前要编译的字符串
    function  GetText():string; //随时都可以调用，该值会随着其他函数的调用而产生变化

    // 类的属性: 是否允许使用注释
    property  EnabledNote: Boolean read FEnabledNote write SetEnabledNote default true;  //(编译前调用)
    // 类的属性: 是否要优化常数浮点除法运算 (除以一个常数变为乘以一个常数)
    property  EnabledOptimizeDiv: Boolean read FEnabledOptimizeDiv write SetEnabledOptimizeDiv default true;//(编译前调用)
    // 类的属性: 是否要优化堆栈调用
    property  EnabledOptimizeStack: Boolean read FEnabledOptimizeStack write SetEnabledOptimizeStack default true; //(编译前调用)
    // 类的属性: 是否要优化常数运算
    property  EnabledOptimizeConst: Boolean read FEnabledOptimizeConst write SetEnabledOptimizeConst default true; //(编译前调用)


    //设置一个外部变量(外部变量名称，外部变量地址); 这样就可以和Delphi或另一个TCompile共享变量了
    function  SetExteriorParameter(const PName:string;const PAddress:PTComplex):boolean;overload;
          //(编译前调用,如果是在编译后，需要调用RefreshExeAddressCodeInPointer刷新地址)
      // 设置一批外部变量
      function  SetExteriorParameter(const PNameList:array of string;const PAddressList:array of PTComplex):boolean;overload;
      // 设置外部数组(数组名称,数组地址);
      function  SetExteriorArrayParameter(const ArrayPName:string;const ArrayPAddress:PTComplex):boolean;
      procedure RefreshExeAddressCodeInPointer();  //刷新变更地址


    //根据参数名称PName得到参数地址值指针
    function  GetParameterAddress(const PName:string):PTComplex;
    //按参数名称PName设置参数值dValue
    function  SetParameter(const PName:string;const dValue:TComplex):boolean;overload;
    //按参数地址PAddress设置参数值dValue
    procedure SetParameter(const PAddress:PTComplex;const dValue:TComplex);overload;
    //得到参数PName的值
    function  GetParameterValue(const PName:string):TComplex;
    //得到参数的总数目(包括常数)
    Function  GetParameterCount():integer;
    //通过PList返回参数列表(包括常数)
    procedure GetParameterList(var PList:array of TParameterListCmCx);
    //得到参数的总数目(不包括常数)
    Function  GetUserParameterCount():integer;
    //通过PList返回参数列表(不包括常数)
    procedure GetUserParameterList(var PList:array of TUserParameterListCmCx);
    //返回用户设置的参数的数目
    Function  GetFunctionPlistCount():integer;   //封装VB使用的API函数时用到 2003.3.29加入
    //测试参数PName是否已经存在
    function  IfHaveParameter(const PName:string):boolean;overload;
    //测试常数dValue是否已经存在 并通过cName返回常数名称
    function  IfHaveParameter(const dValue:TComplex;var cName:string):boolean;overload;

    //返回错误描述
    function  GetError():string;
    //返回错误代码号
    function  GetErrorCode():integer;
    //返回错误描述(中文简体) 要更改错误描述或翻译为其他语言时请改写此函数
    function  GetErrorGB(const xErrorCode{错误代码号}:integer):string;overload;
    //返回错误描述(中文繁体) 这是给的例子
    function  GetErrorBIG5(const xErrorCode:integer):string;overload;
    //返回错误描述(英文) 这是给的例子,英语水平有限,希望有大虾更正:)
    function  GetErrorEnglish(const xErrorCode:integer):string;overload;
    //返回编译以后的程序指令区代码长度(字节)
    Function  GetExeCodeLength():integer;
    //返回编译以后的程序数据区代码长度(字节)
    Function  GetExeParameterLength():integer;

    //设置随机函数Rnd()的初始种子值为完全随机种子(系统用当前精确到毫秒的时间设置)
    procedure SetRandomize();overload;
    //设置随机函数Rnd()的初始种子值
    procedure SetRandomize(const RandomSeed :integer);overload;


    
  public
    //定义用户自由使用的未定义属性,用户可以用来储存自己的数据
    //类本身并不会使用
    Tag         : integer;
    Tag_F       : Extended;
    Tag_P       : Pointer;

  protected


    {私有数据}

    FExeText        :string;     //表达式
    ErrorCode       :integer;     //错误描述代码

    RndSeed         :array [0..1] of integer;  //随机函数种子值

    FunctionList    :array [0..128-1] of TFunctionList;     //函数列表(包括别名)
    PFunctionList   :integer;                               //当前函数信息插入函数列表位置

    FunctionStack   :array  of string;         //函数符号调用堆栈
    PFunctionStack  :integer;                  //函数符号调用堆栈 当前插入位置

    ExeAddressCode  :array of byte; //编译以后的执行码
    PExeAddressCode :integer;       //当前插入机器指令位置

    ExeAddressPMList  :array of TExeAddressPMListCmCx;  //记录指针位置列表(因为参数存储地址用到)
    PExeAddressPMList :integer;           //当前插入位置

    ExeAddressTempData  :array [0..16*1024-1] of byte; //临时数据交换地址
    ExeAddressStack     :array [0..16*1024-1] of byte; //数据堆栈地址

    ParameterList     :array  of TParameterListCmCx;   //参数列表
    PParameterList    :integer; //保存参数列表当前插入位置

    ExeParameter      :array  of byte; //编译后 参数储存空间
    PExeParameter     :integer; //编译后 参数地址 ,当前分配参数位置
                                //PExeParameterList:=@ExeParameter[PExeParameter]

    TF00            :string;    // 比较符号优先级时 Tf00 用来保存上一次的符号


    T_PTrueNow      :TT_PTrueCmCx;  //编译优化常数时  当前参数性质
    T_PTrueOld      :TT_PTrueCmCx;  //编译优化常数时  上一个参数性质
    T_PTrueNowList  :array  of TT_PTrueCmCx; //编译优化常数时  参数性质堆栈
    PT_PTrueNowList :integer;            //当前参数性质堆栈插入位置

    CompileInPFirst :integer;   //第几次调用CompileInP()

    FFunctionPlistCount : integer; // 生成函数的参数个数;
    FFunctionPListIsSet : boolean; // 是否设置了参数列表;

    {私有函数}
    procedure Clear();
    function  Parsing(var str:string):boolean;//第一遍翻译
    function  CheckBK(const str:string):boolean;//括号配对检查
    procedure CompileInP(const PName:string); //编译 参数堆栈插入参数
    procedure CompileInPReNew(const dValue:TComplex;const Pm:integer); //编译 参数堆栈插入参数 (替换)
    procedure CompileOutP(); //编译 弹出参数
    procedure CompileInF(const FName:string); //编译 函数调用
    function  GetSign(var str:string):string; //返回 str 的第一个算数符
    function  CompareSign(const FName1 : string;const FName2 :string): integer; //比较符号的优先级
    procedure CheckWording(const T1 : string;const T2 : string) ;// 按照先后关系检查语法错误

    // 设置参数调用格式(虚参数列表字符串); 比如：ParameterList='x,y' ;
    function  SetFunctionCallFormart(const ParameterList : string):boolean;

    procedure ExeAddressCodeIn(const B:Byte);  overload;      //编译插入CPU指令
    procedure ExeAddressCodeIn(const B:array of Byte); overload;
    procedure ExeAddressCodeIn(const sB:string);  overload;
    procedure GetExeAddressCodeInPointerRePm(const PName:string); //记录编译指令中插入的参数地址,变更地址时以便更新

    procedure FunctionListIn(const s:string;const F:Pointer;const iCount:integer);//把支持的函数插入函数列表
    procedure GetFunctionList();                                 //获得函数列表
    Function  GetFunctionIndex(const fName:string):integer;      //获得指定名称函数的序号
    function  IfHaveFunction (const fName:string):boolean;       //判断指定名称函数是否已经在函数列表中