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.