I can now successfully pass doubles to/from C functions on armhf. I've
written a test program that passes lots of different combinations of
single/double/longint/int64 to C code and all combinations that do not
involve singles are working.
It would also be helpful to add this test to the testsuite
we do have some tests in test/cg
but it wouldn't hurt to add more of that type!
I've attatched the program that generates the test program, if you need
it under a
specific license just ask.
Currently it is set up to test all combinations of up to four parameters
and a more
limited set of combinations up to 17 parameters but these are both
easilly adjusted
to suit.
The generator has two modes, if the letter c is passed as the first
command line
parameter it operates in "pascal calling c" mode. Otherwise it operates in
"pascal calling pascal mode".
In "pascal calling c" mode two files are generated. testfp.dpr and
testfpfunctions.c
in "pascal calling pascal" mode only one file is generated.
Note that "pascal calling c" mode makes some assumptions about the
equivilence
of pascal and c basic types. These assumptions should hold on most platforms
but there may be some where they do not.
program gentestfp;
uses
sysutils,classes;
type
ttype = (sin,dou,int,i64);
const
typenames: array[ttype] of string = ('single','double','longint','int64');
ctypenames: array[ttype] of string = ('float','double','int','long long');
printfspecifiers: array[ttype] of string = ('%f','%f','%ld','%lld');
var
paramcount : longint;
param: longint;
paramcombination: longint;
paramcombinationinner: longint;
returntype : ttype;
paramtype : ttype;
t: text;
c: text;
paramtypes : array[1..17] of ttype;
mainparamtype, lastparamtype : ttype;
calls: tstringlist;
callsofcalls : tstringlist;
cmode : boolean;
procedure genfunction;
var
definitionstring : string;
callstring: string;
cstring: string;
functionname : string;
begin
//generate function name
functionname := 'z';
for param := 1 to paramcount do begin
functionname := functionname + typenames[paramtypes[param]][1];
end;
functionname := functionname + typenames[returntype][1];
definitionstring := 'function ' + functionname;
if paramcount > 0 then begin
definitionstring := definitionstring + '(';
for param := 1 to paramcount do begin
definitionstring := definitionstring +char(param-1+byte('a')) + ':' +
typenames[paramtypes[param]];
definitionstring := definitionstring + ';';
end;
definitionstring[length(definitionstring)] := ')';
end;
definitionstring := definitionstring + ':'+typenames[returntype]+';';
if cmode then begin
definitionstring := definitionstring+'cdecl;external;';
cstring := ctypenames[returntype] + ' ' + functionname;
if paramcount > 0 then begin
cstring := cstring + '(';
for param := 1 to paramcount do begin
cstring := cstring + ctypenames[paramtypes[param]] +' '
+char(param-1+byte('a'));
cstring := cstring + ',';
end;
cstring[length(cstring)] := ')';
end else begin
cstring := cstring + '(void)';
end;
cstring := cstring +'{ ';
if paramcount = 0 then begin
cstring := cstring + 'return 0x12beef;';
end else begin
cstring := cstring +'printf("';
for param := 1 to paramcount do begin
cstring := cstring + printfspecifiers[paramtypes[param]] + ' ';
end;
cstring[length(cstring)] := '\';
cstring := cstring + 'n"';
for param := 1 to paramcount do begin
cstring := cstring + ',' + char(param-1+byte('a'));
end;
cstring := cstring + ');';
cstring := cstring + 'fflush(stdout);';
cstring := cstring + 'return ';
for param := 1 to paramcount do begin
cstring := cstring + char(param-1+byte('a')) + '+';
end;
cstring[length(cstring)] := ';';
end;
cstring := cstring + '}';
writeln(c,cstring);
end else begin
definitionstring := definitionstring +'begin ';
if paramcount = 0 then begin
definitionstring := definitionstring + 'result := $12beef;';
end else begin
definitionstring := definitionstring +'writeln(';
for param := 1 to paramcount do begin
definitionstring := definitionstring + char(param-1+byte('a')) + ',''
'',';
end;
setlength(definitionstring,length(definitionstring)-5);
definitionstring := definitionstring + ');';
definitionstring := definitionstring + 'result := trunc(';
for param := 1 to paramcount do begin
definitionstring := definitionstring + char(param-1+byte('a')) + '+';
end;
definitionstring[length(definitionstring)] := ')';
definitionstring := definitionstring + ';';
end;
definitionstring := definitionstring + ' end;';
end;
writeln(t,definitionstring);
callstring := 'if '+functionname;
callstring := 'd := '+functionname;
if paramcount > 0 then begin
callstring := callstring + '(';
for param := 1 to paramcount do begin
callstring := callstring +inttostr(param);
callstring := callstring + ',';
end;
callstring[length(callstring)] := ')';
end else begin
callstring := callstring + '()';
end;
callstring := callstring + ';';
calls.add(callstring);
if paramcount > 0 then begin
callstring := 'if d='+ inttostr((paramcount+1)*paramcount div 2);
end else begin
callstring := 'if d=$12beef';
end;
callstring := callstring + ' then writeln('''+functionname+' pass'') else
begin writeln('''+functionname+' fail d='',d) ; {halt} end;';
calls.add(callstring);
calls.add('flush(output);');
end;
var
i : integer;
begin
cmode := paramstr(1)='c';
calls := tstringlist.create;
assignfile(t,'testfp.dpr');
rewrite(t);
if cmode then begin
assignfile(c,'testfpfunctions.c');
rewrite(c);
writeln(c,'#include <stdio.h>');
end;
writeln(t,'program testfp;');
if cmode then writeln(t,'{$linklib gcc}');
if cmode then writeln(t,'{$linklib c}');
if cmode then writeln(t,'{$link testfpfunctions}');
//test all combinations up to four parameters.
for paramcount := 0 to 4 do begin
for returntype := sin to i64 do begin
for paramcombination := 0 to (1 shl (paramcount*2))-1 do begin
paramcombinationinner := paramcombination;
for param := 1 to paramcount do begin
paramtypes[param] := ttype(paramcombinationinner and 3);
paramcombinationinner := paramcombinationinner shr 2;
end;
genfunction;
//writeln(typenames[returntype]);
end;
end;
end;
//test up to 17 parameters with one type for the bulk of parameters and
another for the last parameters
for paramcount := 5 to 17 do begin
for returntype := sin to i64 do begin
for mainparamtype := sin to i64 do begin
for lastparamtype := sin to i64 do begin
for param := 1 to paramcount-1 do begin
paramtypes[param] := mainparamtype;
end;
paramtypes[paramcount] := lastparamtype;
genfunction;
end;
end;
end;
end;
//individually test "zssssssssssssssssd"
{paramcount := 16;
returntype := dou;
for param := 1 to 16 do begin
paramtypes[param] := sin;
end;
//paramtypes[15] := dou;
genfunction;}
writeln(t,'var d: double;');
//group calls into procedures with 256 calls each to avoid "procedure too
complex" error.
callsofcalls := tstringlist.create;
for i := 0 to calls.count - 1 do begin
if i and $ff = 0 then begin
if i <> 0 then writeln(t,'end;');
writeln(t,'procedure g'+inttostr(i shr 8)+'; begin');
callsofcalls.add('g'+inttostr(i shr 8)+';');
end;
writeln(t,calls[i]);
end;
writeln(t,'end;');
calls.free;
writeln(t,'begin');
for i := 0 to callsofcalls.count - 1 do begin
writeln(t,callsofcalls[i]);
end;
writeln(t,'end.');
close(t);
if cmode then begin
close(c);
end;
callsofcalls.free;
end._______________________________________________
fpc-devel maillist - fpc-devel@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-devel
