paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-11 04:01:37 +02:00
Code Issues Packages Projects Releases Wiki Activity

* also perform C varargs type conversions for cdecl procedures declared

Browse Source 
as "varargs" instead of using an array of const parameter

git-svn-id: trunk@4572 -
This commit is contained in:
Jonas Maebe 2006-09-08 16:04:15 +00:00
parent 27df719ac3
commit 733f559267
5 changed files with 78 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/ncal.pas
View File

@ -568,6 +568,7 @@ type
{ the necessary conversions have already been performed in }
{ tarrayconstructornode.insert_typeconvs }
set_varstate(left,vs_read,[vsf_must_be_valid]);
insert_varargstypeconv(left,true);
resulttype:=left.resulttype;
{ also update parasym type to get the correct parameter location
for the new types }
@ -1057,7 +1058,6 @@ type
include(callnodeflags,cnf_uses_varargs);
{ Get arrayconstructor node and insert typeconvs }
hp:=tarrayconstructornode(oldleft.left);
hp.insert_typeconvs(true);
{ Add c args parameters }
{ It could be an empty set }
if assigned(hp) and

70
compiler/ncnv.pas
View File

@ -204,6 +204,7 @@ interface
procedure inserttypeconv(var p:tnode;const t:ttype);
procedure inserttypeconv_internal(var p:tnode;const t:ttype);
procedure arrayconstructor_to_set(var p : tnode);
procedure insert_varargstypeconv(var p : tnode; iscvarargs: boolean);
implementation
@ -521,6 +522,75 @@ implementation
end;
procedure insert_varargstypeconv(var p : tnode; iscvarargs: boolean);
begin
if not(iscvarargs) and
(p.nodetype=stringconstn) then
p:=ctypeconvnode.create_internal(p,cansistringtype)
else
case p.resulttype.def.deftype of
enumdef :
p:=ctypeconvnode.create_internal(p,s32inttype);
arraydef :
begin
if is_chararray(p.resulttype.def) then
p:=ctypeconvnode.create_internal(p,charpointertype)
else
if is_widechararray(p.resulttype.def) then
p:=ctypeconvnode.create_internal(p,widecharpointertype)
else
CGMessagePos1(p.fileinfo,type_e_wrong_type_in_array_constructor,p.resulttype.def.typename);
end;
orddef :
begin
if is_integer(p.resulttype.def) and
not(is_64bitint(p.resulttype.def)) then
p:=ctypeconvnode.create(p,s32inttype)
else if is_void(p.resulttype.def) then
CGMessagePos1(p.fileinfo,type_e_wrong_type_in_array_constructor,p.resulttype.def.typename)
else if iscvarargs and
is_currency(p.resulttype.def) then
p:=ctypeconvnode.create(p,s64floattype);
end;
floatdef :
if not(iscvarargs) then
begin
if not(is_currency(p.resulttype.def)) then
p:=ctypeconvnode.create(p,pbestrealtype^);
end
else
begin
if is_constrealnode(p) and
not(nf_explicit in p.flags) then
MessagePos(p.fileinfo,type_w_double_c_varargs);
if (tfloatdef(p.resulttype.def).typ in [{$ifndef x86_64}s32real,{$endif}s64currency]) or
(is_constrealnode(p) and
not(nf_explicit in p.flags)) then
p:=ctypeconvnode.create(p,s64floattype);
end;
procvardef :
p:=ctypeconvnode.create(p,voidpointertype);
stringdef:
if iscvarargs then
p:=ctypeconvnode.create(p,charpointertype);
variantdef:
if iscvarargs then
CGMessagePos1(p.fileinfo,type_e_wrong_type_in_array_constructor,p.resulttype.def.typename);
pointerdef:
;
classrefdef:
if iscvarargs then
p:=ctypeconvnode.create(p,voidpointertype);
objectdef :
if iscvarargs or
is_object(p.resulttype.def) then
CGMessagePos1(p.fileinfo,type_e_wrong_type_in_array_constructor,p.resulttype.def.typename);
else
CGMessagePos1(p.fileinfo,type_e_wrong_type_in_array_constructor,p.resulttype.def.typename);
end;
resulttypepass(p);
end;
{*****************************************************************************
TTYPECONVNODE
*****************************************************************************}

81
compiler/nld.pas
View File

@ -88,7 +88,7 @@ interface
function det_resulttype:tnode;override;
function docompare(p: tnode): boolean; override;
procedure force_type(tt:ttype);
procedure insert_typeconvs(iscvarargs: boolean);
procedure insert_typeconvs;
end;
tarrayconstructornodeclass = class of tarrayconstructornode;
@ -940,14 +940,12 @@ implementation
end;
procedure tarrayconstructornode.insert_typeconvs(iscvarargs: boolean);
procedure tarrayconstructornode.insert_typeconvs;
var
hp : tarrayconstructornode;
dovariant : boolean;
begin
if (iscvarargs) then
include(flags,nf_cvarargs);
dovariant:=(nf_forcevaria in flags) or (ado_isvariant in tarraydef(resulttype.def).arrayoptions) or iscvarargs;
dovariant:=(nf_forcevaria in flags) or (ado_isvariant in tarraydef(resulttype.def).arrayoptions);
{ only pass left tree, right tree contains next construct if any }
if assigned(left) then
begin
@ -957,73 +955,8 @@ implementation
resulttypepass(hp.left);
{ Insert typeconvs for array of const }
if dovariant then
begin
if not(iscvarargs) and
(hp.left.nodetype=stringconstn) then
hp.left:=ctypeconvnode.create_internal(hp.left,cansistringtype)
else
case hp.left.resulttype.def.deftype of
enumdef :
hp.left:=ctypeconvnode.create_internal(hp.left,s32inttype);
arraydef :
begin
if is_chararray(hp.left.resulttype.def) then
hp.left:=ctypeconvnode.create_internal(hp.left,charpointertype)
else
if is_widechararray(hp.left.resulttype.def) then
hp.left:=ctypeconvnode.create_internal(hp.left,widecharpointertype)
else
CGMessagePos1(hp.left.fileinfo,type_e_wrong_type_in_array_constructor,hp.left.resulttype.def.typename);
end;
orddef :
begin
if is_integer(hp.left.resulttype.def) and
not(is_64bitint(hp.left.resulttype.def)) then
hp.left:=ctypeconvnode.create(hp.left,s32inttype)
else if is_void(hp.left.resulttype.def) then
CGMessagePos1(hp.left.fileinfo,type_e_wrong_type_in_array_constructor,hp.left.resulttype.def.typename)
else if iscvarargs and
is_currency(hp.left.resulttype.def) then
hp.left:=ctypeconvnode.create(hp.left,s64floattype);
end;
floatdef :
if not(iscvarargs) then
begin
if not(is_currency(hp.left.resulttype.def)) then
hp.left:=ctypeconvnode.create(hp.left,pbestrealtype^);
end
else
begin
if is_constrealnode(hp.left) and
not(nf_explicit in hp.left.flags) then
MessagePos(hp.left.fileinfo,type_w_double_c_varargs);
if (tfloatdef(hp.left.resulttype.def).typ in [{$ifndef x86_64}s32real,{$endif}s64currency]) or
(is_constrealnode(hp.left) and
not(nf_explicit in hp.left.flags)) then
hp.left:=ctypeconvnode.create(hp.left,s64floattype);
end;
procvardef :
hp.left:=ctypeconvnode.create(hp.left,voidpointertype);
stringdef:
if iscvarargs then
hp.left:=ctypeconvnode.create(hp.left,charpointertype);
variantdef:
if iscvarargs then
CGMessagePos1(hp.left.fileinfo,type_e_wrong_type_in_array_constructor,hp.left.resulttype.def.typename);
pointerdef:
;
classrefdef:
if iscvarargs then
hp.left:=ctypeconvnode.create(hp.left,voidpointertype);
objectdef :
if iscvarargs or
is_object(hp.left.resulttype.def) then
CGMessagePos1(hp.left.fileinfo,type_e_wrong_type_in_array_constructor,hp.left.resulttype.def.typename);
else
CGMessagePos1(hp.left.fileinfo,type_e_wrong_type_in_array_constructor,hp.left.resulttype.def.typename);
end;
end;
resulttypepass(hp.left);
{ at this time C varargs are no longer an arrayconstructornode }
insert_varargstypeconv(hp.left,false);
hp:=tarrayconstructornode(hp.right);
end;
end;
@ -1042,9 +975,7 @@ implementation
resulttypepassed already }
if assigned(left) then
begin
{ in case of C varargs, insert_typeconvs has already been called }
if not(nf_cvarargs in flags) then
insert_typeconvs(false);
insert_typeconvs;
{ call firstpass for all nodes }
hp:=self;
while assigned(hp) do

1
compiler/node.pas
View File

@ -229,7 +229,6 @@ interface
{ tarrayconstructnode }
nf_forcevaria,
nf_novariaallowed,
nf_cvarargs,
{ ttypeconvnode, and the first one also treal/ord/pointerconstn }
nf_explicit,

2
compiler/ppu.pas
View File

@ -43,7 +43,7 @@ type
{$endif Test_Double_checksum}
const
CurrentPPUVersion=62;
CurrentPPUVersion=63;
{ buffer sizes }
maxentrysize = 1024;