pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

chelper: further changes to match c-preprocess text processing. added precompiler evaluation

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3990 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
2015-03-05 05:01:11 +00:00
parent d51ddefe7d
commit 75b09e07c3
4 changed files with 258 additions and 65 deletions
Download Patch File Download Diff File Expand all files Collapse all files

58
components/chelper/cparserexp.pas
View File

@ -30,6 +30,9 @@ const
function ParseCExprEx(p: TTextParser): TExp;
function ValuateIntExp(exp: TExp; macros: TCMacroHandler): Integer; overload;
function ValuateIntExp(const exp: string; macros: TCMacroHandler): Integer; overload;
implementation
function Rotate(core: TExp): TExp;
@ -410,5 +413,60 @@ begin
end;
function IntVal(exp: TExp): Integer;
var
code : Integer;
l, r : Integer;
const
IntRes : array [boolean] of integer = (0,1);
begin
Result:=0;
if exp.dir = edInfix then begin
l:=IntVal(exp.left);
r:=IntVal(exp.right);
if exp.op = '+' then Result:=l+r
else if exp.op = '-' then Result:=l-r
else if exp.op = '/' then Result:=l div r
else if exp.op = '%' then Result:=l mod r
else if exp.op = '*' then Result:=l * r
else if exp.op = '&' then Result:=l and r
else if exp.op = '|' then Result:=l or r
else if exp.op = '<<' then Result:=l shr r
else if exp.op = '>>' then Result:=l shl r
else if exp.op = '==' then Result:=IntRes[l = r]
else if exp.op = '!=' then Result:=IntRes[l <> r]
else if exp.op = '>=' then Result:=IntRes[l >= r]
else if exp.op = '<=' then Result:=IntRes[l <= r]
else if exp.op = '>' then Result:=IntRes[l > r]
else if exp.op = '<' then Result:=IntRes[l < r];
end else begin
Val(exp.val, Result, code);
end;
end;
function ValuateIntExp(exp: TExp; macros: TCMacroHandler): Integer;
begin
Result:=IntVal(Exp);
end;
function ValuateIntExp(const exp: string; macros: TCMacroHandler): Integer;
var
prs : TTextParser;
expObj : TExp;
begin
prs := CreateCParser(exp, false);
try
prs.MacroHandler:=macros;
if prs.NextToken then begin
expObj:=ParseCExprEx(prs);
if Assigned(expObj)
then Result:=ValuateIntExp(expObj, macros)
else Result:=0;
end else
Result:=0;
finally
prs.Free;
end;
end;
end.

220
components/chelper/cparsertypes.pas
View File

@ -161,7 +161,11 @@ type
end;
TEntityClass = class of TEntity;
TCPrepocessor = class(TEntity);
TCPrepocessor = class(TEntity)
public
_Directive : string;
_Value : string;
end;
{ TCPrepDefine }
@ -182,9 +186,9 @@ type
protected
function DoParse(AParser: TTextParser): Boolean; override;
public
Params : TStringList;
Included : AnsiString;
destructor Destroy; override;
isSysFile : Boolean;
isImport : Boolean;
end;
TCPrepElse = class(TCPrepocessor)
@ -197,6 +201,7 @@ type
TCPrepIf = class(TCPrepocessor)
_Cond : AnsiString;
Exp : TObject; // expression object
IfOp : AnsiString;
function DoParse(AParser: TTextParser): Boolean; override;
end;
@ -219,16 +224,6 @@ type
_Comment : AnsiString; // in case sources are UTF8 or Unicode
end;
{ TPrecompiler }
TPrecompiler = class(TEntity)
protected
function DoParse(AParser: TTextParser): Boolean; override;
public
_Directive : AnsiString;
_Params : AnsiString;
end;
type
{ TSimpleType }
@ -415,9 +410,77 @@ function ParseTypeDef(AParser: TTextParser): TTypeDef;
function ParseEnum(AParser: TTextParser): TEnumType;
function PreprocGlobal(const buf: string; fs: TFileOffsets; ent: TList): string;
procedure ParseDirectives(const s: string; entList: TList);
function PreprocessHeader(const s: string; entList: TList; macros: TCMacroHandler; fs: TFileOffsets): string;
procedure CPrepDefineToMacrosHandler(def: TCPrepDefine; mh: TCMacroHandler);
procedure DebugEnList(entlist: TList);
implementation
uses
cparserexp; // todo: expression parsing should in the same unit!
procedure ParseDirectives(const s: string; entList: TList);
var
i : integer;
j : integer;
nm : string;
vl : string;
ent : TCPrepocessor;
t : integer;
begin
i:=1;
while (i<=length(s)) do begin
SkipWhile(s, i, WhiteSpaceChars);
if (i<=length(s)) then begin
if (s[i]='#') then begin
j:=i;
inc(i);
SkipWhile(s, i, WhiteSpaceChars);
nm:=ScanTo(s, i, SpaceEolnChars);
SkipWhile(s, i, WhiteSpaceChars);
vl:=trim(ScanTo(s, i, EolnChars));
if (nm='if') or (nm='elif') then begin
ent:=TCPrepIf.Create(j);
TCPrepIf(ent).IfOp:=nm;
TCPrepIf(ent)._Cond:=vl;
end else if (nm='ifdef') or (nm='ifndef') then begin
ent:=TCPrepIf.Create(j);
TCPrepIf(ent)._Cond:=vl;
TCPrepIf(ent).IfOp:=nm;
end else if (nm='include') or (nm='import') then begin
ent:=TCPrepInclude.Create(j);
if (length(vl)>0) and (vl[1] in ['<','"'])then begin
t:=length(vl)-1;
if (vl[length(vl)] in ['>','"']) then dec(t);
TCPrepInclude(ent).Included:=Copy(vl, 2, t);
TCPrepInclude(ent).isSysFile:=vl[1]='<';
end;
end else if (nm='endif') then begin
ent:=TCPrepEndif.Create(j);
end else
ent:=TCPrepocessor.Create(j);
ent._Directive:=nm;
ent._Value:=vl;
ent.EndOffset:=i;
// consume 1 eoln
if (i<=length(s)) and (s[i] in [#10,#13]) then begin
inc(i);
inc(ent.EndOffset);
if (i<=length(s)) and (s[i] in [#10,#13]) and (s[i]<>s[i-1]) then begin
inc(i);
inc(ent.EndOffset);
end;
end;
entList.Add(ent);
end else
SkipToEoln(s, i);
end;
SkipWhile(s, i, SpaceEolnChars);
end;
end;
{function FindNextPreproc(const s: string; var i: integer;
var PreType: TPreprocType; var Name, Content: string): Boolean;
var
@ -458,7 +521,7 @@ var
begin
if (ToIdx>=k) then begin
Result:=Result+Copy(buf, k, toIdx-k);
ToIdx:=k+1;
k:=ToIdx+1;
end;
end;
@ -565,6 +628,8 @@ begin
Result.AddSymbol('--');
Result.AddSymbol('||');
Result.AddSymbol('&&');
Result.AddSymbol('>=');
Result.AddSymbol('<=');
Result.SpaceChars := EoLnChars + InvsChars;
Result.Precompile := '#';
@ -1172,27 +1237,6 @@ begin
AParser.EndParse;
end;
{ TPrecompiler }
function TPrecompiler.DoParse(AParser: TTextParser): Boolean;
var
tt : TTokenType;
begin
Result := false;
if not AParser.FindNextToken(_Directive, tt) then begin
AParser.SetError('precompiler directive not found');
Exit;
end;
if (_Directive = '') or (_Directive[1] <> '#') then begin
AParser.Index := AParser.TokenPos;
AParser.SetError('identifier is not precompiler directive');
Exit;
end;
_Params := SkipLine(AParser.Buf, AParser.Index);
Result := true;
end;
{ TComment }
function TComment.DoParse(AParser: TTextParser): Boolean;
@ -1284,7 +1328,7 @@ function TCPrepInclude.DoParse(AParser: TTextParser): Boolean;
var
s : AnsiString;
tt : TTokenType;
exp : AnsiString;
exp : AnsiChar;
chars : TCharSet;
begin
chars := AParser.TokenTable.Symbols;
@ -1302,8 +1346,9 @@ begin
AParser.SetError('" is expected');
Exit;
end;
isSysFile:=exp='>';
Included:=ScanTo(AParser.Buf, AParser.Index, [exp[1]]+ EoLnChars);
Included:=ScanTo(AParser.Buf, AParser.Index, [exp]+ EoLnChars);
if (AParser.Index<=length(AParser.Buf)) and (AParser.Buf[AParser.Index] in EoLnChars) then begin
Result:=false;
AParser.SetError(exp+' is expected');
@ -1327,11 +1372,6 @@ begin
end;
end;
destructor TCPrepInclude.Destroy;
begin
Params.Free;
inherited Destroy;
end;
{ TCPrepElse }
@ -2315,6 +2355,102 @@ begin
if Assigned(Result) then Result.EndOffset:=AParser.Index;
end;
procedure ParseIfDef(const s: string; var idx: integer; ifdef: TCPrepIf);
begin
end;
procedure DebugEnList(entlist: TList);
var
i : Integer;
ent : TEntity;
begin
for i:=0 to entList.Count-1 do begin
ent := TEntity(entList[i]);
writeln(ent.Offset,'-',ent.EndOffset,' ',ent.ClassName);
end;
end;
function PreprocessHeader(const s: string; entList: TList; macros: TCMacroHandler; fs: TFileOffsets): string;
var
i : integer;
ent : TEntity;
df : TCPrepDefine;
dif : TCPrepIf;
isCondMet : Boolean;
lvl : Integer;
k : Integer;
procedure Feed(ToIdx: Integer);
begin
if (ToIdx>=k) then begin
Result:=Result+Copy(s, k, toIdx-k);
k:=ToIdx+1;
end;
end;
procedure SetFeedOfs(ToIdx: integer);
begin
k:=ToIdx;
end;
begin
i:=0;
k:=1;
Result:='';
while (i<entList.Count) do begin
ent:=TEntity(entList[i]);
if (ent is TCPrepDefine) then begin
Feed( ent.Offset );
SetFeedOfs( ent.EndOffset );
CPrepDefineToMacrosHandler( TCPrepDefine(ent), macros );
inc(i);
end else if ent is TCPrepIf then begin
Feed( ent.Offset );
dif := TCPrepIf(ent);
if (dif.IfOp='ifdef') or (dif.IfOp='ifndef') then begin
isCondMet:=macros.isMacroDefined(dif._Cond);
if (dif.IfOp='ifndef') then isCondMet:=not isCondMet;
end else if (dif.IfOp='if') or (dif.IfOp='elif') then begin
isCondMet:=ValuateIntExp(dif._Cond, macros)<>0;
end else
isCondMet:=false;
inc(i);
if not isCondMet then begin
lvl:=1;
while (i<entList.Count) and (lvl>0) do begin
ent:=TEntity(entList[i]);
if ent is TCPrepEndif then dec(lvl)
else if ent is TCPrepIf then inc(lvl);
inc(i);
end;
SetFeedOfs( ent.EndOffset );
end else
SetFeedOfs( ent.EndOffset );
end else begin
Feed( ent.Offset );
SetFeedOfs( ent.EndOffset );
inc(i);
end;
end;
Feed( length(s)+1);
end;
procedure CPrepDefineToMacrosHandler(def: TCPrepDefine; mh: TCMacroHandler);
begin
if not Assigned(def) or not Assigned(mh) then Exit;
if not Assigned(def.Params) or (def.Params.Count=0) then
mh.AddSimpleMacro(def._Name, def.SubsText)
else
mh.AddParamMacro(def._Name, def.SubsText, def.Params);
end;
initialization
_ParseNextEntity:=@ParseNextCEntity;
ParseNamePart:=@ParseCNamePart;

18
components/chelper/ctopasconvert.pas
View File

@ -162,7 +162,6 @@ function CEntitiesToPas(const originText: string; entList: TList; cfg: TConvertS
procedure ReleaseList(enlist: TList);
procedure AssignIntComments(SortedEnlist: TList);
procedure DebugEnList(entlist: TList);
procedure DebugHeaders(files: TStrings);
function PreprocDirectives(const buf: string; macro: TMacrosMaker; fs: TFileOffsets; ent: TList): string;
@ -460,11 +459,7 @@ begin
if hnd.isMacroDefined(d._Name) and not allowRedfine then Exit;
if not Assigned(d.Params) or (d.Params.Count=0) then begin
hnd.AddSimpleMacro(d._Name, d.SubsText);
end else begin
hnd.AddParamMacro(d._Name, d.SubsText, d.Params);
end;
CPrepDefineToMacrosHandler(d, hnd);
end;
procedure SkipPreproc(AParser: TTextParser);
@ -655,17 +650,6 @@ begin
SortedEnList.Pack;
end;
procedure DebugEnList(entlist: TList);
var
i : Integer;
ent : TEntity;
begin
for i:=0 to entList.Count-1 do begin
ent := TEntity(entList[i]);
writeln(ent.Offset,'-',ent.EndOffset,' ',ent.ClassName);
end;
end;
procedure DebugHeaders(files: TStrings);
var
hdr : THeaderFile;

25
components/chelper/textparsingutils.pas
View File

@ -38,11 +38,13 @@ const
AlphabetChars = ['a'..'z','A'..'Z'];
AlphaNumChars = AlphabetChars+NumericChars;
function ScanWhile(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString;
function ScanWhile(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString; overload;
function ScanBackWhile(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString;
function ScanTo(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString;
function ScanBackTo(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString;
function SkipToEoln(const s: AnsiString; var index: Integer): AnsiString;
procedure SkipTo(const s: AnsiString; var index: Integer; const ch: TCharSet);
procedure SkipWhile(const s: AnsiString; var index: Integer; const ch: TCharSet);
procedure SkipToEoln(const s: AnsiString; var index: Integer);
// returns #10, #13, #10#13 or #13#10, if s[index] is end-of-line sequence
// otherwise returns empty string
@ -104,7 +106,8 @@ type
implementation
function ScanWhile(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString;
function ScanWhile(const s: AnsiString; var index: Integer; const ch: TCharSet
): string;
var
i : Integer;
begin
@ -132,6 +135,18 @@ begin
Result:=Copy(s, index+1, j-index);
end;
procedure SkipTo(const s: AnsiString; var index: Integer; const ch: TCharSet);
begin
if (index <= 0) or (index > length(s)) then Exit;
while (index<=length(s)) and not (s[index] in ch) do inc(index);
end;
procedure SkipWhile(const s: AnsiString; var index: Integer; const ch: TCharSet);
begin
if (index <= 0) or (index > length(s)) then Exit;
while (index<=length(s)) and (s[index] in ch) do inc(index);
end;
function ScanBackTo(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString;
var
j : integer;
@ -172,9 +187,9 @@ begin
end;
end;
function SkipToEoln(const s: AnsiString; var index: Integer): AnsiString;
procedure SkipToEoln(const s: AnsiString; var index: Integer);
begin
Result := ScanTo(s, index, EoLnChars);
SkipTo(s, index, EoLnChars);
end;
function IsSubStr(const sbs, s: AnsiString; index: Integer): Boolean;