paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

chelper: revising c preprocess handling. added new routines to prepare and collection preprocessing information

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3989 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz 2015-03-04 18:15:02 +00:00
parent 7e52faa49f
commit d51ddefe7d
3 changed files with 259 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

104
components/chelper/cparsertypes.pas
View File

@ -62,8 +62,9 @@ type
end;
TTextParser = class;
TEntity = class;
TPrecompilerEvent = procedure (Sender: TTextParser; PrecompEntity: TObject) of object;
TPrecompilerEvent = procedure (Sender: TTextParser; PrecompEntity: TEntity) of object;
TCMacroStruct = class(TObject)
MacroName : AnsiString;
@ -95,13 +96,14 @@ type
TTextParser = class(TObject)
protected
ProcessingMacro : Boolean;
function HandlePrecomiler: Boolean; virtual;
function HandleMacro(var MacroStr: AnsiString; var ReplaceStr: AnsiString): Boolean;
function IsMultiLine: Boolean;
procedure SkipSingleEoLnChars;
public
ProcessingMacro : Boolean;
Buf : AnsiString;
Token : AnsiString;
@ -412,8 +414,106 @@ function ParseUnion(AParser: TTextParser): TUnionType;
function ParseTypeDef(AParser: TTextParser): TTypeDef;
function ParseEnum(AParser: TTextParser): TEnumType;
function PreprocGlobal(const buf: string; fs: TFileOffsets; ent: TList): string;
implementation
{function FindNextPreproc(const s: string; var i: integer;
var PreType: TPreprocType; var Name, Content: string): Boolean;
var
j : integer;
begin
Result:=false;
while i<=length(S) do begin
ScanTo(s, i, EoLnChars+['#','/']);
Result:=(i<=length(s));
if not Result then Exit;
if s[i] in EoLnChars then begin
ScanWhile(s, i, EoLnChars);
end else if s[i]='#' then begin // a directive?
j:=i;
ScanBackWhile(s, j, WhiteSpaceChars);
if (j=0) or (s[j] in EoLnChars) then begin
// directive!
inc(i);
ScanWhile(s, i, WhiteSpaceChars);
Name:='#'+ScanTo(s, i, EoLnChars+WhiteSpaceChars);
PreType:=ppDirective;
end else
inc(i);
end;
end;
end;}
function PreprocGlobal(const buf: string; fs: TFileOffsets; ent: TList): string;
var
i : integer;
j : integer;
k : integer;
cmt : TComment;
t : integer;
procedure Feed(ToIdx: Integer);
begin
if (ToIdx>=k) then begin
Result:=Result+Copy(buf, k, toIdx-k);
ToIdx:=k+1;
end;
end;
procedure SetFeedOfs(ToIdx: integer);
begin
k:=ToIdx;
end;
procedure FeedChar(ch: AnsiChar = #32);
begin
Result:=Result+ch;
end;
begin
i:=1;
k:=1;
Result:='';
while (i<=length(buf)) do begin
if (buf[i]='\') and (i<length(buf)) and (buf[i+1] in [#10,#13]) then begin
Feed(i);
if (i+2<=length(buf)) and (buf[i+2] in [#10,#13]) and (buf[i+1]<>buf[i+2]) then begin
t:=3;
end else
t:=2;
if Assigned(fs) then fs.AddOffset(i, -t); // decreasing delta
inc(i, t);
SetFeedOfs(i);
end else if (buf[i]='/') and (i<length(buf)) and (buf[i+1] in ['*','/']) then begin
Feed(i);
j:=i;
inc(i,2);
if buf[i-1]='*' then begin
while (i<length(buf)) and (buf[i]<>'*') and (buf[i+1]<>'/') do inc(i);
if buf[i+1]='/' then // well formed comment
inc(i,2)
else
i:=length(buf)+1;
end else
ScanTo(buf, i, EoLnChars);
if Assigned(ent) then begin
cmt := TComment.Create(i);
cmt.EndOffset:=i;
cmt._Comment:=Copy(buf, j, i-j);
end;
if Assigned(fs) then fs.AddOffset(i, j-i-1); // decreasing delta
FeedChar;
SetFeedOfs(i);
end else
inc(I);
end;
Feed(i);
end;
function SkipEndOfLineChars(const Src: AnsiString; idx: integer): Integer;
begin
if idx < length(Src) then begin

100
components/chelper/ctopasconvert.pas
View File

@ -105,17 +105,21 @@ type
PrecompEnd : Integer;
procedure OnComment(Sender: TObject; const Str: ansistring);
procedure OnPrecompiler(Sender: TTextParser; PrecompEntity: TObject);
procedure OnPrecompiler(Sender: TTextParser; PrecompEntity: TEntity);
procedure Clear;
end;
{ TMacrosMaker }
TMacrosMaker = class(TObject)
public
hnd : TCMacroHandler;
allowRedfine: Boolean;
hnd : TCMacroHandler;
allowRedfine : Boolean; // default true
ifCondProc : Boolean; // default false
constructor Create(AHandler: TCMacroHandler);
procedure Precompiler(Sender: TTextParser; PrecompEntity: TObject);
procedure Precompiler(AParser: TTextParser; PrecompEntity: TEntity);
procedure HandleIfCond(AParser: TTextParser; IfEntity: TEntity);
end;
type
@ -161,8 +165,15 @@ procedure AssignIntComments(SortedEnlist: TList);
procedure DebugEnList(entlist: TList);
procedure DebugHeaders(files: TStrings);
function PreprocDirectives(const buf: string; macro: TMacrosMaker; fs: TFileOffsets; ent: TList): string;
implementation
function PreprocDirectives(const buf: string; macro: TMacrosMaker; fs: TFileOffsets; ent: TList): string;
begin
Result:=buf;
end;
type
TFuncWriterProc = procedure (wr: TCodeWriter; const FunctName, FuncRetName: AnsiString;
const Params, ParamTypes: array of AnsiString) of object;
@ -336,7 +347,7 @@ begin
CommentFound := True;
end;
procedure TStopComment.OnPrecompiler(Sender: TTextParser; PrecompEntity: TObject);
procedure TStopComment.OnPrecompiler(Sender: TTextParser; PrecompEntity: TEntity);
begin
if not FirstComment and (PrecompEntity is TEntity) then
begin
@ -434,11 +445,16 @@ begin
hnd:=AHandler;
end;
procedure TMacrosMaker.Precompiler(Sender: TTextParser; PrecompEntity: TObject);
procedure TMacrosMaker.Precompiler(AParser: TTextParser; PrecompEntity: TEntity);
var
d : TCPrepDefine;
begin
if not (PrecompEntity is TCPrepDefine) then Exit;
//writelN('precompiler: ', PrecompEntity.ClassName);
if (ifCondProc) and (PrecompEntity is TCPrepIf) then begin
HandleIfCond(AParser, PrecompEntity);
Exit;
end else if not (PrecompEntity is TCPrepDefine) then
Exit;
d:=TCPrepDefine(PrecompEntity);
@ -451,6 +467,75 @@ begin
end;
end;
procedure SkipPreproc(AParser: TTextParser);
var
cnd : integer;
i : Integer;
begin
// skipping until the end of line
i:=AParser.Index;
ScanTo(AParser.Buf, i, EoLnChars);
ScanWhile(AParser.Buf, i, EoLnChars);
// scan until preproc, comment line or end of line
ScanWhile(AParser.Buf, i, WhiteSpaceChars);
if i>length(AParser.Buf) then Exit;
if AParser.Buf[i] = '#' then begin
// precompiler!
end else begin
if (AParser.Buf[i]='/') and (AParser.Buf[i+1]='/') then begin
// skipping until the end of line
ScanTo(AParser.Buf, i, EoLnChars);
end else if (AParser.Buf[i]='/') and (AParser.Buf[i+1]='*') then begin
// skip until then close of '*
end;
end;
end;
procedure TMacrosMaker.HandleIfCond(AParser: TTextParser; IfEntity: TEntity);
var
op : string;
cond : string;
isCondMet : Boolean;
cnt : integer;
begin
writeln('if cond! ', IfEntity.ClassName);
op:='';
cond:='';
if IfEntity is TCPrepIf then begin
op := trim(TCPrepIf(IfEntity).IfOp);
cond := trim(TCPrepIf(IfEntity)._Cond);
end;
if ((op='ifndef') or (op = 'ifdef')) then begin
isCondMet := hnd.isMacroDefined(cond);
if (op='ifndef') then isCondMet:=not isCondMet;
end else begin
isCondMet := false;
end;
writeln('if op = "',op,'"');
writeln('cond = "',cond,'"');
writeln('result = ', isCondMet);
writeln('processing macro: ', Aparser.ProcessingMacro);
exit;
cnt:=0;
if not isCondMet then begin
// let's skip! until the "end" or "else" or "elif"
AParser.OnPrecompile:=nil; //hack: this must not be HERE!
while AParser.Token<>'' do begin
AParser.NextToken;
end;
AParser.OnPrecompile:=Self.Precompiler; //hack: this must not be HERE!
end;
AParser.NextToken;
end;
procedure PrepareMacros(const t: AnsiString; hnd: TCMacroHandler);
var
p : TTextParser;
@ -509,6 +594,7 @@ begin
//inp.stopcmt:=TStopComment.Create;
inp.mmaker := TMacrosMaker.Create(p.MacroHandler);
inp.mmaker.ifCondProc:=true;
inp.mmaker.allowRedfine:=false; // todo: it should be true!
p.OnPrecompile:=inp.mmaker.Precompiler;

64
components/chelper/textparsingutils.pas
View File

@ -39,7 +39,9 @@ const
AlphaNumChars = AlphabetChars+NumericChars;
function ScanWhile(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString;
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;
// returns #10, #13, #10#13 or #13#10, if s[index] is end-of-line sequence
@ -84,6 +86,22 @@ type
property Count: Integer read GetCount;
end;
type
TFileOfsInfo = record
origOfs : Integer; // original 1-based index in the file
delta : Integer; // the new delta that should be used starting this file
end;
{ TFileOffsets }
TFileOffsets = class(TObject)
public
Ofs : array of TFileOfsInfo;
Count : Integer;
procedure AddOffset(origOfs, delta: integer);
function OrigOffset(tempOfs: integer): Integer;
end;
implementation
function ScanWhile(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString;
@ -103,6 +121,28 @@ begin
index := length(s) + 1;
end;
function ScanBackWhile(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString;
var
j : integer;
begin
Result:='';
if (index <= 0) or (index > length(s)) then Exit;
j:=index;
while (index>0) and (s[index] in ch) do dec(index);
Result:=Copy(s, index+1, j-index);
end;
function ScanBackTo(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString;
var
j : integer;
begin
Result:='';
if (index <= 0) or (index > length(s)) then Exit;
j:=index;
while (index>0) and not (s[index] in ch) do dec(index);
Result:=Copy(s, index+1, j-index);
end;
function ScanTo(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString;
var
i : Integer;
@ -230,5 +270,29 @@ begin
Tag:=ATag;
end;
procedure TFileOffsets.AddOffset(origOfs, delta: integer);
begin
if Count=length(Ofs) then begin
if Count=0 then SetLength(Ofs, 4)
else SetLength(Ofs, Count*2);
end;
Ofs[Count].origOfs:=origOfs;
Ofs[Count].delta:=delta;
inc(Count);
end;
function TFileOffsets.OrigOffset(tempOfs: integer): Integer;
var
i : Integer;
begin
Result:=tempOfs;
for i:=0 to Count-1 do begin
if (Ofs[i].origOfs <= tempOfs) then
inc(Result, Ofs[i].delta);
end;
end;
end.