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

* interface "as" helpers converted from procedures to functions

Browse Source
This commit is contained in:
Jonas Maebe 2002-08-20 18:24:05 +00:00
parent ed08ed1ce0
commit 58fc64dc09
2 changed files with 18 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
rtl/inc/compproc.inc
View File

@ -178,7 +178,8 @@ function fpc_do_as(aclass : tclass;aobject : tobject): tobject; compilerproc;
procedure fpc_intf_decr_ref(var i: pointer); compilerproc;
procedure fpc_intf_incr_ref(i: pointer); compilerproc;
procedure fpc_intf_assign(var D: pointer; const S: pointer); compilerproc;
procedure fpc_intf_as(var D: pointer; const S: pointer; const iid: TGUID); compilerproc;
function fpc_intf_as(const S: pointer; const iid: TGUID): pointer; compilerproc;
function fpc_class_as_intf(const S: pointer; const iid: TGUID): pointer; compilerproc;
Function fpc_PushExceptAddr (Ft: Longint;_buf,_newaddr : pointer): PJmp_buf ; compilerproc;
Procedure fpc_PushExceptObj (Obj : TObject; AnAddr,AFrame : Pointer); compilerproc;
@ -261,7 +262,10 @@ function fpc_qword_to_double(q: qword): double; compilerproc;
{
$Log$
Revision 1.18 2002-07-31 16:58:12 jonas
Revision 1.19 2002-08-20 18:24:05 jonas
* interface "as" helpers converted from procedures to functions
Revision 1.18 2002/07/31 16:58:12 jonas
* fixed conversion from int64/qword to double errors
Revision 1.17 2002/07/28 20:43:47 florian

23
rtl/inc/objpas.inc
View File

@ -88,7 +88,7 @@
D:=S;
end;
procedure fpc_intf_as(var D: pointer; const S: pointer; const iid: TGUID);[public,alias: 'FPC_INTF_AS']; {$ifdef hascompilerproc} compilerproc; {$endif}
function fpc_intf_as(const S: pointer; const iid: TGUID): pointer;[public,alias: 'FPC_INTF_AS']; {$ifdef hascompilerproc} compilerproc; {$endif}
const
S_OK = 0;
var
@ -98,14 +98,14 @@
begin
if IUnknown(S).QueryInterface(iid,tmpi)<>S_OK then
handleerror(219);
if assigned(D) then IUnknown(D)._Release;
D:=tmpi;
fpc_intf_as:=tmpi;
end
else
intf_decr_ref(D);
fpc_intf_as:=nil;
end;
procedure fpc_class_as_intf(var D: pointer; const S: pointer; const iid: TGUID);[public,alias: 'FPC_CLASS_AS_INTF']; {$ifdef hascompilerproc} compilerproc; {$endif}
function fpc_class_as_intf(const S: pointer; const iid: TGUID): pointer;[public,alias: 'FPC_CLASS_AS_INTF']; {$ifdef hascompilerproc} compilerproc; {$endif}
const
S_OK = 0;
var
@ -113,14 +113,12 @@
begin
if assigned(S) then
begin
if TObject(S).GetInterface(iid,tmpi) then
if not TObject(S).GetInterface(iid,tmpi) then
handleerror(219);
if assigned(D) then
IUnknown(D)._Release;
D:=tmpi;
fpc_class_as_intf:=tmpi;
end
else
intf_decr_ref(D);
fpc_class_as_intf:=nil;
end;
{$endif HASINTF}
@ -715,7 +713,10 @@
{
$Log$
Revision 1.23 2002-07-30 17:29:19 florian
Revision 1.24 2002-08-20 18:24:06 jonas
* interface "as" helpers converted from procedures to functions
Revision 1.23 2002/07/30 17:29:19 florian
* interface helpers for 1.1 compilers without interface support fixed
Revision 1.22 2002/07/01 16:29:05 peter