828
社区成员
发帖
与我相关
我的任务
分享请发表友善的回复…
发表回复
windindance 2004-09-03
- 打赏
- 举报
转非技术区。
hmily1688 2004-09-03
- 打赏
- 举报
{编译 函数}
//约定: 单元函数 通过 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;
//约定: 单元函数 通过 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;
hmily1688 2004-09-03
- 打赏
- 举报
type
TFunctionList = record
FName: string; //函数名称
FAddress: Pointer; //函数地址入口
FCCount: 0..2; //函数所需参数个数
end;
type
TParameterList = record
CName: string; //参数名称
CAddress: PExtended; //参数地址
CIndex: integer; //参数地址序号
IfConst: boolean; //是否为常数; false:变量 true:常数
end;
type
TT_PTrue = record
ifConst: boolean; //编译优化常数时 参数性质 是否为常数
dValue: Extended; //编译优化常数时 参数性质 值
end;
type
TExeAddressPMList = record
ExeIndex: integer; //插入ExeCode的当前位置序号
PMIndex: integer; //参数序号
end;
const
ExendedFormatLength = 16;
//Extended类型(10字节)的存储长度, 设为16是为了数据对齐(8字节对齐)
type
TCompile = class // <<数学函数动态编译器TCompile类>>
private {私有}
// const a
FEnabledNote: boolean;
procedure SetEnabledNote(Value: boolean);
public
//>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>//
// <<对外可见成员 即 接口部分>> //
//<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<//
//Enabled :boolean; // 是否有效
property EnabledNote: Boolean read FEnabledNote write SetEnabledNote default
false;
//类的属性:是否允许使用注释
function SetText(const Value: string): boolean;
//设置需要编译的字符串Value
function GetText(): string;
//获得当前编译的字符串
function GetValue(): Extended; overload;
//返回表达式的值 。
procedure GetValue(var x: Extended); overload;
//返回表达式的值 ,通过 x 返回。
function GetParameterAddress(const PName: string): PExtended;
//根据参数名称PName得到参数地址值
function SetParameter(const PName: string; const dValue: Extended): boolean;
overload;
//按参数名称PName设置参数值dValue
procedure SetParameter(const PAddress: PExtended; const dValue: Extended);
overload;
//按参数地址PAddress设置参数值dValue
function GetParameterValue(const PName: string): Extended;
//得到参数PName的值
function GetParameterCount(): integer;
//得到参数的总数目(包括常数)
procedure GetParameterList(var PList: array of TParameterList);
//通过PList返回参数列表
function IfHaveParameter(const PName: string): boolean; overload;
//测试参数PName是否已经存在
function IfHaveParameter(const dValue: Extended; var cName: string): boolean;
overload;
//测试常数dValue是否已经存在 并通过cName返回常数名称
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;
//返回编译以后的程序数据区代码长度(字节)
procedure SetRandomize1(); //overload;
//设置随机函数Rnd()的初始种子值为完全随机种子(系统用当前精确到毫秒的时间设置)
procedure SetRandomize2(const RandomSeed: integer); //overload;
//设置随机函数Rnd()的初始种子值
private
{ Private declarations }
{私有数据}
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_ff_sys_ConstN: integer; //积分变量 序号
T_PTrueNow: TT_PTrue; //编译优化常数时 当前参数性质
T_PTrueOld: TT_PTrue; //编译优化常数时 上一个参数性质
T_PTrueNowList: array of TT_PTrue; //编译优化常数时 参数性质堆栈
PT_PTrueNowList: integer; //当前参数性质堆栈插入位置
CompileInPFirst: integer; //第几次调用CompileInP()
{私有函数}
procedure Clear();
function Compile(): boolean; //编译
function Parsing(var 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);
// 按照先后关系检查语法错误
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; // 返回积分函数名称
TFunctionList = record
FName: string; //函数名称
FAddress: Pointer; //函数地址入口
FCCount: 0..2; //函数所需参数个数
end;
type
TParameterList = record
CName: string; //参数名称
CAddress: PExtended; //参数地址
CIndex: integer; //参数地址序号
IfConst: boolean; //是否为常数; false:变量 true:常数
end;
type
TT_PTrue = record
ifConst: boolean; //编译优化常数时 参数性质 是否为常数
dValue: Extended; //编译优化常数时 参数性质 值
end;
type
TExeAddressPMList = record
ExeIndex: integer; //插入ExeCode的当前位置序号
PMIndex: integer; //参数序号
end;
const
ExendedFormatLength = 16;
//Extended类型(10字节)的存储长度, 设为16是为了数据对齐(8字节对齐)
type
TCompile = class // <<数学函数动态编译器TCompile类>>
private {私有}
// const a
FEnabledNote: boolean;
procedure SetEnabledNote(Value: boolean);
public
//>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>//
// <<对外可见成员 即 接口部分>> //
//<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<//
//Enabled :boolean; // 是否有效
property EnabledNote: Boolean read FEnabledNote write SetEnabledNote default
false;
//类的属性:是否允许使用注释
function SetText(const Value: string): boolean;
//设置需要编译的字符串Value
function GetText(): string;
//获得当前编译的字符串
function GetValue(): Extended; overload;
//返回表达式的值 。
procedure GetValue(var x: Extended); overload;
//返回表达式的值 ,通过 x 返回。
function GetParameterAddress(const PName: string): PExtended;
//根据参数名称PName得到参数地址值
function SetParameter(const PName: string; const dValue: Extended): boolean;
overload;
//按参数名称PName设置参数值dValue
procedure SetParameter(const PAddress: PExtended; const dValue: Extended);
overload;
//按参数地址PAddress设置参数值dValue
function GetParameterValue(const PName: string): Extended;
//得到参数PName的值
function GetParameterCount(): integer;
//得到参数的总数目(包括常数)
procedure GetParameterList(var PList: array of TParameterList);
//通过PList返回参数列表
function IfHaveParameter(const PName: string): boolean; overload;
//测试参数PName是否已经存在
function IfHaveParameter(const dValue: Extended; var cName: string): boolean;
overload;
//测试常数dValue是否已经存在 并通过cName返回常数名称
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;
//返回编译以后的程序数据区代码长度(字节)
procedure SetRandomize1(); //overload;
//设置随机函数Rnd()的初始种子值为完全随机种子(系统用当前精确到毫秒的时间设置)
procedure SetRandomize2(const RandomSeed: integer); //overload;
//设置随机函数Rnd()的初始种子值
private
{ Private declarations }
{私有数据}
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_ff_sys_ConstN: integer; //积分变量 序号
T_PTrueNow: TT_PTrue; //编译优化常数时 当前参数性质
T_PTrueOld: TT_PTrue; //编译优化常数时 上一个参数性质
T_PTrueNowList: array of TT_PTrue; //编译优化常数时 参数性质堆栈
PT_PTrueNowList: integer; //当前参数性质堆栈插入位置
CompileInPFirst: integer; //第几次调用CompileInP()
{私有函数}
procedure Clear();
function Compile(): boolean; //编译
function Parsing(var 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);
// 按照先后关系检查语法错误
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; // 返回积分函数名称
hmily1688 2004-09-03
- 打赏
- 举报
unit Compile_Calc;
interface
uses SysUtils, Forms, Classes, Math; //, Variants;
(*
<<详细说明>>:
1.支持带参数编译,参数默认值为0;运行前请赋值;
2.常数可以用科学计数法表示,如: -1.4E-4=-0.00014;
系统定义的常数: 圆周率 PI=3.1415926535897932384626433832795
自然数 e=2.7182818284590452353602874713527
(允许重新赋值)
3.使用多重括号并不会降低速度,特别是在不容易分清楚计算优先级的时候,请多使用括号;
4.表达式中函数名和参数名等不区分大小写;关键字中不允许插入空格等字符;
5.编译的文本长度几乎不受限制(只是受内存和编译时间等系统影响)
6.利用错误号功能可以将错误描述翻译为其他语言(给出了两个翻译例子:中文繁体BIG5码的错误描述和英文版的错误描述);
7.允许在表达式中使用注释(TCopmile.EnabledNote:=true;),注释写法为:
单行注释: 双斜杠// 开始到一行结束(即遇到回车换行符)
长段注释: '{'、'}' 或'/*'、'*/' 之间的部分
8.系统使用的标识符除去下面列出的函数名(包括别名)外还有 :
'Const_SYS_N' 、'Const_ff_SYS_x_N'和 'ff_SYS_N' ,自定义的参数名称请不要再次使用它们;
如果参数名称为 'PI' 和 'e' ,那默认值见上面,但这只是它的默认值,程序中可以重新赋值;
9.支持的函数:
这里的实数域为: R' , R'约为 (-1.1E+4932,-3.6E-4951) and [ 0 ] and (+3.6E-4951,+1.1E+4932)
当实数属于(+-3.6E-4951,0) 时认为实数等于0
没有特别说明的变量取值范围为实数域 R'
(函数计算的结果和中间结果也不能超出实数域 R')
算符(函数)名称 书写格式和变量取值范围 例子(说明)
+ 加法 x+y 或者: Add(x,y) 3.5+5=8.5
- 减法 x-y 或者: Sub(x,y) 8-3=5
* 乘法 x*y 或者: Mul(x,y) 2*3=6
/ 除法 x/y 或者: Div(x,y) ; y<>0 3/2=1.5
\ 整除 x\y 或者: DivE(x,y) ; y<>0 25\10=2
Mod 求余 x Mod y 或者: x%y、Mod(x,y) ; y<>0 14 Mod 5=4
^ 指数 x^y 或者: Power(x,y)、x**y 2^3=8
; x<0时,y必须为整数
; x=0时,y>0
Max 最大值 Max(x,y) Max(3,4)=4
Min 最小值 Min(x,y) Min(3,4)=3
Sqr 平方 Sqr(x) Sqr(3)=9 //注意平方和开方的函数名称
Sqrt 开方 Sqrt(x) ; x>=0 Sqrt(3)=1.73205080756888
Sin 正弦 Sin(x) Sin(pi/6)=0.5
Cos 余弦 Cos(x) Cos(0)=1
Tan 正切 Tan(x) 或者: tg(x) Tan(pi/4)=1
ArcSin 反正弦 ArcSin(x) ; -1<=x<=1 ArcSin(1)=1.5707963267949=pi/2
ArcCos 反余弦 ArcCos(x) ; -1<=x<=1 ArcCos(0)=1
ArcTan 反正切 ArcTan(x) 或者: Arctg(x) ArcTan(1)=0.785398163397448=pi/4
ArcTan2 反正切2 ArcTan2(y,x) 或者: Arctg2(y,x) ArcTan2(2,1)=1.10714871779409
;y为纵坐标、x为横坐标
Cot 余切 Cot(x) 或者: Ctg(x) ;x<>0 Cot(x)=1/Tan(x)
Sec 正割 Sec(x) Sec(x)=1/Cos(x)
Csc 余割 Csc(x) ;x<>0 Csc(x)=1/Sin(x)
ArcCot 反余切函数 ArcCot(x) 或者: ArcCtg(x) ;x<>0 ArcCtg(x)=ArcTan(1/X) //Delphi6 误为 ArcCtg(x)=Tan(1/X) !
ArcSec 反正割函数 ArcSec(x) ;|x|>=1 ArcSec(x)=ArcCos(1/X) //Delphi6 误为 ArcSec(x)=Cos(1/X) !
ArcCsc 反余割函数 ArcCsc(x) ;|x|>=1 ArcCsc(x)=ArcSin(1/X) //Delphi6 误为 ArcCsc(x)=Sin(1/X) !
Exp 自然指数 Exp(x) Exp(2)=e*e=e^2
Ln 自然对数 Ln(x) ; x>0 Ln(e)=1
Log 10的对数 Log(x) 或者: Log10(x) ; x>0 Log(100)=2
Log2 2的对数 Log2(x) ; x>0 Log2(8)=3
Abs 绝对值 Abs(x) Abs(-2)=2 ; Abs(2)=2
Rev 倒数 Rev(x) Rev(5)=1/5=0.2
Int 取整 Int(x) 或者: Floor(x) (不超过x的最大整数) Int(2.3)=2 ; Int(-2.3)=-3
Trunc 截断取整 Trunc(x) (向零取整) Trunc(2.3)=2 ; Trunc(-2.3)=-2
Round 四舍五入 Round(x) (四舍五入取整) Round(2.51)=3 ; Round(2.49)=2
Sgn 符号函数 Sgn(x) Sgn(-2)=-1 ; Sgn(0)=0 ; Sgn(2)=1
Hypot 斜边 Hypot(x,y) Hypot(x,y)=Sqrt(x*x+y*y)
Random 随机函数 Random(x) 或者:RND(x)、Rand(x) Random(2.5)=2.5*a ,其中a为随机数0<=a<1
(要产生真正的随机数,而不是固定随机数序列,请在创建或编译完成后
取得表达式值之前调用一次TCopmile.SetRandomize();函数。)
SinH 双曲正弦 SinH(x) SinH(2)=3.62686040784702=(e^2-e^(-2))/2
CosH 双曲余弦 CosH(x) CosH(2)=3.76219569108363=(e^2+e^(-2))/2
TanH 双曲正切 TanH(x) 或者: tgH(x) TanH(2)=0.964027580075817=SinH(2)/CosH(2)
ArcSinH 反双曲正弦 ArcSinH(x) ArcSinH(3.62686040784702)=2
ArcCosH 反双曲余弦 ArcCosH(x) ; x>=1 ArcCosH(3.76219569108363)=2
ArcTanH 反双曲正切 ArcTanH(x) 或者: ArctgH(x) ArcTanH(0.761594155955765)=1
CotH 双曲余切 CotH(x) 或者: CtgH(x) ;x<>0 CotH(x)=1/TanH(x)
SecH 双曲正割 SecH(x) SecH(x)=1/CosH(x)
CscH 双曲余割 CscH(x) ;x<>0 CscH(x)=1/SinH(x)
ArcCotH 反双曲余切函数 ArcCotH(x) 或者: ArcCtgH(x) ;x<>0 ArcCtgH(x)=ArcTanH(1/X) //Delphi6 误为 ArcCotH(x)=1/ArcCot(X) !
ArcSecH 反双曲正割函数 ArcSecH(x) ;0<x<=1 ArcSecH(x)=ArcCosH(1/X) //Delphi6 误为 ArcSecH(x)=1/ArcSec(X) !
ArcCscH 反双曲余割函数 ArcCscH(x) ;x<>0 ArcCscH(x)=ArcSinH(1/X) //Delphi6 误为 ArcCscH(x)=1/ArcCsc(X) !
ff 定积分函数 ff(a,b,x,g(x)) 或者: ff(a,b,x,N,g(x)) ff(-1,1,y,Sqrt(1-y*y))=pi/2
( ff函数特别说明:
函数g(x)是关于'x'的表达式(也可以不含有变量x),这里的自变量x与本函数ff以外的x没有关系;
ff函数表示 对函数 g(x) 从 a 积到 b 积分,
x表示以x为积分变量对函数g(x)积分,
N (N>0) 表示 把积分区间分成 N 份来积 ,省略 N 时默认为 1000 ;
积分函数支持多重积分(较慢)
(注意: 多重积分和积分套嵌不是一个意思)
比如求单位球体的体积(R=1)
二重积分表达式为:
ff(-1,1,x, //x从-1到1积分
ff(-Sqrt(1-x*x),Sqrt(1-x*x),y, //y从-Sqrt(1-x*x)到sqrt(1-x*x)积分
2*Sqrt(1-x*x-y*y)
)
)
=4.18883330446894
=4*Pi/3
=ff(-1,1,x,PI*(1-x*x)) // (求单位球体体积的一重积分表达式)
)
*)
interface
uses SysUtils, Forms, Classes, Math; //, Variants;
(*
<<详细说明>>:
1.支持带参数编译,参数默认值为0;运行前请赋值;
2.常数可以用科学计数法表示,如: -1.4E-4=-0.00014;
系统定义的常数: 圆周率 PI=3.1415926535897932384626433832795
自然数 e=2.7182818284590452353602874713527
(允许重新赋值)
3.使用多重括号并不会降低速度,特别是在不容易分清楚计算优先级的时候,请多使用括号;
4.表达式中函数名和参数名等不区分大小写;关键字中不允许插入空格等字符;
5.编译的文本长度几乎不受限制(只是受内存和编译时间等系统影响)
6.利用错误号功能可以将错误描述翻译为其他语言(给出了两个翻译例子:中文繁体BIG5码的错误描述和英文版的错误描述);
7.允许在表达式中使用注释(TCopmile.EnabledNote:=true;),注释写法为:
单行注释: 双斜杠// 开始到一行结束(即遇到回车换行符)
长段注释: '{'、'}' 或'/*'、'*/' 之间的部分
8.系统使用的标识符除去下面列出的函数名(包括别名)外还有 :
'Const_SYS_N' 、'Const_ff_SYS_x_N'和 'ff_SYS_N' ,自定义的参数名称请不要再次使用它们;
如果参数名称为 'PI' 和 'e' ,那默认值见上面,但这只是它的默认值,程序中可以重新赋值;
9.支持的函数:
这里的实数域为: R' , R'约为 (-1.1E+4932,-3.6E-4951) and [ 0 ] and (+3.6E-4951,+1.1E+4932)
当实数属于(+-3.6E-4951,0) 时认为实数等于0
没有特别说明的变量取值范围为实数域 R'
(函数计算的结果和中间结果也不能超出实数域 R')
算符(函数)名称 书写格式和变量取值范围 例子(说明)
+ 加法 x+y 或者: Add(x,y) 3.5+5=8.5
- 减法 x-y 或者: Sub(x,y) 8-3=5
* 乘法 x*y 或者: Mul(x,y) 2*3=6
/ 除法 x/y 或者: Div(x,y) ; y<>0 3/2=1.5
\ 整除 x\y 或者: DivE(x,y) ; y<>0 25\10=2
Mod 求余 x Mod y 或者: x%y、Mod(x,y) ; y<>0 14 Mod 5=4
^ 指数 x^y 或者: Power(x,y)、x**y 2^3=8
; x<0时,y必须为整数
; x=0时,y>0
Max 最大值 Max(x,y) Max(3,4)=4
Min 最小值 Min(x,y) Min(3,4)=3
Sqr 平方 Sqr(x) Sqr(3)=9 //注意平方和开方的函数名称
Sqrt 开方 Sqrt(x) ; x>=0 Sqrt(3)=1.73205080756888
Sin 正弦 Sin(x) Sin(pi/6)=0.5
Cos 余弦 Cos(x) Cos(0)=1
Tan 正切 Tan(x) 或者: tg(x) Tan(pi/4)=1
ArcSin 反正弦 ArcSin(x) ; -1<=x<=1 ArcSin(1)=1.5707963267949=pi/2
ArcCos 反余弦 ArcCos(x) ; -1<=x<=1 ArcCos(0)=1
ArcTan 反正切 ArcTan(x) 或者: Arctg(x) ArcTan(1)=0.785398163397448=pi/4
ArcTan2 反正切2 ArcTan2(y,x) 或者: Arctg2(y,x) ArcTan2(2,1)=1.10714871779409
;y为纵坐标、x为横坐标
Cot 余切 Cot(x) 或者: Ctg(x) ;x<>0 Cot(x)=1/Tan(x)
Sec 正割 Sec(x) Sec(x)=1/Cos(x)
Csc 余割 Csc(x) ;x<>0 Csc(x)=1/Sin(x)
ArcCot 反余切函数 ArcCot(x) 或者: ArcCtg(x) ;x<>0 ArcCtg(x)=ArcTan(1/X) //Delphi6 误为 ArcCtg(x)=Tan(1/X) !
ArcSec 反正割函数 ArcSec(x) ;|x|>=1 ArcSec(x)=ArcCos(1/X) //Delphi6 误为 ArcSec(x)=Cos(1/X) !
ArcCsc 反余割函数 ArcCsc(x) ;|x|>=1 ArcCsc(x)=ArcSin(1/X) //Delphi6 误为 ArcCsc(x)=Sin(1/X) !
Exp 自然指数 Exp(x) Exp(2)=e*e=e^2
Ln 自然对数 Ln(x) ; x>0 Ln(e)=1
Log 10的对数 Log(x) 或者: Log10(x) ; x>0 Log(100)=2
Log2 2的对数 Log2(x) ; x>0 Log2(8)=3
Abs 绝对值 Abs(x) Abs(-2)=2 ; Abs(2)=2
Rev 倒数 Rev(x) Rev(5)=1/5=0.2
Int 取整 Int(x) 或者: Floor(x) (不超过x的最大整数) Int(2.3)=2 ; Int(-2.3)=-3
Trunc 截断取整 Trunc(x) (向零取整) Trunc(2.3)=2 ; Trunc(-2.3)=-2
Round 四舍五入 Round(x) (四舍五入取整) Round(2.51)=3 ; Round(2.49)=2
Sgn 符号函数 Sgn(x) Sgn(-2)=-1 ; Sgn(0)=0 ; Sgn(2)=1
Hypot 斜边 Hypot(x,y) Hypot(x,y)=Sqrt(x*x+y*y)
Random 随机函数 Random(x) 或者:RND(x)、Rand(x) Random(2.5)=2.5*a ,其中a为随机数0<=a<1
(要产生真正的随机数,而不是固定随机数序列,请在创建或编译完成后
取得表达式值之前调用一次TCopmile.SetRandomize();函数。)
SinH 双曲正弦 SinH(x) SinH(2)=3.62686040784702=(e^2-e^(-2))/2
CosH 双曲余弦 CosH(x) CosH(2)=3.76219569108363=(e^2+e^(-2))/2
TanH 双曲正切 TanH(x) 或者: tgH(x) TanH(2)=0.964027580075817=SinH(2)/CosH(2)
ArcSinH 反双曲正弦 ArcSinH(x) ArcSinH(3.62686040784702)=2
ArcCosH 反双曲余弦 ArcCosH(x) ; x>=1 ArcCosH(3.76219569108363)=2
ArcTanH 反双曲正切 ArcTanH(x) 或者: ArctgH(x) ArcTanH(0.761594155955765)=1
CotH 双曲余切 CotH(x) 或者: CtgH(x) ;x<>0 CotH(x)=1/TanH(x)
SecH 双曲正割 SecH(x) SecH(x)=1/CosH(x)
CscH 双曲余割 CscH(x) ;x<>0 CscH(x)=1/SinH(x)
ArcCotH 反双曲余切函数 ArcCotH(x) 或者: ArcCtgH(x) ;x<>0 ArcCtgH(x)=ArcTanH(1/X) //Delphi6 误为 ArcCotH(x)=1/ArcCot(X) !
ArcSecH 反双曲正割函数 ArcSecH(x) ;0<x<=1 ArcSecH(x)=ArcCosH(1/X) //Delphi6 误为 ArcSecH(x)=1/ArcSec(X) !
ArcCscH 反双曲余割函数 ArcCscH(x) ;x<>0 ArcCscH(x)=ArcSinH(1/X) //Delphi6 误为 ArcCscH(x)=1/ArcCsc(X) !
ff 定积分函数 ff(a,b,x,g(x)) 或者: ff(a,b,x,N,g(x)) ff(-1,1,y,Sqrt(1-y*y))=pi/2
( ff函数特别说明:
函数g(x)是关于'x'的表达式(也可以不含有变量x),这里的自变量x与本函数ff以外的x没有关系;
ff函数表示 对函数 g(x) 从 a 积到 b 积分,
x表示以x为积分变量对函数g(x)积分,
N (N>0) 表示 把积分区间分成 N 份来积 ,省略 N 时默认为 1000 ;
积分函数支持多重积分(较慢)
(注意: 多重积分和积分套嵌不是一个意思)
比如求单位球体的体积(R=1)
二重积分表达式为:
ff(-1,1,x, //x从-1到1积分
ff(-Sqrt(1-x*x),Sqrt(1-x*x),y, //y从-Sqrt(1-x*x)到sqrt(1-x*x)积分
2*Sqrt(1-x*x-y*y)
)
)
=4.18883330446894
=4*Pi/3
=ff(-1,1,x,PI*(1-x*x)) // (求单位球体体积的一重积分表达式)
)
*)
jinjazz 2004-09-03
- 打赏
- 举报
http://community.csdn.net/Expert/topic/2641/2641406.xml?temp=.7165033
http://community.csdn.net/Expert/topic/2794/2794615.xml?temp=.5860865
http://community.csdn.net/Expert/topic/2794/2794615.xml?temp=.5860865
happy1123 2004-09-02
- 打赏
- 举报
我再声明，我从来不倒分，
To jinjazz(人雅的标记--落寞刺客)
你是版主？看看我上面贴的链接，我在里面跟他要的源码。我很感激，我觉得很少有人这么热情的对待一个初学者。
你这个人很无聊
To jinjazz(人雅的标记--落寞刺客)
你是版主？看看我上面贴的链接，我在里面跟他要的源码。我很感激，我觉得很少有人这么热情的对待一个初学者。
你这个人很无聊
angle097113 2004-09-02
- 打赏
- 举报
To jinjazz(人雅的标记--落寞刺客) 你很无聊啊，你看我像倒分的人吗?有倒分的必要吗?只不过用马甲给别人发了个源代码，你至于吗？
jinjazz 2004-09-02
- 打赏
- 举报
hmily1688(没什么好说的)
-------------------------
为了避免被某些人有机可趁，历来都不支持在qq上的问题来这里给分，希望你们理解；
楼主不能证明你链接里的事实的话，你的两个帖子将转移，将会损失性欲分
-------------------------
为了避免被某些人有机可趁，历来都不支持在qq上的问题来这里给分，希望你们理解；
楼主不能证明你链接里的事实的话，你的两个帖子将转移，将会损失性欲分
happy1123 2004-09-02
- 打赏
- 举报
干嘛这样啊，我真的没倒分。里面的happy1123就是我，hmily1688(没什么好说的)就是他。他给了我一个源码，对我很有帮助，所有我给这么多分。我从来不倒分
hmily1688 2004-09-02
- 打赏
- 举报
To jinjazz(人雅的标记--落寞刺客):刘胜涛是导分，你封他帐号吧，哈哈。
WGYKING 2004-09-02
- 打赏
- 举报
UP 修 UP PUPUPUPUP
UP 罗 UP UP UP
UP 灌 UP UP UP
UP 水 UP UPUPUP
UP 专 UP UP
UP 用 UP UP
UPUP PUPUP
jinjazz 2004-09-02
- 打赏
- 举报
那个链接不能说明什么,如果这贴还没有结果揭帖的话,将转移至非技术区
happy1123 2004-09-02
- 打赏
- 举报
http://community.csdn.net/Expert/TopicView.asp?id=3332201
jinjazz 2004-09-02
- 打赏
- 举报
相关链接，否则不予支持
happy1123 2004-09-02
- 打赏
- 举报
不是倒分，他帮了我一个大忙
lihua9666 2004-09-02
- 打赏
- 举报
哈哈，倒分
