paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-16 19:29:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: cfg parser: typecasts

Browse Source 
git-svn-id: trunk@26966 -
This commit is contained in:
mattias 2010-08-01 22:04:26 +00:00
parent 317f836fa3
commit 121d88afc3
3 changed files with 389 additions and 146 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

524
components/codetools/codetoolscfgscript.pas
View File

@ -25,12 +25,16 @@
programs.
Working:
if, then, else, begin..end, ;, (), not, and, or, xor, =, <>, >, <, <=, >=,
:=, defined(), variable,
if, then, else, begin..end, ;
()
boolean operators: not, and, or, xor
operators: =, <>, >, <, <=, >=, :=,
variables
constants: decimal, hex, octal, binary, string, #decimal
functions: string(), integer(), int64(), defined(), undefined()
procedures: undefine()
ToDo:
+=, string(), integer(), int64(), shl, shr, div, mod, *, +, -
+, - as unary operator
+=, +
}
unit CodeToolsCfgScript;
@ -78,6 +82,8 @@ type
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);
end;
type
@ -164,6 +170,8 @@ type
procedure Push(Typ: TCTCfgScriptStackItemType; const StartPos: PChar);
procedure Pop(Count: integer = 1);
procedure Delete(Index: integer);
function TopItem: PCTCfgScriptStackItem;
function TopItemOperand: PCTCfgScriptVariable;
end;
{ TCTCfgScriptError }
@ -189,15 +197,18 @@ type
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(var Value: TCTCfgScriptVariable): boolean;
function AtomIsKeyWord: 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;
public
Src: PChar;
AtomStart: PChar;
@ -235,11 +246,15 @@ 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 SumVar, AddVar: PCTCfgScriptVariable);
function CTCSNumberEqualsString(const Number: int64; const P: PChar): boolean; inline;
function CTCSStringToNumber(P: PChar; out Number: int64): boolean;
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;
function dbgs(const t: TCTCfgScriptStackItemType): string; overload;
@ -528,6 +543,74 @@ begin
V^.ValueType:=ctcsvNone;
end;
procedure MakeCTCSVariableString(const V: PCTCfgScriptVariable);
var
s: String;
begin
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;
end;
procedure MakeCTCSVariableInt64(const V: PCTCfgScriptVariable);
var
i: Int64;
begin
case V^.ValueType of
ctcsvNone:
begin
V^.Number:=0;
V^.ValueType:=ctcsvNumber;
end;
ctcsvString:
begin
i:=StrToInt64Def(V^.StrStart,0);
V^.Number:=i;
V^.ValueType:=ctcsvNumber;
end;
ctcsvNumber: ;
end;
end;
procedure MakeCTCSVariableInteger(const V: PCTCfgScriptVariable);
var
i: integer;
begin
case V^.ValueType of
ctcsvNone:
begin
V^.Number:=0;
V^.ValueType:=ctcsvNumber;
end;
ctcsvString:
begin
i:=StrToIntDef(V^.StrStart,0);
V^.Number:=i;
V^.ValueType:=ctcsvNumber;
end;
ctcsvNumber: ;
end;
end;
procedure AddCTCSVariables(const SumVar, AddVar: PCTCfgScriptVariable);
begin
end;
function CTCSNumberEqualsString(const Number: int64; const P: PChar): boolean;
var
n: int64;
@ -864,6 +947,36 @@ begin
Result:=nil;
end;
procedure TCTCfgScriptVariables.Undefine(Name: PChar);
var
Node: TAVLTreeNode;
Item: PCTCfgScriptVariable;
begin
Node:=FItems.FindKey(Name,@ComparePCharWithCTCSVariableName);
if Node=nil then exit;
Item:=PCTCfgScriptVariable(Node.Data);
FreeCTCSVariable(Item);
FItems.Delete(Node);
end;
procedure TCTCfgScriptVariables.Define(Name: PChar; const Value: string);
var
V: PCTCfgScriptVariable;
i: Int64;
begin
V:=GetVariable(Name,true);
if Value='' then
ClearCTCSVariable(V)
else begin
try
i:=StrToInt64(Value);
SetCTCSVariableAsNumber(V,i);
except
SetCTCSVariableAsString(V,Value);
end;
end;
end;
{ TCTConfigScriptEngine }
function TCTConfigScriptEngine.GetErrors(Index: integer): TCTCfgScriptError;
@ -899,40 +1012,51 @@ procedure TCTConfigScriptEngine.RunStatement(Skip: boolean);
end;
var
IsKeyword: Boolean;
Handled: Boolean;
StartTop: LongInt;
begin
debugln(['TCTConfigScriptEngine.ParseStatement Atom=',GetAtom]);
StartTop:=FStack.Top;
case AtomStart^ of
#0: ;
';': ; // empty statement
'a'..'z','A'..'Z':
begin
// identifier or keyword
IsKeyword:=false;
Handled:=false;
case UpChars[AtomStart^] of
'B':
if CompareIdentifiers('BEGIN',AtomStart)=0 then begin
IsKeyword:=true;
Handled:=true;
RunBegin(Skip);
end;
'I':
if CompareIdentifiers('IF',AtomStart)=0 then begin
IsKeyword:=true;
Handled:=true;
RunIf(Skip);
end;
'U':
if CompareIdentifiers('Undefine',AtomStart)=0 then begin
Handled:=true;
RunUndefine(Skip);
end;
end;
if (not IsKeyword) and AtomIsKeyWord then begin
AddError('unexpected keyword '+GetAtom);
exit;
end;
if not IsKeyword then begin
// parse assignment
RunAssignment(Skip);
if (not Handled) then begin
if IsKeyWord(AtomStart) then begin
AddError('unexpected keyword '+GetAtom);
end else if IsFunction(AtomStart) then begin
if not RunFunction then exit;
end else begin
// parse assignment
RunAssignment(Skip);
end;
end;
end;
else
ErrorUnexpectedAtom;
end;
// clean up stack
while FStack.Top>StartTop do FStack.Pop;
end;
procedure TCTConfigScriptEngine.RunBegin(Skip: boolean);
@ -977,7 +1101,6 @@ procedure TCTConfigScriptEngine.RunIf(Skip: boolean);
}
var
IfStart: PChar;
Value: TCTCfgScriptVariable;
ExprIsTrue: Boolean;
StartTop: LongInt;
begin
@ -985,8 +1108,11 @@ begin
StartTop:=FStack.Top;
FStack.Push(ctcssIf,IfStart);
ReadRawNextPascalAtom(Src,AtomStart);
FillByte(Value,SizeOf(Value),0);
ExprIsTrue:=RunExpression(Value) and CTCSVariableIsTrue(@Value);
ExprIsTrue:=false;
if RunExpression then begin
ExprIsTrue:=CTCSVariableIsTrue(FStack.TopItemOperand);
FStack.Pop;
end;
debugln(['TCTConfigScriptEngine.RunIf expression=',ExprIsTrue]);
// read then
@ -1004,14 +1130,35 @@ begin
while FStack.Top>StartTop do FStack.Pop;
end;
procedure TCTConfigScriptEngine.RunUndefine(Skip: boolean);
var
VarStart: PChar;
begin
ReadRawNextPascalAtom(Src,AtomStart);
if AtomStart^<>'(' then begin
AddError('expected (, but found '+GetAtomOrNothing);
exit;
end;
ReadRawNextPascalAtom(Src,AtomStart);
if (not IsIdentStartChar[AtomStart^]) or IsKeyWord(AtomStart) then begin
AddError('expected identifier, but found '+GetAtomOrNothing);
exit;
end;
VarStart:=AtomStart;
ReadRawNextPascalAtom(Src,AtomStart);
if AtomStart^<>')' then begin
AddError('expected ), but found '+GetAtomOrNothing);
exit;
end;
Variables.Undefine(VarStart);
end;
procedure TCTConfigScriptEngine.RunAssignment(Skip: boolean);
{ Examples:
a:=3;
}
var
VarStart: PChar;
OperatorStart: PChar;
Value: TCTCfgScriptVariable;
Variable: PCTCfgScriptVariable;
StartTop: TCTCfgScriptStackItemType;
begin
@ -1021,7 +1168,6 @@ begin
FStack.Push(ctcssAssignment,VarStart);
ReadRawNextPascalAtom(Src,AtomStart);
debugln(['TCTConfigScriptEngine.RunAssignment Operator=',GetAtom]);
OperatorStart:=AtomStart;
// read :=
if AtomStart^=#0 then begin
AddError('missing :=');
@ -1033,13 +1179,10 @@ begin
end;
// read expression
ReadRawNextPascalAtom(Src,AtomStart);
FillByte(Value,SizeOf(Value),0);
RunExpression(Value);
if (not Skip) then begin
if RunExpression and (not Skip) then begin
Variable:=Variables.GetVariable(VarStart,true);
debugln(['TCTConfigScriptEngine.RunAssignment ',GetIdentifier(VarStart),'=(Old=',dbgs(Variable),') := ',dbgs(PCTCfgScriptVariable(@Value))]);
if OperatorStart=nil then ;
SetCTCSVariableValue(@Value,Variable);
debugln(['TCTConfigScriptEngine.RunAssignment ',GetIdentifier(VarStart),'=(Old=',dbgs(Variable),') := ',dbgs(FStack.TopItemOperand)]);
SetCTCSVariableValue(FStack.TopItemOperand,Variable);
debugln(['TCTConfigScriptEngine.RunAssignment ',GetIdentifier(VarStart),' = ',dbgs(Variable)]);
end;
// clean up stack
@ -1048,12 +1191,12 @@ end;
procedure TCTConfigScriptEngine.PushNumberValue(const Number: int64);
var
Item: PCTCfgScriptStackItem;
Operand: PCTCfgScriptVariable;
begin
FStack.Push(ctcssOperand,AtomStart);
Item:=@FStack.Items[FStack.Top];
Item^.Operand.ValueType:=ctcsvNumber;
Item^.Operand.Number:=Number;
Operand:=FStack.TopItemOperand;
Operand^.ValueType:=ctcsvNumber;
Operand^.Number:=Number;
ExecuteStack(1);
end;
@ -1069,14 +1212,14 @@ begin
exit;
end;
ReadRawNextPascalAtom(Src,AtomStart);
if (not IsIdentStartChar[AtomStart^]) or AtomIsKeyWord then begin
if (not IsIdentStartChar[AtomStart^]) or IsKeyWord(AtomStart) then begin
AddError('expected identifier, but found '+GetAtomOrNothing);
exit;
end;
VarStart:=AtomStart;
ReadRawNextPascalAtom(Src,AtomStart);
if AtomStart^<>')' then begin
AddError('expected (, but found '+GetAtomOrNothing);
AddError('expected ), but found '+GetAtomOrNothing);
exit;
end;
b:=Variables.GetVariable(VarStart)<>nil;
@ -1085,9 +1228,58 @@ begin
Result:=true;
end;
function TCTConfigScriptEngine.RunFunction: boolean;
var
StartTop: LongInt;
Value: TCTCfgScriptVariable;
FunctionName: PChar;
begin
Result:=false;
FunctionName:=AtomStart;
StartTop:=FStack.Top;
ReadRawNextPascalAtom(Src,AtomStart);
if AtomStart^<>'(' then begin
AddError('expected (, but found '+GetAtomOrNothing);
exit;
end;
ReadRawNextPascalAtom(Src,AtomStart);
FStack.Push(ctcssRoundBracketOpen,AtomStart);
FillByte(Value,SizeOf(Value),0);
if RunExpression then
SetCTCSVariableValue(FStack.TopItemOperand,@Value);
if AtomStart^<>')' then begin
AddError('expected ), but found '+GetAtomOrNothing);
exit;
end;
// clean up stack
while FStack.Top>StartTop do FStack.Pop;
// execute function
debugln(['TCTConfigScriptEngine.RunFunction FunctionName="',GetAtom(FunctionName),'" Parameter=',dbgs(PCTCfgScriptVariable(@Value))]);
case UpChars[FunctionName^] of
'I':
if CompareIdentifiers(FunctionName,'int64')=0 then
MakeCTCSVariableInt64(@Value)
else if CompareIdentifiers(FunctionName,'integer')=0 then
MakeCTCSVariableInteger(@Value);
'S':
if CompareIdentifiers(FunctionName,'string')=0 then
MakeCTCSVariableString(@Value);
end;
// put result on stack as operand
debugln(['TCTConfigScriptEngine.RunFunction FunctionName="',GetAtom(FunctionName),'" Result=',dbgs(PCTCfgScriptVariable(@Value))]);
FStack.Push(ctcssOperand,FunctionName);
SetCTCSVariableValue(@Value,FStack.TopItemOperand);
Result:=true;
end;
procedure TCTConfigScriptEngine.PushStringConstant;
var
Item: PCTCfgScriptStackItem;
Operand: PCTCfgScriptVariable;
procedure Add(p: PChar; Count: integer);
var
@ -1095,11 +1287,11 @@ var
NewLen: Integer;
begin
if Count=0 then exit;
OldLen:=Item^.Operand.StrLen;
OldLen:=Operand^.StrLen;
NewLen:=OldLen+Count;
ReAllocMem(Item^.Operand.StrStart,NewLen);
System.Move(p^,Item^.Operand.StrStart[OldLen],Count);
Item^.Operand.StrLen:=NewLen;
ReAllocMem(Operand^.StrStart,NewLen);
System.Move(p^,Operand^.StrStart[OldLen],Count);
Operand^.StrLen:=NewLen;
end;
var
@ -1109,10 +1301,10 @@ var
c: char;
begin
FStack.Push(ctcssOperand,AtomStart);
Item:=@FStack.Items[FStack.Top];
Item^.Operand.ValueType:=ctcsvString;
Item^.Operand.StrLen:=0;
Item^.Operand.StrStart:=nil;
Operand:=FStack.TopItemOperand;
Operand^.ValueType:=ctcsvString;
Operand^.StrLen:=0;
Operand^.StrStart:=nil;
p:=AtomStart;
while true do begin
case p^ of
@ -1161,7 +1353,7 @@ var
c: Char;
begin
FStack.Push(ctcssOperand,AtomStart);
Item:=@FStack.Items[FStack.Top];
Item:=FStack.TopItem;
p:=AtomStart;
c:=p^;
if not (c in ['0'..'9']) then inc(p);
@ -1188,6 +1380,7 @@ begin
else break;
end;
else
// decimal or float
case p^ of
'0'..'9': Number:=Number*10+ord(p^)-ord('0');
else break;
@ -1215,20 +1408,19 @@ end;
procedure TCTConfigScriptEngine.PushBooleanValue(b: boolean);
var
Item: PCTCfgScriptStackItem;
Operand: PCTCfgScriptVariable;
begin
FStack.Push(ctcssOperand,AtomStart);
Item:=@FStack.Items[FStack.Top];
Item^.Operand.ValueType:=ctcsvNumber;
Operand:=FStack.TopItemOperand;
Operand^.ValueType:=ctcsvNumber;
if b then
Item^.Operand.Number:=1
Operand^.Number:=1
else
Item^.Operand.Number:=0;
Operand^.Number:=0;
ExecuteStack(1);
end;
function TCTConfigScriptEngine.RunExpression(var Value: TCTCfgScriptVariable
): boolean;
function TCTConfigScriptEngine.RunExpression: boolean;
{ Examples:
A is false if A=0 or A='0'
defined(A)
@ -1238,11 +1430,6 @@ function TCTConfigScriptEngine.RunExpression(var Value: TCTCfgScriptVariable
binary operators:
}
procedure ErrorUnexpectedRoundBracketClose;
begin
AddError('expression expected, but ) found');
end;
function OperandAllowed: boolean;
begin
case FStack.TopTyp of
@ -1270,14 +1457,17 @@ function TCTConfigScriptEngine.RunExpression(var Value: TCTCfgScriptVariable
function PushBinaryOperator: boolean;
begin
Result:=BinaryOperatorAllowed;
if not Result then exit;
if not Result then begin
RunExpression:=false;
exit;
end;
ExecuteStack(GetOperatorLevel(AtomStart));
FStack.Push(ctcssOperator,AtomStart);
end;
var
ExprStart: PChar;
IsKeyword: Boolean;
Handled: Boolean;
Item: PCTCfgScriptStackItem;
StartTop: LongInt;
v: PCTCfgScriptVariable;
@ -1300,16 +1490,18 @@ begin
begin
ExecuteStack(5);
if FStack.TopTyp=ctcssRoundBracketOpen then begin
// empty ()
AddError('operand expected, but '+GetAtom+' found');
Result:=false;
break;
end else if (FStack.TopTyp=ctcssOperand)
and (FStack.Top>0) and (FStack.Items[FStack.Top-1].Typ=ctcssRoundBracketOpen)
then begin
WriteDebugReportStack('AAA1');
FStack.Delete(FStack.Top-1);
WriteDebugReportStack('AAA2');
end
else
ErrorUnexpectedRoundBracketClose;
end else
break;
end;
'=':
if not PushBinaryOperator then break;
@ -1318,12 +1510,24 @@ begin
if not PushBinaryOperator then break;
end else begin
AddError('invalid operator '+GetAtom);
Result:=false;
break;
end;
'>':
if (Src-AtomStart=1) or (AtomStart[1] in ['=']) then begin
if not PushBinaryOperator then break;
end else begin
AddError('invalid operator '+GetAtom);
Result:=false;
break;
end;
'+':
if (Src-AtomStart=1) then begin
if not PushBinaryOperator then break;
end else begin
AddError('invalid operator '+GetAtom);
Result:=false;
break;
end;
'a'..'z','A'..'Z':
begin
@ -1331,24 +1535,24 @@ begin
debugln(['TCTConfigScriptEngine.RunExpression StackTop=',dbgs(FStack.TopTyp),' Atom=',GetAtom]);
// execute
IsKeyword:=false;
Handled:=false;
case UpChars[AtomStart^] of
'A':
if CompareIdentifiers('and',AtomStart)=0 then begin
IsKeyword:=true;
Handled:=true;
if not PushBinaryOperator then break;
end;
'D':
case UpChars[AtomStart[1]] of
'E':
if CompareIdentifiers('defined',AtomStart)=0 then begin
IsKeyword:=true;
Handled:=true;
if not OperandAllowed then break;
if not RunDefined(false) then break;
end;
'I':
if CompareIdentifiers('div',AtomStart)=0 then begin
IsKeyword:=true;
Handled:=true;
if not PushBinaryOperator then break;
end;
end;
@ -1363,25 +1567,25 @@ begin
end;
'F':
if CompareIdentifiers('false',AtomStart)=0 then begin
IsKeyword:=true;
Handled:=true;
if not OperandAllowed then break;
PushBooleanValue(false);
end;
'M':
if CompareIdentifiers('mod',AtomStart)=0 then begin
IsKeyword:=true;
Handled:=true;
if not PushBinaryOperator then break;
end;
'N':
if CompareIdentifiers('not',AtomStart)=0 then begin
IsKeyword:=true;
Handled:=true;
if not OperandAllowed then break;
// Note: no execute, "not" is unary operator for the next operand
FStack.Push(ctcssOperator,AtomStart);
end;
'O':
if CompareIdentifiers('or',AtomStart)=0 then begin
IsKeyword:=true;
Handled:=true;
if not PushBinaryOperator then break;
end;
'T':
@ -1392,35 +1596,45 @@ begin
end;
'R':
if CompareIdentifiers('true',AtomStart)=0 then begin
IsKeyword:=true;
Handled:=true;
if not OperandAllowed then break;
PushBooleanValue(true);
end;
end;
'U':
if CompareIdentifiers('undefined',AtomStart)=0 then begin
IsKeyword:=true;
Handled:=true;
if not OperandAllowed then break;
if not RunDefined(true) then break;
end;
'X':
if CompareIdentifiers('xor',AtomStart)=0 then begin
IsKeyword:=true;
Handled:=true;
if not PushBinaryOperator then break;
end;
end;
if (not IsKeyword) and AtomIsKeyWord then begin
if (not Handled) and IsKeyWord(AtomStart) then begin
AddError('unexpected keyword '+GetAtom);
Result:=false;
break;
end;
if not IsKeyword then begin
// a variable
if (not Handled) then begin
if not OperandAllowed then break;
FStack.Push(ctcssOperand,AtomStart);
Item:=@FStack.Items[FStack.Top];
v:=Variables.GetVariable(AtomStart);
if v<>nil then begin
SetCTCSVariableValue(v,@Item^.Operand);
debugln(['TCTConfigScriptEngine.RunExpression ',GetAtom(AtomStart),' ',IsFunction(AtomStart)]);
if IsFunction(AtomStart) then begin
// a function
if not RunFunction then begin
Result:=false;
break;
end;
end else begin
// a variable
FStack.Push(ctcssOperand,AtomStart);
Item:=FStack.TopItem;
v:=Variables.GetVariable(AtomStart);
if v<>nil then begin
SetCTCSVariableValue(v,@Item^.Operand);
end;
end;
ExecuteStack(1);
end;
@ -1448,7 +1662,8 @@ begin
end;
if Result then begin
ExecuteStack(10);
if not ExecuteStack(10) then
Result:=false;
if FStack.Top=StartTop+1 then begin
// empty expression
AddError('operand expected, but '+GetAtom+' found');
@ -1461,11 +1676,13 @@ begin
AddError('operator expected, but '+GetAtom+' found');
Result:=false;
end
else begin
else if Result then begin
// success
Item:=@FStack.Items[FStack.Top];
SetCTCSVariableValue(@Item^.Operand,@Value);
debugln(['TCTConfigScriptEngine.RunExpression Result="',dbgs(PCTCfgScriptVariable(@Value)),'" ',dbgs(@Value)]);
// delete ctcssExpression and keep the operand
FStack.Delete(FStack.Top-1);
Item:=FStack.TopItem;
inc(StartTop);
debugln(['TCTConfigScriptEngine.RunExpression Result="',dbgs(PCTCfgScriptVariable(@Item^.Operand)),'" ']);
end;
end;
@ -1473,100 +1690,79 @@ begin
while (FStack.Top>StartTop) do FStack.Pop;
end;
function TCTConfigScriptEngine.AtomIsKeyWord: boolean;
function TCTConfigScriptEngine.IsKeyWord(P: PChar): boolean;
begin
Result:=false;
case UpChars[AtomStart^] of
if p=nil then exit;
case UpChars[p^] of
'A':
if CompareIdentifiers('and',AtomStart)=0 then
exit(true);
if CompareIdentifiers('and',p)=0 then exit(true);
'B':
if CompareIdentifiers('begin',AtomStart)=0 then
exit(true);
if CompareIdentifiers('begin',p)=0 then exit(true);
'C':
if CompareIdentifiers('case',AtomStart)=0 then
exit(true);
if CompareIdentifiers('case',p)=0 then exit(true);
'D':
case UpChars[AtomStart[1]] of
case UpChars[p[1]] of
'E':
if CompareIdentifiers('defined',AtomStart)=0 then
exit(true);
if CompareIdentifiers('defined',p)=0 then exit(true);
'I':
if CompareIdentifiers('div',AtomStart)=0 then
exit(true);
if CompareIdentifiers('div',p)=0 then exit(true);
end;
'E':
case UpChars[AtomStart[1]] of
case UpChars[p[1]] of
'L':
if CompareIdentifiers('else',AtomStart)=0 then
exit(true);
if CompareIdentifiers('else',p)=0 then exit(true);
'N':
if CompareIdentifiers('end',AtomStart)=0 then
exit(true);
if CompareIdentifiers('end',p)=0 then exit(true);
end;
'F':
case UpChars[AtomStart[1]] of
case UpChars[p[1]] of
'A':
if CompareIdentifiers('false',AtomStart)=0 then
exit(true);
if CompareIdentifiers('false',p)=0 then exit(true);
'U':
if CompareIdentifiers('function',AtomStart)=0 then
exit(true);
if CompareIdentifiers('function',p)=0 then exit(true);
end;
'I':
case UpChars[AtomStart[1]] of
case UpChars[p[1]] of
'F':
if CompareIdentifiers('if',AtomStart)=0 then
exit(true);
if CompareIdentifiers('if',p)=0 then exit(true);
'N':
if CompareIdentifiers('in',AtomStart)=0 then
exit(true);
if (CompareIdentifiers('in',p)=0) then exit(true)
end;
'M':
if CompareIdentifiers('mod',AtomStart)=0 then
exit(true);
if CompareIdentifiers('mod',p)=0 then exit(true);
'N':
if CompareIdentifiers('not',AtomStart)=0 then
exit(true);
if CompareIdentifiers('not',p)=0 then exit(true);
'O':
case UpChars[AtomStart[1]] of
case UpChars[p[1]] of
'F':
if CompareIdentifiers('of',AtomStart)=0 then
exit(true);
if CompareIdentifiers('of',p)=0 then exit(true);
'R':
if CompareIdentifiers('or',AtomStart)=0 then
exit(true);
if CompareIdentifiers('or',p)=0 then exit(true);
end;
'P':
if CompareIdentifiers('procedure',AtomStart)=0 then
exit(true);
if CompareIdentifiers('procedure',p)=0 then exit(true);
'S':
case UpChars[AtomStart[1]] of
case UpChars[p[1]] of
'H':
case UpChars[AtomStart[2]] of
case UpChars[p[2]] of
'L':
if CompareIdentifiers('shl',AtomStart)=0 then
exit(true);
if CompareIdentifiers('shl',p)=0 then exit(true);
'R':
if CompareIdentifiers('shr',AtomStart)=0 then
exit(true);
if CompareIdentifiers('shr',p)=0 then exit(true);
end;
end;
'T':
case UpChars[AtomStart[1]] of
case UpChars[p[1]] of
'H':
if CompareIdentifiers('then',AtomStart)=0 then
exit(true);
if CompareIdentifiers('then',p)=0 then exit(true);
'R':
if CompareIdentifiers('true',AtomStart)=0 then
exit(true);
if CompareIdentifiers('true',p)=0 then exit(true);
end;
'X':
if CompareIdentifiers('xor',AtomStart)=0 then
exit(true);
if CompareIdentifiers('xor',p)=0 then exit(true);
'U':
if CompareIdentifiers('undefined',AtomStart)=0 then
exit(true);
if CompareIdentifiers('undefined',p)=0 then exit(true);
end;
end;
@ -1597,7 +1793,7 @@ begin
if (OperatorItem^.Typ<>ctcssOperator)
or (GetOperatorLevel(OperatorItem^.StartPos)>MaxLevel) then
exit;
OperandItem:=@FStack.Items[FStack.Top];
OperandItem:=FStack.TopItem;
// execute operator
Typ:=AtomToCTCfgOperator(OperatorItem^.StartPos);
@ -1616,7 +1812,7 @@ begin
b:=CTCSVariableIsTrue(@OperandItem^.Operand);
FStack.Pop(2);
if (FStack.Top>=0) then begin
OperandItem:=@FStack.Items[FStack.Top];
OperandItem:=FStack.TopItem;
case Typ of
ctcsoAnd: b:=b and CTCSVariableIsTrue(@OperandItem^.Operand);
ctcsoOr: b:=b or CTCSVariableIsTrue(@OperandItem^.Operand);
@ -1660,6 +1856,18 @@ begin
PushBooleanValue(b);
end;
ctcsoPlus:
begin
if (FStack.Top>=2) then begin
LeftOperandItem:=@FStack.Items[FStack.Top-2];
FStack.Pop(3);
end else begin
// unary operator
FStack.Delete(FStack.Top-1);
end;
end;
else
ErrorInvalidOperator;
end;
@ -1671,6 +1879,20 @@ begin
Result:=CTCfgScriptOperatorLvl[AtomToCTCfgOperator(P)];
end;
function TCTConfigScriptEngine.IsFunction(P: PChar): boolean;
begin
Result:=false;
if p=nil then exit;
case UpChars[p^] of
'I':
if (CompareIdentifiers(p,'integer')=0)
or (CompareIdentifiers(p,'int64')=0)
then exit(true);
'S':
if CompareIdentifiers(p,'string')=0 then exit(true);
end;
end;
constructor TCTConfigScriptEngine.Create;
begin
FVariables:=TCTCfgScriptVariables.Create;
@ -1923,6 +2145,22 @@ begin
dec(Top);
end;
function TCTCfgScriptStack.TopItem: PCTCfgScriptStackItem;
begin
if Top<0 then
Result:=nil
else
Result:=@Items[Top];
end;
function TCTCfgScriptStack.TopItemOperand: PCTCfgScriptVariable;
begin
if Top<0 then
Result:=nil
else
Result:=@Items[Top].Operand;
end;
{ TCTCfgScriptError }
constructor TCTCfgScriptError.Create(const aMsg: string; anErrorPos: PChar);

9
components/codetools/examples/runcfgscript.lpi
View File

@ -1,7 +1,7 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="7"/>
<Version Value="8"/>
<General>
<Flags>
<MainUnitHasUsesSectionForAllUnits Value="False"/>
@ -42,7 +42,12 @@
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<Version Value="9"/>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>

2
components/codetools/examples/runcfgscript.lpr
View File

@ -52,7 +52,7 @@ begin
raise Exception.Create('unable to read '+Filename);
Src:=Code.Source;
end else begin
Src:='a:=2; b:=2; if a<=b then Result:=3';
Src:='a:=string(2); b:=2; if a<=b then Result:=3';
//Src:='if (TargetOS=''win32'') then Result:=3';
end;