unit CodeToolsCfgScript;

Classes, SysUtils, TypInfo, AVL_Tree,

// Codetools

BasicCodeTools, KeywordFuncLists, FileProcs, CodeToolsStrConsts;

ECodeToolCfgScript = class(Exception);

TCTCSValueType = (

ctcsvNone,

ctcsvString,

ctcsvNumber

);

{ TCTCfgScriptVariable }

TCTCfgScriptVariable = record

Name: PChar;

ValueType: TCTCSValueType;

case Integer of

0: (StrStart: PChar; StrLen: integer);

1: (Number: int64);

end;

PCTCfgScriptVariable = ^TCTCfgScriptVariable;

{ TCTCfgScriptVariables }

TCTCfgScriptVariables = class

private

FItems: TAVLTree; // tree of PCTCfgScriptVariable sorted for name

function GetValues(const Name: string): string;

procedure SetValues(const Name: string; const AValue: string);

public

constructor Create;

destructor Destroy; override;

procedure Clear;

function Equals(Vars: TCTCfgScriptVariables): boolean; reintroduce;

procedure Assign(Source: TCTCfgScriptVariables); overload;

procedure Assign(Source: TStrings); overload;

procedure AddOverrides(Source: TCTCfgScriptVariables);

procedure AddOverride(Source: PCTCfgScriptVariable);

function GetVariable(const Name: PChar;

CreateIfNotExists: Boolean = false): PCTCfgScriptVariable;

property Values[const Name: string]: string read GetValues write SetValues; default;

procedure Undefine(Name: PChar);

procedure Define(Name: PChar; const Value: string);

function IsDefined(Name: PChar): boolean;

property Tree: TAVLTree read FItems;

procedure WriteDebugReport(const Title: string; const Prefix: string = '');

end;

PCTCfgScriptVariables = ^TCTCfgScriptVariables;

TCTCfgScriptOperator = (

ctcsoNone,

ctcsoNot,

ctcsoAnd,

ctcsoOr,

ctcsoXOr,

ctcsoShL,

ctcsoShR,

ctcsoDiv,

ctcsoMod,

ctcsoPlus,

ctcsoMinus,

ctcsoMultiply,

ctcsoDivide,

ctcsoEqual,

ctcsoNotEqual,

ctcsoLowerThan,

ctcsoLowerOrEqualThan,

ctcsoGreaterThan,

ctcsoGreaterOrEqualThan

);

TCTCfgScriptOperators = set of TCTCfgScriptOperator;

CTCfgScriptOperatorLvl: array[TCTCfgScriptOperator] of integer = (

0, //ctcsoNone,

1, //ctcsoNot,

1, //ctcsoAnd,

2, //ctcsoOr,

2, //ctcsoXOr,

1, //ctcsoShL,

1, //ctcsoShR,

1, //ctcsoDiv,

1, //ctcsoMod,

2, //ctcsoPlus,

2, //ctcsoMinus,

1, //ctcsoMultiply,

1, //ctcsoDivide,

4, //ctcsoEqual,

4, //ctcsoNotEqual,

4, //ctcsoLowerThan,

4, //ctcsoLowerOrEqualThan,

4, //ctcsoGreaterThan,

4 //ctcsoGreaterOrEqualThan

);

TCTCfgScriptStackItemType = (

ctcssNone,

ctcssStatement,

ctcssBegin,

ctcssIf,

ctcssIfThen,

ctcssIfElse,

ctcssExpression,

ctcssRoundBracketOpen,

ctcssOperand,

ctcssOperator,

ctcssAssignment

);

ctcssAllStatementStarts = [ctcssNone,ctcssIfThen,ctcssIfElse,ctcssBegin];

TCTCfgScriptStackItem = record

Typ: TCTCfgScriptStackItemType;

StartPos: PChar;

Operand: TCTCfgScriptVariable;

end;

PCTCfgScriptStackItem = ^TCTCfgScriptStackItem;

{ TCTCfgScriptStack }

TCTCfgScriptStack = class

public

Items: PCTCfgScriptStackItem;

Top: integer; // current item, -1 = empty

TopTyp: TCTCfgScriptStackItemType;

Capacity: integer;

constructor Create;

destructor Destroy; override;

procedure Clear;

procedure Push(Typ: TCTCfgScriptStackItemType; const StartPos: PChar);

procedure Pop(Count: integer = 1);

procedure Delete(Index: integer);

function TopItem: PCTCfgScriptStackItem;

function TopItemOperand: PCTCfgScriptVariable;

{$IFDEF CheckCTCfgVars}

procedure CheckOperands;

{$ENDIF}

end;

{ TCTCfgScriptError }

TCTCfgScriptError = class

public

Msg: string;

Position: integer;

Line: integer;

Column: integer;

constructor Create(const aMsg: string; aPos, aLine, aCol: integer);

constructor Create(const aMsg: string);

end;

{ TCTConfigScriptEngine }

TCTConfigScriptEngine = class

protected

FVariables: TCTCfgScriptVariables;

FStack: TCTCfgScriptStack;

FErrors: TFPList; // list of TCTCfgScriptError

function GetErrors(Index: integer): TCTCfgScriptError;

procedure AddError(const aMsg: string; ErrorPos: PChar); overload;

procedure AddError(const aMsg: string); overload;

procedure PushNumberConstant;

procedure PushBooleanValue(b: boolean);

procedure PushNumberValue(const Number: int64);

function RunDefined(Negate: boolean): boolean;

function RunFunction: boolean;

procedure PushStringConstant;

procedure RunStatement(Skip: boolean);

procedure RunBegin(Skip: boolean);

procedure RunIf(Skip: boolean);

procedure RunUndefine(Skip: boolean);

procedure RunAssignment(Skip: boolean);

function RunExpression: boolean; // if true the stack top has an operand

function ExecuteStack(MaxLevel: integer): boolean;

function GetOperatorLevel(P: PChar): integer;

function IsKeyWord(P: PChar): boolean;

function IsFunction(P: PChar): boolean;

function IsCustomFunction({%H-}FunctionName: PChar): boolean; virtual;

procedure RunCustomSimpleFunction({%H-}FunctionName: PChar; {%H-}Value: PCTCfgScriptVariable); virtual;

public

Src: PChar;

AtomStart: PChar;

SrcStart, SrcEnd: PChar;

MaxErrorCount: integer;

constructor Create;

destructor Destroy; override;

procedure ClearErrors;

property Variables: TCTCfgScriptVariables read FVariables;

function Execute(const Source: string; StopAfterErrors: integer = 1): boolean;// true if no errors

function ErrorCount: integer;

property Errors[Index: integer]: TCTCfgScriptError read GetErrors;

function GetAtom: string;

function GetAtomOrNothing: string;

function GetAtom(P: PChar): string;

function PosToLineCol(p: PChar; out Line, Column: integer): boolean;

function PosToStr(p: PChar): string;

function GetErrorStr(Index: integer): string;

procedure WriteDebugReportStack(Title: string);

end;

procedure RenameCTCSVariable(var Src: string; const OldName, NewName: string);

function CompareCTCSVariables(Var1, Var2: Pointer): integer;

function ComparePCharWithCTCSVariableName(Name, aVar: Pointer): integer;

function AreCTCSVariablesEqual(const V1, V2: PCTCfgScriptVariable): Boolean;

function AreCTCSVariablesExactEqual(const V1, V2: PCTCfgScriptVariable): Boolean;

function CompareCTCSVariables(const Left, Right: PCTCfgScriptVariable;

out Equal, LeftIsLowerThanRight: boolean): boolean;

function NewCTCSVariable: PCTCfgScriptVariable;

function NewCTCSVariable(CloneName: PChar): PCTCfgScriptVariable;

function CloneCTCSVariable(const V: PCTCfgScriptVariable): PCTCfgScriptVariable;

procedure FreeCTCSVariable(var V: PCTCfgScriptVariable);

procedure ClearCTCSVariable(const V: PCTCfgScriptVariable);

procedure SetCTCSVariableAsString(const V: PCTCfgScriptVariable; const s: string);

procedure SetCTCSVariableAsNumber(const V: PCTCfgScriptVariable; const i: int64);

procedure SetCTCSVariableValue(const Src, Dest: PCTCfgScriptVariable);

function GetCTCSVariableAsString(const V: PCTCfgScriptVariable): string;

procedure MakeCTCSVariableString(const V: PCTCfgScriptVariable);

procedure MakeCTCSVariableInt64(const V: PCTCfgScriptVariable);

procedure MakeCTCSVariableInteger(const V: PCTCfgScriptVariable);

procedure AddCTCSVariables(const AddVar, SumVar: PCTCfgScriptVariable);

function CTCSNumberEqualsString(const Number: int64; const P: PChar): boolean; inline;

function CTCSVariableIsTrue(const V: PCTCfgScriptVariable): boolean; inline;

function CTCSVariableIsFalse(const V: PCTCfgScriptVariable): boolean;

function CTCSStringToNumber(P: PChar; out Number: int64): boolean;

function AtomToCTCfgOperator(p: PChar): TCTCfgScriptOperator;

procedure CheckCTCSVariable(const V: PCTCfgScriptVariable);

function dbgs(const t: TCTCfgScriptStackItemType): string; overload;

function dbgs(const t: TCTCSValueType): string; overload;

function dbgs(const t: TCTCfgScriptOperator): string; overload;

function dbgs(const V: PCTCfgScriptVariable): string; overload;

procedure RenameCTCSVariable(var Src: string; const OldName, NewName: string);

p: PChar;

AtomStart: PChar;

SrcPos: PtrUInt;

if (Src='') or not IsValidIdent(OldName) or (NewName='') then exit;

p:=PChar(Src);

//debugln(['RenameCTCSVariable START ',dbgstr(Src)]);

repeat

ReadRawNextPascalAtom(p,AtomStart,nil,false,true);

if (p=AtomStart) then break;

if IsIdentStartChar[AtomStart^]

and (CompareIdentifiers(PChar(OldName),AtomStart)=0)

then begin

SrcPos:=PtrUInt(AtomStart-PChar(Src))+1;

Src:=copy(Src,1,SrcPos-1)+NewName+copy(Src,SrcPos+PtrUInt(length(OldName)),length(Src));

p:=@Src[SrcPos]+length(NewName);

end;

until false;

//debugln(['RenameCTCSVariable END ',dbgstr(Src)]);

end;

function CompareCTCSVariables(Var1, Var2: Pointer): integer;

v1: PCTCfgScriptVariable absolute Var1;

v2: PCTCfgScriptVariable absolute Var2;

{$IFDEF CheckCTCfgVars}

CheckCTCSVariable(v1);

CheckCTCSVariable(v2);

{$ENDIF}

Result:=CompareIdentifiers(v1^.Name,v2^.Name);

end;

function ComparePCharWithCTCSVariableName(Name, aVar: Pointer): integer;

n: PChar absolute Name;

v: PCTCfgScriptVariable absolute aVar;

{$IFDEF CheckCTCfgVars}CheckCTCSVariable(v);{$ENDIF}

Result:=CompareIdentifiers(n,v^.Name);

end;

function AreCTCSVariablesEqual(const V1, V2: PCTCfgScriptVariable): Boolean;

{$IFDEF CheckCTCfgVars}

CheckCTCSVariable(v1);

CheckCTCSVariable(v2);

{$ENDIF}

Result:=false;

case V1^.ValueType of

ctcsvNone:

exit; // invalid is never equal to anything

ctcsvString:

case V2^.ValueType of

ctcsvNone: exit;

ctcsvString:

if (V1^.StrLen<>V2^.StrLen)

or ((V1^.StrStart<>nil)

and (not CompareMem(V1^.StrStart,V2^.StrStart,V1^.StrLen)))

then exit;

ctcsvNumber:

if not CTCSNumberEqualsString(V2^.Number,V1^.StrStart) then exit;

end;

ctcsvNumber:

case V2^.ValueType of

ctcsvNone: exit;

ctcsvString:

if not CTCSNumberEqualsString(V1^.Number,V2^.StrStart) then exit;

ctcsvNumber:

if V1^.Number<>V2^.Number then exit;

end;

end;

Result:=true;

end;

function AreCTCSVariablesExactEqual(const V1, V2: PCTCfgScriptVariable

): Boolean;

{$IFDEF CheckCTCfgVars}

CheckCTCSVariable(v1);

CheckCTCSVariable(v2);

{$ENDIF}

Result:=false;

if V1^.ValueType<>V2^.ValueType then exit;

case V1^.ValueType of

ctcsvNone: ;

ctcsvString: if (V1^.StrLen<>V2^.StrLen)

or ((V1^.StrStart<>nil)

and (not CompareMem(V1^.StrStart,V2^.StrStart,V1^.StrLen)))

then exit;

ctcsvNumber: if V1^.Number<>V2^.Number then exit;

end;

Result:=true;

end;

function CompareCTCSVariables(const Left, Right: PCTCfgScriptVariable; out

Equal, LeftIsLowerThanRight: boolean): boolean;

procedure CompareNumberWithString(Number: int64; p: PChar);

var

i: Integer;

Cnt: integer;

s: array[0..30] of char;

begin

if p=nil then begin

Equal:=false;

LeftIsLowerThanRight:=false;

exit;

end;

// convert number to decimal string

if Number=0 then begin

Cnt:=1;

s[0]:='0';

end else begin

Cnt:=0;

if Number<0 then begin

Cnt:=1;

s[0]:='-';

Number:=-Number;

end;

while Number>0 do begin

s[Cnt]:=chr(Number mod 10+ord('0'));

inc(Cnt);

Number:=Number div 10;

end;

end;

for i:=0 to Cnt-1 do begin

if p^<>s[i] then begin

Equal:=false;

LeftIsLowerThanRight:=s[i]<p^;

exit;

end;

inc(p);

end;

if p^=#0 then begin

Equal:=true;

LeftIsLowerThanRight:=false;

end else begin

Equal:=False;

LeftIsLowerThanRight:=true;

end;

end;

V1: PChar;

V2: PChar;

{$IFDEF CheckCTCfgVars}

CheckCTCSVariable(Left);

CheckCTCSVariable(Right);

{$ENDIF}

//debugln(['CompareCTCSVariables START Left=',dbgs(Left),' Right=',dbgs(Right)]);

Result:=false;

Equal:=false;

LeftIsLowerThanRight:=false;

case Left^.ValueType of

ctcsvNone:

exit; // invalid is never equal to anything

ctcsvString:

case Right^.ValueType of

ctcsvNone: exit;

ctcsvString:

begin

// compare two strings

V1:=Left^.StrStart;

V2:=Right^.StrStart;

if V1=nil then begin

if V2=nil then begin

Equal:=true;

LeftIsLowerThanRight:=false;

end else begin

Equal:=False;

LeftIsLowerThanRight:=true; // left is shorter than right

end;

end else begin

if V2=nil then begin

Equal:=False;

LeftIsLowerThanRight:=false; // left is longer than right

end else begin

repeat

if V1^=V2^ then begin

if V1^=#0 then begin

Equal:=true;

LeftIsLowerThanRight:=false;

break;

end else begin

inc(V1);

inc(V2);

end;

end else begin

Equal:=false;

LeftIsLowerThanRight:=V1^<V2^;

break;

end;

until false;

end;

end;

end;

ctcsvNumber:

begin

CompareNumberWithString(Right^.Number,Left^.StrStart);

LeftIsLowerThanRight:=not LeftIsLowerThanRight;

end;

end;

ctcsvNumber:

case Right^.ValueType of

ctcsvNone: exit;

ctcsvString:

CompareNumberWithString(Left^.Number,Right^.StrStart);

ctcsvNumber:

begin

Equal:=Left^.Number=Right^.Number;

LeftIsLowerThanRight:=Left^.Number<Right^.Number;

end;

end;

end;

Result:=true;

end;

function NewCTCSVariable: PCTCfgScriptVariable;

New(Result);

FillByte(Result^,SizeOf(TCTCfgScriptVariable),0);

{$IFDEF CheckCTCfgVars}

CheckCTCSVariable(Result);

{$ENDIF}

end;

function NewCTCSVariable(CloneName: PChar): PCTCfgScriptVariable;

l: LongInt;

Result:=NewCTCSVariable();

l:=GetIdentLen(CloneName);

if l>0 then begin

Result^.Name:=GetMem(l+1);

System.Move(CloneName^,Result^.Name^,l);

Result^.Name[l]:=#0;

end;

{$IFDEF CheckCTCfgVars}

CheckCTCSVariable(Result);

{$ENDIF}

end;

function CloneCTCSVariable(const V: PCTCfgScriptVariable): PCTCfgScriptVariable;

l: LongInt;

{$IFDEF CheckCTCfgVars}

CheckCTCSVariable(v);

{$ENDIF}

Result:=NewCTCSVariable(V^.Name);

{$IFDEF CheckCTCfgVars}

CheckCTCSVariable(Result);

{$ENDIF}

Result^.ValueType:=V^.ValueType;

{$IFDEF CheckCTCfgVars}

CheckCTCSVariable(Result);

{$ENDIF}

case V^.ValueType of

ctcsvNone: ;

ctcsvString:

begin

l:=V^.StrLen;

if l>0 then begin

Result^.StrLen:=l;

Result^.StrStart:=GetMem(l+1);

System.Move(V^.StrStart^,Result^.StrStart^,l);

Result^.StrStart[l]:=#0;

end;

end;

ctcsvNumber:

Result^.Number:=V^.Number;

end;

{$IFDEF CheckCTCfgVars}

CheckCTCSVariable(Result);

{$ENDIF}

end;

procedure SetCTCSVariableValue(const Src, Dest: PCTCfgScriptVariable);

l: LongInt;

{$IFDEF CheckCTCfgVars}

CheckCTCSVariable(Src);

CheckCTCSVariable(Dest);

{$ENDIF}

if Src=Dest then exit;

case Src^.ValueType of

ctcsvNone:

ClearCTCSVariable(Dest);

ctcsvString:

begin

if Dest^.ValueType<>ctcsvString then begin

Dest^.ValueType:=ctcsvString;

Dest^.StrStart:=nil;

end;

l:=Src^.StrLen;

Dest^.StrLen:=l;

if l>0 then begin

ReAllocMem(Dest^.StrStart,l+1);

System.Move(Src^.StrStart^,Dest^.StrStart^,l);

Dest^.StrStart[l]:=#0;

end else

ReAllocMem(Dest^.StrStart,0);

end;

ctcsvNumber:

begin

case Dest^.ValueType of

ctcsvNone:

Dest^.ValueType:=ctcsvNumber;

ctcsvString:

begin

Dest^.ValueType:=ctcsvNumber;

if Dest^.StrStart<>nil then

Freemem(Dest^.StrStart);

end;

ctcsvNumber: ;

end;

Dest^.Number:=Src^.Number;

end;

end;

{$IFDEF CheckCTCfgVars}

CheckCTCSVariable(Src);

CheckCTCSVariable(Dest);

{$ENDIF}

end;

procedure FreeCTCSVariable(var V: PCTCfgScriptVariable);

{$IFDEF CheckCTCfgVars}

CheckCTCSVariable(v);

{$ENDIF}

ClearCTCSVariable(V);

ReAllocMem(V^.Name,0);

Dispose(V);

end;

procedure ClearCTCSVariable(const V: PCTCfgScriptVariable);

{$IFDEF CheckCTCfgVars}

CheckCTCSVariable(v);

{$ENDIF}

if V^.ValueType=ctcsvString then

ReAllocMem(V^.StrStart,0);

V^.ValueType:=ctcsvNone;

{$IFDEF CheckCTCfgVars}

CheckCTCSVariable(v);

{$ENDIF}

end;

procedure MakeCTCSVariableString(const V: PCTCfgScriptVariable);

s: String;

{$IFDEF CheckCTCfgVars}

CheckCTCSVariable(V);

{$ENDIF}

case V^.ValueType of

ctcsvNone:

begin

V^.StrLen:=0;

V^.StrStart:=nil;

V^.ValueType:=ctcsvString;

end;

ctcsvString: ;

ctcsvNumber:

begin

s:=IntToStr(V^.Number);

V^.StrLen:=length(s);

V^.StrStart:=GetMem(length(s)+1);

System.Move(s[1],V^.StrStart^,length(s)+1);

V^.ValueType:=ctcsvString;

end;

end;

{$IFDEF CheckCTCfgVars}

CheckCTCSVariable(V);

{$ENDIF}

end;

procedure MakeCTCSVariableInt64(const V: PCTCfgScriptVariable);

i: Int64;

{$IFDEF CheckCTCfgVars}

CheckCTCSVariable(V);

{$ENDIF}

case V^.ValueType of

ctcsvNone:

begin

V^.Number:=0;

V^.ValueType:=ctcsvNumber;

end;

ctcsvString:

begin

if V^.StrStart<>nil then begin

i:=StrToInt64Def(V^.StrStart,0);

FreeMem(V^.StrStart);

V^.Number:=i;

end else

V^.Number:=0;

V^.ValueType:=ctcsvNumber;

end;

ctcsvNumber: ;

end;

{$IFDEF CheckCTCfgVars}

CheckCTCSVariable(V);

{$ENDIF}

end;

procedure MakeCTCSVariableInteger(const V: PCTCfgScriptVariable);

i: integer;

{$IFDEF CheckCTCfgVars}

CheckCTCSVariable(V);

{$ENDIF}

case V^.ValueType of

ctcsvNone:

begin

V^.Number:=0;

V^.ValueType:=ctcsvNumber;

end;

ctcsvString:

begin

if V^.StrStart<>nil then begin

i:=StrToIntDef(V^.StrStart,0);

FreeMem(V^.StrStart);

V^.Number:=i;

end else

V^.Number:=0;

V^.ValueType:=ctcsvNumber;

end;

ctcsvNumber: ;

end;

{$IFDEF CheckCTCfgVars}

CheckCTCSVariable(V);

{$ENDIF}

end;

procedure AddCTCSVariables(const AddVar, SumVar: PCTCfgScriptVariable);

OldLen: LongInt;

s: String;

{$IFDEF CheckCTCfgVars}

CheckCTCSVariable(AddVar);

CheckCTCSVariable(SumVar);

{$ENDIF}

case SumVar^.ValueType of

ctcsvNone:

SetCTCSVariableValue(AddVar,SumVar);

ctcsvString:

case AddVar^.ValueType of

ctcsvNone:

;

ctcsvString:

if AddVar^.StrLen>0 then begin

// append

OldLen:=SumVar^.StrLen;

SumVar^.StrLen+=AddVar^.StrLen;

ReAllocMem(SumVar^.StrStart,SumVar^.StrLen+1);

System.Move(AddVar^.StrStart^,SumVar^.StrStart[OldLen],AddVar^.StrLen+1);

end;

ctcsvNumber:

begin

// append as string

s:=IntToStr(AddVar^.Number);

OldLen:=SumVar^.StrLen;

SumVar^.StrLen+=length(s);

ReAllocMem(SumVar^.StrStart,SumVar^.StrLen+1);

System.Move(s[1],SumVar^.StrStart[OldLen],length(s)+1);

end;

end;

ctcsvNumber:

case AddVar^.ValueType of

ctcsvNone:

;

ctcsvString:

begin

// convert SumVar from number to string and append

s:=IntToStr(SumVar^.Number);

SumVar^.ValueType:=ctcsvString;

SumVar^.StrLen:=length(s)+AddVar^.StrLen;

SumVar^.StrStart:=GetMem(SumVar^.StrLen+1);

System.Move(s[1],SumVar^.StrStart^,length(s));

if AddVar^.StrStart<>nil then

System.Move(AddVar^.StrStart^,SumVar^.StrStart[length(s)],AddVar^.StrLen+1)

else

SumVar^.StrStart[SumVar^.StrLen]:=#0;

end;

ctcsvNumber:

try

SumVar^.Number+=AddVar^.Number;

except

end;

end;

end;

{$IFDEF CheckCTCfgVars}

CheckCTCSVariable(AddVar);

CheckCTCSVariable(SumVar);

{$ENDIF}

end;

function CTCSNumberEqualsString(const Number: int64; const P: PChar): boolean;

n: int64;

Result:=CTCSStringToNumber(P,n) and (n=Number);

end;

function CTCSStringToNumber(P: PChar; out Number: int64): boolean;

n: int64;

Negated: Boolean;

Result:=false;

if (P=nil) or (P^=#0) then exit;

try

n:=0;

if p^='-' then begin

Negated:=true;

inc(p);

end else

Negated:=false;

if p^='$' then begin

// hex

repeat

case p^ of

'0'..'9': n:=n*16+Ord(p^)-Ord('0');

'a'..'f': n:=n*16+Ord(p^)-Ord('a')+10;

'A'..'F': n:=n*16+Ord(p^)-Ord('A')+10;

#0: break;

else exit;

end;

inc(p);

until false;

end else if p^='%' then begin

// binary

repeat

case p^ of

'0': n:=n*2;

'1': n:=n*2+1;

#0: break;

else exit;

end;

inc(p);

until false;

end else begin

// decimal

repeat

case p^ of

'0'..'9': n:=n*10+Ord(p^)-Ord('0');

#0: break;

else exit;

end;

inc(p);

until false;

end;

if Negated then n:=-n;

except

exit;

end;

Number:=n;

Result:=true;

end;

function CTCSVariableIsTrue(const V: PCTCfgScriptVariable): boolean;

Result:=not CTCSVariableIsFalse(V);

end;

function CTCSVariableIsFalse(const V: PCTCfgScriptVariable): boolean;

case V^.ValueType of

ctcsvNone:

Result:=false;

ctcsvString:

Result:=(V^.StrLen=1) and (V^.StrStart^='0');

ctcsvNumber:

Result:=V^.Number=0;

end;

end;

function AtomToCTCfgOperator(p: PChar): TCTCfgScriptOperator;

Result:=ctcsoNone;

case UpChars[p^] of

'A':

if CompareIdentifiers('and',p)=0 then Result:=ctcsoAnd;

'D':

if CompareIdentifiers('div',p)=0 then Result:=ctcsoDiv;

'M':

if CompareIdentifiers('mod',p)=0 then Result:=ctcsoMod;

'N':

if CompareIdentifiers('not',p)=0 then Result:=ctcsoNot;

'O':

if CompareIdentifiers('or',p)=0 then Result:=ctcsoOr;

'S':

case UpChars[p[1]] of

'H':

case UpChars[p[2]] of

'L': if CompareIdentifiers('shl',p)=0 then Result:=ctcsoShL;

'R': if CompareIdentifiers('shr',p)=0 then Result:=ctcsoShR;

end;

end;

'X':

if CompareIdentifiers('xor',p)=0 then Result:=ctcsoXOr;

'=':

Result:=ctcsoEqual;

'<':

case p[1] of

'>': Result:=ctcsoNotEqual;

'=': Result:=ctcsoLowerOrEqualThan;

else { < lower than } Result:=ctcsoLowerThan;

end;

'>':

case p[1] of

'=': Result:=ctcsoGreaterOrEqualThan;

else { > greater than } Result:=ctcsoGreaterThan;

end;

'*':

case p[1] of

'*': ;

'=': ;

else { * multiply } Result:=ctcsoMultiply;

end;

'/':

case p[1] of

'/': ;

'=': ;

else { / divide } Result:=ctcsoDivide;

end;

'+':

case p[1] of

'=': ;

else { + plus } Result:=ctcsoPlus;

end;

'-':

case p[1] of

'=': ;

else { - minus } Result:=ctcsoMinus;

end;

':':

case p[1] of

'=': ;

else { : colon } ;

end;

end;

end;

procedure CheckCTCSVariable(const V: PCTCfgScriptVariable);

if V=nil then

RaiseCatchableException('');

if (V^.Name<>nil) and (strlen(V^.Name)>255) then

RaiseCatchableException('');

case V^.ValueType of

ctcsvNone: ;

ctcsvString:

begin

if V^.StrLen=0 then begin

if V^.StrStart<>nil then

RaiseCatchableException('');

end else begin

if V^.StrStart=nil then

RaiseCatchableException('');

if strlen(V^.StrStart)<>V^.StrLen then

RaiseCatchableException('');

end;

end;

ctcsvNumber: ;

end;

end;

function dbgs(const t: TCTCfgScriptStackItemType): string;

Result:=GetEnumName(typeinfo(t),ord(t));

end;

function dbgs(const t: TCTCSValueType): string;

Result:=GetEnumName(typeinfo(t),ord(t));

end;

function dbgs(const t: TCTCfgScriptOperator): string;

Result:=GetEnumName(typeinfo(t),ord(t));

end;

function dbgs(const V: PCTCfgScriptVariable): string;