paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 20:29:23 +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_decr_ref(var i: pointer); compilerproc;
procedure fpc_intf_incr_ref(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_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; Function fpc_PushExceptAddr (Ft: Longint;_buf,_newaddr : pointer): PJmp_buf ; compilerproc;
Procedure fpc_PushExceptObj (Obj : TObject; AnAddr,AFrame : Pointer); compilerproc; Procedure fpc_PushExceptObj (Obj : TObject; AnAddr,AFrame : Pointer); compilerproc;
@ -261,7 +262,10 @@ function fpc_qword_to_double(q: qword): double; compilerproc;
{ {
$Log$ $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 * fixed conversion from int64/qword to double errors
Revision 1.17 2002/07/28 20:43:47 florian Revision 1.17 2002/07/28 20:43:47 florian

23
rtl/inc/objpas.inc
View File

@ -88,7 +88,7 @@
D:=S; D:=S;
end; 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 const
S_OK = 0; S_OK = 0;
var var
@ -98,14 +98,14 @@
begin begin
if IUnknown(S).QueryInterface(iid,tmpi)<>S_OK then if IUnknown(S).QueryInterface(iid,tmpi)<>S_OK then
handleerror(219); handleerror(219);
if assigned(D) then IUnknown(D)._Release; fpc_intf_as:=tmpi;
D:=tmpi;
end end
else else
intf_decr_ref(D); fpc_intf_as:=nil;
end; 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 const
S_OK = 0; S_OK = 0;
var var
@ -113,14 +113,12 @@
begin begin
if assigned(S) then if assigned(S) then
begin begin
if TObject(S).GetInterface(iid,tmpi) then if not TObject(S).GetInterface(iid,tmpi) then
handleerror(219); handleerror(219);
if assigned(D) then fpc_class_as_intf:=tmpi;
IUnknown(D)._Release;
D:=tmpi;
end end
else else
intf_decr_ref(D); fpc_class_as_intf:=nil;
end; end;
{$endif HASINTF} {$endif HASINTF}
@ -715,7 +713,10 @@
{ {
$Log$ $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 * interface helpers for 1.1 compilers without interface support fixed
Revision 1.22 2002/07/01 16:29:05 peter Revision 1.22 2002/07/01 16:29:05 peter