diff --git a/components/chelper/cparsertypes.pas b/components/chelper/cparsertypes.pas index 4e81d6b3b..b5c94478a 100755 --- a/components/chelper/cparsertypes.pas +++ b/components/chelper/cparsertypes.pas @@ -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 (ibuf[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'*') 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 diff --git a/components/chelper/ctopasconvert.pas b/components/chelper/ctopasconvert.pas index a18dbb487..aed5104f6 100644 --- a/components/chelper/ctopasconvert.pas +++ b/components/chelper/ctopasconvert.pas @@ -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; diff --git a/components/chelper/textparsingutils.pas b/components/chelper/textparsingutils.pas index 69e4edb85..c2c658ab8 100644 --- a/components/chelper/textparsingutils.pas +++ b/components/chelper/textparsingutils.pas @@ -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.