compile_calc.pas

进销存·完整的·有数据库的·非常完整·只得参考

    // 按照先后关系检查语法错误

    procedure ExeAddressCodeIn(const B: Byte); overload; //编译插入CPU指令
    procedure ExeAddressCodeIn(const B: array of Byte); overload;
    procedure ExeAddressCodeIn(const sB: string); overload;
    procedure GetExeAddressCodeInPointerRePm(const PMIndex: integer);
    //记录编译指令中插入的参数地址,变更地址时以便更新
    function GetExeAddressCodeInPointerReCode(): Pointer;
    //记录编译指令中插入的执行偏移地址,变更地址时以便更新
    procedure RefreshExeAddressCodeInPointer(); //刷新变更地址

    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; //管理  函数符号调用堆栈
    function FunctionStackRead(): string; //

    procedure ParameterListIn(const PName: string); overload;
    //将参数插入参数堆栈
    function GetParameterListConstIndex(const PName: string): integer;
    function ParameterListIn(const dValue: Extended): string; overload;
    //将常数插入参数堆栈 并返回由系统定义的别名
    function GetParameterIndex(const PName: string): integer;
    //得到指定名称参数的序号

    procedure T_PTrueNowListIN(const TP: TT_PTrue);
    //管理   (编译优化常数时) 参数性质堆栈
    function T_PTrueNowListOut(): TT_PTrue; //

    //传入参数str,通过s返回
    function Dbxch(var s: string; var str: string): boolean;
    // 书写格式转换函数  f(x,y) => ((x)f(y))
    function Dbxchff_SYS(var s: string; var str: string): boolean;
    // 书写格式转换函数 ff(a,b,x,N,g(x)) => ( (a) F_FF_SYS_0 (b) F_FF_SYS_1 (N) F_FF_SYS_2 ( g(x) ) )

    procedure DelStrNote(var str: string); // 去掉str注释部分

    function ifFF_SYS(const fName: string): boolean; // fName 中是否有 积分函数
    function getFF_SYS(const fName: string): string; // 返回积分函数名称

    {编译 函数}
    //约定:  单元函数 通过 st 传参数值 ,通过 st 返回结果值
    //       双元函数 通过 st 传第一参数值,通过 [ecx] 传第二个参数 ,通过 st 返回结果值
    //       函数可以 通过 [edx] 及以后的临时数据交换区来保存、修改或读取数据
    //       函数可以随意使用EAX、EBX
    procedure F_Add();
    procedure F_Sub();
    procedure F_Mul();
    procedure F_Div();
    procedure F_DivE();
    procedure F_Mod();
    procedure F_Power();
    procedure F_Max();
    procedure F_Min();
    procedure F_Bracket(); { ()函数 }
    procedure F_Rev();
    procedure F_Sqr();
    procedure F_Sqrt();
    procedure F_Sin();
    procedure F_Cos();
    procedure F_Tan();
    procedure F_ArcSin();
    procedure F_ArcCos();
    procedure F_ArcTan();
    procedure F_ArcTan2();
    procedure F_Ln();
    procedure F_Log();
    procedure F_Log2();
    procedure F_Abs();
    procedure F_Floor();
    procedure F_Trunc();
    procedure F_Round();
    procedure F_Sgn();
    procedure F_exp();
    procedure F_SinH();
    procedure F_CosH();
    procedure F_TanH();
    procedure F_ArcSinH();
    procedure F_ArcCosH();
    procedure F_ArcTanH();
    procedure F_Rnd();
    procedure F_Ctg();
    procedure F_Sec();
    procedure F_Csc();
    procedure F_CscH();
    procedure F_SecH();
    procedure F_CtgH();
    procedure F_ArcCsc();
    procedure F_ArcSec();
    procedure F_ArcCtg();
    procedure F_ArcCscH();
    procedure F_ArcSecH();
    procedure F_ArcCtgH();
    procedure F_Hypot();

    procedure F_FF_SYS_0(const N: integer); //积分函数0
    procedure F_FF_SYS_1(const N: integer); //积分函数1
    procedure F_FF_SYS_2(const N: integer); //积分函数2

    {有限状态自动机}

    function Conversion0(var s: string; var str: string): boolean;
    //得到参数(常数)列表、函数转换
    procedure GetMarker(const Str: string; const iFirst: integer; var iEnd:
      integer); //含'@'、'&'取出标识符

    procedure GetMarkerValue0(const Str: string; const iFirst: integer; var
      iEnd: integer); {取出标识符的有限状态自动机}
    procedure GetMarkerValue1(const Str: string; const iFirst: integer; var
      iEnd: integer);

    procedure GetFloatValue0(const Str: string; const iFirst: integer; var iEnd:
      integer); {取出常数的有限状态自动机}
    procedure GetFloatValue1(const Str: string; const iFirst: integer; var iEnd:
      integer);
    procedure GetFloatValue2(const Str: string; const iFirst: integer; var iEnd:
      integer);
    procedure GetFloatValue3(const Str: string; const iFirst: integer; var iEnd:
      integer);
    procedure GetFloatValue4(const Str: string; const iFirst: integer; var iEnd:
      integer);
    procedure GetFloatValue5(const Str: string; const iFirst: integer; var iEnd:
      integer);
    procedure GetFloatValue6(const Str: string; const iFirst: integer; var iEnd:
      integer);

  public
    { Public declarations }
    constructor Create();
    destructor Destroy(); override;
  end;

  {$IFDEF MSWINDOWS}

  TSystemTime = record
    wYear: Word;
    wMonth: Word;
    wDayOfWeek: Word;
    wDay: Word;
    wHour: Word;
    wMinute: Word;
    wSecond: Word;
    wMilliSeconds: Word;
    reserved: array[0..7] of char;
  end;
procedure GetSystemTime(var lpSystemTime: TSystemTime); stdcall;
{$EXTERNALSYM GetSystemTime}

{$ENDIF}

//错误号定义
const
  csTCompile_NoError = 0;
  csTCompile_NoKnownError = 1;
  csTCompile_NoErrorCode = 2;

  csTCompile_CompileHexCodeError = 3;
  csTCompile_HexMod2_EQ_1_Error = 4;

  csTCompile_PMMarker_Error = 5;
  csTCompile_FMMarker_Error = 6;
  csTCompile_Wording_Error = 7;
  csTCompile_Bracket_Error = 8;
  csTCompile_Optimize_Error = 9;
  csTCompile_Define_Error = 10;
  csTCompile_Handwriting_Error = 11;
  csTCompile_FFHandwriting_Error = 12;

  csTCompile_ReadFloat_Error = 13;
  csTCompile_ReadMarker_Error = 14;
  csTCompile_Read_Error = 15;
  csTCompile_Note_Match_Error = 16;

implementation

function TCompile.GetError(): string;
begin
  result := GetErrorGB(ErrorCode);
end;

function TCompile.GetErrorGB(const xErrorCode: integer): string; //返回错误描述
begin
  case xErrorCode of
    csTCompile_NoError: result := ''; //没有发现错误!
    csTCompile_NoKnownError: result := '不知道的错误!';
    csTCompile_NoErrorCode: result := '找不到错误号所对应的错误描述!';
    csTCompile_CompileHexCodeError: result := '编译时指令的十六进制代码错误!';
    csTCompile_HexMod2_EQ_1_Error: result := '编译时传入指令长度错误!';
    csTCompile_PMMarker_Error: result := '编译得到参数名称时发生错误!';
    csTCompile_FMMarker_Error: result := '编译得到函数名称时发生错误!';
    csTCompile_Wording_Error: result := '语法发生错误!';
    csTCompile_Bracket_Error: result := '语法错误,在 ( ) 处!';
    csTCompile_Optimize_Error: result := '编译优化时发生错误!';
    csTCompile_Define_Error: result := '函数编译错误(或超出定义域)!';
    csTCompile_Handwriting_Error: result := '函数书写格式错误!';
    csTCompile_FFHandwriting_Error: result := '积分函数书写格式错误!';
    csTCompile_ReadFloat_Error: result := '编译读取常数数字时发生错误!';
    csTCompile_ReadMarker_Error: result := '编译读取标识符时发生错误!';
    csTCompile_Read_Error: result := '语法错误,有不识别的字符!';
    csTCompile_Note_Match_Error: result := '注释符号不匹配!  { } 或 /*  */';
  else
    result := GetErrorGB(csTCompile_NoErrorCode);
  end;
end;

function TCompile.GetErrorBIG5(const xErrorCode: integer): string; //返回错误描述
begin
  //注意:以下使用的是中文繁体BIG5码,要使用内码转换器才能察看
  case xErrorCode of
    csTCompile_NoError: result := ''; //⊿Τ祇瞷岿粇!
    csTCompile_NoKnownError: result := 'ぃ