Skip to content

Commit f70646d

Browse files
author
[email protected]
committed
+ Added ability to ignore one or more files (by mask) in directory with headers.
+ Added ability to set user-defined type mapping. + When xmldoc/pasdoc comment format is selected, "-fparse-all-comments" directive is executed automatically. * Translation of bit structures in case type contains inserts has been improved. * updated ScriptStringList unit, unit CleanHeader renamed to PostProcessor class TCleanHeader renamed to TFilePostProcessor
1 parent e469f02 commit f70646d

13 files changed

+530
-255
lines changed

‎Bin/Chet.exe

63.5 KB
Binary file not shown.

‎Chet.dpr

+1-1
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@ uses
1111
Chet.HeaderTranslator in 'Classes\Chet.HeaderTranslator.pas',
1212
Chet.SourceWriter in 'Classes\Chet.SourceWriter.pas',
1313
Chet.CommentWriter in 'Classes\Chet.CommentWriter.pas',
14-
Chet.CleanHeader in 'Classes\Chet.CleanHeader.pas',
14+
Cnet.Postprocessor in 'Classes\Cnet.Postprocessor.pas',
1515
Form.ScriptHelp in 'Forms\Form.ScriptHelp.pas' {FormScriptHelp};
1616

1717
{$R *.res}

‎Chet.dproj

+14-5
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,12 @@
2323
<CfgParent>Base</CfgParent>
2424
<Base>true</Base>
2525
</PropertyGroup>
26+
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win64)'!=''">
27+
<Cfg_1_Win64>true</Cfg_1_Win64>
28+
<CfgParent>Cfg_1</CfgParent>
29+
<Cfg_1>true</Cfg_1>
30+
<Base>true</Base>
31+
</PropertyGroup>
2632
<PropertyGroup Condition="'$(Config)'=='DebugExperimental' or '$(Cfg_3)'!=''">
2733
<Cfg_3>true</Cfg_3>
2834
<CfgParent>Cfg_1</CfgParent>
@@ -53,7 +59,7 @@
5359
<DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
5460
<DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>
5561
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
56-
<DCC_UnitSearchPath>classes;..\Neslib.Clang;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
62+
<DCC_UnitSearchPath>..\Neslib.Clang;classes;externals;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
5763
<DCC_UsePackage>RESTComponents;emsclientfiredac;DataSnapFireDAC;FireDACIBDriver;emsclient;FireDACCommon;RESTBackendComponents;soapserver;CloudService;FireDACCommonDriver;inet;FireDAC;FireDACSqliteDriver;soaprtl;soapmidas;$(DCC_UsePackage)</DCC_UsePackage>
5864
<Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
5965
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
@@ -79,6 +85,9 @@
7985
<DCC_Optimize>false</DCC_Optimize>
8086
<DCC_RemoteDebug>true</DCC_RemoteDebug>
8187
</PropertyGroup>
88+
<PropertyGroup Condition="'$(Cfg_1_Win64)'!=''">
89+
<Debugger_RunParams>..\Sample\Sample.chet</Debugger_RunParams>
90+
</PropertyGroup>
8291
<PropertyGroup Condition="'$(Cfg_3)'!=''">
8392
<DCC_Define>EXPERIMENTAL;$(DCC_Define)</DCC_Define>
8493
</PropertyGroup>
@@ -92,12 +101,12 @@
92101
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
93102
</PropertyGroup>
94103
<PropertyGroup Condition="'$(Cfg_2_Win64)'!=''">
95-
<DCC_UnitSearchPath>Classes;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
104+
<DCC_UnitSearchPath>externals;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
96105
<Debugger_RunParams>..\Sample\usp10.chet</Debugger_RunParams>
97106
<VerInfo_AutoIncVersion>true</VerInfo_AutoIncVersion>
98-
<VerInfo_Build>55</VerInfo_Build>
107+
<VerInfo_Build>58</VerInfo_Build>
99108
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
100-
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.3.0.55;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.1.0.42;Comments=</VerInfo_Keys>
109+
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.3.0.58;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.1.0.42;Comments=</VerInfo_Keys>
101110
<VerInfo_MinorVer>3</VerInfo_MinorVer>
102111
</PropertyGroup>
103112
<ItemGroup>
@@ -112,7 +121,7 @@
112121
<DCCReference Include="Classes\Chet.HeaderTranslator.pas"/>
113122
<DCCReference Include="Classes\Chet.SourceWriter.pas"/>
114123
<DCCReference Include="Classes\Chet.CommentWriter.pas"/>
115-
<DCCReference Include="Classes\Chet.CleanHeader.pas"/>
124+
<DCCReference Include="Classes\Cnet.Postprocessor.pas"/>
116125
<DCCReference Include="Forms\Form.ScriptHelp.pas">
117126
<Form>FormScriptHelp</Form>
118127
<FormType>dfm</FormType>

‎Chet.res

0 Bytes
Binary file not shown.

‎Classes/Chet.HeaderTranslator.pas

+99-57
Original file line numberDiff line numberDiff line change
@@ -163,7 +163,8 @@ implementation
163163
uses
164164
Winapi.Windows,
165165
System.Types,
166-
System.IOUtils;
166+
System.IOUtils,
167+
System.Masks;
167168

168169
{ THeaderTranslator }
169170

@@ -353,7 +354,7 @@ procedure THeaderTranslator.CreateCombinedHeaderFile;
353354
var
354355
Option: TSearchOption;
355356
Writer: TStreamWriter;
356-
HeaderFiles: TStringDynArray;
357+
HeaderFiles,IgnoredFiles: TStringDynArray;
357358
HeaderPath, HeaderFile: String;
358359
I: Integer;
359360
begin
@@ -363,7 +364,26 @@ procedure THeaderTranslator.CreateCombinedHeaderFile;
363364
Option := TSearchOption.soTopDirectoryOnly;
364365

365366
HeaderPath := IncludeTrailingPathDelimiter(FProject.HeaderFileDirectory);
366-
HeaderFiles := TDirectory.GetFiles(HeaderPath, '*.h', Option);
367+
IgnoredFiles := FProject.IgnoredFiles.Split([','],'"','"',TStringSplitOptions.ExcludeEmpty);
368+
369+
if Length(IgnoredFiles) = 0 then
370+
HeaderFiles := TDirectory.GetFiles(HeaderPath, '*.h', Option)
371+
else
372+
HeaderFiles := TDirectory.GetFiles(HeaderPath, '*.h', Option,
373+
function(const Path: string; const SearchRec: TSearchRec): Boolean
374+
var
375+
mask: string;
376+
begin
377+
for mask in IgnoredFiles do
378+
begin
379+
if MatchesMask(SearchRec.Name, mask) then
380+
Exit(False);
381+
end;
382+
383+
Result := True;
384+
end
385+
);
386+
367387
if (Length(HeaderFiles) = 0) then
368388
raise EHeaderTranslatorError.CreateFmt('No C header files found in directory "%s".', [FProject.HeaderFileDirectory]);
369389

@@ -1067,6 +1087,10 @@ procedure THeaderTranslator.SetupTokenMap;
10671087
end;
10681088

10691089
procedure THeaderTranslator.SetupTypeMap;
1090+
var
1091+
customTypePair: TPair<string,string>;
1092+
customTypes: TArray<string>;
1093+
i,n: Integer;
10701094
begin
10711095
FTypeMap.Add('size_t', 'NativeUInt');
10721096
FTypeMap.Add('intptr_t', 'IntPtr');
@@ -1115,12 +1139,24 @@ procedure THeaderTranslator.SetupTypeMap;
11151139
// Type FILE the cannot be used in Delphi, so we convert to a Pointer.
11161140
FTypeMap.Add('FILE', 'Pointer');
11171141

1118-
// WinNT.h
1119-
FTypeMap.Add('WORD', 'UInt16');
1120-
FTypeMap.Add('DWORD', 'UInt32');
1121-
FTypeMap.Add('LONG', 'Int32');
1122-
FTypeMap.Add('ULONG', 'UInt32');
1123-
FTypeMap.Add('BYTE', 'Byte');
1142+
// attempt to add user-defined types, if any.
1143+
customTypes := FProject.CustomCTypesMap.Split([','],'"','"',TStringSplitOptions.ExcludeEmpty);
1144+
for i := 0 to High(customTypes) do
1145+
begin
1146+
customTypes[i] := customTypes[i].Replace(';','',[rfReplaceAll]).Trim.DeQuotedString('"');
1147+
n := customTypes[i].IndexOf('=');
1148+
if n < 0 then Continue;
1149+
1150+
customTypePair.Key := customTypes[i].Substring(0,n).DeQuotedString('"').Trim;
1151+
customTypePair.Value := customTypes[i].Substring(1+n).DeQuotedString('"').Trim;
1152+
1153+
if customTypePair.Key.IsEmpty or
1154+
customTypePair.Value.IsEmpty or
1155+
FTypeMap.ContainsKey(customTypePair.Key) then
1156+
Continue;
1157+
1158+
FTypeMap.TryAdd(customTypePair.Key,customTypePair.Value);
1159+
end;
11241160
end;
11251161

11261162
function THeaderTranslator.Spelling(const AType: TType): String;
@@ -2283,9 +2319,10 @@ procedure THeaderTranslator.WriteProceduralType(const ACursor: TCursor;
22832319
procedure THeaderTranslator.WriteStructType(const ACursor: TCursor; const AIsUnion: Boolean);
22842320
var
22852321
T: TType;
2286-
FieldIndex, BitFieldCount: Integer;
2287-
StructName, FieldName, BitDataDelphiTypeName: String;
2322+
FieldIndex, BitFieldOffsetFromStructStart, BitFieldDataFieldCount, BitFieldCount: Integer;
2323+
StructName, FieldName: String;
22882324
IsAnonymousStruct, IsFieldInited: Boolean;
2325+
BitFieldValueFieldName: string;
22892326
begin
22902327
T := ACursor.CursorType;
22912328
if (not FWriter.IsAtSectionStart) then
@@ -2308,13 +2345,15 @@ FWriter.WriteLn('%s = record', [StructName]);
23082345

23092346
FieldIndex := 0;
23102347
BitFieldCount := 0;
2348+
BitFieldOffsetFromStructStart := 0;
23112349
IsFieldInited := True;
2312-
BitDataDelphiTypeName := '';
2350+
BitFieldDataFieldCount := 0;
2351+
23132352
T.VisitFields(
23142353
function(const ACursor: TCursor): TVisitorResult
23152354
var
23162355
CursorType, PointeeType: TType;
2317-
OffsetOfField,BitWidth, BitIndex: Integer;
2356+
BitWidth, FieldOfset, BitIndex: Integer;
23182357
DelphiTypeName: string;
23192358
begin
23202359
FCommentWriter.WriteComment(ACursor);
@@ -2327,25 +2366,63 @@ FWriter.WriteLn('%s = record', [StructName]);
23272366

23282367
if ACursor.IsBitField then
23292368
begin
2330-
if FieldIndex = 0 then
2369+
// https://en.cppreference.com/w/cpp/language/bit_field
2370+
// http://www.rvelthuis.de/articles/articles-convert.html#bitfields
2371+
// https://stackoverflow.com/questions/282019/how-to-simulate-bit-fields-in-delphi-records#282385
2372+
BitWidth := ACursor.FieldDeclBitWidth;
2373+
FieldOfset := BitFieldOffsetFromStructStart;
2374+
if BitFieldDataFieldCount > 0 then
2375+
Dec(FieldOfset, 32 * BitFieldDataFieldCount);
2376+
BitIndex := (FieldOfset shl 8) + BitWidth;
2377+
2378+
if (BitFieldCount = 0) or (BitFieldDataFieldCount > 0) then
23312379
begin
2332-
BitDataDelphiTypeName := DelphiTypeName;
2380+
BitFieldValueFieldName := 'Data' + BitFieldDataFieldCount.ToString;
2381+
23332382
FWriter.WriteLn('private');
23342383
FWriter.Indent;
2335-
FWriter.WriteLn('FData: '+DelphiTypeName+';');
2336-
FWriter.WriteLn('function GetBits(const aIndex: Integer): '+BitDataDelphiTypeName+';');
2337-
FWriter.WriteLn('procedure SetBits(const aIndex: Integer; const aValue: '+BitDataDelphiTypeName+');');
2384+
FWriter.WriteLn(BitFieldValueFieldName+': '+DelphiTypeName+';');
2385+
FWriter.WriteLn('function Get'+BitFieldValueFieldName+'Value(const aIndex: Integer): '+DelphiTypeName+';');
2386+
FWriter.WriteLn('procedure Set'+BitFieldValueFieldName+'Value(const aIndex: Integer; const aValue: '+DelphiTypeName+');');
23382387
FWriter.Outdent;
23392388
FWriter.WriteLn('public');
2389+
2390+
if FImplementation = nil then
2391+
FImplementation := TStringList.Create;
2392+
// todo: compatibility with "ancient" delphi versions?
2393+
FImplementation.Add('{'+StructName +'}');
2394+
FImplementation.Add('function '+StructName+'.Get'+BitFieldValueFieldName+'Value(const aIndex: Integer): '+DelphiTypeName+';');
2395+
FImplementation.Add('var');
2396+
FImplementation.Add(' BitCount, Offset, Mask: Integer;');
2397+
FImplementation.Add('begin');
2398+
FImplementation.Add('// {$UNDEF Q_temp}{$IFOPT Q+}{$DEFINE Q_temp}{$ENDIF}{$Q-} // disable OverFlowChecks');
2399+
FImplementation.Add(' BitCount := aIndex and $FF;');
2400+
FImplementation.Add(' Offset := aIndex shr 8;');
2401+
FImplementation.Add(' Mask := ((1 shl BitCount) - 1);');
2402+
FImplementation.Add(' Result := ('+BitFieldValueFieldName+' shr Offset) and Mask;');
2403+
FImplementation.Add('// {$IFDEF Q_temp}{$Q-}{$ENDIF}');
2404+
FImplementation.Add('end;'+ sLineBreak);
2405+
2406+
FImplementation.Add('procedure '+StructName+'.Set'+BitFieldValueFieldName+'Value(const aIndex: Integer; const aValue: '+DelphiTypeName+');');
2407+
FImplementation.Add('var');
2408+
FImplementation.Add(' BitCount, Offset, Mask: Integer;');
2409+
FImplementation.Add('begin');
2410+
FImplementation.Add('// {$UNDEF Q_temp}{$IFOPT Q+}{$DEFINE Q_temp}{$ENDIF}{$Q-} // disable OverFlowChecks');
2411+
FImplementation.Add(' BitCount := aIndex and $FF;');
2412+
FImplementation.Add(' Offset := aIndex shr 8;');
2413+
FImplementation.Add(' Mask := ((1 shl BitCount) - 1);');
2414+
FImplementation.Add(' '+BitFieldValueFieldName+' := ('+BitFieldValueFieldName+' and (not (Mask shl Offset))) or (aValue shl Offset);');
2415+
FImplementation.Add('// {$IFDEF Q_temp}{$Q-}{$ENDIF}');
2416+
FImplementation.Add('end;'+sLineBreak);
23402417
end;
23412418

2342-
OffsetOfField := ACursor.OffsetOfField;
2343-
BitWidth := ACursor.FieldDeclBitWidth;
2344-
BitIndex := (OffsetOfField shl 8) + BitWidth;
23452419
FWriter.Indent;
2346-
FWriter.WriteLn('property '+FieldName+': '+DelphiTypeName+' index $'+BitIndex.ToHexString(CursorType.Sizeof)+' read GetBits write SetBits; // '+BitWidth.ToString+' bits at offset '+OffsetOfField.ToString);
2420+
FWriter.WriteLn('property '+FieldName+': '+DelphiTypeName+' index $'+BitIndex.ToHexString(CursorType.Sizeof)+' read Get'+BitFieldValueFieldName+'Value write Set'+BitFieldValueFieldName+'Value; // '+BitWidth.ToString+' bits at offset '+FieldOfset.ToString +' in '+ BitFieldValueFieldName);
23472421
FWriter.Outdent;
23482422
Inc(BitFieldCount);
2423+
Inc(BitFieldOffsetFromStructStart, BitWidth);
2424+
if BitFieldOffsetFromStructStart > 31 then
2425+
Inc(BitFieldDataFieldCount);
23492426
IsFieldInited := False;
23502427
end
23512428
else
@@ -2383,41 +2460,6 @@ FWriter.WriteLn('%s = record', [StructName]);
23832460
FWriter.Outdent;
23842461
FWriter.WriteLn('end;');
23852462

2386-
if (BitFieldCount > 0) and (BitDataDelphiTypeName <> '') then
2387-
begin
2388-
if FImplementation = nil then
2389-
FImplementation := TStringList.Create;
2390-
2391-
FImplementation.Add('{$region '''+StructName + 'fields read/write''}');
2392-
// FImplementation.Add('(*');
2393-
FImplementation.Add('function '+StructName+'.GetBits(const aIndex: Integer): '+BitDataDelphiTypeName+';');
2394-
FImplementation.Add('var');
2395-
FImplementation.Add(' Offset, NrBits, Mask: Integer;');
2396-
FImplementation.Add('begin');
2397-
FImplementation.Add('{$UNDEF Q_temp}{$IFOPT Q+}{$DEFINE Q_temp}{$ENDIF}{$Q-} // disable OverFlowChecks');
2398-
FImplementation.Add(' NrBits := aIndex and $FF;');
2399-
FImplementation.Add(' Offset := aIndex shr 8;');
2400-
FImplementation.Add(' Mask := ((1 shl NrBits) - 1);');
2401-
FImplementation.Add(' Result := (FData shr Offset) and Mask;');
2402-
FImplementation.Add('{$IFDEF Q_temp}{$Q-}{$ENDIF}');
2403-
FImplementation.Add('end;'+ sLineBreak);
2404-
2405-
FImplementation.Add('procedure '+StructName+'.SetBits(const aIndex: Integer; const aValue: '+BitDataDelphiTypeName+');');
2406-
FImplementation.Add('var');
2407-
FImplementation.Add(' Offset, NrBits, Mask: Integer;');
2408-
FImplementation.Add('begin');
2409-
FImplementation.Add('{$UNDEF Q_temp}{$IFOPT Q+}{$DEFINE Q_temp}{$ENDIF}{$Q-} // disable OverFlowChecks');
2410-
FImplementation.Add(' NrBits := aIndex and $FF;');
2411-
FImplementation.Add(' Offset := aIndex shr 8;');
2412-
FImplementation.Add(' Mask := ((1 shl NrBits) - 1);');
2413-
FImplementation.Add(' Assert(aValue <= Mask);');
2414-
FImplementation.Add(' FData := (FData and (not (Mask shl Offset))) or (aValue shl Offset);');
2415-
FImplementation.Add('{$IFDEF Q_temp}{$Q-}{$ENDIF}');
2416-
FImplementation.Add('end;');
2417-
FImplementation.Add('{$endregion '''+StructName + ' fields read/write''}'+sLineBreak);
2418-
// FImplementation.Add('*)');
2419-
end;
2420-
24212463
FWriter.WriteLn;
24222464
end;
24232465

0 commit comments

Comments
 (0)