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

* Added ability to specify in type-mappings if var,constref etc should be uesed

Browse Source 
* Added ability to force passing a variable in a parameter instead of function result
 * Removed ctypes-mapping, this in not necessary anymore

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2355 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
loesje_
2012-03-19 13:48:22 +00:00
parent ffbc7d0761
commit 2610161021
2 changed files with 179 additions and 49 deletions
Download Patch File Download Diff File Expand all files Collapse all files

198
applications/idlparser/idlgenpascal.pas
View File

@ -38,25 +38,10 @@ uses
Classes, SysUtils, strutils,
idlParser;
procedure GeneratePascalSource(const AnIdlList: TIDLList; const PascalCode: tstrings;TypeConvList, CTypesList: TStrings; AlwaysAddPrefixToParam: boolean; AForwardDeclList: TStrings = nil);
procedure GeneratePascalSource(const AnIdlList: TIDLList; const PascalCode: tstrings;TypeConvList: TStrings; AlwaysAddPrefixToParam: boolean; AForwardDeclList: TStrings = nil);
implementation
function CTypeToPascalType(AValue: string; unsigned: boolean; TypeConvList, CTypesList: TStrings): string;
begin
if TypeConvList.Values[AValue]<>'' then
result := TypeConvList.Values[AValue]
else if CTypesList.IndexOf(AValue) > -1 then
begin
result := 'idl';
if unsigned then result := Result + 'u';
result := result+AValue;
end
else
result := AValue;
end;
function HasDoubleIdentifier(const AnIDL: TIDL; AValue: string): boolean;
var
i: Integer;
@ -98,7 +83,142 @@ begin
end;
end;
procedure GeneratePascalSource(const AnIdlList: TIDLList; const PascalCode: tstrings;TypeConvList, CTypesList: TStrings; AlwaysAddPrefixToParam: boolean; AForwardDeclList: TStrings = nil);
function IsReturnTypeFunction(AnIDLMember: TIDLMember; TypeConvList: TStrings; var AParamStr: string; var AReturnType: string) : boolean;
var
found: boolean;
Isfunction: boolean;
function Search(const AValue: string): boolean;
var
i,c: integer;
res: string;
begin
result := true;
if AValue='' then
AReturnType := AnIDLMember.ReturnType
else
begin
result := false;
i := TypeConvList.IndexOfName(AValue);
if i > -1 then
begin
result := true;
res := TypeConvList.ValueFromIndex[i];
c := pos(',',res);
if c>0 then
begin
IsFunction:=false;
AReturnType:= copy(res,1,c-1);
AParamStr := copy(res,c+1,10) + ' result_: ' + AReturnType;
end
else
AReturnType := res;
end;
end;
end;
begin
found := false;
IsFunction:=true;
AReturnType:='';
AParamStr:='';
if AnIDLMember.ReturnTypeUnsigned then
begin
found := Search(AnIDLMember.ReturnType+',unsigned,f');
if not found then
found := Search(AnIDLMember.ReturnType+',f');
if not found then
found := Search(AnIDLMember.ReturnType+',unsigned');
end;
if not found then
found := Search(AnIDLMember.ReturnType+',f');
if not found then
found := Search(AnIDLMember.ReturnType);
if not found then
found := Search('');
result := Isfunction;
end;
function GetIdentifierDeclaration(AParamName: String; AnIDLMemberParameter: TIDLMemberParameter; TypeConvList: TStrings) : string;
var
s: string;
SearchFor: string;
found: boolean;
defprefix: string;
function Search(const AValue: string): boolean;
var
i,c: integer;
res: string;
begin
result := true;
if avalue='' then
s := defprefix + AParamName + ': ' +AnIDLMemberParameter.ParamType
else
begin
result := false;
i := TypeConvList.IndexOfName(AValue);
if (i > -1) then
begin
result := true;
res := TypeConvList.ValueFromIndex[i];
if res = '' then
s := 'out ' + AParamName
else
begin
c := pos(',',res);
if c > 0 then
begin
s := copy(res,c+1,10) + ' ' +AParamName + ': ' + copy(res,1,c-1);
end
else
s := defprefix + AParamName + ': ' +res;
end;
end;
end;
end;
begin
defprefix := '';
if anIDLMemberParameter.ParamInOutType=piOut then
begin
SearchFor := AnIDLMemberParameter.ParamType + ',out';
defprefix:='out ';
end
else if anIDLMemberParameter.ParamInOutType=piInOut then
begin
SearchFor := AnIDLMemberParameter.ParamType + ',inout';
defprefix:='var ';
end
else if anIDLMemberParameter.ParamInOutType=piIn then
SearchFor := AnIDLMemberParameter.ParamType + ',in';
if AnIDLMemberParameter.ParamTypeUnsigned then
begin
Found := search(SearchFor+',unsigned');
if not Found then
Found := search(AnIDLMemberParameter.ParamType+',unsigned');
end
else
Found := false;
if not Found then
Found := search(SearchFor);
if not found then
Found := search(AnIDLMemberParameter.ParamType);
if not Found then
search('');
result := s;
end;
procedure GeneratePascalSource(const AnIdlList: TIDLList; const PascalCode: tstrings;TypeConvList: TStrings; AlwaysAddPrefixToParam: boolean; AForwardDeclList: TStrings = nil);
var
i,l,m: integer;
@ -110,6 +230,8 @@ var
ml: boolean;
AParamName: string;
PasType: string;
FuncRet: string;
IsFunc: boolean;
begin
PascalCode.add('type');
@ -135,9 +257,18 @@ begin
if anIDLMember.MemberType=mtFunc then
begin
if anIDLMember.ReturnType = 'void' then
s := s + ' procedure '
begin
IsFunc:=false;
FuncRet:='';
end
else
s := s + ' function ';
IsFunc := IsReturnTypeFunction(anIDLMember, TypeConvList, FuncRet, PasType);
if IsFunc then
s := s + ' function '
else
s := s + ' procedure ';
s := s + IdentifierNameToPascalName(anIDLMember.MemberName) + '(';
for m := 0 to anIDLMember.Params.Count-1 do
begin
@ -152,30 +283,39 @@ begin
end;
if m > 0 then s := s + '; ';
if anIDLMemberParameter.ParamInOutType=piOut then
s := s + 'out '
else if anIDLMemberParameter.ParamInOutType=piInOut then
s := s + 'var ';
s := s + AParamName +': ' + CTypeToPascalType(anIDLMemberParameter.ParamType,anIDLMemberParameter.ParamTypeUnsigned,TypeConvList,CTypesList);
s := s + GetIdentifierDeclaration(AParamName, AnIDLMemberParameter, TypeConvList);
end;
if not IsFunc and (FuncRet<>'') then
begin
// Pass the function result as a parameter
if anIDLMember.Params.Count>0 then
s := s + ';';
s := s + FuncRet;
end;
s := s + ')';
if anIDLMember.ReturnType <> 'void' then
s := s + ' : '+ CTypeToPascalType(anIDLMember.ReturnType,anIDLMember.ReturnTypeUnsigned,TypeConvList,CTypesList);
if IsFunc then
s := s + ' : '+ PasType;
s := s + '; safecall;'+ LineEnding
end
else if anIDLMember.MemberType=mtAttribute then
begin
PasType:= CTypeToPascalType(anIDLMember.ReturnType, anIDLMember.ReturnTypeUnsigned,TypeConvList,CTypesList);
s := s + ' function Get' +anIDLMember.MemberName + '(): ' + PasType + '; safecall;' + LineEnding;
IsFunc := IsReturnTypeFunction(anIDLMember, TypeConvList, FuncRet, PasType);
if IsFunc then
s := s + ' function Get' +anIDLMember.MemberName + '(): ' + PasType + '; safecall;' + LineEnding
else // Pass the function result as a parameter
s := s + ' procedure Get' +anIDLMember.MemberName + '('+FuncRet+'); safecall;' + LineEnding;
if not anIDLMember.MemberReadonly then
s := s + ' procedure Set' +anIDLMember.MemberName + '(a'+anIDLMember.MemberName+': '+ PasType+'); safecall;' + LineEnding;
if IsFunc then
begin
s := s + ' property ' +IdentifierNameToPascalName(anIDLMember.MemberName)+ ' : '+PasType+
' read Get' +anIDLMember.MemberName;
if not anIDLMember.MemberReadonly then
s := s + ' write Set' +anIDLMember.MemberName;
s := s + ';' +LineEnding;
end;
end
else
Consts:=Consts + ' ' + anIDL.InterfaceName +'_'+ anIDLMember.MemberName + '=' + CValueToPascalValue(anIDLMember.ConstValue) + ';'+LineEnding;

20
applications/idlparser/idltopas.pp
View File

@ -24,7 +24,7 @@ type
{ TIDLToPascal }
procedure HandleIDLFile(AFilename: string; AnOutput, ForwardOutput: TStrings; TypeConvList, CTypesList: TStrings; AlwaysAddPrefixToParam: boolean);
procedure HandleIDLFile(AFilename: string; AnOutput, ForwardOutput: TStrings; TypeConvList: TStrings; AlwaysAddPrefixToParam: boolean);
var
AnIDLList: TIDLList;
AnInput: TStrings;
@ -35,7 +35,7 @@ begin
AnIDLList := TIDLList.create;
try
ParseFile(AnIDLList, AnInput);
GeneratePascalSource(AnIDLList,AnOutput,TypeConvList, CTypesList, AlwaysAddPrefixToParam, ForwardOutput);
GeneratePascalSource(AnIDLList,AnOutput,TypeConvList, AlwaysAddPrefixToParam, ForwardOutput);
finally
AnIDLList.Free;
end;
@ -52,16 +52,15 @@ var
output, forwardoutput: TStringList;
OutputToFile: boolean;
OutputFilename: string;
CTypes, TypeMapList: TStrings;
TypeMapList: TStrings;
AlwaysAddPrefixToParam: boolean;
begin
filenames := TStringList.Create;
CTypes := TStringList.Create;
TypeMapList := TStringList.Create;
try
// quick check parameters
ErrorMsg:=CheckOptions('hpo::c:m:f:',nil,nil,filenames);
ErrorMsg:=CheckOptions('hpo::m:f:',nil,nil,filenames);
if ErrorMsg<>'' then
begin
ShowException(Exception.Create(ErrorMsg));
@ -77,11 +76,6 @@ begin
Exit;
end;
if HasOption('c') then
begin
CTypes.LoadFromFile(GetOptionValue('c'));
end;
if HasOption('m') then
begin
TypeMapList.LoadFromFile(GetOptionValue('m'));
@ -109,7 +103,7 @@ begin
if OutputToFile and (OutputFilename='') then
Output.Clear;
HandleIDLFile(filenames.Strings[i], output, forwardoutput, TypeMapList, CTypes, AlwaysAddPrefixToParam);
HandleIDLFile(filenames.Strings[i], output, forwardoutput, TypeMapList, AlwaysAddPrefixToParam);
if OutputToFile and (OutputFilename='') then
output.SaveToFile(LowerCase(ExtractFileName(ChangeFileExt(filenames.Strings[i],'.inc'))));
@ -134,11 +128,9 @@ begin
finally
filenames.Free;
CTypes.Free;
TypeMapList.Free;
end;
// stop program loop
Terminate;
end;
@ -166,8 +158,6 @@ begin
writeln(' directory with the same filenames name as the input files but with');
writeln(' the ''.inc'' extension');
writeln(' -o filename Write the output to one file called ''filename''');
writeln(' -c filename Read ''filename'' to get a list of typenames that have to be');
writeln(' prefixed with ''c'' or ''cu'' (as used in the ctypes unit)');
writeln(' -m filename Read ''filename'' for a list of mappings between idl-type names');
writeln(' and their Pascal counterpart');
writeln(' -f filename Place all forward declarations into one file called ''filename''');