////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2023 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// Expression evaluator - simple interpreter for calculations.                //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20011215 - Creation (uses CRW16) & test                                    //
// 20011216 - smartargs                                                       //
// 20011219 - TeeFunction,ee_MaxFuncArgs, test Ok                             //
// 20020131 - now actions start from @ or \, so @voice or \voice equals.      //
// 20020202 - change Search methods, inline QuickSearch code in place         //
// 20030326 - Struggle for safety (add some try/except checks)...             //
// 20030328 - Replace TObjectList to TObjectStorage.                          //
// 20060303 - Case sensitive, x=@cmd assignment                               //
// 20060318 - @mmtimer                                                        //
// 20060325 - @async                                                          //
// 20170818 - getpid, getppid, cpu_count, pidaffinity                         //
// 20170926 - rgb,cga2rgb                                                     //
// 20171010 - IsSimpleScript, EvaluateSimpleScript                            //
// 20171017 - Optimization + string hashing makes EE *2 times faster          //
// 20171026 - Parent property                                                 //
// 20171116 - Hash become Cardinal, Search & CalcHash modified.               //
// 20171204 - Uses _HASH library and Hasher property, ee_DefaultHasher.       //
// 20180831 - add constant processid                                          //
// 20190906 - add mksecnow(),cpu_start(),cpu_clock()                          //
// 20230601 - Modified for FPC (A.K.)                                         //
////////////////////////////////////////////////////////////////////////////////

unit _crw_ee; { Expression Evaluator }

{$I _crw_sysdef}

{$IFDEF FPC}{$mode Delphi}{$ENDIF}{$H+}

interface

uses
 _crw_sharemem, // NB: THIS UNIT MUST BE FIRST !!!
 {$IFDEF UNIX} cthreads, dl, {$ENDIF}
 {$IFDEF WINDOWS} windows, {$ENDIF}
 sysutils, classes, contnrs, math, sockets,
 _crw_alloc, _crw_fpu, _crw_rtc, _crw_ef, _crw_zm, _crw_str,
 _crw_fio, _crw_snd, _crw_fifo, _crw_dynar, _crw_mmt, _crw_proc,
 {_crw_task,} _crw_plut, _crw_hash;

const
 ee_MaxVarsLen  = 31;  // Максимальная длина имени переменных
 ee_MaxNoteLen  = 127; // Максимальная длина комментария/
 ee_MaxToksLen  = 255; // Максимальная длина разбираемых лексем
 ee_MaxFuncArgs = 15;  // Максимальное число аргументов функции
 ee_MaxStack    = 255; // Размер стека для вызовов gosub

const                  // Default hash function
 ee_DefaultHasher : THash32Function = Hash32_RS;

type
 {
 Forward declaration
 }
 TExpressionEvaluator = class;
 {
 List of buffers allocated by Allocate/Reallocate/Deallocate calls.
 }
 TeeBufferList = class(TList)
 private
  FOwnsBuffers: Boolean;
 protected
  procedure Notify(Ptr:Pointer; Action:TListNotification); override;
 public
  constructor Create; overload;
  constructor Create(aOwnsBuffers:Boolean); overload;
 public
  property OwnsBuffers:Boolean read FOwnsBuffers write FOwnsBuffers;
 end;
 {
 Реализует переменную для использования в TExpressionEvaluator
 }
 PeeVariableItem = ^TeeVariableItem;
 TeeVariableItem = packed record // Buffer to store variable
  Hash    : Cardinal;            // Hash for fast search
  Value   : Double;              // Value of variable
  Name    : record end;          // Name is zstring
 end;
 {
 Реализует упорядоченный список переменных для использования в TExpressionEvaluator
 }
 TeeVariableItemList = class(TMasterObject)
 private
  myList       : TeeBufferList;
  myHasher     : THash32Function;
  myParent     : TExpressionEvaluator;
  myCollisions : Cardinal;
  function    GetCount:Integer;
  function    GetCollisions:Cardinal;
  function    GetHasher:THash32Function;
  function    GetItems(aIndex:Integer):PeeVariableItem;
  function    GetHashs(aIndex:Integer):Cardinal;
  function    GetNames(aIndex:Integer):PChar;
  function    GetValues(aIndex:Integer):Double;
  procedure   SetValues(aIndex:Integer; aValue:Double);
 public
  constructor Create(aParent:TExpressionEvaluator);
  destructor  Destroy; override;
 public
  function    ClearVar(aName:PChar):Boolean;
  function    FindVar(aName:PChar):PeeVariableItem;
  function    Search(aKey:PChar; var aIndex:Integer):Boolean;
  function    GetValue(aName:PChar; var aValue:Double):Boolean;
  function    SetValue(aName:PChar; const aValue:Double):Boolean;
  function    GetText(aText:TText):TText;
  procedure   Clear;
 public
  property    Count:Integer                         read GetCount;
  property    Hasher:THash32Function                read GetHasher;
  property    Collisions:Cardinal                   read GetCollisions;
  property    Items[aIndex:Integer]:PeeVariableItem read GetItems; default;
  property    Hashs[aIndex:Integer]:Cardinal        read GetHashs;
  property    Names[aIndex:Integer]:PChar           read GetNames;
  property    Values[aIndex:Integer]:Double         read GetValues write SetValues;
 end;
 {
 Реализует ссылку на функцию и сервис для ее вызова
 }
 TeeFunction     = function(ee:TExpressionEvaluator; const Arg:array of Double; Narg:Integer):Double;
 PeeFunctionItem = ^TeeFunctionItem;
 TeeFunctionItem = packed record // Buffer to store functions
  Hash    : Cardinal;            // Hash for fast search
  Narg    : Integer;             // Number of arguments
  Func    : TeeFunction;         // Function pointer
  Name    : record end;          // Name is zstring
  Note    : record end;          // Note is zstring
 end;
 {
 Реализует упорядоченный список функций для использования в TExpressionEvaluator
 }
 TeeFunctionItemList = class(TMasterObject)
 private
  myList       : TeeBufferList;
  myHasher     : THash32Function;
  myParent     : TExpressionEvaluator;
  myCollisions : Cardinal;
  function    GetCount:Integer;
  function    GetCollisions:Cardinal;
  function    GetHasher:THash32Function;
  function    GetItems(aIndex:Integer):PeeFunctionItem;
  function    GetHashs(aIndex:Integer):Cardinal;
  function    GetNames(aIndex:Integer):PChar;
  function    GetNotes(aIndex:Integer):PChar;
  function    GetNargs(aIndex:Integer):Integer;
 public
  constructor Create(aParent:TExpressionEvaluator);
  destructor  Destroy; override;
 public
  function    ClearFunc(aName:PChar):Boolean;
  function    FindFunc(aName:PChar):PeeFunctionItem;
  function    Search(aKey:PChar; var aIndex:Integer):Boolean;
  function    SetFunc(aName:PChar; aNarg:Integer; aFunc:TeeFunction; aNote:PChar):Boolean;
  function    GetText(aText:TText):TText;
  procedure   Clear;
 public
  property    Count:Integer                         read GetCount;
  property    Hasher:THash32Function                read GetHasher;
  property    Collisions:Cardinal                   read GetCollisions;
  property    Items[aIndex:Integer]:PeeFunctionItem read GetItems; default;
  property    Hashs[aIndex:Integer]:Cardinal        read GetHashs;
  property    Names[aIndex:Integer]:PChar           read GetNames;
  property    Notes[aIndex:Integer]:PChar           read GetNotes;
  property    Nargs[aIndex:Integer]:Integer         read GetNargs;
 end;
 {
 Реализует ссылку на акцию и сервис для вызова
 Акции - выполнение процедур, которые не имеют численного результата
 и принимают аргумент-строку, которую анализируют сами
 }
 TeeAction     = function(ee:TExpressionEvaluator; const aArgs:LongString):Double;
 PeeActionItem = ^TeeActionItem;
 TeeActionItem = packed record // Buffer to store actions
  Hash   : Cardinal;           // Hash for fast search
  Action : TeeAction;          // Action pointer
  Name   : record end;         // Name is zstring
  Note   : record end;         // Note is zstring
 end;
 {
 Реализует упорядоченный по именам список акций с сервисом для
 поиска и работы с ними
 }
 TeeActionItemList = class(TMasterObject)
 private
  myList       : TeeBufferList;
  myHasher     : THash32Function;
  myParent     : TExpressionEvaluator;
  myCollisions : Cardinal;
  function    GetCount:Integer;
  function    GetCollisions:Cardinal;
  function    GetHasher:THash32Function;
  function    GetItems(aIndex:Integer):PeeActionItem;
  function    GetHashs(aIndex:Integer):Cardinal;
  function    GetNames(aIndex:Integer):PChar;
  function    GetNotes(aIndex:Integer):PChar;
 public
  constructor Create(aParent:TExpressionEvaluator);
  destructor  Destroy; override;
 public
  function    ClearAction(aName:PChar):Boolean;
  function    FindAction(aName:PChar):PeeActionItem;
  function    Search(aKey:PChar; var aIndex:Integer):Boolean;
  function    SetAction(aName:PChar; aAction:TeeAction; aNote:PChar):Boolean;
  function    GetText(aText:TText):TText;
  procedure   Clear;
 public
  property    Count:Integer                       read GetCount;
  property    Hasher:THash32Function              read GetHasher;
  property    Collisions:Cardinal                 read GetCollisions;
  property    Items[aIndex:Integer]:PeeActionItem read GetItems; default;
  property    Hashs[aIndex:Integer]:Cardinal      read GetHashs;
  property    Names[aIndex:Integer]:PChar         read GetNames;
  property    Notes[aIndex:Integer]:PChar         read GetNotes;
 end;
 {
 Buffer type for TExpressionEvaluator tokens.
 }
 TeeTokenBuffer = packed array[0..ee_MaxToksLen] of Char;
 {
 *******************************************************************************
 Объект TExpressionEvaluator реализует вычислитель выражений.
 Пример программы:
  ee:=TExpressionEvaluator.Create;
  if ee.EvaluateExpression('sin(pi/6)*exp(1)+2')=ee_Ok
  then Echo(ee.Answer) else Echo('error '+ee.Status);
  ee.Script:='x=2'+EOLN+'y=2'+EOLN+'z=x*y';
  if ee.RunScript=ee_Ok then Echo(ee.Answer) else Echo('error '+ee.Status);
  Kill(ee);
 *******************************************************************************
 Вычислитель не предназначен специально для многопоточной работы, однако так как
 он порожден от TLatch, при помощи Lock/Unlock можно организовать синхронизацию
 в вызывающем коде. При работе в рамках одного потока ничего не надо.
 *******************************************************************************
 В вычисляемых выражениях можно использовать переменные, встроенные функции,
 директивы (акции) и константы. При помощи Script можно задать, а при помощи
 RunScript выполнить программу из выражений, например, типа таких:
    var n,fact
    n=6
    fact=1
    loop:
     gosub mult
     n=n-1
    if gt(n,1) then goto loop
    exit
    mult:
     fact=fact*n
    return
 Текст программы прекомпилируется для ускорения работы в PreScript.
 Акции начинаются с признака - символа @ или \, затем идет имя акции и после
 пробела - строка-аргумент акции, например,
  @voice hello world
 В отличие от функций акции принимают строковый аргумент, содержимое которого
 обязаны интерпретировать сами. Синтаксический анализатор НЕ КОНТРОЛИРУЕТ
 содержимое акций. Поэтому акции могут содержать любые строковые данные.
 Интерпретатор имеет расширяемый набор акций и поэтому может
 за счет этого расширять свою функциональность без потери надежности работы
 синтаксического ядра.
 Результат последней акции записывается в переменную actionresult.
 Есть операторы +,-,*,/,^,функции
 Распознаются числа в e-формате (типа 1.5E3) а также шестнадцатиричные
 числа, которые должны начинаться с символа $, например, $AF
    deg(x)        перевод радиан в градусы
    rad(x)        перевод градус в радианы
    sin(x)        синус
    cos(x)        косинус
    tan(x)        тангенс
    asin(x)       обратный синус
    acos(x)       обратный косинус
    atan(x)       обратный тангенс
    sinh(x)       гиперболический синус
    cosh(x)       гиперболический косинус
    tanh(x)       гиперболический тангенс
    exp(x)        экспонента
    ln(x)         натуральный логарифм x
    log(n,x)      логарифм x по основанию n
    sqrt(x)       корень
    int(x)        округление в сторону нуля
    trunc(x)      округление в сторону нуля
    frac(x)       дробная часть
    round(x)      округление в сторону ближайшего целого
    floor(x)      округление в сторону нуля
    ceil(x)       округление в сторону INF
    abs(x)        модуль
    hypot(x,y)    sqrt(x^2+y^2)
    rand()        случайное число от 0 до 1
    random(a,b)   случайное число в интервале (a,b)
    sign(x)       знак (+1,0,-1)
    eq(x,y)       равно 1/0 если x=y
    ne(x,y)       равно 1/0 если x<>y
    lt(x,y)       равно 1/0 если x<y
    gt(x,y)       равно 1/0 если x>y
    le(x,y)       равно 1/0 если x<=y
    ge(x,y)       равно 1/0 если x>=y
    max(x,y)      максимальное из x и y
    min(x,y)      минимальное  из x и y
    msecnow()     текущее время в миллисекундах от Рождества Христова
    secnow()      текущее время в секундах      от Рождества Христова
    getticks()    текущее время в тиках таймера BIOS
    mksecnow()    время в микросекундах от старта
    or(x,y)       логическое неисключающее или
    xor(x,y)      логическое исключающее или
    and(x,y)      логическое и
    not(x)        логическое отрицание
    bitor(x,y)    побитное арифметическое неисключающее или
    bitxor(x,y)   побитное арифметическое исключающее или
    bitand(x,y)   побитное арифметическое  и
    bitnot(x)     побитное арифметическое отрицание
    getbitmask(n) получить 2^n
    isbit(x,n)    есть ли в x бит номер n
    gamma(n)      гамма-функция: gamma(n) = (n-1)!
    isnan(a)      1 если a=NAN или 0
    isinf(a)      1 если a=INF или 0
    getpid()      get current process id
    getppid()     get parent process id
    cpu_count()   get CPU count
    cpu_start()   start CPU clocks measure
    cpu_clock()   get CPU clocks since cpu_start
    pidaffinity(p,m) set affinity mask m to process p
 Примеры выражений
  1+1
  10*(x=5)                 <== присвоение, как в C, может быть в выражении!
  ((1/3)*sin(45))^2
  X=50
  Y=100
  z=hypot(x,y)*rand()
 *******************************************************************************
 }
 EExpressionEvaluator = class(ESoftException);
 TExpressionEvaluator = class(TLatch)
 private
  myVarList    : TeeVariableItemList;               {список переменных}
  myConstList  : TeeVariableItemList;               {список констант}
  myLabelList  : TeeVariableItemList;               {список меток}
  myFuncList   : TeeFunctionItemList;               {список функций}
  myActionList : TeeActionItemList;                 {список акций}
  myScript     : TText;                             {исходный текст}
  myPreScript  : TText;                             {текст после прекомпиляции}
  myPreStatus  : Integer;                           {статус ошибки прекомпиляции}
  myPreErrMsg  : TeeTokenBuffer;                    {причина ошибки прекомпиляции}
  myStatus     : Integer;                           {статус ошибки интерпретации}
  myAnswer     : Double;                            {результат выражения}
  myMayPrint   : Boolean;                           {флаг печати}
  myExpression : PChar;                             {текущее выражение}
  myTokenType  : Integer;                           {тип разбираемой лексемы}
  myBuffer     : TeeTokenBuffer;                    {вычисляемое выражение}
  myToken      : TeeTokenBuffer;                    {текущая разбираемая лексема}
  myErrorToken : TeeTokenBuffer;                    {выражение, вызвавшее ошибку}
  myErrorPos   : Integer;                           {позиция ошибки}
  myCustom     : Pointer;                           {ссылка на пользовательские данные}
  myParent     : TObject;                           {ссылка на родительский объект}
  myLineBuf    : TeeTokenBuffer;                    {временный буфер}
  myStack      : array[0..ee_MaxStack-1] of Integer;{Стек вызовов gosub}
  myHasher     : THash32Function;                   {Функция хеширования}
  myCpuBase    : Int64;                             {cpu_start,cpu_clock}
  function    GetVarList:TeeVariableItemList;
  function    GetConstList:TeeVariableItemList;
  function    GetLabelList:TeeVariableItemList;
  function    GetFuncList:TeeFunctionItemList;
  function    GetActionList:TeeActionItemList;
  function    GetStatus:Integer;
  function    GetAnswer:Double;
  function    GetMayPrint:Boolean;
  function    GetExpression:PChar;
  function    GetBuffer:PChar;
  function    GetToken:PChar;
  function    GetErrorToken:PChar;
  function    GetErrorPos:Integer;
  function    GetCustom:Pointer;
  procedure   SetCustom(aCustom:Pointer);
  function    GetParent:TObject;
  procedure   SetParent(aParent:TObject);
  procedure   RaiseError(n:Integer);                {возбуждает исключение}
  procedure   Parse;                                {выделение лексемы}
  function    Level1(var r:Double):Boolean;         {процедуры рекурсивного анализа}
  procedure   Level2(var r:Double);
  procedure   Level3(var r:Double);
  procedure   Level4(var r:Double);
  procedure   Level5(var r:Double);
  procedure   Level6(var r:Double);
  function    ExecuteScript(aScript:TText):Integer; {выполняет прекомпилированный текст}
  function    GetScript:LongString;                 {текст исходного текста программы}
  procedure   SetScript(aLines:LongString);         {задает новый текст программы, включая прекомпиляцию}
  function    GetPreScript:LongString;              {прекомпилированный текст}
  function    GetHasher:THash32Function;
 public
  constructor Create(aHasher:THash32Function=nil);
  destructor  Destroy;override;
  function    SetConst(const aName:LongString; aValue:Double):Boolean;
  function    SetFunc(const aName:LongString; aNarg:Integer; aFunc:TeeFunction; const aNote:LongString):Boolean;
  function    SetAction(const aName:LongString; aAction:TeeAction; const aNote:LongString):Boolean;
 public
  property    VarList:TeeVariableItemList   read GetVarList;                 {список переменных}
  property    ConstList:TeeVariableItemList read GetConstList;               {список констант}
  property    LabelList:TeeVariableItemList read GetLabelList;               {список меток}
  property    FuncList:TeeFunctionItemList  read GetFuncList;                {список функций}
  property    ActionList:TeeActionItemList  read GetActionList;              {список акций}
  property    Status:Integer                read GetStatus;                  {статус последней операции}
  property    Answer:Double                 read GetAnswer;                  {результат вычислений}
  property    MayPrint:Boolean              read GetMayPrint;                {флаг печати}
  property    Expression:PChar              read GetExpression;              {текущее выражение}
  property    Buffer:PChar                  read GetBuffer;                  {буфер анализируемого выражения}
  property    Token:PChar                   read GetToken;                   {текущая лексема}
  property    ErrorToken:PChar              read GetErrorToken;              {лексема на которой возникла ошибка}
  property    ErrorPos:Integer              read GetErrorPos;                {позиция ошибки в выражении}
  property    Script:LongString             read GetScript write SetScript;  {исходный текст программного сценария}
  property    PreScript:LongString          read GetPreScript;               {прекомпилированный текст сценария}
  property    Custom:Pointer                read GetCustom write SetCustom;  {ссылка на пользовательские данные}
  property    Parent:TObject                read GetParent write SetParent;  {ссылка на родительский объект}
  property    RuntimeError:Integer                         write RaiseError; {возбуждение исключения}
  property    Hasher:THash32Function        read GetHasher;                  {функция хеширования}
 public
  procedure   Clear;                                                       {удаление всех переменных}
  function    ClearVar(aName:PChar):Boolean;                               {удаление переменной}
  function    DeclareVar(aName:PChar):Boolean;                             {объявление переменной}
  function    GetValue(aName:PChar; var aValue:Double):Boolean;            {чтение переменной}
  function    SetValue(aName:PChar; const aValue:Double):Boolean;          {запись переменной}
  function    EvaluateExpression(e:PChar;ForbidEmpty:Boolean=true):Integer;{вычисляет выражение}
  function    EvaluateLine(e:PChar):Integer;                               {выполнить выражение (для программ)}
  function    RunScript:Integer;                                           {выполнить программу Script}
  procedure   SaveVars(const IniFile,Section:LongString);                  {сохранение переменных в конфигфайл}
  procedure   RestoreVars(const IniFile,Section:LongString);               {восстановление из конфигфайла}
  function    SmartArgs(const Args:LongString):LongString;                 {заменяет в строке ссылку на переменную %var ее значением}
 end;

function  NewExpressionEvaluator:TExpressionEvaluator;
procedure Kill(var TheObject:TExpressionEvaluator); overload;

procedure Kill(var TheObject:TeeBufferList); overload;

function NewTeeVariableItem(aName:PChar; aValue:Double; aHasher:THash32Function):PeeVariableItem;
function NewTeeFunctionItem(aName:PChar; aNarg:Integer; aFunc:TeeFunction; aNote:PChar; aHasher:THash32Function):PeeFunctionItem;
function NewTeeActionItem(aName:PChar; aAction:TeeAction; aNote:PChar; aHasher:THash32Function):PeeActionItem;

 {
 Коды, статуса ошибки, возвращаемые вычислителем
 }
const
 ee_Ok          = 0;        { Успешное вычисление }
 ee_Syntax      = 1;        { Синтаксическая ошибка }
 ee_UnBalanced  = 2;        { Несбалансированные скобки }
 ee_DivZero     = 3;        { Деление на ноль }
 ee_Unknown     = 4;        { Ссылка на неизвестную переменную }
 ee_MaxVars     = 5;        { Достигнуто максимальное число переменных }
 ee_BadFunc     = 6;        { Неизвестная функция }
 ee_NumArgs     = 7;        { Неверное число аргументов функции }
 ee_NoArgs      = 8;        { Пропущен аргумент функции }
 ee_Empty       = 9;        { Пустое выражение }
 ee_Label       = 10;       { Неизвестная метка }
 ee_VarDecl     = 11;       { Ошибка объявления переменной }
 ee_If          = 12;       { Ошибка в операторе if }
 ee_NilRef      = 13;       { Неинициализированный объект (nil) }
 ee_BadReturn   = 14;       { Return без GoSub }
 ee_StackOver   = 15;       { Переполнение стека вызовов GoSub }
 ee_Exception   = 16;       { Исключение при выполнении скрипта }
 ee_LineTooLong = 17;       { Слишком длинная строка выражения }
 ee_User        = 18;       { Пользовательская }

function ee_ErrorMessage(ErrorCode:Integer):LongString;

 // Check if Script is simple, i.e. can be executed line by line, without precompilation.
function IsSimpleScript(const Script:LongString):Boolean;

 // Evaluate Script text line by line.
function EvaluateSimpleScript(ee:TExpressionEvaluator; const Script:LongString):Integer;

 // Expression Evaluator Benchmark to eastimate performance.
function ExpressionEvaluatorBenchmark(n:Integer=1000000):LongString;

 // Hash collisions counter
const
 ee_HashCollisions : Int64 = 0;

implementation

uses _crw_syscal;

 {
 Внутренние коды синтаксического анализатора
 }
const
 id_Error    = 0;  { Ошибка анализа     }
 id_Variable = 1;  { Разбор переменной  }
 id_Delimer  = 2;  { Разбор разделителя }
 id_Number   = 3;  { Разбор числа       }

 {
 Наборы распознаваемых символов
 }
const
 WhiteChars  = [' ',ASCII_TAB];                           {Символы-пробелы}
 AlphaChars  = ['a'..'z','A'..'Z','0'..'9','_'];          {Идентификаторы}
 DelimChars  = ['+','-','*','/','%','^','(',')',',','=']; {Pазделители}
 ArgDelims   = [' ',',',ASCII_TAB,ASCII_CR];              {Pазделители аргументов}
 ActionChars = ['@','\'];                                 {Признак акции}
 UpChar      = '`';                                       {Uppercase formatter}
 DefaultFmt  = '%g';                                      {Default format}
 DigitChars  = ['0'..'9','.'];                            {Chars uses as format params}
 FormtChars  = DigitChars + ['f','g','e'];                {Chars uses as format specifiers}

 {
 *****************************************
 Здесь расположены распознаваемые функции.
 *****************************************
 }
function deg(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=x[0]*180/pi; end;

function rad(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=x[0]*pi/180; end;

function sin(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=system.sin(x[0]); end;

function cos(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=system.cos(x[0]); end;

function tan(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=math.tan(x[0]); end;

function asin(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=math.arcsin(x[0]); end;

function acos(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=math.arccos(x[0]); end;

function atan(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=system.arctan(x[0]); end;

function sinh(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=math.sinh(x[0]); end;

function cosh(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=math.cosh(x[0]); end;

function tanh(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=math.tanh(x[0]); end;

function exp(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=system.exp(x[0]); end;

function ln(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=system.ln(x[0]); end;

function log(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=math.logn(x[0],x[1]); end;

function sqrt(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=system.sqrt(x[0]); end;

function int(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=system.int(x[0]); end;

function trunc(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=system.trunc(x[0]); end;

function frac(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=system.frac(x[0]); end;

function round(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=system.round(x[0]); end;

function floor(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=math.floor(x[0]); end;

function ceil(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=math.ceil(x[0]); end;

function abs(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=system.abs(x[0]); end;

function hypot(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=math.hypot(x[0],x[1]); end;

function rand(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=system.random; end;

function random(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=x[0]+(x[1]-x[0])*system.random; end;

function sign(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=_crw_ef.sign(x[0]); end;

function eq(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=ord(x[0]=x[1]); end;

function ne(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=ord(x[0]<>x[1]); end;

function lt(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=ord(x[0]<x[1]); end;

function gt(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=ord(x[0]>x[1]); end;

function le(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=ord(x[0]<=x[1]); end;

function ge(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=ord(x[0]>=x[1]); end;

function max(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=math.max(x[0],x[1]); end;

function min(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=math.min(x[0],x[1]); end;

function msecnow(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=_crw_rtc.msecnow; end;

function secnow(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=_crw_rtc.msecnow*0.001; end;

function getticks(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=_crw_rtc.GetTickCount/55; end;

function mksecnow(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=_crw_rtc.mksecnow; end;

function getclockres(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=_crw_rtc.GetClockResolution(System.Round(x[0]))/FileTimesPerMSec; end;

function setclockres(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=_crw_rtc.SetClockResolution(System.Round(x[0]*FileTimesPerMSec))/FileTimesPerMSec; end;

function bor(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=ord((x[0]<>0) or (x[1]<>0)); end;

function bxor(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=ord((x[0]<>0) xor (x[1]<>0)); end;

function band(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=ord((x[0]<>0) and (x[1]<>0)); end;

function bnot(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=ord(not(x[0]<>0)); end;

function aor(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=system.round(x[0]) or system.round(x[1]); end;

function axor(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=system.round(x[0]) xor system.round(x[1]); end;

function aand(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=system.round(x[0]) and system.round(x[1]); end;

function anot(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=not system.round(x[0]); end;

function getbitmask(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=DWORD(1) shl system.round(x[0]); end;

function isbit(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=ord(system.round(x[0]) and (DWORD(1) shl system.round(x[1]))<>0); end;

function gamma(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=_crw_ef.gamma(x[0]); end;

function isnan(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=ord(_crw_fpu.isnan(x[0])); end;

function isinf(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=ord(_crw_fpu.isinf(x[0])); end;

function getpid(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=GetCurrentProcessId; end;

function getppid(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=_crw_proc.GetParentProcessId; end;

function cpu_count(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=_crw_proc.cpu_count; end;

function cpu_start(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin ee.myCpuBase:=_crw_rtc.ReadTimeStampCounter; Result:=Ord(ee.myCpuBase<>0); end;

function cpu_clock(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=_crw_rtc.ReadTimeStampCounter-ee.myCpuBase; end;

function pidaffinity(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=_crw_proc.SetThreadAffinityMask(system.round(x[0]),system.round(x[1])); end;

function rgb(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=_crw_plut.RGB(system.round(x[0]),system.round(x[1]),system.round(x[2])); end;

function cga2rgb(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=_crw_plut.CgaToRGBColor(system.round(x[0])); end;

function htonl(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=sockets.htonl(system.round(x[0])); end;

function ntohl(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=sockets.ntohl(system.round(x[0])); end;

function htons(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=sockets.htons(system.round(x[0])); end;

function ntohs(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=sockets.ntohs(system.round(x[0])); end;

function msecrangemin(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=_crw_rtc.MSecRangeMin; end;

function msecrangemax(ee:TExpressionEvaluator; const x:array of Double; narg:Integer):Double;
begin Result:=_crw_rtc.MSecRangeMax; end;

 {акция @voice выдает звуковое сообщение}
function act_voice(ee:TExpressionEvaluator; const args:LongString):Double;
begin
 if UsesBlaster then begin
  Result:=1;
  Voice(ee.SmartArgs(args));
 end else Result:=0;
end;

 {акция @async помещает выражение в FIFO системного калькулятора}
function act_async(ee:TExpressionEvaluator; const args:LongString):Double;
var Len:SizeInt;
begin
 Result:=0;
 try
  Len:=Length(args);
  if (Len>0) then begin
   Inc(Len,Length(EOLN));
   Result:=Ord(SystemCalculator.Fifo.PutText(args+EOLN))*Len;
  end;
 except
  on E:Exception do BugReport(E,ee,'act_async');
 end;
end;

 {акция @global выполняет выражение в системном калькуляторе}
function act_global(ee:TExpressionEvaluator; const args:LongString):Double;
var p:PChar; arg:TeeTokenBuffer;
begin
 Result:=0;
 try
  p:=StrPLCopy(arg,ee.SmartArgs(args),SizeOf(arg)-1); while p^ in WhiteChars do inc(p);
  if (StrLIComp('@async',p,6)=0) and not (p[6] in AlphaChars) then begin
   inc(p,6); while p^ in WhiteChars do inc(p);
   Result:=act_async(ee,StrPas(p));
   Exit;
  end;
  Result:=SystemCalculator.Eval(StrPas(arg));
 except
  on E:Exception do BugReport(E,ee,'act_global');
 end;
end;

 {акция @system выполняет выражение в системном калькуляторе}
function act_system(ee:TExpressionEvaluator; const args:LongString):Double;
var p:PChar; arg:TeeTokenBuffer;
begin
 Result:=0;
 try
  p:=StrPLCopy(arg,args,SizeOf(arg)-1); while p^ in WhiteChars do inc(p);
  if (StrLIComp('@async',p,6)=0) and not (p[6] in AlphaChars) then begin
   inc(p,6); while p^ in WhiteChars do inc(p);
   Result:=act_async(ee,StrPas(p));
   Exit;
  end;
  Result:=SystemCalculator.Eval(args);
 except
  on E:Exception do BugReport(E,ee,'act_system');
 end;
end;

 {акция @echo выводит строку в консоль}
function act_echo(ee:TExpressionEvaluator; const args:LongString):Double;
var s:LongString;
begin
 s:=ee.SmartArgs(args);
 Result:=Length(s);
 Echo(s);
end;

 {акция @mmtimer читает\устанавливает период мультимедийного таймера}
function act_mmtimer(ee:TExpressionEvaluator; const args:LongString):Double;
var s:LongString; n:Integer;
begin
 Result:=0;
 try
  s:=ee.SmartArgs(args);
  if Str2Int(Trim(s),n) then mmTimer.Period:=n;
  Result:=mmTimer.Period;
 except
  on E:Exception do BugReport(E,ee,'act_mmtimer');
 end;
end;

 {
 ******************************************
 Внутренние функции для поиска и сортировки
 ******************************************
 }
function StrOk(Str:PChar):Boolean;
begin
 if Assigned(Str) then Result:=(Str[0]<>#0) else Result:=false;
end;

function SortText(const aText:LongString):LongString;
var List:TStringList;
begin
 Result:='';
 try
  List:=TStringList.Create;
  try
   List.Text:=aText;
   List.Sort;
   Result:=List.Text;
  finally
   Kill(List);
  end;
 except
  on E:Exception do BugReport(E,nil,'SortText');
 end;
end;

 {
 **************************
 TeeBufferList implementation
 **************************
 }
constructor TeeBufferList.Create;
begin
 inherited Create;
 FOwnsBuffers:=True;
end;

constructor TeeBufferList.Create(aOwnsBuffers:Boolean);
begin
 inherited Create;
 FOwnsBuffers:=aOwnsBuffers;
end;

procedure TeeBufferList.Notify(Ptr: Pointer; Action: TListNotification);
begin
 if OwnsBuffers and (Action=lnDeleted) then Deallocate(Ptr);
 inherited Notify(Ptr,Action);
end;

procedure Kill(var TheObject:TeeBufferList); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

 {
 ******************************
 TeeVariableItem implementation
 ******************************
 }
function NewTeeVariableItem(aName:PChar; aValue:Double; aHasher:THash32Function):PeeVariableItem;
var NameLen:Integer;
begin
 Result:=nil;
 try
  NameLen:=StrLLen(aName,ee_MaxVarsLen);
  if (NameLen>0)
  then Result:=Allocate(SizeOf(Result^)+NameLen+1);
  if Assigned(Result) then begin
   Result.Hash:=0;
   Result.Value:=aValue;
   StrLower(StrLCopy(PChar(@Result.Name),aName,NameLen));
   if Assigned(aHasher) then Result.Hash:=aHasher(PChar(@Result.Name),NameLen);
  end;
 except
  on E:Exception do BugReport(E,nil,'NewTeeVariableItem');
 end;
end;

 {
 **********************************
 TeeVariableItemList implementation
 **********************************
 }
constructor TeeVariableItemList.Create(aParent:TExpressionEvaluator);
begin
 inherited Create;
 Exceptions:=false;
 myList:=TeeBufferList.Create;
 myHasher:=aParent.Hasher;
 myParent:=aParent;
end;

destructor TeeVariableItemList.Destroy;
begin
 Kill(myList);
 inherited Destroy;
end;

function TeeVariableItemList.GetCount:Integer;
begin
 if Assigned(Self) then Result:=myList.Count else Result:=0;
end;

function TeeVariableItemList.GetCollisions:Cardinal;
begin
 if Assigned(Self) then Result:=myCollisions else Result:=0;
end;

function TeeVariableItemList.GetHasher:THash32Function;
begin
 if Assigned(Self) then Result:=myHasher else Result:=nil;
end;

function TeeVariableItemList.GetItems(aIndex:Integer):PeeVariableItem;
var Item:PeeVariableItem;
begin
 if Assigned(Self) and (aIndex>=0) and (aIndex<myList.Count)
 then Item:=myList.List[aIndex]
 else Item:=nil;
 Result:=Item;
end;

function TeeVariableItemList.GetHashs(aIndex:Integer):Cardinal;
var Item:PeeVariableItem;
begin
 if Assigned(Self) and (aIndex>=0) and (aIndex<myList.Count)
 then Item:=myList.List[aIndex]
 else Item:=nil;
 if Assigned(Item)
 then Result:=Item.Hash
 else Result:=0;
end;

function TeeVariableItemList.GetNames(aIndex:Integer):PChar;
var Item:PeeVariableItem;
begin
 if Assigned(Self) and (aIndex>=0) and (aIndex<myList.Count)
 then Item:=myList.List[aIndex]
 else Item:=nil;
 if Assigned(Item)
 then Result:=PChar(@Item.Name)
 else Result:=nil;
end;

function TeeVariableItemList.GetValues(aIndex:Integer):Double;
var Item:PeeVariableItem;
begin
 if Assigned(Self) and (aIndex>=0) and (aIndex<myList.Count)
 then Item:=myList.List[aIndex]
 else Item:=nil;
 if Assigned(Item)
 then Result:=Item.Value
 else Result:=0;
end;

procedure TeeVariableItemList.SetValues(aIndex:Integer; aValue:Double);
var Item:PeeVariableItem;
begin
 if Assigned(Self) and (aIndex>=0) and (aIndex<myList.Count)
 then Item:=myList.List[aIndex]
 else Item:=nil;
 if Assigned(Item)
 then Item.Value:=aValue;
end;

function TeeVariableItemList.Search(aKey:PChar; var aIndex:Integer):Boolean;
var Left,Right,Middle,Comparison:Integer; ItemList:PPointerList;
    MiddleItem:PeeVariableItem; MiddleKey:PChar; aHash:Cardinal;
    KeyLen:Integer; KeyBuf:array[0..ee_MaxVarsLen] of char;
begin
 Left:=0;
 Result:=False;
 if Assigned(Self) then
 if Assigned(aKey) then
 if (aKey[0]<>#0) then begin
  KeyLen:=0;
  while (aKey[KeyLen]<>#0) and (KeyLen<ee_MaxVarsLen) do begin
   KeyBuf[KeyLen]:=LoCaseTable[aKey[KeyLen]];
   inc(KeyLen);
  end;
  KeyBuf[KeyLen]:=#0;
//Code above is fast equivalent of call:
//KeyLen:=StrLen(StrLower(StrLCopy(KeyBuf,aKey,ee_MaxVarsLen)));
  if Assigned(myHasher)
  then aHash:=myHasher(KeyBuf,KeyLen)
  else aHash:=0;
  ItemList:=myList.List;
  Right:=myList.Count-1;
  while (Left<=Right) do begin
   Middle:=(Left+Right) shr 1;
   MiddleItem:=ItemList[Middle];
   if Assigned(myHasher) and Assigned(MiddleItem) then begin
    if MiddleItem.Hash>aHash then Comparison:=+1 else
    if MiddleItem.Hash<aHash then Comparison:=-1 else Comparison:=0;
   end else Comparison:=0;
   if (Comparison=0) then begin
    if Assigned(MiddleItem)
    then MiddleKey:=PChar(@MiddleItem.Name)
    else MiddleKey:=nil;
    Comparison:=StrComp(MiddleKey,KeyBuf);
    if (Comparison<>0) and Assigned(myHasher) then begin
     Inc(ee_HashCollisions);
     Inc(myCollisions);
    end;
   end;
   if (Comparison<0) then Left:=Middle+1 else begin
    Right:=Middle-1;
    if (Comparison=0) then begin
     Result:=True;
     Left:=Middle;
    end;
   end;
  end;
 end;
 aIndex:=Left;
end;

function TeeVariableItemList.FindVar(aName:PChar):PeeVariableItem;
var aIndex:Integer;
begin
 if Search(aName,aIndex) then Result:=Items[aIndex] else Result:=nil;
end;

function TeeVariableItemList.ClearVar(aName:PChar):Boolean;
var aIndex:Integer;
begin
 if Search(aName,aIndex) then begin
  myList.Delete(aIndex);
  Result:=true;
 end else Result:=false;
end;

function TeeVariableItemList.GetValue(aName:PChar; var aValue:Double):Boolean;
var aIndex:Integer;
begin
 if Search(aName,aIndex) then begin
  aValue:=Values[aIndex];
  Result:=true;
 end else begin
  aValue:=0;
  Result:=false;
 end;
end;

function TeeVariableItemList.SetValue(aName:PChar; const aValue:Double):Boolean;
var aIndex:Integer; aItem:PeeVariableItem;
begin
 Result:=false;
 if Search(aName,aIndex) then begin
  Values[aIndex]:=aValue;
  Result:=true;
 end else if Assigned(Self) and StrOk(aName) then
 try
  aItem:=NewTeeVariableItem(aName,aValue,myHasher);
  if Assigned(aItem) then myList.Insert(aIndex,aItem);
  Result:=Assigned(aItem);
 except
  on E:Exception do begin
   ErrorReport(E,'SetValue');
  end;
 end;
end;

function TeeVariableItemList.GetText(aText:TText):TText;
var MaxLen,i:Integer; List:TText;
begin
 Result:=aText;
 if Assigned(Self) and Assigned(aText) then
 try
  List:=NewText;
  try
   MaxLen:=0;
   for i:=0 to Count-1 do MaxLen:=math.max(MaxLen,StrLen(Names[i]));
   for i:=0 to Count-1 do List.Addln(Format('%-*s = %g',[MaxLen,Names[i],Values[i]]));
   if Assigned(myHasher) then List.Text:=SortText(List.Text);
   aText.Concat(List);
  finally
   Kill(List);
  end;
 except
  on E:Exception do BugReport(E,Self,'GetText');
 end;
end;

procedure TeeVariableItemList.Clear;
begin
 if Assigned(Self) then myList.Clear;
end;

 {
 ****************************
 TFunctionItem implementation
 ****************************
 }
function NewTeeFunctionItem(aName:PChar; aNarg:Integer; aFunc:TeeFunction; aNote:PChar; aHasher:THash32Function):PeeFunctionItem;
var NameLen,NoteLen:Integer;
begin
 Result:=nil;
 try
  NameLen:=StrLLen(aName,ee_MaxVarsLen);
  NoteLen:=StrLLen(aNote,ee_MaxNoteLen);
  if (NameLen>0) and (NoteLen>0) and Assigned(aFunc) and (aNarg in [0..ee_MaxFuncArgs])
  then Result:=Allocate(SizeOf(Result^)+NameLen+1+NoteLen+1);
  if Assigned(Result) then begin
   Result.Hash:=0;
   Result.Narg:=aNarg;
   Result.Func:=aFunc;
   StrLower(StrLCopy(PChar(@Result.Name),aName,NameLen));
   StrLCopy(PChar(@Result.Name)+NameLen+1,aNote,NoteLen);
   if Assigned(aHasher) then Result.Hash:=aHasher(PChar(@Result.Name),NameLen); 
  end;
 except
  on E:Exception do BugReport(E,nil,'NewTeeFunctionItem');
 end;
end;

function TeeFunctionItemEval(const Item:PeeFunctionItem; ee:TExpressionEvaluator; const Arg:array of Double):Double;
begin
 if Assigned(Item) and Assigned(Item.Func) and Assigned(ee)
 then Result:=Item.Func(ee,Arg,Item.Narg)
 else Result:=0;
end;

 {
 ********************************
 TFunctionItemList implementation
 ********************************
 }
constructor TeeFunctionItemList.Create(aParent:TExpressionEvaluator);
begin
 inherited Create;
 Exceptions:=false;
 myList:=TeeBufferList.Create;
 myHasher:=aParent.Hasher;
 myParent:=aParent;
end;

destructor TeeFunctionItemList.Destroy;
begin
 Kill(myList);
 inherited Destroy;
end;

function TeeFunctionItemList.GetCount:Integer;
begin
 if Assigned(Self) then Result:=myList.Count else Result:=0;
end;

function TeeFunctionItemList.GetCollisions:Cardinal;
begin
 if Assigned(Self) then Result:=myCollisions else Result:=0;
end;

function TeeFunctionItemList.GetHasher:THash32Function;
begin
 if Assigned(Self) then Result:=myHasher else Result:=nil;
end;

function TeeFunctionItemList.GetItems(aIndex:Integer):PeeFunctionItem;
var Item:PeeFunctionItem;
begin
 if Assigned(Self) and (aIndex>=0) and (aIndex<myList.Count)
 then Item:=myList.List[aIndex]
 else Item:=nil;
 Result:=Item;
end;

function TeeFunctionItemList.GetHashs(aIndex:Integer):Cardinal;
var Item:PeeFunctionItem;
begin
 if Assigned(Self) and (aIndex>=0) and (aIndex<myList.Count)
 then Item:=myList.List[aIndex]
 else Item:=nil;
 if Assigned(Item)
 then Result:=Item.Hash
 else Result:=0;
end;

function TeeFunctionItemList.GetNames(aIndex:Integer):PChar;
var Item:PeeFunctionItem;
begin
 if Assigned(Self) and (aIndex>=0) and (aIndex<myList.Count)
 then Item:=myList.List[aIndex]
 else Item:=nil;
 if Assigned(Item)
 then Result:=PChar(@Item.Name)
 else Result:=nil;
end;

function TeeFunctionItemList.GetNotes(aIndex:Integer):PChar;
var Item:PeeFunctionItem;
begin
 if Assigned(Self) and (aIndex>=0) and (aIndex<myList.Count)
 then Item:=myList.List[aIndex]
 else Item:=nil;
 if Assigned(Item)
 then Result:=PChar(@Item.Name)+StrLen(PChar(@Item.Name))+1
 else Result:=nil;
end;

function TeeFunctionItemList.GetNargs(aIndex:Integer):Integer;
var Item:PeeFunctionItem;
begin
 if Assigned(Self) and (aIndex>=0) and (aIndex<myList.Count)
 then Item:=myList.List[aIndex]
 else Item:=nil;
 if Assigned(Item)
 then Result:=Item.Narg
 else Result:=0;
end;

function TeeFunctionItemList.Search(aKey:PChar; var aIndex:Integer):Boolean;
var Left,Right,Middle,Comparison:Integer; ItemList:PPointerList;
    MiddleItem:PeeFunctionItem; MiddleKey:PChar; aHash:Cardinal;
    KeyLen:Integer; KeyBuf:array[0..ee_MaxVarsLen] of char;
begin
 Left:=0;
 Result:=False;
 if Assigned(Self) then
 if Assigned(aKey) then
 if (aKey[0]<>#0) then begin
  KeyLen:=0;
  while (aKey[KeyLen]<>#0) and (KeyLen<ee_MaxVarsLen) do begin
   KeyBuf[KeyLen]:=LoCaseTable[aKey[KeyLen]];
   inc(KeyLen);
  end;
  KeyBuf[KeyLen]:=#0;
//Code above is fast equivalent of call:
//KeyLen:=StrLen(StrLower(StrLCopy(KeyBuf,aKey,ee_MaxVarsLen)));
  if Assigned(myHasher)
  then aHash:=myHasher(KeyBuf,KeyLen)
  else aHash:=0;
  ItemList:=myList.List;
  Right:=myList.Count-1;
  while (Left<=Right) do begin
   Middle:=(Left+Right) shr 1;
   MiddleItem:=ItemList[Middle];
   if Assigned(myHasher) and Assigned(MiddleItem) then begin
    if MiddleItem.Hash>aHash then Comparison:=+1 else
    if MiddleItem.Hash<aHash then Comparison:=-1 else Comparison:=0;
   end else Comparison:=0;
   if (Comparison=0) then begin
    if Assigned(MiddleItem)
    then MiddleKey:=PChar(@MiddleItem.Name)
    else MiddleKey:=nil;
    Comparison:=StrComp(MiddleKey,KeyBuf);
    if (Comparison<>0) and Assigned(myHasher) then begin
     Inc(ee_HashCollisions);
     Inc(myCollisions);
    end;
   end;
   if (Comparison<0) then Left:=Middle+1 else begin
    Right:=Middle-1;
    if (Comparison=0) then begin
     Result:=True;
     Left:=Middle;
    end;
   end;
  end;
 end;
 aIndex:=Left;
end;

function TeeFunctionItemList.FindFunc(aName:PChar):PeeFunctionItem;
var aIndex:Integer;
begin
 if Search(aName,aIndex) then Result:=Items[aIndex] else Result:=nil;
end;

function TeeFunctionItemList.ClearFunc(aName:PChar):Boolean;
var aIndex:Integer;
begin
 if Search(aName,aIndex) then begin
  myList.Delete(aIndex);
  Result:=true;
 end else Result:=false;
end;

function TeeFunctionItemList.SetFunc(aName:PChar; aNarg:Integer; aFunc:TeeFunction; aNote:PChar):Boolean;
var aIndex:Integer; aItem:PeeFunctionItem;
begin
 Result:=false;
 if Assigned(Self) and StrOk(aName) then begin
  if Search(aName,aIndex) then myList.Delete(aIndex);
  try
   aItem:=NewTeeFunctionItem(aName,aNarg,aFunc,aNote,myHasher);
   if Assigned(aItem) then myList.Insert(aIndex,aItem);
   Result:=Assigned(aItem);
  except
   on E:Exception do begin
    ErrorReport(E);
   end;
  end;
 end;
end;

function TeeFunctionItemList.GetText(aText:TText):TText;
var s:LongString; c:Char; MaxLen,i,j:Integer; List:TText;
begin
 Result:=aText;
 if Assigned(Self) and Assigned(aText) then
 try
  List:=NewText;
  try
   MaxLen:=0;
   for i:=0 to Count-1 do MaxLen:=math.max(MaxLen,StrLen(Names[i])+2*Nargs[i]+2);
   for i:=0 to Count-1 do begin
    s:=StrPas(Names[i]);
    s:=s+'(';
    c:='a';
    for j:=1 to Nargs[i] do begin
     s:=s+c;
     if j<Nargs[i] then s:=s+',';
     inc(c);
    end;
    s:=s+')';
    List.Addln(Format('%-*s %s',[MaxLen,s,Notes[i]]));
   end;
   if Assigned(myHasher) then List.Text:=SortText(List.Text);
   aText.Concat(List);
  finally
   Kill(List);
  end;
 except
  on E:Exception do BugReport(E,Self,'GetText');
 end;
end;

procedure TeeFunctionItemList.Clear;
begin
 if Assigned(Self) then myList.Clear;
end;

 {
 **************************
 TActionItem implementation
 **************************
 }
function NewTeeActionItem(aName:PChar; aAction:TeeAction; aNote:PChar; aHasher:THash32Function):PeeActionItem;
var NameLen,NoteLen:Integer;
begin
 Result:=nil;
 try
  NameLen:=StrLLen(aName,ee_MaxVarsLen);
  NoteLen:=StrLLen(aNote,ee_MaxNoteLen);
  if (NameLen>0) and (NoteLen>0) and Assigned(aAction)
  then Result:=Allocate(SizeOf(Result^)+NameLen+1+NoteLen+1);
  if Assigned(Result) then begin
   Result.Hash:=0;
   Result.Action:=aAction;
   StrLower(StrLCopy(PChar(@Result.Name),aName,NameLen));
   StrLCopy(PChar(@Result.Name)+NameLen+1,aNote,NoteLen);
   if Assigned(aHasher) then Result.Hash:=aHasher(PChar(@Result.Name),NameLen); 
  end;
 except
  on E:Exception do BugReport(E,nil,'NewTeeActionItem');
 end;
end;

function TeeActionItemExecute(Item:PeeActionItem; ee:TExpressionEvaluator; const aNarg:LongString):Double;
begin
 if Assigned(Item) and Assigned(Item.Action) and Assigned(ee)
 then Result:=Item.Action(ee,aNarg)
 else Result:=0;
end;

 {
 ******************************
 TActionItemList implementation
 ******************************
 }
constructor TeeActionItemList.Create(aParent:TExpressionEvaluator);
begin
 inherited Create;
 Exceptions:=false;
 myList:=TeeBufferList.Create;
 myHasher:=aParent.Hasher;
 myParent:=aParent;
end;

destructor TeeActionItemList.Destroy;
begin
 Kill(myList);
 inherited Destroy;
end;

function TeeActionItemList.GetCount:Integer;
begin
 if Assigned(Self) then Result:=myList.Count else Result:=0;
end;

function TeeActionItemList.GetCollisions:Cardinal;
begin
 if Assigned(Self) then Result:=myCollisions else Result:=0;
end;

function TeeActionItemList.GetHasher:THash32Function;
begin
 if Assigned(Self) then Result:=myHasher else Result:=nil;
end;

function TeeActionItemList.GetItems(aIndex:Integer):PeeActionItem;
var Item:PeeActionItem;
begin
 if Assigned(Self) and (aIndex>=0) and (aIndex<myList.Count)
 then Item:=myList.List[aIndex]
 else Item:=nil;
 Result:=Item;
end;

function TeeActionItemList.GetHashs(aIndex:Integer):Cardinal;
var Item:PeeActionItem;
begin
 if Assigned(Self) and (aIndex>=0) and (aIndex<myList.Count)
 then Item:=myList.List[aIndex]
 else Item:=nil;
 if Assigned(Item)
 then Result:=Item.Hash
 else Result:=0;
end;

function TeeActionItemList.GetNames(aIndex:Integer):PChar;
var Item:PeeActionItem;
begin
 if Assigned(Self) and (aIndex>=0) and (aIndex<myList.Count)
 then Item:=myList.List[aIndex]
 else Item:=nil;
 if Assigned(Item)
 then Result:=PChar(@Item.Name)
 else Result:=nil;
end;

function TeeActionItemList.GetNotes(aIndex:Integer):PChar;
var Item:PeeActionItem;
begin
 if Assigned(Self) and (aIndex>=0) and (aIndex<myList.Count)
 then Item:=myList.List[aIndex]
 else Item:=nil;
 if Assigned(Item)
 then Result:=PChar(@Item.Name)+StrLen(PChar(@Item.Name))+1
 else Result:=nil;
end;

function TeeActionItemList.Search(aKey:PChar; var aIndex:Integer):Boolean;
var Left,Right,Middle,Comparison:Integer; ItemList:PPointerList;
    MiddleItem:PeeActionItem; MiddleKey:PChar; aHash:Cardinal;
    KeyLen:Integer; KeyBuf:array[0..ee_MaxVarsLen] of char;
begin
 Left:=0;
 Result:=False;
 if Assigned(Self) then
 if Assigned(aKey) then
 if (aKey[0]<>#0) then begin
  KeyLen:=0;
  while (aKey[KeyLen]<>#0) and (KeyLen<ee_MaxVarsLen) do begin
   KeyBuf[KeyLen]:=LoCaseTable[aKey[KeyLen]];
   inc(KeyLen);
  end;
  KeyBuf[KeyLen]:=#0;
//Code above is fast equivalent of call:
//KeyLen:=StrLen(StrLower(StrLCopy(KeyBuf,aKey,ee_MaxVarsLen)));
  if Assigned(myHasher)
  then aHash:=myHasher(KeyBuf,KeyLen)
  else aHash:=0;
  ItemList:=myList.List;
  Right:=myList.Count-1;
  while (Left<=Right) do begin
   Middle:=(Left+Right) shr 1;
   MiddleItem:=ItemList[Middle];
   if Assigned(myHasher) and Assigned(MiddleItem) then begin
    if MiddleItem.Hash>aHash then Comparison:=+1 else
    if MiddleItem.Hash<aHash then Comparison:=-1 else Comparison:=0;
   end else Comparison:=0;
   if (Comparison=0) then begin
    if Assigned(MiddleItem)
    then MiddleKey:=PChar(@MiddleItem.Name)
    else MiddleKey:=nil;
    Comparison:=StrComp(MiddleKey,KeyBuf);
    if (Comparison<>0) and Assigned(myHasher) then begin
     Inc(ee_HashCollisions);
     Inc(myCollisions);
    end;
   end;
   if (Comparison<0) then Left:=Middle+1 else begin
    Right:=Middle-1;
    if (Comparison=0) then begin
     Result:=True;
     Left:=Middle;
    end;
   end;
  end;
 end;
 aIndex:=Left;
end;

function TeeActionItemList.FindAction(aName:PChar):PeeActionItem;
var aIndex:Integer;
begin
 if Search(aName,aIndex) then Result:=Items[aIndex] else Result:=nil;
end;

function TeeActionItemList.ClearAction(aName:PChar):Boolean;
var aIndex:Integer;
begin
 if Search(aName,aIndex) then begin
  myList.Delete(aIndex);
  Result:=true;
 end else Result:=false;
end;

function TeeActionItemList.SetAction(aName:PChar; aAction:TeeAction; aNote:PChar):Boolean;
var aIndex:Integer; aItem:PeeActionItem;
begin
 Result:=false;
 if Assigned(Self) and StrOk(aName) then begin
  if Search(aName,aIndex) then myList.Delete(aIndex);
  try
   aItem:=NewTeeActionItem(aName,aAction,aNote,myHasher);
   if Assigned(aItem) then myList.Insert(aIndex,aItem);
   Result:=Assigned(aItem);
  except
   on E:Exception do begin
    ErrorReport(E);
   end; 
  end;
 end;
end;

procedure TeeActionItemList.Clear;
begin
 if Assigned(Self) then myList.Clear;
end;

function TeeActionItemList.GetText(aText:TText):TText;
var MaxLen,i:Integer; List:TText;
begin
 Result:=aText;
 if Assigned(Self) and Assigned(aText) then
 try
  List:=NewText;
  try
   MaxLen:=0;
   for i:=0 to Count-1 do MaxLen:=math.max(MaxLen,StrLen(Names[i]));
   for i:=0 to Count-1 do List.Addln(Format('@%-*s - %s',[MaxLen+1,Names[i],Notes[i]]));
   if Assigned(myHasher) then List.Text:=SortText(List.Text);
   aText.Concat(List);
  finally
   Kill(List);
  end;
 except
  on E:Exception do BugReport(E,Self,'GetText');
 end; 
end;

 {
 ***********************************
 TExpressionEvaluator implementation
 ***********************************
 }
constructor TExpressionEvaluator.Create(aHasher:THash32Function);
begin
 inherited Create;
 Exceptions:=false;
 if not Assigned(aHasher) then aHasher:=ee_DefaultHasher;
 myHasher:=aHasher;
 {Инициализация списков}
 myVarList:=TeeVariableItemList.Create(Self);   myVarList.Master:=@myVarList;
 myConstList:=TeeVariableItemList.Create(Self); myConstList.Master:=@myConstList;
 myLabelList:=TeeVariableItemList.Create(Self); myLabelList.Master:=@myLabelList;
 myFuncList:=TeeFunctionItemList.Create(Self);  myFuncList.Master:=@myFuncList;
 myActionList:=TeeActionItemList.Create(Self);  myActionList.Master:=@myActionList;
 myScript:=NewText;                             myScript.Master:=@myScript;
 myPreScript:=NewText;                          myPreScript.Master:=@myPreScript;
 myPreStatus:=ee_Ok;
 myPreErrMsg[0]:=#0;
 myCustom:=nil;
 myParent:=nil;
 {Очистка буферов}
 Clear;
 {Стандартные константы}
 SetConst('pi',          3.14159265358979323846);
 SetConst('e',           2.71828182845904523536);
 SetConst('false',       0);
 SetConst('true',        1);
 SetConst('macheps',     macheps);
 SetConst('_nan',        _nan);
 SetConst('_inf',        _plusinf);
 SetConst('_minusinf',   _minusinf);
 SetConst('minshortint', Low(ShortInt));
 SetConst('maxshortint', High(ShortInt));
 SetConst('minsmallint', Low(SmallInt));
 SetConst('maxsmallint', High(SmallInt));
 SetConst('minlongint',  Low(LongInt));
 SetConst('maxlongint',  High(LongInt));
 SetConst('minint',      Low(Integer));
 SetConst('maxint',      High(Integer));
 SetConst('maxbyte',     High(Byte));
 SetConst('maxword',     High(Word));
 SetConst('maxdword',    High(DWORD));
 SetConst('maxlongword', High(LongWord));
 SetConst('minsingle',   MinSingle);
 SetConst('maxsingle',   MaxSingle);
 SetConst('mindouble',   MinDouble);
 SetConst('maxdouble',   MaxDouble);
 SetConst('processid',   GetCurrentProcessId);
 {Стандартные функции}
 SetFunc('sin',          1, sin,          RusEng('синус',                           'sine'));
 SetFunc('cos',          1, cos,          RusEng('косинус',                         'cosine'));
 SetFunc('tan',          1, tan,          RusEng('тангенс',                         'tangent'));
 SetFunc('asin',         1, asin,         RusEng('обратный синус',                  'inverted sine'));
 SetFunc('acos',         1, acos,         RusEng('обратный косинус',                'inverted cosine'));
 SetFunc('atan',         1, atan,         RusEng('обратный тангенс',                'inverted tangent'));
 SetFunc('sinh',         1, sinh,         RusEng('синус гиперболический',           'sine hyperbolic'));
 SetFunc('cosh',         1, cosh,         RusEng('косинус гиперболический',         'cosine hyperbolic'));
 SetFunc('tanh',         1, tanh,         RusEng('тангенс гиперболический',         'tangent hyperbolic'));
 SetFunc('exp',          1, exp,          RusEng('натуральная экспонента',          'napierian exponent'));
 SetFunc('ln',           1, ln,           RusEng('натуральный логарифм',            'napierian logarithm'));
 SetFunc('log',          2, log,          RusEng('логарифм b по основанию a',       'logarithm of b with base a'));
 SetFunc('sqrt',         1, sqrt,         RusEng('корень',                          'radical'));
 SetFunc('int',          1, int,          RusEng('округление в сторону 0',          'truncate to 0'));
 SetFunc('trunc',        1, trunc,        RusEng('округление в сторону 0',          'truncate to 0'));
 SetFunc('frac',         1, frac,         RusEng('дробная часть числа',             'fractional part'));
 SetFunc('round',        1, round,        RusEng('округление до ближайшего целого', 'round to nearest integer'));
 SetFunc('floor',        1, floor,        RusEng('округление в сторону 0',          'truncate to 0'));
 SetFunc('ceil',         1, ceil,         RusEng('округление в сторону INF',        'truncate to INF'));
 SetFunc('abs',          1, abs,          RusEng('модуль',                          'absolute value'));
 SetFunc('deg',          1, deg,          RusEng('перевод радиан в градусы',        'radians to degrees'));
 SetFunc('rad',          1, rad,          RusEng('перевод градусов в радианы',      'degrees to radians'));
 SetFunc('hypot',        2, hypot,        RusEng('sqrt(a^2+b^2)',                   'sqrt(a^2+b^2)'));
 SetFunc('rand',         0, rand,         RusEng('случайное число от 0 до 1',       'random value from 0 to 1'));
 SetFunc('random',       2, random,       RusEng('случайное число от a до b',       'random value from a to b'));
 SetFunc('sign',         1, sign,         RusEng('функция знака: -1,0,1',           'signum: -1,0,1'));
 SetFunc('eq',           2, eq,           RusEng('1 если a=b или 0',                '1 if a=b,  0 otherwise'));
 SetFunc('ne',           2, ne,           RusEng('1 если a<>b или 0',               '1 if a<>b, 0 otherwise'));
 SetFunc('lt',           2, lt,           RusEng('1 если a<b или 0',                '1 if a<b,  0 otherwise'));
 SetFunc('gt',           2, gt,           RusEng('1 если a>b или 0',                '1 if a>b,  0 otherwise'));
 SetFunc('le',           2, le,           RusEng('1 если a<=b или 0',               '1 if a<=b, 0 otherwise'));
 SetFunc('ge',           2, ge,           RusEng('1 если a>=b или 0',               '1 if a>=b, 0 otherwise'));
 SetFunc('max',          2, max,          RusEng('максимальное из a,b',             'max of a,b'));
 SetFunc('min',          2, min,          RusEng('минимальное из a,b',              'min of a,b'));
 SetFunc('msecnow',      0, msecnow,      RusEng('время в миллисек. от Р.Х.',       'time in msec from Xmas'));
 SetFunc('secnow',       0, secnow,       RusEng('время в сек. от Р.Х.',            'time in sec from Xmas'));
 SetFunc('getticks',     0, getticks,     RusEng('время BIOS в тиках',              'time in BIOS ticks'));
 SetFunc('mksecnow',     0, mksecnow,     RusEng('время в микросек. от старта',     'time in mksec from start'));
 SetFunc('getclockres',  1, getclockres,  RusEng('узнать разрешение таймера в ms',  'get timer resolution in ms'));
 SetFunc('setclockres',  1, setclockres,  RusEng('задать разрешение таймера в ms',  'set timer resolution in ms'));
 SetFunc('or',           2, bor,          RusEng('логическое неисключающее или',    'logical OR'));
 SetFunc('xor',          2, bxor,         RusEng('логическое исключающее или',      'logical XOR'));
 SetFunc('and',          2, band,         RusEng('логическое и',                    'logical AND'));
 SetFunc('not',          1, bnot,         RusEng('логическая инверсия',             'logical inversion'));
 SetFunc('bitor',        2, aor,          RusEng('побитное неисключающее или',      'arithmetical OR'));
 SetFunc('bitxor',       2, axor,         RusEng('побитное исключающее или',        'arithmetical XOR'));
 SetFunc('bitand',       2, aand,         RusEng('побитное и',                      'arithmetical AND'));
 SetFunc('bitnot',       1, anot,         RusEng('побитная инверсия',               'arithmetical inversion'));
 SetFunc('getbitmask',   1, getbitmask,   RusEng('число 2^a',                       '2^int(a)'));
 SetFunc('isbit',        2, isbit,        RusEng('1 если в a есть бит b или 0',     '1 if a''s bit b <> 0, 0 otherwise'));
 SetFunc('gamma',        1, gamma,        RusEng('гамма-функция: gamma(a)=(a-1)!',  'gamma(a)=(a-1)!'));
 SetFunc('isnan',        1, isnan,        RusEng('1 если а=NAN или 0',              '1 if а=NAN, 0 otherwise'));
 SetFunc('isinf',        1, isinf,        RusEng('1 если а=INF или 0',              '1 if а=INF, 0 otherwise'));
 SetFunc('getpid',       0, getpid,       RusEng('номер текущего процесса',         'get current process ID'));
 SetFunc('getppid',      0, getppid,      RusEng('номер родительского процесса',    'get parent process ID'));
 SetFunc('cpu_count',    0, cpu_count,    RusEng('счетчик числа процессоров',       'get number of processors'));
 SetFunc('cpu_start',    0, cpu_start,    RusEng('начать измерение счетчика CPU',   'start CPU clock counter measure'));
 SetFunc('cpu_clock',    0, cpu_clock,    RusEng('счетчик CPU от вызова cpu_start', 'CPU clock counter since cpu_start'));
 SetFunc('pidaffinity',  2, pidaffinity,  RusEng('задать привязку процесса к CPU',  'set process affinity mask'));
 SetFunc('rgb',          3, rgb,          RusEng('вычислить цвет (R,G,B)=(a,b,c)',  'compose true color (R,G,B)=(a,b,c)'));
 SetFunc('cga2rgb',      1, cga2rgb,      RusEng('RGB цвет CGA(a)',                 'RGB true color of CGA(a)'));
 SetFunc('htonl',        1, htonl,        RusEng('host to net long (a)',            'host to net long (a)'));
 SetFunc('ntohl',        1, ntohl,        RusEng('net to host long (a)',            'net to host long (a)'));
 SetFunc('htons',        1, htons,        RusEng('host to net short (a)',           'host to net short (a)'));
 SetFunc('ntohs',        1, ntohs,        RusEng('net to host short (a)',           'net to host short (a)'));
 SetFunc('msecrangemin', 0, msecrangemin, RusEng('нижний диапазон msecnow',         'low range of msecnow'));
 SetFunc('msecrangemax', 0, msecrangemax, RusEng('верхний диапазон msecnow',        'high range of msecnow'));
 SetAction('voice',      act_voice,       RusEng('проигрывание звуковых wav файлов','play sound wav files'));
 SetAction('async',      act_async,       RusEng('Выполнить команду асинхронно (в очередь).','Asynchronous command (thru queue).'));
 SetAction('global',     act_global,      RusEng('Выполнение выражения в системном калькуляторе','Evaluate expression in system calculator'));
 SetAction('system',     act_system,      RusEng('Выполнение выражения в системном калькуляторе','Evaluate expression in system calculator'));
 SetAction('echo',       act_echo,        RusEng('Вывод сообщения в консоль','Output message to console'));
 SetAction('mmtimer',    act_mmtimer,     RusEng('Чтение\установка периода мулитимедийного таймера, [ms].','Get\set multimedia timer period, [ms].'));
end;

 {
 Процедура освобождает пямять
 }
destructor TExpressionEvaluator.Destroy;
begin
 Kill(TObject(myVarList));
 Kill(TObject(myConstList));
 Kill(TObject(myLabelList));
 Kill(TObject(myFuncList));
 Kill(TObject(myActionList));
 Kill(myScript);
 Kill(myPreScript);
 inherited Destroy;
end;

function TExpressionEvaluator.SetConst(const aName:LongString; aValue:Double):Boolean;
var buf:TeeTokenBuffer;
begin
 if Assigned(Self)
 then Result:=ConstList.SetValue(StrPLCopy(buf,aName,SizeOf(buf)-1),aValue)
 else Result:=false;
end;

function TExpressionEvaluator.SetFunc(const aName:LongString; aNarg:Integer; aFunc:TeeFunction; const aNote:LongString):Boolean;
var buf1,buf2:TeeTokenBuffer;
begin
 if Assigned(Self)
 then Result:=FuncList.SetFunc(StrPLCopy(buf1,aName,SizeOf(buf1)-1), aNarg, aFunc, StrPLCopy(buf2,aNote,SizeOf(buf2)-1))
 else Result:=false;
end;

function TExpressionEvaluator.SetAction(const aName:LongString; aAction:TeeAction; const aNote:LongString):Boolean;
var buf1,buf2:TeeTokenBuffer;
begin
 if Assigned(Self)
 then Result:=ActionList.SetAction(StrPLCopy(buf1,aName,SizeOf(buf1)-1), aAction, StrPLCopy(buf2,aNote,SizeOf(buf2)-1))
 else Result:=false;
end;

function TExpressionEvaluator.GetVarList:TeeVariableItemList;
begin
 if Assigned(Self) then Result:=myVarList else Result:=nil;
end;

function TExpressionEvaluator.GetConstList:TeeVariableItemList;
begin
 if Assigned(Self) then Result:=myConstList else Result:=nil;
end;

function TExpressionEvaluator.GetLabelList:TeeVariableItemList;
begin
 if Assigned(Self) then Result:=myLabelList else Result:=nil;
end;

function TExpressionEvaluator.GetFuncList:TeeFunctionItemList;
begin
 if Assigned(Self) then Result:=myFuncList else Result:=nil;
end;

function TExpressionEvaluator.GetActionList:TeeActionItemList;
begin
 if Assigned(Self) then Result:=myActionList else Result:=nil;
end;

function TExpressionEvaluator.GetStatus:Integer;
begin
 if Assigned(Self) then Result:=myStatus else Result:=ee_NilRef;
end;

function TExpressionEvaluator.GetAnswer:Double;
begin
 if Assigned(Self) then Result:=myAnswer else Result:=0;
end;

function TExpressionEvaluator.GetMayPrint:Boolean;
begin
 if Assigned(Self) then Result:=myMayPrint else Result:=false;
end;

function TExpressionEvaluator.GetExpression:PChar;
begin
 if Assigned(Self) then Result:=myExpression else Result:=nil;
end;

function TExpressionEvaluator.GetBuffer:PChar;
begin
 if Assigned(Self) then Result:=myBuffer else Result:=nil;
end;

function TExpressionEvaluator.GetToken:PChar;
begin
 if Assigned(Self) then Result:=myToken else Result:=nil;
end;

function TExpressionEvaluator.GetErrorToken:PChar;
begin
 if Assigned(Self) then Result:=myErrorToken else Result:=nil;
end;

function TExpressionEvaluator.GetErrorPos:Integer;
begin
 if Assigned(Self) then Result:=myErrorPos else Result:=0;
end;

function TExpressionEvaluator.GetCustom:Pointer;
begin
 if Assigned(Self) then Result:=myCustom else Result:=nil;
end;

procedure TExpressionEvaluator.SetCustom(aCustom:Pointer);
begin
 if Assigned(Self) then myCustom:=aCustom;
end;

function TExpressionEvaluator.GetParent:TObject;
begin
 if Assigned(Self) then Result:=myParent else Result:=nil;
end;

procedure TExpressionEvaluator.SetParent(aParent:TObject);
begin
 if Assigned(Self) then myParent:=aParent;
end;

function TExpressionEvaluator.GetHasher:THash32Function;
begin
 if Assigned(Self) then Result:=myHasher else Result:=nil;
end;

 {
 Очистка полей перед началом синтаксического анализа
 }
procedure TExpressionEvaluator.Clear;
begin
 if Assigned(Self) then begin
  myStatus:=ee_Ok;
  myAnswer:=0;
  myMayPrint:=false;
  myExpression:=@myBuffer;
  myTokenType:=id_Error;
  myBuffer[0]:=#0;
  myToken[0]:=#0;
  myErrorToken[0]:=#0;
  myErrorPos:=0;
 end;
end;

 {
 Процедура возбуждает исключение с номером ошибки n
 }
procedure TExpressionEvaluator.RaiseError(n:Integer);
begin
 if Assigned(Self) then begin
  myErrorPos:=math.max(0,PointerToPtrUInt(myExpression)-PointerToPtrUInt(@myBuffer)-1);
  StrLCopy(myErrorToken,myToken,ee_MaxToksLen);
  myStatus:=n;
  RAISE EExpressionEvaluator.CreateFmt('Expression evaluator exception: "%s".',
                                       [ee_ErrorMessage(myStatus)]);
 end; 
end;

 {
 Очистка переменной, вернет false, если переменная не существовала
 }
function TExpressionEvaluator.ClearVar(aName:PChar):Boolean;
begin
 if Assigned(Self) then Result:=myVarList.ClearVar(aName) else Result:=false;
end;

 {
 Если переменная name существует, ничего не делаем.
 Если переменная не существует, она создается с инициализацией нулем.
 Возвращает true если переменная с именем name существовала или была создана.
 }
function TExpressionEvaluator.DeclareVar(aName:PChar):Boolean;
var aValue:Double;
begin
 if Assigned(Self) then begin
  Result:=true;
  if not myVarList.GetValue(aName,aValue) then begin
   aValue:=0;
   Result:=myVarList.SetValue(aName,aValue);
  end;
 end else Result:=false;
end;

 {
 Функция извлечения значения вернет true если существует переменная
 или константа с таким именем.
 }
function TExpressionEvaluator.GetValue(aName:PChar; var aValue:Double):Boolean;
begin
 if Assigned(Self)
 then Result:=myVarList.GetValue(aName,aValue) or myConstList.GetValue(aName,aValue)
 else Result:=false;
end;

 {
 Назначает переменной с именем name новое значение или создает новую
 переменную, если ее не было.
 }
function TExpressionEvaluator.SetValue(aName:PChar; const aValue:Double):Boolean;
begin
 if Assigned(Self) then Result:=myVarList.SetValue(aName,aValue) else Result:=false;
end;

 {
 Функция берет строку выражения Expression и выделяет в ней лексему типа
 Разделитель, Число или Переменная. Лексема помещается в строку Token.
 Если встречается неизвестная лексема, генерируется ошибка.
 Удаляет незначащие пробелы до и после лексемы.
 Ехpression устанавливается на символ после выделенной лексемы и пробелов,
 то есть готово для выделения следующей лексемы.
 }
procedure TExpressionEvaluator.Parse;
var t:PChar;
begin
 if Assigned(Self) then begin
  myTokenType:=id_Error;
  t:=myToken;
  while (myExpression^ in WhiteChars) do inc(myExpression);
  if (myExpression^ in (DelimChars+ActionChars)) then begin
   myTokenType:=id_Delimer;
   t^:=myExpression^;
   inc(t);
   inc(myExpression);
  end
  else if (myExpression^ in ['0'..'9','.','$']) then begin
   myTokenType:=id_Number;
   if (myExpression^='$') then begin
    t^:=myExpression^;
    inc(t);
    inc(myExpression);
    while (myExpression^ in ['0'..'9','a'..'f','A'..'F']) do begin
     t^:=myExpression^;
     inc(t);
     inc(myExpression);
    end;
   end else begin
    while (myExpression^ in ['0'..'9','.']) do begin
     t^:=myExpression^;
     inc(t);
     inc(myExpression);
    end;
    if (myExpression^ in ['e','E']) then begin
     t^:=myExpression^;
     inc(t);
     inc(myExpression);
     if (myExpression^ in ['+','-']) then begin
      t^:=myExpression^;
      inc(t);
      inc(myExpression);
     end;
     while (myExpression^ in ['0'..'9']) do begin
      t^:=myExpression^;
      inc(t);
      inc(myExpression);
     end;
    end;
   end;
  end
  else if (myExpression^ in AlphaChars) then begin
   myTokenType:=id_Variable;
   while (myExpression^ in AlphaChars) do begin
    t^:=myExpression^;
    inc(t);
    inc(myExpression);
   end;
  end
  else if (myExpression^<>#0) then begin
   t^:=myExpression^;
   inc(t);
   inc(myExpression);
   RaiseError(ee_Syntax);
  end;
  t^:=#0;
  while (myExpression^ in WhiteChars) do inc(myExpression);
 end;
end;

 {
 Функция реализует оператор присвоения, конструкцию var.
 Вернет true если это присвоение верхнего уровня (и печать не нужна).
 }
function TExpressionEvaluator.Level1(var r:Double):Boolean;
var t:array[0..ee_MaxVarsLen] of Char;
begin
 Result:=false;
 if Assigned(Self) then begin
  Result:=(myToken[0] in ActionChars);
  if (myTokenType=id_Variable) then
  if (StrIComp('var',myToken)=0) then begin
   while true do begin
    Parse;
    if (myTokenType<>id_Variable) or (myToken[0]=#0) or not DeclareVar(myToken)
    then RaiseError(ee_VarDecl);
    Parse;
    case myToken[0] of
     #0  : break;
     ',' : continue;
     else RaiseError(ee_VarDecl);
    end;
   end;
   Result:=true;
   exit;
  end else
  if (myExpression^='=') then begin
   StrLCopy(t,myToken,ee_MaxVarsLen);
   Parse;
   Parse;
   if (myToken[0]=#0) then begin
    ClearVar(t);
    Result:=true;
    exit;
   end;
   Level2(r);
   if not SetValue(t,r) then begin
    Result:=false;
    RaiseError(ee_MaxVars);
    exit;
   end;
   Result:=true;
   exit;
  end;
  Level2(r);
 end;
end;

 {
 Функция реализует бинарные операторы + и -.
 }
procedure TExpressionEvaluator.Level2(var r:Double);
var t:Double; c:Char;
begin
 if Assigned(Self) then begin
  t:=0;
  Level3(r);
  while (myToken[0] in ['+','-']) do begin
   c:=myToken[0];
   Parse;
   Level3(t);
   case c of
    '+':r:=r+t;
    '-':r:=r-t;
   end;
  end;
 end;
end;


 {
 Функция реализует операции *, /, %.
 Контроль деления на ноль не делается так как в данной программе допустимы
 специальные "числа" - NAN,INF.
 }
procedure TExpressionEvaluator.Level3(var r:Double);
var t:Double; c:Char;
begin
 if Assigned(Self) then begin
  Level4(r);
  while (myToken[0] in ['*','/','%']) do begin
   c:=myToken[0];
   Parse;
   Level4(t);
   {if (t=0) and (c<>'*') then RaiseError(ee_DivZero);}
   case c of
    '*': r:=r*t;
    '/': r:=r/t;
    '%': r:=system.frac(r/t)*t;
   end;
  end;
 end;
end;

 {
 Функция обрабатывает оператор "в степени".
 }
procedure TExpressionEvaluator.Level4(var r:Double);
var t:Double;
begin
 if Assigned(Self) then begin
  Level5(r);
  if (myToken[0]='^') then begin
   Parse;
   Level5(t);
   r:=Power(r,t);
  end;
 end;
end;


 {
 Функция обрабатывает унарный оператор + или -.
 }
procedure TExpressionEvaluator.Level5(var r:Double);
var c:Char;
begin
 if Assigned(Self) then begin
  c:=#0;
  if (myToken[0] in ['+','-']) then begin
   c:=myToken[0];
   Parse;
  end;
  Level6(r);
  if c='-' then r:=-r;
 end;
end;

 {
 Функция реализует константы, переменные, функции, акции.
 }
procedure TExpressionEvaluator.Level6(var r:Double);
var n:Integer;  a:array[0..ee_MaxFuncArgs] of Double; Func:PeeFunctionItem;
    Action:PeeActionItem;
begin
 if Assigned(Self) then begin
  if (myToken[0] in ActionChars) then begin
   Parse;
   if (myToken[0]=#0) then RaiseError(ee_Syntax);
   if (myTokenType<>id_Variable) then RaiseError(ee_Syntax);
   Action:=myActionList.FindAction(myToken);
   if not Assigned(Action) then RaiseError(ee_Syntax);
   while (myExpression^ in WhiteChars) do inc(myExpression);
   r:=TeeActionItemExecute(Action,Self,StrPas(myExpression));
   myExpression:=StrEnd(myExpression);
   SetValue('actionresult',r);
   Parse;
  end else
  if (myToken[0]='(') then begin
   Parse;
   if (myToken[0]=')') then RaiseError(ee_NoArgs);
   Level1(r);
   if (myToken[0]<>')') then RaiseError(ee_UnBalanced);
   Parse;
  end else begin
   if (myTokenType=id_Number) then begin
    if not atof(myToken,r) then RaiseError(ee_Syntax);
    Parse;
   end
   else if (myTokenType=id_Variable) then begin
    if (myExpression^='(') then begin
     Func:=myFuncList.FindFunc(myToken);
     if Assigned(Func) then begin
      Parse;
      n:=0;
      repeat
       Parse;
       case myToken[0] of
        ')':break;
        ',':RaiseError(ee_NoArgs);
       end;
       a[n]:=0;
       Level1(a[n]);
       inc(n);
      until  (n>ee_MaxFuncArgs) or (myToken[0]<>',') or (Func.Narg=n);
      if (myToken[0]<>')') then RaiseError(ee_Unbalanced);
      Parse;
      if (n<>Func.Narg) then begin
       StrLCopy(myToken,PChar(@Func.Name),ee_MaxVarsLen);
       RaiseError(ee_NumArgs);
      end;
      r:=TeeFunctionItemEval(Func,Self,a);
      exit;
     end else RaiseError(ee_BadFunc);
    end
    else if not GetValue(myToken,r) then RaiseError(ee_Unknown);
    Parse;
   end else RaiseError(ee_Syntax);
  end;
 end;
end;

 {
 Функция вычисляет выражение e и возвращает результат в переменной myResult.
 Возвращает a=true, если это высокоуровневое присвоение
 Возвращает ee_Ok, если выражение правильно или код ошибки.
 Пустая строка не допускается, если ForbidEmpty=true.
 }
function TExpressionEvaluator.EvaluateExpression(e:PChar;ForbidEmpty:Boolean):Integer;
begin
 Result:=ee_NilRef;
 if Assigned(Self) then
 try
  Clear;                                              {Очистка буферов}
  try                                                 {Начало анализа}
   if not Assigned(e) then RaiseError(ee_Empty);      {Указатель nil недопустим}
   while (e^ in WhiteChars) do inc(e);                {Пропуск незначащих пробелов}
   myExpression:=StrLCopy(myBuffer,e,ee_MaxToksLen);  {Копируем строку в буфер}
   Parse;                                             {Выделяем лексему}
   if (myToken[0]=#0) then begin                      {Если пустая строка,то}
    if ForbidEmpty then RaiseError(ee_Empty);         {Пустая строка-ошибка}
    Result:=myStatus;                                 {выход без кода ошибки}
    exit;
   end;
   myMayPrint:=not Level1(myAnswer);                  {Рекурсивный анализатор}
   if (myToken[0]<>#0) then RaiseError(ee_Syntax);    {Мусор в конце-ошибка}
   Result:=myStatus;                                  {Все хоккей}
  except                                              {Сюда попадаем при ошибке}
   on EExpressionEvaluator do begin
    myMayPrint:=true;                                 {Флаг печати}
    Result:=myStatus;                                 {Код ошибки}
   end;
   else RAISE;
  end;
 except
  on E:Exception do begin
   myErrorPos:=0;
   myStatus:=ee_Exception;
   StrLCopy(myErrorToken,myToken,ee_MaxToksLen);
   ErrorReport(E,'EvaluateExpression');
   myMayPrint:=true;
   Result:=myStatus;
  end;
 end;
end;

 {
 Функция вычисляет выражение e.
 В отличие от EvaluateExpression допустимы пустые строки - это не ошибка.
 }
function TExpressionEvaluator.EvaluateLine(e:PChar):Integer;
begin
 Result:=EvaluateExpression(e,false);
end;

 {
 Получить текст исходной программы Daqsic
 }
function TExpressionEvaluator.GetScript:LongString;
begin
 if Assigned(Self) then Result:=myScript.Text else Result:='';
end;

 {
 Установить новый исходный текст и выполнить прекомпиляцию
 Прекомпиляция делается для ускорения работы при использовании в циклах
 Прекомпиляция состоит в
 1.Удалении комментариев
 2.Удалении незначащих пробелов
 3.Удалении пустых строк
 3.Создании таблицы меток и одновременно удалении меток из текста
 }
procedure TExpressionEvaluator.SetScript(aLines:LongString);
var i,p,n:Integer; s,lab:LongString; v:Double;
 function MayBeLabel(const s:LongString;p:Integer):Boolean;
 var i:Integer;
 begin
  MayBeLabel:=false;
  if (p>1) then begin
   i:=1;
   while (i<p) and (s[i] in WhiteChars) do inc(i);
   if i<p then begin
    while (i<p) and (s[i] in AlphaChars) do inc(i);
    MayBeLabel:=(i=p);
   end;
  end;
 end;
begin
 if Assigned(Self) then
 try
  myScript.Count:=0;                        {Очистить исходный текст}
  myPreScript.Count:=0;                     {Очистить выполняемый текст}
  myLabelList.Clear;                        {Очистить таблицу меток}
  myScript.Text:=aLines;                    {Присвоить новый исходный текст}
  myPreStatus:=ee_Ok;                       {Сбросить флаг ошибки прекомпиляции}
  myPreErrMsg[0]:=#0;                       {Сбросить ошибку прекомпиляции}
  n:=0;                                     {Номер строки выполняемого текста}
  for i:=0 to myScript.Count-1 do begin     {Цикл по строкам исходного текста}
   s:=myScript[i];                          {Берем строку исходного текста}
   p:=pos(';',s);                           {Находим позицию комментария}
   if (p>0) then delete(s,p,length(s)-p+1); {Удаляем комментарий если он есть}
   s:=TrimChars(s,WhiteChars,WhiteChars);   {Удаляем незначащие пробелы}
   if s='' then continue;                   {Пустые строки пропускаем}
   p:=pos(':',s);                           {Находим позицию признака метки}
   if MayBeLabel(s,p) then begin            {Если признак метки найден}
    lab:=copy(s,1,p-1);                     {то выделяем метку}
    delete(s,1,p);                          {и удаляем ее из текста}
    s:=TrimChars(s,WhiteChars,WhiteChars);  {Удаляем незначащие пробелы}
    try                                     {Начало анализа метки}
     myExpression:=StrPLCopy(myBuffer,lab,SizeOf(myBuffer)-1); {Инициализация лексич. анализатора}
     Parse;                                 {Выделение лексемы}
     if (myTokenType<>id_Variable) or       {Это должен быть идентификатор}
        (myToken[0]=#0) or                  {который имеет непустое имя}
        (myExpression[0]<>#0) or            {и после имени ничего более}
        (myLabelList.GetValue(myToken,v))   {метки не могут дублироваться}
     then RaiseError(ee_Label);             {иначе это плохая метка}
     v:=n;                                  {Берем номер строки метки}
     if not myLabelList.SetValue(myToken,v) {Заносим метку в список меток}
     then RaiseError(ee_Label);             {Иначе ошибка}
    except                                  {Сюда попадаем при ошибке:}
     on EExpressionEvaluator do begin       {это исключение интерпретатора}
      myPreScript.Count:=0;                 {Очистка исполняемого текста}
      myLabelList.Clear;                    {Очистка таблицы меток}
      myPreStatus:=myStatus;                {Взводим флаг ошибки прекомпиляции}
      StrPLCopy(myPreErrMsg,myScript[i],SizeOf(myPreErrMsg)-1);   {Запомним строку ошибки}
      exit;                                 {Выход}
     end;
     else RAISE;                            {остальные исключения}
    end;
   end;
   myPreScript.Addln(s);                    {добавляем в исполняемый текст}
   inc(n);                                  {текущую строку и идем к следующей}
  end;
 except
  on E:Exception do begin
   myPreScript.Count:=0;                   {Очистка исполняемого текста}
   myLabelList.Clear;                      {Очистка таблицы меток}
   myPreStatus:=ee_Exception;              {Взводим флаг ошибки прекомпиляции}
   StrPLCopy(myPreErrMsg,E.Message,SizeOf(myPreErrMsg)-1); {Запомним строку ошибки}
   ErrorReport(E,'SetScript');
  end;
 end;
end;

 {
 Получить исполняемый текст программы - текст, обработанный прекомпилятором
 }
function TExpressionEvaluator.GetPreScript:LongString;
begin
 if Assigned(Self) then Result:=myPreScript.Text else Result:='';
end;

 {
 Функция реализует интерпретатор для выполнения программ на языке
 условно названном DAQsic (Basic для DAQ).
 Это узко-ориентированный интерпретатор для встраивания в устройства
 DAQ и проведения простых вычислений в процессе измерений.
 В настоящее время формально можно описать Daqsic так:
  1. Набор допустимых символов 'a'..'z', '0'..'9', '.', '_', ' ', Tab,
     '+', '-', '*', '/', '%', '^', '(', ')', ',', '=', ':',';'
  2. Поддерживается один тип данных-число (Double).
     Массивы и строки не предусмотрены.
     Поддерживаются переменные, константы, встроенные функции, арифметические
     операторы, скобки любого уровня, метки, условный оператор if..then.. ,
     оператор перехода на метку goto.
     Циклы можно организовывать через if и goto.
  3. Программа Daqsic состоит из последовательно выполняемых строк вида
      Метка: Оператор ;Комментарий
     Наличие метки, комментария и оператора в строке необязательно.
     (То есть могут быть разные комбинации).
     На одной строке может быть только один оператор.
  4. Признаком начала комментария является символ ';'.
     Комментарий при выполнении игнорируется.
  5. Признаком метки является символ ':', причем пробелов между именем
     метки и ':' быть не должно. Имя метки состоит из символов
     'a'..'z', '0'..'9', '_' , но первой должна быть буква или '_'.
     Двух одинаковых меток в программе быть не должно.
  6. Поддерживаются переменные. Имя переменной состоит из символов
     'a'..'z', '0'..'9', '_' , но первой должна быть буква или '_'.
     Переменные создаются автоматически при непустом присвоении типа
     ИмяПеременной=Выражение
     Переменные удаляются автоматически при пустом присвоении типа
     ИмяПеременной=
     Переменные могут быть объявлены в конструкции
     var Имя1,Имя2...
     Конструкция var создает указанные переменные со значением 0, если
     они не существовали, но не меняет значений уже существующих
     переменных.
  7. Условный оператор имеет вид
     if(Условие)then Оператор или
     if Условие then Оператор
     Если выражение Условие имеет значение 0, то Оператор игнорируется.
     Если выражение Условие не равно 0, то Оператор выполняется.
  8. Оператор перехода на метку имеет вид
     goto ИмяМетки
     Интерпретатор найдет строку с меткой ИмяМетки: и передаст управление
     этой строке.
  9. Выражения могут содержать операторы +,-,*,/,%,^,скобки,ссылки
     на переменные, константы, вызовы функций - все как обычно
  10.Функции различаются наличием после имени скобок с параметрами,
     разделенными запятыми с числом параметров от 0 до 7, например,
     time()
     hypot(x,y)
 }
function TExpressionEvaluator.RunScript:Integer;
begin
 Result:=ee_NilRef;
 if Assigned(Self) then
 try
  Clear;                                  {Очистка буферов}
  if (myPreStatus<>ee_Ok) then begin      {Если прекомпиляция неудачна}
   myStatus:=myPreStatus;                 {То просто берем код ошибки}
   StrLCopy(myBuffer,myPreErrMsg,SizeOf(myBuffer)-1); {текст ошибки}
   myMayPrint:=true;                      {флаг печати}
   Result:=myStatus;                      {и уходим}
  end else begin                          {Если же прекомпиляция удачна,то}
   Result:=ExecuteScript(myPreScript);    {выполняем прекомпилированный текст}
  end;
 except
  on E:Exception do begin
   myErrorPos:=0;
   myStatus:=ee_Exception;
   StrLCopy(myErrorToken,myToken,ee_MaxToksLen);
   ErrorReport(E,'RunScript');
   myMayPrint:=true;
   Result:=myStatus;
  end;
 end;
end;

 {
 Выполнение предварительно прекомпилированной программы
 Прекомпилированная программа уже
  не содержит комментариев
  не содержит меток по тексту
  но зато имеет готовый список всех меток
 Прекомпиляция ускоряет выполнение программы за счет исключения многократного
 создания таблицы меток, удаления комментария, ускорения поиска меток и т.д.
 }
function TExpressionEvaluator.ExecuteScript(aScript:TText):Integer;
label ExtractLine,CheckIf,CheckGoto,CheckGoSub,CheckReturn,CheckExit,
      EvalExpression,NextLine;
var LineNum,StackPtr,isOk:Integer; Line:LongString; Cur,P:PChar; nl:Double;
begin
 Result:=ee_NilRef;
 if Assigned(Self) then
 try
  Result:=ee_Ok;
  Clear;                                   {Очистка полей анализатора}
  if Assigned(aScript) then begin
   LineNum:=0;                             {Текущая выполняемая строка}
   StackPtr:=Low(myStack);                 {Указатель стека вызовов}
   while (LineNum<aScript.Count) do begin
    {
    Подготовка очередной строки
    }
   ExtractLine:
    Line:=aScript[LineNum];                {Выделяем очередную строку}
    if (Line='') then goto NextLine;       {Продолжить, если пустая строка}
    Cur:=StrPLCopy(myLineBuf,Line,SizeOf(myLineBuf)-1); {Копируем строку в буфер}
    while (Cur^ in WhiteChars) do inc(Cur); {Пропускаем незначащие пробелы}
    if (Cur^=#0) then goto NextLine;       {Продолжить, если пустая строка}
    {
    Конструкция if имеет формат "if условие then оператор", где условие-
    выражение (ноль=false,не ноль=true).
    Признак конструкции - наличие "if " или "if(" в начале строки.
    }
   CheckIf:
    if (StrLIComp(Cur,'if',2)=0) and (Cur[2] in (WhiteChars+['('])) then begin
     P:=StrIPos(Cur,'then');
     if (P<>nil) and (P[4] in (WhiteChars+[#0])) then begin
      P^:=#0;                              {Выделяем то что до then}
      isOk:=EvaluateExpression(Cur+2);     {Вычисляем выражение после if}
      if (isOk=ee_Ok) then begin           {Вычисление удачно?}
       if myAnswer=0                       {Ветвление}
       then goto NextLine                  {Если ветвь false, то идем дальше}
       else begin                          {Иначе выполняем then:}
        Cur:=P+4;                          {Выделяем то что после then}
        while (Cur^ in WhiteChars) do inc(Cur); {Удалить незначащие пробелы}
        if (Cur[0]=#0) then goto NextLine; {Продолжить, если пустая строка}
        goto CheckIf;                      {Возможен вложенный if..then..if...}
       end;
      end else begin                       {Вычисление условия неудачно}
       myMayPrint:=true;
       Result:=isOk;                       {Вернуть код ошибки}
       break;
      end;
     end else begin                        {Ошибка в конструкции if..then}
      Clear;
      StrCopy(myErrorToken,StrCopy(myToken,StrLCopy(myBuffer,Cur,SizeOf(myBuffer)-1)));
      myStatus:=ee_If;
      myMayPrint:=true;
      Result:=myStatus;
      break;
     end;
    end;
    {
    Оператор goto имеет формат "goto Label", где Label-имя метки
    Если метка "Label:" не найдена, то ошибка.
    }
   CheckGoto:
    if (StrLIComp(Cur,'goto',4)=0) and (Cur[4] in WhiteChars) then begin
     Clear;
     try
      myExpression:=StrLCopy(myBuffer,Cur+4,SizeOf(myBuffer)-1); {Выделяем то что после goto}
      Parse;                                     {Выделяем лексему, которая}
      if (myTokenType<>id_Variable) or           {должна быть именем метки}
         (myToken[0]=#0) or                      {Имя должно быть непустое}
         (myExpression[0]<>#0) or                {После метки нет лексем!}
         (not myLabelList.GetValue(myToken,nl))  {и ищем метку в списке меток}
      then RaiseError(ee_Label);                 {иначе неверная метка}
      LineNum:=system.round(nl);                 {Метка найдена-переход}
      continue;
     except
      on EExpressionEvaluator do begin
       myMayPrint:=true;
       Result:=myStatus;
       break;
      end;
      else RAISE;
     end;
    end;
    {
    Оператор gosub имеет формат "gosub Label", где Label-имя метки
    Если метка "Label:" не найдена, то ошибка.
    }
   CheckGoSub:
    if (StrLIComp(Cur,'gosub',5)=0) and (Cur[5] in WhiteChars) then begin
     Clear;
     try
      myExpression:=StrLCopy(myBuffer,Cur+5,SizeOf(myBuffer)-1); {Выделяем то что после gosub}
      Parse;                                     {Выделяем лексему, которая}
      if (myTokenType<>id_Variable) or           {должна быть именем метки}
         (myToken[0]=#0) or                      {Имя должно быть непустое}
         (myExpression[0]<>#0) or                {После метки нет лексем!}
         (not myLabelList.GetValue(myToken,nl))  {и ищем метку в списке меток}
      then RaiseError(ee_Label);                 {иначе неверная метка}
      if (StackPtr>=High(myStack))               {Проверка стека}
      then RaiseError(ee_StackOver);             {на переполнение}
      myStack[StackPtr]:=LineNum+1;              {сохранить адрес возврата}
      inc(StackPtr);                             {сдвинуть указатель стека}
      LineNum:=system.round(nl);                 {Метка найдена-переход}
      continue;
     except
      on E:EExpressionEvaluator do begin
       myMayPrint:=true;
       Result:=myStatus;
       break;
      end;
      else RAISE;
     end;
    end;
    {
    Оператор return делает выход из подпрограммы после вызова gosub
    }
   CheckReturn:
    if (StrLIComp(Cur,'return',6)=0) and (Cur[6] in (WhiteChars+[#0])) then begin
     if (StackPtr<=Low(myStack)) then begin     {Проверка стека на неверный возврат}
      Clear;
      StrCopy(myErrorToken,StrCopy(myToken,StrLCopy(myBuffer,Cur,SizeOf(myBuffer)-1)));
      myStatus:=ee_BadReturn;
      myMayPrint:=true;
      Result:=myStatus;
      break;
     end;
     dec(StackPtr);                              {обратный сдвиг указателя стека}
     LineNum:=myStack[StackPtr];                 {переход по адресу возврата}
     continue;
    end;
    {
    Оператор exit делает выход из скрипта
    }
   CheckExit:
    if (StrLIComp(Cur,'exit',4)=0) and (Cur[4] in (WhiteChars+[#0])) then begin
     Clear;
     myStatus:=ee_Ok;
     myMayPrint:=false;
     Result:=myStatus;
     break;
    end;
    {
    Обычное выражение вычисляется здесь
    }
   EvalExpression:
    isOk:=EvaluateLine(Cur);
    Result:=isOk;
    if (isOk<>ee_Ok) then break;
    {
    Переход на следующую строку здесь
    }
   NextLine:
    inc(LineNum);
   end;
  end;
 except
  on E:Exception do begin
   myErrorPos:=0;
   myStatus:=ee_Exception;
   StrLCopy(myErrorToken,myToken,ee_MaxToksLen);
   ErrorReport(E,'ExecuteScript');
   myMayPrint:=true;
   Result:=myStatus;
  end;
 end;
end;

procedure TExpressionEvaluator.SaveVars(const IniFile,Section:LongString);
var f:text; P:TText;
begin
 if Assigned(Self) and (not IsEmptyStr(IniFile)) and (not IsEmptyStr(Section)) then
 try
  SetInOutRes(0);
  system.Assign(f,IniFile);
  system.Rewrite(f);
  try
   writeln(f,Section);
   P:=VarList.GetText(NewText);
   try
    P.Write(f);
   finally
    Kill(P);
   end;
  finally
   system.Close(f);
   SetInOutRes(0);
  end;
 except
  on E:Exception do ErrorReport(E,'SaveVars');
 end;
end;

procedure TExpressionEvaluator.RestoreVars(const IniFile,Section:LongString);
var P:TText;
begin
 if (not IsEmptyStr(IniFile)) and (not IsEmptyStr(Section)) and FileExists(IniFile) then
 try
  P:=ExtractListSection(IniFile,Section,efAsIs);
  try
   ExecuteScript(P);
  finally
   Kill(P);
  end;
 except
  on E:Exception do ErrorReport(E,'RestoreVars');
 end;
end;

 ///////////////////////////////////////////////////////////////////////////////
 // Special conversions for interpreter output
 // %Var        - insert Format('%g',[Var])
 // %3.4f%Var   - insert Format{'%3.4f',[Var])
 // a`          - convert a to A
 ///////////////////////////////////////////////////////////////////////////////
function TExpressionEvaluator.SmartArgs(const Args:LongString):LongString;
var
 v   : Double;
 i,j : Integer;
 Fmt : LongString;
 Buf : TeeTokenBuffer;
begin
 Result:=TrimChars(Args,WhiteChars,WhiteChars);
 if Assigned(Self) and not IsEmptyStr(Result) then
 try
  Fmt:=DefaultFmt;
  i:=1;
  while (i<=Length(Result)) do begin
   if Result[i]='%' then begin
    j:=i+1;
    if (j<=Length(Result)) and (Result[j] in DigitChars) then begin
     while (j<=Length(Result)) and (Result[j] in FormtChars) do Inc(j);
     Fmt:=System.Copy(Result,i,j-i);
     System.Delete(Result,i,j-i);
     Continue;
    end else begin
     while (j<=Length(Result)) and (Result[j] in AlphaChars) do Inc(j);
     if GetValue(StrPLCopy(Buf,System.Copy(Result,i+1,j-i-1),SizeOf(Buf)-1),v) then begin
      System.Delete(Result,i,j-i);
      System.Insert(Format(Fmt,[v]),Result,i);
     end else i:=j;
     Fmt:=DefaultFmt;
     Continue;
    end;
   end;
   Inc(i);
  end;
  if (UpChar>#0) then begin
   for i:=2 to Length(Result) do
   if (Result[i]=UpChar) then Result[i-1]:=UpCase(Result[i-1]);
   Result:=SysUtils.StringReplace(Result,UpChar,'',[rfReplaceAll]);
  end;
 except
  on E:Exception do ErrorReport(E,'SmartArgs');
 end;
end;

function  NewExpressionEvaluator:TExpressionEvaluator;
begin
 Result:=nil;
 try
  Result:=TExpressionEvaluator.Create;
 except
  on E:Exception do BugReport(E,nil,'NewExpressionEvaluator');
 end;
end;

procedure Kill(var TheObject:TExpressionEvaluator); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

 {
 Функция возвращает строку ошибки по коду ошибки
 }
function ee_ErrorMessage(ErrorCode:Integer):LongString;
begin
 case ErrorCode of
  ee_Ok          : Result:=RusEng('Операция выполнена успешно','Operation complete success');
  ee_Syntax      : Result:=RusEng('Синтаксическая ошибка','Syntax error');
  ee_UnBalanced  : Result:=RusEng('Несбалансированность скобок','Unbalanced parenthesis');
  ee_DivZero     : Result:=RusEng('Деление на ноль','Division by zero');
  ee_Unknown     : Result:=RusEng('Неизвестная переменная','Unknown variable');
  ee_MaxVars     : Result:=RusEng('Слишком много переменных','Maximum variables exceeded');
  ee_BadFunc     : Result:=RusEng('Неизвестная функция','Unrecognised funtion');
  ee_NumArgs     : Result:=RusEng('Неверное число аргументов функции','Wrong number of arguments to funtion');
  ee_NoArgs      : Result:=RusEng('Пропущен аргумент функции','Missing an argument');
  ee_Empty       : Result:=RusEng('Пустое выражение','Empty expression');
  ee_Label       : Result:=RusEng('Недопустимая метка','Invalid label');
  ee_VarDecl     : Result:=RusEng('Ошибка обьявления переменной','Variable declare error');
  ee_If          : Result:=RusEng('Ошибка оператора if','Error in If operator');
  ee_NilRef      : Result:=RusEng('Недопустимый объект NIL','NIL object reference');
  ee_BadReturn   : Result:=RusEng('Обнаружен Return без GoSub!','Return without GoSub!');
  ee_StackOver   : Result:=RusEng('Переполнение стека вызовов!','GoSub stack overflow!');
  ee_Exception   : Result:=RusEng('Исключение при выполнении программы','Exception during script execution');
  ee_LineTooLong : Result:=RusEng('Слишком длинная строка выражения','Input line string too long');
  ee_User        : Result:=RusEng('Пользовательская ошибка','User defined error');
  else             Result:=RusEng('Неизвестная ошибка','Unknown error');
 end;
end;
 
 // Check if Script is simple, i.e. can be executed line by line, without precompilation.
function IsSimpleScript(const Script:LongString):Boolean;
var List:TText; i,j,wc:Integer; Line,ws:LongString;
const Delims=WhiteChars+DelimChars+ArgDelims;
begin
 Result:=true;
 if Length(Script)>0 then
 try
  Result:=false;
  List:=NewText;
  try
   List.Text:=Script;                    // Convert to text
   for i:=0 to List.Count-1 do begin     // For each line:
    Line:=Trim(List[i]);                 // Get line
    if (Line='') then continue;          // Skip empty lines
    wc:=WordCount(Line,Delims);          // Find number of words
    for j:=1 to wc do begin              // For each word:
     ws:=ExtractWord(j,Line,Delims);     // Extract word
     if (StrFetch(ws,1)='@') then break; // Skip @actions
     if (StrFetch(ws,1)='\') then break; // Skip \actions
     if Pos(':',ws)>0 then exit;         // Found Lable:
     if SameText(ws,'if') then exit;     // Found If
     if SameText(ws,'then') then exit;   // Found Then
     if SameText(ws,'goto') then exit;   // Found GoTo
     if SameText(ws,'exit') then exit;   // Found Exit
     if SameText(ws,'gosub') then exit;  // Found GoSub
     if SameText(ws,'return') then exit; // Found Return
    end;
   end;
   Result:=true;
  finally
   Kill(List);
  end;
 except
  on E:Exception do BugReport(E,nil,'IsSimpleScript');
 end;
end;

 // Evaluate Script text line by line.
function EvaluateSimpleScript(ee:TExpressionEvaluator; const Script:LongString):Integer;
var Line:TeeTokenBuffer; i,LinePos,Count:Integer;
begin
 Result:=ee_NilRef;
 if Assigned(ee) then
 try
  Result:=ee_OK;
  LinePos:=0; Count:=0;
  for i:=1 to Length(Script) do begin
   if (Script[i] in [ASCII_CR,ASCII_LF,ASCII_NUL]) then begin
    if (LinePos>0) and (Count>0) then begin
     if (Count>ee_MaxToksLen)
     then Result:=ee_LineTooLong
     else Result:=ee.EvaluateExpression(StrLCopy(Line,@(Script[LinePos]),Count),false);
    end;
    LinePos:=0; Count:=0;
    if (Result<>ee_OK) then break;
   end else begin
    if LinePos=0 then LinePos:=i;
    inc(Count);
   end;
  end;
  if (LinePos>0) and (Count>0) then begin
   if (Count>ee_MaxToksLen)
   then Result:=ee_LineTooLong
   else Result:=ee.EvaluateExpression(StrLCopy(Line,@(Script[LinePos]),Count),false);
  end;
 except
  on E:Exception do BugReport(E,nil,'EvaluateSimpleScript');
 end;
end;

 // Expression Evaluator Benchmark to eastimate performance.
function ExpressionEvaluatorBenchmark(n:Integer=1000000):LongString;
var ee:TExpressionEvaluator; expr:LongString; i:Integer; ms:Double;
begin
 Result:='Expression Evaluator Benchmark:'+EOLN;
 try
  expr:='gt(v,alarm1)+gt(v,alarm2)';
  ee:=NewExpressionEvaluator;
  try
   ms:=_crw_rtc.mSecNow;
   for i:=0 to n-1 do begin
    ee.SetValue('v',system.frac(ms*0.01));
    ee.SetValue('alarm1',0.5);
    ee.SetValue('alarm2',0.7);
    if (ee.EvaluateLine(PChar(expr))<>0) then break;
   end;
   ms:=_crw_rtc.mSecNow-ms;
   Result:=Result+Format('Expression = %s',[expr])+EOLN;
   Result:=Result+Format('Total loop = %d',[i])+EOLN;
   Result:=Result+Format('Total time = %g ms',[ms])+EOLN;
   Result:=Result+Format('Oper. time = %3g mks/op',[ms*1000/n])+EOLN;
  finally
   Kill(ee);
  end;
 except
  on E:Exception do BugReport(E,nil,'ExpressionEvaluatorBenchmark');
 end;
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_ee;
begin
end;

procedure Free_crw_ee;
begin
 ResourceLeakageLog(Format('%-60s = %d',['Expression Evaluator Hash Collisions',ee_HashCollisions]));
end;

initialization

 Init_crw_ee;

finalization

 Free_crw_ee;

end.

//////////////
// END OF FILE
//////////////

