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

* convert extended to double when passing it to automation dispatchers

Browse Source 
* fix code generation for automation dispatching of doubles

git-svn-id: trunk@7184 -
This commit is contained in:
florian 2007-04-28 19:35:51 +00:00
parent f3660976bc
commit 0d9609d614
1 changed files with 24 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
compiler/ncal.pas
View File

@ -245,6 +245,7 @@ implementation
currargpos,
namedparacount,
paracount : longint;
assignmenttype,
vardatadef,
pvardatadef : tdef;
dispatchbyref : boolean;
@ -318,6 +319,12 @@ implementation
begin
para.value:=ctypeconvnode.create_internal(para.value,bool16type);
typecheckpass(para.value);
end
{ force automatable float type }
else if is_extended(para.value.resultdef) then
begin
para.value:=ctypeconvnode.create_internal(para.value,s64floattype);
typecheckpass(para.value);
end;
if assigned(para.parametername) then
@ -375,12 +382,22 @@ implementation
)),voidpointertype),
ctypeconvnode.create_internal(caddrnode.create_internal(para.value),voidpointertype)))
else
addstatement(statements,cassignmentnode.create(
ctypeconvnode.create_internal(cderefnode.create(caddnode.create(addn,
caddrnode.create(ctemprefnode.create(params)),
cordconstnode.create(paramssize,ptruinttype,false)
)),voidpointertype),
ctypeconvnode.create_internal(para.value,voidpointertype)));
begin
case para.value.resultdef.size of
1..4:
assignmenttype:=u32inttype;
8:
assignmenttype:=u64inttype;
else
internalerror(2007042801);
end;
addstatement(statements,cassignmentnode.create(
ctypeconvnode.create_internal(cderefnode.create(caddnode.create(addn,
caddrnode.create(ctemprefnode.create(params)),
cordconstnode.create(paramssize,ptruinttype,false)
)),assignmenttype),
ctypeconvnode.create_internal(para.value,assignmenttype)));
end;
if is_ansistring(para.value.resultdef) then
calldesc.argtypes[currargpos]:=varStrArg
@ -2674,7 +2691,7 @@ implementation
if not(assigned(hp)) or
(hp.left.nodetype <> tempdeleten) then
exit;
{ the function result once more }
hp:=tstatementnode(hp.right);
if not(assigned(hp)) or