From 30ea3d4d03b1c0dcd2c0205d8959d7b29409e5a8 Mon Sep 17 00:00:00 2001 From: skalogryz Date: Tue, 15 Apr 2008 14:13:34 +0000 Subject: [PATCH] unions convertion added git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@423 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- bindings/pascocoa/parser/ObjCParserTypes.pas | 220 +++++++++++++++---- bindings/pascocoa/parser/ObjCParserUtils.pas | 131 ++++++++++- bindings/pascocoa/parser/objcparser.lpi | 35 ++- bindings/pascocoa/parser/objcparser.pas | 8 +- 4 files changed, 330 insertions(+), 64 deletions(-) diff --git a/bindings/pascocoa/parser/ObjCParserTypes.pas b/bindings/pascocoa/parser/ObjCParserTypes.pas index 36a0bfd43..dda9f4de6 100755 --- a/bindings/pascocoa/parser/ObjCParserTypes.pas +++ b/bindings/pascocoa/parser/ObjCParserTypes.pas @@ -54,10 +54,12 @@ type TokenTable : TTokenTable; OnPrecompile : TNotifyEvent; OnComment : procedure (Sender: TObject; const Comment: AnsiString) of object; + OnIgnoreToken : procedure (Sender: TObject; const Ignored: AnsiString) of object; Line : Integer; Stack : TList; Errors : TStringList; + IgnoreTokens : TStringList; constructor Create; destructor Destroy; override; @@ -70,6 +72,7 @@ type function FindNextToken(var Token: AnsiString; var TokenType: TTokenType): Boolean; procedure SetError(const ErrorCmt: AnsiString); + end; { TEntity } @@ -166,10 +169,19 @@ type _isPointer : Boolean; end; + TUnionTypeDef = class(TStructTypeDef) + protected + function DoParse(AParser: TTextParser): Boolean; override; + public + _Name : AnsiString; + //todo: remove + _isPointer : Boolean; + end; + { TTypeDef } //C token - any type, including unsigned short - TTypeDefSpecs = set of (td_Unsigned, td_Signed, td_Volitale, td_Const, td_Long, td_Short); + TTypeDefSpecs = set of (td_Unsigned, td_Signed, td_Volitale, td_Const, td_Long, td_Short, td_Char); {updated} TTypeDef = class(TEntity) @@ -296,8 +308,20 @@ procedure FreeEntity(Item: TEntity); procedure ParseCNumeric(const S: AnsiString; var idx: integer; var NumStr: AnsiSTring); function CToPascalNumeric(const Cnum: AnsiString): AnsiString; +function IsTypePointer(AType: TEntity; DefResult: Boolean ): Boolean; + implementation +function IsTypePointer(AType: TEntity; DefResult: Boolean ): Boolean; +begin + Result := DefResult; + if not Assigned(AType) then Exit; + if AType is TTypeDef then + Result := TTypeDef(AType)._IsPointer + else if AType is TStructTypeDef then + Result := TStructTypeDef(AType)._isPointer; +end; + function ErrExpectStr(const Expected, Found: AnsiString): AnsiString; begin Result := Format(Err_Expect, [Expected, Found]); @@ -348,6 +372,8 @@ begin Result := TEnumTypeDef.Create(Owner) else if s = 'struct' then Result := TStructTypeDef.Create(Owner) + else if s = 'union' then + Result := TUnionTypeDef.Create(Owner) else Result := TTypeDef.Create(Owner); @@ -474,10 +500,12 @@ begin Line := 1; Stack := TList.Create; Errors := TStringList.Create; + IgnoreTokens := TStringList.Create; end; destructor TTextParser.Destroy; begin + IgnoreTokens.Free; Errors.Free; Stack.Free; inherited Destroy; @@ -640,12 +668,21 @@ begin Result := Result and (Token <> ''); end; end; + + if Result and (IgnoreTokens.Count > 0) then begin + if IgnoreTokens.IndexOf(Token) >= 0 then begin + if Assigned(OnIgnoreToken) then + OnIgnoreToken(Self, Token); + Result := false; + TokenType := tt_None; + Token := ''; + end; + end; end; {of while} finally if not Result then TokenType := tt_None else TokenPos := Index - length(Token); - //todo: make an event or something if TokenType = tt_Numeric then Token := CToPascalNumeric(Token); @@ -1155,28 +1192,38 @@ begin brac := 0; ExpS := ''; Result := false; - while AParser.FindNextToken(nm, tt) do begin - if (tt = tt_Numeric) or (tt = tt_Ident) then begin - ExpS := ExpS + nm; - i := AParser.Index; - if not ParseCOperator(AParser, nm) then begin - AParser.Index := i; - Break; - end else - ExpS := ExpS + ' ' + nm + ' '; - end else if (tt = tt_Symbol) then begin - if nm ='(' then inc(brac) - else if nm = ')' then dec(brac); - end else begin - //i := AParser.Index; - Exit; + + try + while AParser.FindNextToken(nm, tt) do begin + if (nm = #39) then begin + ExpS := #39 + ScanTo(APArser.Buf, AParser.Index, [#39]) + #39; + inc(AParser.Index); + Result := true; + Exit; + end else if (tt = tt_Numeric) or (tt = tt_Ident) then begin + ExpS := ExpS + nm; + i := AParser.Index; + if not ParseCOperator(AParser, nm) then begin + AParser.Index := i; + Break; + end else + ExpS := ExpS + ' ' + nm + ' '; + end else if (tt = tt_Symbol) then begin + if nm ='(' then inc(brac) + else if nm = ')' then dec(brac); + end else begin + //i := AParser.Index; + Exit; + end; end; + Result := true; + + finally + if brac > 0 then + while (brac > 0) and (AParser.FindNextToken(nm, tt)) do + if nm = ')' then + dec(brac); end; - if brac > 0 then - while (brac > 0) and (AParser.FindNextToken(nm, tt)) do - if nm = ')' then - dec(brac); - Result := true; end; { TEnumValue } @@ -1274,6 +1321,8 @@ begin end; AParser.FindNextToken(s, tt); + if s <> '}' then + AParser.Index := AParser.TokenPos; prev := nil; while (s <> '}') do begin //i := AParser.TokenPos; @@ -1294,13 +1343,12 @@ begin if s = ',' then prev := st else prev := nil; - + if s = ';' then begin AParser.FindNextToken(s, tt); if s <> '}' then AParser.Index := AParser.TokenPos; end else begin - AParser.SetError(ErrExpectStr('";"', st._Name)); - Exit; + AParser.Index := AParser.TokenPos; end; end; @@ -1326,7 +1374,7 @@ var begin Result := false; _Type := ParseTypeDef(Self, AParser); - if Assigned(_Type) then Exit; + if not Assigned(_Type) then Exit; _TypeName := GetTypeNameFromEntity(_Type); @@ -1334,6 +1382,7 @@ begin AParser.SetError(ErrExpectStr('Identifier', s)); Exit; end; + _Name := s; AParser.FindNextToken(s, tt); if (tt = tt_Symbol) and (s = ':') then begin @@ -1344,7 +1393,8 @@ begin end; CVal(s, _BitSize); AParser.FindNextToken(s, tt); - end; + end else + AParser.Index := AParser.TokenPos; Result := true; //success: (tt = tt_Symbol) and (s = ';') end; @@ -1368,10 +1418,13 @@ begin SpecMask := [td_Signed, td_Unsigned]; end else if (s = 'long') then begin SpecVal := [td_Long]; - SpecMask := [td_Long, td_Short]; + SpecMask := [td_Long, td_Short, td_Char]; end else if (s = 'short') then begin SpecVal := [td_Short]; - SpecMask := [td_Long, td_Short]; + SpecMask := [td_Long, td_Short, td_Char]; + end else if (s = 'char') then begin + SpecVal := [td_Char]; + SpecMask := [td_Long, td_Short, td_Char]; end else Result := false; end; @@ -1385,33 +1438,41 @@ var begin Result := false; AParser.FindNextToken(s, tt); - while (tt = tt_Ident) and (IsSpecifier(s, vl, msk)) do begin - if _Spec * msk <> [] then begin - AParser.SetError( ErrExpectStr('Type identifier', s)); - Exit; - end; - _Spec := _Spec + vl; + if (tt = tt_Ident) and (IsSpecifier(s, vl, msk)) then + while (tt = tt_Ident) and (IsSpecifier(s, vl, msk)) do begin + if (_Spec * msk <> []) and (s <> 'long') then begin + AParser.SetError( ErrExpectStr('Type identifier', s)); + Exit; + end; + _Spec := _Spec + vl; + if _Name = '' then _Name := s + else _Name := _Name + ' ' + s; + AParser.FindNextToken(s, tt); + end {of while} + else begin + _Name := s; AParser.FindNextToken(s, tt); + Result := true; end; - if tt <> tt_Ident then begin + if tt = tt_Ident then begin Result := true; // type name can be: usigned long! AParser.Index := AParser.TokenPos; Exit; - end; - _Name := s; - AParser.FindNextToken(s, tt); - if (tt = tt_Symbol) then begin + end else if tt = tt_Symbol then begin if (s = '*') then _isPointer := true - else begin + else if (s <> ';') or (s <>',') then begin AParser.Index := AParser.TokenPos; AParser.SetError( ErrExpectStr('identifier', 'symbol ' + s )); Exit; - end; - end else - AParser.Index := AParser.TokenPos; - Result := true; + end else + AParser.Index := AParser.TokenPos; + Result := true; + end else begin + AParser.SetError(ErrExpectStr( 'Identifier', s) ); + end; + end; { TSkip } @@ -1421,4 +1482,73 @@ begin Result := true; end; +{ TUnionTypeDef } + +function TUnionTypeDef.DoParse(AParser: TTextParser): Boolean; +var + s : AnsiString; + tt : TTokenType; + i : Integer; + st : TStructField; + prev : TStructField; +begin + Result := false; + AParser.FindNextToken(s, tt); + if s <> 'union' then begin + AParser.SetError(ErrExpectStr('union', s)); + Exit; + end; + + AParser.FindNextToken(s, tt); + i := AParser.TokenPos; + if (tt = tt_Ident) then begin + _Name := s; + AParser.FindNextToken(s, tt); + i := AParser.TokenPos; + end; + + if not ((tt = tt_Symbol) and (s = '{')) then begin + if (tt = tt_Symbol) and (s = '*') + then _isPointer := true + else AParser.Index := i; + Exit; + end; + + AParser.FindNextToken(s, tt); + if s <> '}' then + AParser.Index := AParser.TokenPos; + prev := nil; + while (s <> '}') do begin + //i := AParser.TokenPos; + st := TStructField.Create(Self); + if not Assigned(prev) then begin + if not st.Parse(AParser) then Exit; + end else begin + AParser.FindNextToken(st._Name, tt); + if tt <> tt_Ident then begin + AParser.SetError(ErrExpectStr('field name', st._Name)); + Exit; + end; + st._TypeName := prev._TypeName; + end; + + Items.Add(st); + AParser.FindNextToken(s, tt); + if s = ',' + then prev := st + else prev := nil; + + if s = ';' then begin + AParser.FindNextToken(s, tt); + if s <> '}' then AParser.Index := AParser.TokenPos; + end else begin + AParser.Index := AParser.TokenPos; + end; + end; + + Result := true; + //no skipping last ';', because after structure a variable can be defined + //ie: struct POINT {int x; int y} point; +end; + end. diff --git a/bindings/pascocoa/parser/ObjCParserUtils.pas b/bindings/pascocoa/parser/ObjCParserUtils.pas index c38a30036..bd46366d0 100755 --- a/bindings/pascocoa/parser/ObjCParserUtils.pas +++ b/bindings/pascocoa/parser/ObjCParserUtils.pas @@ -7,6 +7,7 @@ unit ObjCParserUtils; interface + {$ifdef fpc}{$mode delphi}{$H+}{$endif} uses @@ -45,6 +46,7 @@ type IgnoreIncludes : TStringList; DefineReplace : TReplaceList; TypeDefReplace : TReplaceList; // replaces for C types + IgnoreTokens : TStringList; ConvertPrefix : TStringList; constructor Create; @@ -70,6 +72,8 @@ function IsPascalReserved(const s: AnsiString): Boolean; implementation +procedure WriteOutRecordField(AField: TStructField; const Prefix: AnsiString; subs: TStrings); forward; + function IsPascalReserved(const s: AnsiString): Boolean; var ls : AnsiString; @@ -106,6 +110,17 @@ begin end; end; +function FixIfReserved(const AName: AnsiString; NotUse: TStrings = nil): AnsiString; +begin + Result := AName; + if isPascalReserved(AName) then + Result := '_'+AName; + if Assigned(NotUse) then begin + while (NotUse.IndexOf(Result) >= 0) do + Result := '_' + Result; + end; +end; + function GetMethodResultType(const m: TClassMethodDef): AnsiString; var res : TObjCResultTypeDef; @@ -289,11 +304,18 @@ begin pth := vs; + + {$IFDEF MSWINDOWS} + + {$ENDIF} + while (pth <> '') and (length(pth)>1) do begin if ConvertSettings.IgnoreIncludes.IndexOf(pth) >= 0 then Exit; // file must be excluded; pth := ExtractFilePath(ExcludeTrailingPathDelimiter(pth)); end; + + Result := ExtractFileName(vs); Result := Copy(Result, 1, length(Result) - length(ExtractFileExt(vs))) + '.inc'; @@ -708,6 +730,80 @@ begin end; end; +procedure WriteOutUnion(AField: TUnionTypeDef; const Prefix: AnsiString; subs: TStrings); +var + i : integer; + n : integer; + c : Integer; + s : AnsiString; +begin + n := 0; + subs.Add(Prefix + 'case Integer of'); + for i := 0 to AField.Items.Count - 1 do begin + if TObject(AField.Items[i]) is TStructField then begin + subs.Add(Prefix + Format('%d: (', [n])); + c := subs.Count; + WriteOutRecordField(TStructField(AField.Items[i]), Prefix + ' ', subs); + subs[subs.Count-1] := subs[subs.Count-1] + ');'; + + if subs.Count - 1 = c then begin + s := subs[subs.Count - 1]; + Delete(s, 1, length(Prefix + ' ')); + subs.Delete(subs.Count - 1); + subs[subs.Count - 1] := subs[subs.Count - 1] + s; + end; + + inc(n); + end; + end; +end; + +procedure WriteOutRecordField(AField: TStructField; const Prefix: AnsiString; subs: TStrings); +var + pastype : AnsiString; +begin + //todo:! + if Assigned(AField._Type) and (AField._Type is TUnionTypeDef) then begin + WriteOutUnion(TUnionTypeDef(AField._Type), Prefix, subs); + end else begin + pastype := ObjCToDelphiType( AField._TypeName, IsTypePointer(AField._Type, false)); + subs.Add(Prefix + Format('%s : %s; ', [FixIfReserved(AField._Name), pastype])); + end; +end; + +procedure WriteOutRecord(struct: TStructTypeDef; const Prefix, RecPrefix : AnsiString; subs: TStrings); +var + i : integer; +begin + subs.Add(Prefix + Format('%s record ', [RecPrefix])); + for i := 0 to struct.Items.Count - 1 do + if TObject(struct.Items[i]) is TStructField then + WriteOutRecordField( TStructField(struct.Items[i]), Prefix + ' ', subs); + subs.Add(Prefix + 'end;'); +end; + +procedure WriteOutTypeDefRecord(struct: TStructTypeDef; const Prefix, RecPrefix : AnsiString; subs: TStrings); +var + i : integer; + s : AnsiString; +begin + i := subs.Count; + + WriteOutRecord(struct, Prefix, RecPrefix, subs); + s := subs[i]; + Delete(s, 1, length(Prefix)); + s := Prefix + struct._Name + ' = ' + s; + subs[i] := s; +end; + +function WriteOutTypeDefName(const NewType, FromType: AnsiSTring; isPointer: Boolean): AnsiString; +begin + if not isPointer then + Result := Format('%s = %s;', [NewType, FromType]) + else + Result := Format('%s = ^%s;', [NewType, FromType]); +end; + procedure WriteOutTypeDefToHeader(typedef: TTypeNameDef; const Prefix: AnsiString; subs: TStrings); var vs : AnsiString; @@ -717,15 +813,23 @@ begin if vs = '' then vs := typedef._Inherited; if not Assigned(typedef._Type) or (typedef._Type is TTypeDef) then begin subs.Add('type'); - subs.Add(Prefix + Format('%s = %s;', [typedef._TypeName, vs])) - end else begin - if typedef._Type is TEnumTypeDef then begin - tmp := TEnumTypeDef(typedef._Type)._Name; - TEnumTypeDef(typedef._Type)._Name := typedef._TypeName; - WriteOutEnumToHeader(TEnumTypeDef(typedef._Type), subs); - TEnumTypeDef(typedef._Type)._Name := tmp; + subs.Add(Prefix + WriteOutTypeDefName(typedef._TypeName, vs, IsTypePointer(typedef._Type, false))); + end else if typedef._Type is TEnumTypeDef then begin + tmp := TEnumTypeDef(typedef._Type)._Name; + TEnumTypeDef(typedef._Type)._Name := typedef._TypeName; + WriteOutEnumToHeader(TEnumTypeDef(typedef._Type), subs); + TEnumTypeDef(typedef._Type)._Name := tmp; + end else if typedef._Type is TStructTypeDef then begin + subs.Add('type'); + if TStructTypeDef(typedef._Type)._Name <> '' then begin + WriteOutTypeDefRecord(typedef._Type as TStructTypeDef, ' ', 'packed ', subs); + subs.Add(Prefix + WriteOutTypeDefName(typedef._TypeName, TStructTypeDef(typedef._Type)._Name, IsTypePointer(typedef._Type, false))); + end else begin + TStructTypeDef(typedef._Type)._Name := typedef._TypeName; + WriteOutTypeDefRecord(typedef._Type as TStructTypeDef, ' ', 'packed ', subs); end; end; + subs.Add(''); end; @@ -1081,8 +1185,11 @@ begin end; +//Removed, must not be used, because enumerations must be converted to constants function AppleEnumType(items: TList; TypeDefIdx: Integer): Boolean; -var +begin + Result := false; +{var EnumIdx : integer; typedef : TTypeNameDef; enumdef : TEnumTypeDef; @@ -1104,7 +1211,7 @@ begin enumdef._Name := typedef._TypeName; Result := true; end; - +} end; @@ -1204,6 +1311,7 @@ end; constructor TConvertSettings.Create; begin + IgnoreTokens := TStringList.Create; IgnoreIncludes := TStringList.Create; IgnoreIncludes.CaseSensitive := false; DefineReplace := TReplaceList.Create; @@ -1213,6 +1321,7 @@ end; destructor TConvertSettings.Destroy; begin + IgnoreTokens.Free; IgnoreIncludes.Free; TypeDefReplace.Free; DefineReplace.Free; @@ -1237,10 +1346,14 @@ begin DefineReplace['MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_4'] := 'MAC_OS_X_VERSION_10_4'; DefineReplace['MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_5'] := 'MAC_OS_X_VERSION_10_5'; DefineReplace['__LP64__'] := 'LP64'; + TypeDefReplace['uint32_t'] := 'LongWord'; TypeDefReplace['uint8_t'] := 'byte'; TypeDefReplace['NSUInteger'] := 'LongWord'; TypeDefReplace['NSInteger'] := 'Integer'; + TypeDefReplace['long long'] := 'Int64'; + + IgnoreTokens.Add('DEPRECATED_IN_MAC_OS_X_VERSION_10_5_AND_LATER'); end; end; diff --git a/bindings/pascocoa/parser/objcparser.lpi b/bindings/pascocoa/parser/objcparser.lpi index 03b2fa71d..5aad8d9a6 100755 --- a/bindings/pascocoa/parser/objcparser.lpi +++ b/bindings/pascocoa/parser/objcparser.lpi @@ -35,8 +35,8 @@ - - + + @@ -44,8 +44,8 @@ - - + + @@ -53,8 +53,8 @@ - - + + @@ -268,7 +268,28 @@ - + + + + + + + + + + + + + + + + + + + + + + diff --git a/bindings/pascocoa/parser/objcparser.pas b/bindings/pascocoa/parser/objcparser.pas index 03c0484a6..54be755fe 100755 --- a/bindings/pascocoa/parser/objcparser.pas +++ b/bindings/pascocoa/parser/objcparser.pas @@ -24,7 +24,7 @@ type { TPrecompileHandler } TPrecompileHandler = class(TObject) public - hdr : TObjCHeader; + hdr : TObjCHeader; procedure OnPrecompile(Sender: TObject); procedure OnComment(Sender: TObject; const Comment: AnsiString); constructor Create(AHeader: TObjCHeader); @@ -97,7 +97,7 @@ begin Err := 'File not found: ' + FileName; Exit; end; - + s := StrFromFile(FileName); hdr := TObjCHeader.Create; prec := TPrecompileHandler.Create(hdr); @@ -110,6 +110,8 @@ begin parser.TokenTable.Precompile := '#'; parser.OnPrecompile := prec.OnPrecompile; parser.OnComment := prec.OnComment; + parser.IgnoreTokens.AddStrings(ConvertSettings.IgnoreTokens); + hdr._FileName := ExtractFileName(FileName); Result := hdr.Parse(parser); if not Result then begin @@ -276,7 +278,7 @@ begin try GetConvertSettings(ConvertSettings, inpf); if not FileExists(inpf) then begin - //ParseAll; + ParseAll; Exit; end;