+ AfterConstruction and BeforeDestruction implemented

+ TInterfacedObject implemented

rtl/i386/i386.inc

@@ -1117,11 +1117,56 @@ end;
 {$ifdef SYSTEMDEBUG}
 end;
 {$endif def SYSTEMDEBUG}
+{$ifdef HASINTF}
+{ do a thread save inc/dec }
 
+procedure declocked(var l : longint);assembler;
+
+  asm
+{$ifdef MTRTL}
+     { this check should be done because a lock takes a lot }
+     { of time!                                             }
+     cmpb       $0,IsMultithreaded
+     jz         .Ldeclockednolock
+     movl       l,%edi
+     lock
+     decl       (%edi)
+     jmp        .Ldeclockedend
+.Ldeclockednolock:
+{$endif MTRTL}
+     movl       l,%edi
+     decl       (%edi);
+.Ldeclockedend:
+  end ['EDI'];
+
+procedure inclocked(var l : longint);assembler;
+
+  asm
+{$ifdef MTRTL}
+     { this check should be done because a lock takes a lot }
+     { of time!                                             }
+     cmpb       $0,IsMultithreaded
+     jz         .Linclockednolock
+     movl       l,%edi
+     lock
+     incl       (%edi)
+     jmp        .Linclockedend
+.Linclockednolock:
+{$endif MTRTL}
+     movl       l,%edi
+     incl       (%edi);
+.Linclockedend:
+  end ['EDI'];
+
+{$endif HASINTF}
 
 {
   $Log$
-  Revision 1.3  2000-07-14 10:33:09  michael
+  Revision 1.4  2000-11-07 23:42:21  florian
+    + AfterConstruction and BeforeDestruction implemented
+    + TInterfacedObject implemented
+
+  Revision 1.3  2000/07/14 10:33:09  michael
   + Conditionals fixed
 
   Revision 1.2  2000/07/13 11:33:41  michael

rtl/inc/dynarr.inc

@@ -132,10 +132,13 @@ function dynarray_copy(var p : pointer;ti : pdynarraytypeinfo;
 
 {
   $Log$
-  Revision 1.2  2000-11-06 21:35:59  peter
+  Revision 1.3  2000-11-07 23:42:21  florian
+    + AfterConstruction and BeforeDestruction implemented
+    + TInterfacedObject implemented
+
+  Revision 1.2  2000/11/06 21:35:59  peter
     * removed some warnings
 
   Revision 1.1  2000/11/04 17:52:46  florian
     * fixed linker errors
-
 }

rtl/inc/objpas.inc

@@ -595,6 +595,58 @@ Procedure Finalize (Data,TypeInfo: Pointer);forward;
         begin
           getinterfacetable:=pinterfacetable((pointer(Self)+vmtIntfTable)^);
         end;
+{****************************************************************************
+                               TINTERFACEDOBJECT
+****************************************************************************}
+
+    function TInterfacedObject.QueryInterface(
+      const iid : tguid;out obj) : longint;stdcall;
+
+      begin
+         if getinterface(iid,obj) then
+           result:=0
+         else
+           result:=$80004002;
+      end;
+
+    function TInterfacedObject._AddRef : longint;stdcall;
+
+      begin
+         inclocked(frefcount);
+         _addref:=frefcount;
+      end;
+
+    function TInterfacedObject._Release : longint;stdcall;
+
+      begin
+         declocked(frefcount);
+         _release:=frefcount;
+         if frefcount=0 then
+           destroy;
+      end;
+
+    procedure TInterfacedObject.AfterConstruction;
+
+      begin
+         { we need to fix the refcount we forced in newinstance }
+         { further, it must be done in a thread safe way        }
+         declocked(frefcount);
+      end;
+
+    procedure TInterfacedObject.BeforeDestruction;
+
+      begin
+         if frefcount<>0 then
+           HandleError(204);
+      end;
+
+    class function TInterfacedObject.NewInstance : TObject;
+
+      begin
+         NewInstance:=inherited NewInstance;
+         TInterfacedObject(NewInstance).frefcount:=1;
+      end;
+
 {$endif HASINTF}
 
 {****************************************************************************
@@ -609,7 +661,11 @@ Procedure Finalize (Data,TypeInfo: Pointer);forward;
 
 {
   $Log$
-  Revision 1.9  2000-11-06 22:03:12  florian
+  Revision 1.10  2000-11-07 23:42:21  florian
+    + AfterConstruction and BeforeDestruction implemented
+    + TInterfacedObject implemented
+
+  Revision 1.9  2000/11/06 22:03:12  florian
     * another fix
 
   Revision 1.8  2000/11/06 21:53:38  florian

rtl/inc/objpash.inc

@@ -151,23 +151,38 @@
 {$ifdef HASINTF}
        IUnknown = interface
          ['{00000000-0000-0000-C000-000000000046}']
-         function QueryInterface(const iid: tguid; out obj): LongInt; stdcall;
+         function QueryInterface(const iid : tguid;out obj) : longint;stdcall;
-         function _AddRef: LongInt; stdcall;
+         function _AddRef : longint;stdcall;
-         function _Release: LongInt; stdcall;
+         function _Release : longint;stdcall;
        end;
 
        { for native dispinterface support }
        IDispatch = interface(IUnknown)
-         ['{00020400-0000-0000-C000-000000000046}']
+          ['{00020400-0000-0000-C000-000000000046}']
-         function GetTypeInfoCount(out count: LongInt): LongInt; stdcall;
+          function GetTypeInfoCount(out count : longint) : longint;stdcall;
-         function GetTypeInfo(Index, LocaleID: LongInt;
+          function GetTypeInfo(Index,LocaleID : longint;
-           out TypeInfo): LongInt; stdcall;
+            out TypeInfo): LongInt;stdcall;
-         function GetIDsOfNames(const iid: TGUID; names: Pointer;
+          function GetIDsOfNames(const iid: TGUID; names: Pointer;
-           NameCount, LocaleID: LongInt; DispIDs: Pointer): LongInt; stdcall;
+            NameCount, LocaleID: LongInt; DispIDs: Pointer) : longint;stdcall;
-         function Invoke(DispID: LongInt; const iid: TGUID;
+          function Invoke(DispID: LongInt;const iid : TGUID;
-           LocaleID: LongInt; Flags: Word; var params;
+            LocaleID : longint; Flags: Word;var params;
-           VarResult, ExcepInfo, ArgErr: Pointer): Integer; stdcall;
+            VarResult,ExcepInfo,ArgErr : pointer) : longint;stdcall;
        end;
+
+       TInterfacedObject = class(TObject,IUnknown)
+       protected
+          frefcount : longint;
+          { implement methods of IUnknown }
+          function QueryInterface(const iid : tguid;out obj) : longint;stdcall;
+          function _AddRef : longint;stdcall;
+          function _Release : longint;stdcall;
+        public
+          procedure AfterConstruction;override;
+          procedure BeforeDestruction;override;
+          class function NewInstance : TObject;override;
+          property RefCount : longint read frefcount;
+       end;
+
 {$endif HASINTF}
 
        TExceptProc = Procedure (Obj : TObject; Addr,Frame: Pointer);
@@ -258,7 +273,11 @@
        end;
 {
   $Log$
-  Revision 1.7  2000-11-06 20:34:24  peter
+  Revision 1.8  2000-11-07 23:42:21  florian
+    + AfterConstruction and BeforeDestruction implemented
+    + TInterfacedObject implemented
+
+  Revision 1.7  2000/11/06 20:34:24  peter
     * changed ver1_0 defines to temporary defs
 
   Revision 1.6  2000/11/04 17:31:50  florian