compile_hss.pas

酒店管理VB源码

    CName     :String;     //参数名称
    CAddress  :PExtended;  //参数地址  
    CIndex    :integer;    //参数地址序号 (在ExeParameter中的位置序号,系统使用)
    IsConst   :boolean;    //是否为常数;  false:变量 true:常数
    IsExterior:boolean;    //是否是外部变量 false:内部变量 true:外部变量
  end;
  const SizeofTParameterList=sizeof(TParameterList);

  type TUserParameterList =record   //用户使用 (系统用 TParameterList)
    CName     :String;     //参数名称
    CAddress  :PExtended;  //参数地址
  end;

  type TT_PTrue=record
    isConst   :boolean;    //编译优化常数时  参数性质  是否为常数
    dValue    :Extended;   //编译优化常数时  参数性质  值
  end;

  type TExeAddressPMList=record
    ExeIndex  :integer;     //插入ExeCode的当前位置序号
    PName     :string;       //参数名称
  end;

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


////////////////////////////////////////////////////////////////////////////////

const
  // 版本
  csTCompile_Version :double =1.43;  //2002.11.28-12.03    改进函数设置和调用、优化常数除法、增加消除堆栈的优化方法、增加强大的预处理宏、共享外部变量支持
    // csTCompile_Version :double =1.31   //2002.11.5-11.8   小的改进、修改用户调用方式等
    // csTCompile_Version :double =1.30;  //2002.8           增加布尔运算和逻辑运算支持等
    // csTCompile_Version :double =1.20;  //2002.7-2002.8    改进、除错、增加允许注释功能、增加错误描述等
    // csTCompile_Version :double =1.10;  //2002.5-2002.6    改进、除错、对常数运算进行优化等
    // csTCompile_Version :double =1.00;  //2002.5           完成框架

type
  TCompile=class    // <<数学函数动态编译器TCompile类>>

  protected  {私有}

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

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

    //Enabled   :boolean;    // 是否有效

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

    // 设置需要编译的字符串(要编译的字符串,虚参数列表字符串,是否自动编译);
    //    比如：Value:='Sqr(x)+Sqr(y)'; ParameterList:='x,y' ;
    function  SetText(const Value:string;const ParameterList : string='';const IfCompile: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;  //(编译后才能调用)

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

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

    // 类的属性: 是否允许使用注释
    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:PExtended):boolean;overload;
              //(编译前调用,如果是在编译后，需要调用RefreshExeAddressCodeInPointer刷新地址)
      // 设置外部数组(数组名称,数组地址);
      function  SetExteriorArrayParameter(const ArrayPName:string;const ArrayPAddress:PExtended):boolean;
      function  SetExteriorParameter(const PNameList:array of string;const PAddressList:array of PExtended):boolean;overload;
      procedure RefreshExeAddressCodeInPointer();  //刷新变更地址  //(设置完所有的外部变量以后需要调用一次该函数)

    //根据参数名称PName得到参数地址值
    function  GetParameterAddress(const PName:string):PExtended;
    //按参数名称PName设置参数值dValue
    function  SetParameter(const PName:string;const dValue:Extended):boolean;overload;
    //按参数地址PAddress设置参数值dValue
    procedure SetParameter(const PAddress:PExtended;const dValue:Extended);overload;
    //得到参数PName的值
    function  GetParameterValue(const PName:string):Extended;
    //得到参数的总数目(不包括常数)
    Function  GetUserParameterCount():integer;
    //返回用户设置的参数的数目
    Function  GetFunctionPlistCount():integer;   //封装VB使用的API函数时用到 2003.3.29加入
    //通过PList返回参数列表(不包括常数)
    procedure GetUserParameterList(var PList:array of TUserParameterList);
    //得到参数的总数目(包括常数)
    Function  GetParameterCount():integer;
    //通过PList返回参数列表(包括常数)
    procedure GetParameterList(var PList:array of TParameterList);
    //测试参数PName是否已经存在
    function  IfHaveParameter(const PName:string):boolean;overload;
    //测试常数dValue是否已经存在 并通过cName返回常数名称
    function  IfHaveParameter(const dValue:Extended;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;
    //设置随机函数Random()的初始种子值
    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;     //函数列表,已经有60多个函数了(包括别名)
    PFunctionList   :integer;                               //当前函数信息插入函数列表位置

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

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

    ExeAddressList  :array of integer;  //记录指针位置列表(因为积分函数用到)
    PExeAddressList :integer;           //当前插入位置

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

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

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

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

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

    T_SYS_FF_ConstN :integer;   //积分变量 序号

    T_PTrueNow      :TT_PTrue;  //编译优化常数时  当前参数性质
    T_PTrueOld      :TT_PTrue;  //编译优化常数时  上一个参数性质
    T_PTrueNowList  :array  of TT_PTrue; //编译优化常数时  参数性质堆栈
    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:Extended;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);  //记录编译指令中插入的参数名称,变更地址时以便更新
    Function  GetExeAddressCodeInPointerReCode():Pointer; //记录编译指令中插入的执行偏移地址,变更地址时以便更新
    function  OptimizeStackCall(const IfFxch:boolean=true):boolean; // 优化堆栈调用

    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;       //判断指定名称函数是否已经在函数列表中

    procedure FunctionStackIn(const s:string);    //
    Function  FunctionStackOut():string;          //管理  函数符号调用堆栈