* classes moved to rtl for 1.1

  * classes .inc and classes.pp files moved to fcl/classes for
    backwards 1.0.x compatiblity to have it in the fcl

fcl/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 1.1 [2003/10/04]
+# Don't edit, this file is generated by FPCMake Version 1.1 [2003/10/05]
 #
 default: all
 MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos darwin emx watcom
@@ -205,8 +205,11 @@ endif
 PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
 override PACKAGE_NAME=fcl
 override PACKAGE_VERSION=1.0.6
+ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
+CLASSES10=classes
+endif
 override TARGET_DIRS+=xml image db shedit passrc net
-override TARGET_UNITS+=classes contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls xmlreg registry eventlog custapp cgiapp wformat whtml wtex
+override TARGET_UNITS+=$(CLASSES10) contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls xmlreg registry eventlog custapp cgiapp wformat whtml wtex
 ifeq ($(OS_TARGET),linux)
 override TARGET_UNITS+=process resolve ssockets fpasync syncobjs
 endif
@@ -225,7 +228,7 @@ endif
 ifeq ($(OS_TARGET),openbsd)
 override TARGET_UNITS+=process ssockets resolve fpasync
 endif
-override TARGET_RSTS+=classes ssockets cachecls resolve custapp cgiapp eventlog registry
+override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry
 override TARGET_EXAMPLEDIRS+=tests
 override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil
 override INSTALL_FPCPACKAGE=y
@@ -2180,4 +2183,8 @@ makefiles: fpc_makefiles
 ifneq ($(wildcard fpcmake.loc),)
 include fpcmake.loc
 endif
+ifdef CLASSES10
+classes$(PPUEXT):
+	$(COMPILER) -Ficlasses -Ficlasses/$(OS_TARGET) classes/$(OS_TARGET)/classes.pp
+endif
 xmlreg.pp: xml

fcl/Makefile.fpc

@@ -20,7 +20,7 @@ units=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszl
 
 [target]
 dirs=xml image db shedit passrc net 
-units=classes contnrs inifiles ezcgi pipes rtfpars idea base64 gettext \
+units=$(CLASSES10) contnrs inifiles ezcgi pipes rtfpars idea base64 gettext \
       iostream zstream cachecls xmlreg registry eventlog custapp cgiapp \
       wformat whtml wtex
 units_freebsd=process ssockets resolve fpasync
@@ -29,7 +29,7 @@ units_openbsd=process ssockets resolve fpasync
 units_linux=process resolve ssockets fpasync syncobjs
 units_win32=process fileinfo resolve ssockets syncobjs
 units_netware=resolve ssockets
-rsts=classes ssockets cachecls resolve custapp cgiapp eventlog registry
+rsts=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry
 exampledirs=tests
 
 [compiler]
@@ -54,5 +54,16 @@ fpcpackage=y
 [default]
 fpcdir=..
 
+[prerules]
+# Also build classes for 1.0.x 
+ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
+CLASSES10=classes
+endif
+
 [rules]
-xmlreg.pp: xml
+ifdef CLASSES10
+classes$(PPUEXT):
+	$(COMPILER) -Ficlasses -Ficlasses/$(OS_TARGET) classes/$(OS_TARGET)/classes.pp
+endif
+
+xmlreg.pp: xml

fcl/inc/action.inc → fcl/classes/action.inc

@@ -187,7 +187,12 @@ end;
 
 {
   $Log$
-  Revision 1.1  2002-01-06 21:54:49  peter
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.1  2002/01/06 21:54:49  peter
     * action classes added
 
 }

fcl/inc/bits.inc → fcl/classes/bits.inc

@@ -24,9 +24,9 @@ Procedure BitsError (Msg : string);
 
 begin
 {$ifdef VER1_0}
-  Raise EBitsError.Create(Msg) at get_caller_addr(get_frame);
+  Raise EBitsError.Create(Msg) at longint(get_caller_addr(get_frame));
 {$else VER1_0}
-  Raise EBitsError.Create(Msg) at pointer(get_caller_addr(get_frame));
+  Raise EBitsError.Create(Msg) at get_caller_addr(get_frame);
 {$endif VER1_0}
 end;
 
@@ -34,9 +34,9 @@ Procedure BitsErrorFmt (Msg : string; const Args : array of const);
 
 begin
 {$ifdef VER1_0}
-  Raise EBitsError.CreateFmt(Msg,args) at get_caller_addr(get_frame);
+  Raise EBitsError.CreateFmt(Msg,args) at longint(get_caller_addr(get_frame));
 {$else VER1_0}
-  Raise EBitsError.CreateFmt(Msg,args) at pointer(get_caller_addr(get_frame));
+  Raise EBitsError.CreateFmt(Msg,args) at get_caller_addr(get_frame);
 {$endif VER1_0}
 end;
 
@@ -380,7 +380,12 @@ end;
 
 {
   $Log$
-  Revision 1.9  2003-05-25 16:05:18  jonas
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.9  2003/05/25 16:05:18  jonas
     * made Args parameter of BitsErrorFmt a const one
 
   Revision 1.8  2002/09/07 15:15:24  peter

fcl/inc/classes.inc → fcl/classes/classes.inc

@@ -60,9 +60,6 @@ var
 { TStrings and TStringList implementations }
 {$i stringl.inc}
 
-{ TThread implementation }
-{$i thread.inc}
-
 { TPersistent implementation }
 {$i persist.inc }
 
@@ -1212,7 +1209,12 @@ end;
 
 {
   $Log$
-  Revision 1.14  2003-06-04 17:40:44  michael
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.14  2003/06/04 17:40:44  michael
   + Minor fix by Mattias Gaertner
 
   Revision 1.13  2003/06/04 15:27:24  michael

fcl/inc/classesh.inc → fcl/classes/classesh.inc

@@ -1081,59 +1081,6 @@ type
     property Token: Char read FToken;
   end;
 
-{ TThread }
-
-  EThread = class(Exception);
-
-  TThreadMethod = procedure of object;
-  TThreadPriority = (tpIdle, tpLowest, tpLower, tpNormal, tpHigher, tpHighest,
-    tpTimeCritical);
-
-  TThread = class
-  private
-    FHandle: THandle;
-    FThreadID: THandle;
-    FTerminated: Boolean;
-    FSuspended: Boolean;
-    FFreeOnTerminate: Boolean;
-    FFinished: Boolean;
-    FReturnValue: Integer;
-    FOnTerminate: TNotifyEvent;
-    FMethod: TThreadMethod;
-    FSynchronizeException: TObject;
-    FFatalException: TObject;
-    procedure CallOnTerminate;
-    function GetPriority: TThreadPriority;
-    procedure SetPriority(Value: TThreadPriority);
-    procedure SetSuspended(Value: Boolean);
-  protected
-    procedure DoTerminate; virtual;
-    procedure Execute; virtual; abstract;
-    procedure Synchronize(Method: TThreadMethod);
-    property ReturnValue: Integer read FReturnValue write FReturnValue;
-    property Terminated: Boolean read FTerminated;
-  public
-{$ifdef Unix}
-    { Needed for linux }
-    FStackPointer : integer;
-    FStackSize    : integer;
-    FCallExitProcess : boolean;
-{$endif}
-    constructor Create(CreateSuspended: Boolean);
-    destructor Destroy; override;
-    procedure Resume;
-    procedure Suspend;
-    procedure Terminate;
-    function WaitFor: Integer;
-    property FreeOnTerminate: Boolean read FFreeOnTerminate write FFreeOnTerminate;
-    property Handle: THandle read FHandle;
-    property Priority: TThreadPriority read GetPriority write SetPriority;
-    property Suspended: Boolean read FSuspended write SetSuspended;
-    property ThreadID: THandle read FThreadID;
-    property OnTerminate: TNotifyEvent read FOnTerminate write FOnTerminate;
-    property FatalException: TObject read FFatalException;
-  end;
-
 { TComponent class }
 
   TOperation = (opInsert, opRemove);
@@ -1521,8 +1468,10 @@ function LineStart(Buffer, BufPos: PChar): PChar;
 
 {
   $Log$
-  Revision 1.26  2003-10-06 17:06:55  florian
-    * applied Johannes Berg's patch for exception handling in threads
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
 
   Revision 1.25  2003/08/16 15:50:47  michael
   + Fix from Mattias gaertner for IDE support

fcl/inc/collect.inc → fcl/classes/collect.inc

@@ -341,7 +341,12 @@ end;
 
 {
   $Log$
-  Revision 1.3  2002-09-07 15:15:24  peter
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.3  2002/09/07 15:15:24  peter
     * old logs removed and tabs fixed
 
 }

fcl/inc/compon.inc → fcl/classes/compon.inc

@@ -533,7 +533,12 @@ end;
 
 {
   $Log$
-  Revision 1.9  2003-04-27 21:16:11  sg
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.9  2003/04/27 21:16:11  sg
   * Fixed TComponent.ValidateRename
 
   Revision 1.8  2002/10/15 20:06:19  michael

fcl/inc/constse.inc → fcl/classes/constse.inc

@@ -276,7 +276,12 @@ const
 
 {
   $Log$
-  Revision 1.8  2003-06-04 17:37:52  michael
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.8  2003/06/04 17:37:52  michael
   en InitInheritedComponent erbij voor Delphi 6 compatibiliteit
 
   Revision 1.7  2002/09/07 15:15:24  peter

fcl/inc/constsg.inc → fcl/classes/constsg.inc

@@ -274,7 +274,12 @@ const
 
 {
   $Log$
-  Revision 1.4  2002-09-07 15:15:24  peter
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.4  2002/09/07 15:15:24  peter
     * old logs removed and tabs fixed
 
 }

fcl/inc/constss.inc → fcl/classes/constss.inc

@@ -273,7 +273,12 @@ const
 
 {
   $Log$
-  Revision 1.4  2002-09-07 15:15:24  peter
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.4  2002/09/07 15:15:24  peter
     * old logs removed and tabs fixed
 
 }

fcl/inc/cregist.inc → fcl/classes/cregist.inc

@@ -197,7 +197,12 @@ end;
 
 {
   $Log$
-  Revision 1.5  2003-04-19 14:29:25  michael
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.5  2003/04/19 14:29:25  michael
   + Fix from Mattias Gaertner, closes memory leak
 
   Revision 1.4  2002/09/07 15:15:24  peter

fcl/inc/felog.inc → fcl/classes/felog.inc

@@ -64,7 +64,12 @@ end;
 
 {
   $Log$
-  Revision 1.1  2003-02-19 20:25:16  michael
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.1  2003/02/19 20:25:16  michael
   + Added event log
 
 }

fcl/inc/filer.inc → fcl/classes/filer.inc

@@ -23,7 +23,12 @@ end;
 
 {
   $Log$
-  Revision 1.3  2002-09-07 15:15:24  peter
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.3  2002/09/07 15:15:24  peter
     * old logs removed and tabs fixed
 
 }

fcl/inc/filerec.inc → fcl/classes/filerec.inc

@@ -35,7 +35,12 @@ type
 
 {
   $Log$
-  Revision 1.3  2002-09-07 15:15:24  peter
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.3  2002/09/07 15:15:24  peter
     * old logs removed and tabs fixed
 
 }

fcl/freebsd/classes.pp → fcl/classes/freebsd/classes.pp

@@ -55,7 +55,12 @@ finalization
 end.
 {
   $Log$
-  Revision 1.6  2003-09-20 12:38:29  marco
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.6  2003/09/20 12:38:29  marco
    * FCL now compiles for FreeBSD with new 1.1. Now Linux.
 
   Revision 1.5  2002/09/07 15:15:24  peter

fcl/go32v2/classes.pp → fcl/classes/go32v2/classes.pp

@@ -43,7 +43,12 @@ finalization
 end.
 {
   $Log$
-  Revision 1.3  2002-09-07 15:15:24  peter
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.3  2002/09/07 15:15:24  peter
     * old logs removed and tabs fixed
 
 }

fcl/inc/intf.inc → fcl/classes/intf.inc

@@ -114,7 +114,12 @@
 
 {
   $Log$
-  Revision 1.2  2002-09-07 15:15:24  peter
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.2  2002/09/07 15:15:24  peter
     * old logs removed and tabs fixed
 
   Revision 1.1  2002/07/16 13:32:51  florian

fcl/linux/classes.pp → fcl/classes/linux/classes.pp

@@ -16,11 +16,6 @@
 
 {$mode objfpc}
 
-{ Require threading }
-{$ifndef ver1_0}
-  {$threading on}
-{$endif ver1_0}
-
 { determine the type of the resource/form file }
 {$define Win16Res}
 
@@ -54,13 +49,15 @@ initialization
 finalization
   CommonCleanup;
 
-  if ThreadsInited then
-     DoneThreads;
-
 end.
 {
   $Log$
-  Revision 1.7  2003-09-20 15:10:30  marco
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.7  2003/09/20 15:10:30  marco
    * small fixes. fcl now compiles
 
   Revision 1.6  2002/10/14 19:45:54  peter

fcl/inc/lists.inc → fcl/classes/lists.inc

@@ -165,9 +165,9 @@ class procedure TList.Error(const Msg: string; Data: Integer);
 
 begin
 {$ifdef VER1_0}
-  Raise EListError.CreateFmt(Msg,[Data]) at get_caller_addr(get_frame);
+  Raise EListError.CreateFmt(Msg,[Data]) at longint(get_caller_addr(get_frame));
 {$else VER1_0}
-  Raise EListError.CreateFmt(Msg,[Data]) at pointer(get_caller_addr(get_frame));
+  Raise EListError.CreateFmt(Msg,[Data]) at get_caller_addr(get_frame);
 {$endif VER1_0}
 end;
 
@@ -440,7 +440,12 @@ end;
 
 {
   $Log$
-  Revision 1.9  2002-09-07 15:15:24  peter
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.9  2002/09/07 15:15:24  peter
     * old logs removed and tabs fixed
 
   Revision 1.8  2002/08/16 10:04:58  michael

fcl/os2/classes.pp → fcl/classes/os2/classes.pp

@@ -47,7 +47,12 @@ finalization
 end.
 {
   $Log$
-  Revision 1.7  2003-09-02 19:49:16  hajny
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.7  2003/09/02 19:49:16  hajny
     * compilation fix (typinfo needed already in interface now)
 
   Revision 1.6  2002/09/07 15:15:27  peter

fcl/inc/parser.inc → fcl/classes/parser.inc

@@ -308,7 +308,12 @@ begin
 end;
 {
   $Log$
-  Revision 1.4  2002-09-07 15:15:24  peter
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.4  2002/09/07 15:15:24  peter
     * old logs removed and tabs fixed
 
 }

fcl/inc/persist.inc → fcl/classes/persist.inc

@@ -160,7 +160,12 @@ end;
 
 {
   $Log$
-  Revision 1.4  2002-09-07 15:15:25  peter
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.4  2002/09/07 15:15:25  peter
     * old logs removed and tabs fixed
 
 }

fcl/inc/reader.inc → fcl/classes/reader.inc

@@ -1305,7 +1305,12 @@ end;
 
 {
   $Log$
-  Revision 1.8  2003-08-16 15:50:47  michael
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.8  2003/08/16 15:50:47  michael
   + Fix from Mattias gaertner for IDE support
 
   Revision 1.7  2002/12/02 12:04:07  sg

fcl/inc/streams.inc → fcl/classes/streams.inc

@@ -783,7 +783,12 @@ end;
 
 {
   $Log$
-  Revision 1.13  2003-07-26 16:20:50  michael
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.13  2003/07/26 16:20:50  michael
   + Fixed readstring from TStringStream (
 
   Revision 1.12  2002/04/25 19:14:13  sg

fcl/inc/stringl.inc → fcl/classes/stringl.inc

@@ -250,9 +250,9 @@ Procedure TStrings.Error(const Msg: string; Data: Integer);
 
 begin
 {$ifdef VER1_0}
-  Raise EStringListError.CreateFmt(Msg,[Data]) at get_caller_addr(get_frame);
+  Raise EStringListError.CreateFmt(Msg,[Data]) at longint(get_caller_addr(get_frame));
 {$else VER1_0}
-  Raise EStringListError.CreateFmt(Msg,[Data]) at pointer(get_caller_addr(get_frame));
+  Raise EStringListError.CreateFmt(Msg,[Data]) at get_caller_addr(get_frame);
 {$endif VER1_0}
 end;
 
@@ -1044,7 +1044,12 @@ end;
 
 {
   $Log$
-  Revision 1.15  2003-05-29 23:13:57  michael
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.15  2003/05/29 23:13:57  michael
   fixed case insensitivity of TStrings.IndexOf
 
   Revision 1.14  2002/12/10 21:05:44  michael

fcl/inc/twriter.inc → fcl/classes/twriter.inc

@@ -215,7 +215,12 @@ end;*)
 
 {
   $Log$
-  Revision 1.3  2002-09-07 15:15:26  peter
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.3  2002/09/07 15:15:26  peter
     * old logs removed and tabs fixed
 
 }

fcl/inc/util.inc → fcl/classes/util.inc

@@ -26,7 +26,12 @@ end;
 
 {
   $Log$
-  Revision 1.3  2002-09-07 15:15:26  peter
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.3  2002/09/07 15:15:26  peter
     * old logs removed and tabs fixed
 
 }

fcl/win32/classes.pp → fcl/classes/win32/classes.pp

@@ -51,7 +51,12 @@ finalization
 end.
 {
   $Log$
-  Revision 1.4  2002-10-14 19:46:13  peter
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.4  2002/10/14 19:46:13  peter
     * threading switch
 
   Revision 1.3  2002/09/07 15:15:29  peter

fcl/inc/writer.inc → fcl/classes/writer.inc

@@ -832,7 +832,12 @@ end;}
 
 {
   $Log$
-  Revision 1.8  2003-08-16 15:50:47  michael
+  Revision 1.1  2003-10-06 20:33:58  peter
+    * classes moved to rtl for 1.1
+    * classes .inc and classes.pp files moved to fcl/classes for
+      backwards 1.0.x compatiblity to have it in the fcl
+
+  Revision 1.8  2003/08/16 15:50:47  michael
   + Fix from Mattias gaertner for IDE support
 
   Revision 1.7  2002/09/20 09:28:11  michael

fcl/freebsd/thread.inc

@@ -1,347 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by Peter Vreman
-
-    Linux TThread implementation
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-type
-  PThreadRec=^TThreadRec;
-  TThreadRec=record
-    thread : TThread;
-    next   : PThreadRec;
-  end;
-
-var
-  ThreadRoot : PThreadRec;
-  ThreadsInited : boolean;
-//  MainThreadID: longint;
-
-Const
-  ThreadCount: longint = 0;
-
-function ThreadSelf:TThread;
-var
-  hp : PThreadRec;
-  sp : longint;
-begin
-  sp:=SPtr;
-  hp:=ThreadRoot;
-  while assigned(hp) do
-   begin
-     if (sp<=hp^.Thread.FStackPointer) and
-        (sp>(hp^.Thread.FStackPointer-hp^.Thread.FStackSize)) then
-      begin
-        Result:=hp^.Thread;
-        exit;
-      end;
-     hp:=hp^.next;
-   end;
-  Result:=nil;
-end;
-
-
-//function SIGCHLDHandler(Sig: longint): longint; cdecl;//this is std linux C declaration as function
-procedure SIGCHLDHandler(Sig: longint); cdecl;
-begin
- {$ifdef ver1_0}
-  waitpid(-1, nil, WNOHANG);
- {$else}
-  fpwaitpid(-1, nil, WNOHANG);
- {$endif}
-end;
-
-const zeroset :sigset = (0,0,0,0);
-
-procedure InitThreads;
-var
-  Act, OldAct: PSigActionRec;
-begin
-  ThreadRoot:=nil;
-  ThreadsInited:=true;
-
-
-
-// This will install SIGCHLD signal handler
-// signal() installs "one-shot" handler,
-// so it is better to install and set up handler with sigaction()
-
-  GetMem(Act, SizeOf(SigActionRec));
-  GetMem(OldAct, SizeOf(SigActionRec));
-
-  {$ifndef ver1_0}
-    Act^.sa_handler := @SIGCHLDHandler;
-    fillchar(Act^.sa_mask,sizeof(sigset_t),#0);
-  {$else}
-    Act^.handler.sh := @SIGCHLDHandler;
-    Act^.sa_mask := zeroset; 
-  {$endif}
-  Act^.sa_flags := SA_NOCLDSTOP {or SA_NOMASK or SA_RESTART};
-			//Do not block all signals ??. Don't need if SA_NOMASK in flags
-
-  {$ifdef ver1_0}
-   SigAction(SIGCHLD, @Act, @OldAct);
-  {$else}
-   fpsigaction(SIGCHLD, @Act, @OldAct);
-  {$endif}
-
-  FreeMem(Act, SizeOf(SigActionRec));
-  FreeMem(OldAct, SizeOf(SigActionRec));
-end;
-
-
-procedure DoneThreads;
-var
-  hp : PThreadRec;
-begin
-  while assigned(ThreadRoot) do
-   begin
-     ThreadRoot^.Thread.Destroy;
-     hp:=ThreadRoot;
-     ThreadRoot:=ThreadRoot^.Next;
-     dispose(hp);
-   end;
-  ThreadsInited:=false;
-end;
-
-
-procedure AddThread(t:TThread);
-var
-  hp : PThreadRec;
-begin
-  { Need to initialize threads ? }
-  if not ThreadsInited then
-   InitThreads;
-
-  { Put thread in the linked list }
-  new(hp);
-  hp^.Thread:=t;
-  hp^.next:=ThreadRoot;
-  ThreadRoot:=hp;
-
-  inc(ThreadCount, 1);
-end;
-
-
-procedure RemoveThread(t:TThread);
-var
-  lasthp,hp : PThreadRec;
-begin
-  hp:=ThreadRoot;
-  lasthp:=nil;
-  while assigned(hp) do
-   begin
-     if hp^.Thread=t then
-      begin
-        if assigned(lasthp) then
-         lasthp^.next:=hp^.next
-        else
-         ThreadRoot:=hp^.next;
-        dispose(hp);
-        exit;
-      end;
-     lasthp:=hp;
-     hp:=hp^.next;
-   end;
-
-  Dec(ThreadCount, 1);
-  if ThreadCount = 0 then DoneThreads;
-end;
-
-
-{ TThread }
-function ThreadProc(args:pointer): Integer;cdecl;
-var
-  FreeThread: Boolean;
-  Thread : TThread absolute args;
-begin
-  try
-    Thread.Execute;
-  except
-    Thread.FFatalException := TObject(AcquireExceptionObject);
-  end;
-  FreeThread := Thread.FFreeOnTerminate;
-  Result := Thread.FReturnValue;
-  Thread.FFinished := True;
-  Thread.DoTerminate;
-  if FreeThread then
-    Thread.Free;
-  {$ifdef ver1_0}ExitProcess{$else}fpExit{$endif}(Result);
-end;
-
-
-constructor TThread.Create(CreateSuspended: Boolean);
-var
-  Flags: Integer;
-begin
-  inherited Create;
-  AddThread(self);
-  FSuspended := CreateSuspended;
-  Flags := CLONE_VM + CLONE_FS + CLONE_FILES + CLONE_SIGHAND + SIGCHLD;
-  { Setup 16k of stack }
-  FStackSize:=16384;
-  Getmem(pointer(FStackPointer),FStackSize);
-  inc(FStackPointer,FStackSize);
-  FCallExitProcess:=false;
-  { Clone }
-  FHandle:= Clone(@ThreadProc,pointer(FStackPointer),Flags,self);
-  if FSuspended then Suspend;
-  FThreadID := FHandle;
-  IsMultiThread := TRUE;
-  FFatalException := nil;
-end;
-
-
-destructor TThread.Destroy;
-begin
-  if not FFinished and not Suspended then
-   begin
-     Terminate;
-     WaitFor;
-   end;
-  if FHandle <> -1 then
-    {$ifdef ver1_0}kill({$else}fpkill({$endif}FHandle, SIGKILL);
-  dec(FStackPointer,FStackSize);
-  Freemem(pointer(FStackPointer),FStackSize);
-  FFatalException.Free;
-  FFatalException := nil;
-  inherited Destroy;
-  RemoveThread(self);
-end;
-
-
-procedure TThread.CallOnTerminate;
-begin
-  FOnTerminate(Self);
-end;
-
-procedure TThread.DoTerminate;
-begin
-  if Assigned(FOnTerminate) then
-    Synchronize(@CallOnTerminate);
-end;
-
-
-const
-{ I Don't know idle or timecritical, value is also 20, so the largest other
-  possibility is 19 (PFV) }
-  Priorities: array [TThreadPriority] of Integer =
-   (-20,-19,-10,9,10,19,20);
-
-function TThread.GetPriority: TThreadPriority;
-var
-  P: Integer;
-  I: TThreadPriority;
-begin
-  P := {$ifdef ver1_0}
-         Linux.getpriority
-       {$else}
-         Unix.fpGetPriority
-       {$endif}  	(Prio_Process,FHandle);
-  Result := tpNormal;
-  for I := Low(TThreadPriority) to High(TThreadPriority) do
-    if Priorities[I] = P then
-      Result := I;
-end;
-
-
-procedure TThread.SetPriority(Value: TThreadPriority);
-begin
-       {$ifdef ver1_0}
-         Linux.Setpriority
-       {$else}
-        Unix.fpSetPriority
-       {$endif} (Prio_Process,FHandle, Priorities[Value]);
-end;
-
-
-procedure TThread.Synchronize(Method: TThreadMethod);
-begin
-  FSynchronizeException := nil;
-  FMethod := Method;
-{  SendMessage(ThreadWindow, CM_EXECPROC, 0, Longint(Self)); }
-  if Assigned(FSynchronizeException) then
-    raise FSynchronizeException;
-end;
-
-
-procedure TThread.SetSuspended(Value: Boolean);
-begin
-  if Value <> FSuspended then
-    if Value then
-      Suspend
-    else
-      Resume;
-end;
-
-
-procedure TThread.Suspend;
-begin
-  {$ifdef ver1_0}kill({$else}fpkill({$endif}FHandle, SIGSTOP);
-  FSuspended := true;
-end;
-
-
-procedure TThread.Resume;
-begin
-  {$ifdef ver1_0}kill({$else}fpkill({$endif}FHandle, SIGCONT);
-  FSuspended := False;
-end;
-
-
-procedure TThread.Terminate;
-begin
-  FTerminated := True;
-end;
-
-function TThread.WaitFor: Integer;
-var
-  status : longint;
-begin
-{$ifdef ver1_0}
-  if FThreadID = MainThreadID then
-   WaitPid(0,@status,0)
-  else
-   WaitPid(FHandle,@status,0);
-{$else}
-  if FThreadID = MainThreadID then
-   fpWaitPid(0,@status,0)
-  else
-   fpWaitPid(FHandle,@status,0);
-{$endif}
-  Result:=status;
-end;
-
-{
-  $Log$
-  Revision 1.12  2003-10-06 17:06:55  florian
-    * applied Johannes Berg's patch for exception handling in threads
-
-  Revision 1.11  2003/09/20 14:51:42  marco
-   * small v1_0 fix
-
-  Revision 1.10  2003/09/20 12:38:29  marco
-   * FCL now compiles for FreeBSD with new 1.1. Now Linux.
-
-  Revision 1.9  2003/01/17 19:01:07  marco
-   * small fix
-
-  Revision 1.8  2002/11/17 21:09:44  marco
-   * 16byte sigset
-
-  Revision 1.7  2002/10/24 12:47:54  marco
-   * Fix emptying sa_mask
-
-  Revision 1.6  2002/09/07 15:15:24  peter
-    * old logs removed and tabs fixed
-
-}

fcl/go32v2/thread.inc

@@ -1,99 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-{****************************************************************************}
-{*                             TThread                                      *}
-{****************************************************************************}
-
-
-procedure TThread.CallOnTerminate;
-
-begin
-end;
-
-
-function TThread.GetPriority: TThreadPriority;
-
-begin
-  GetPriority:=tpNormal;
-end;
-
-
-procedure TThread.SetPriority(Value: TThreadPriority);
-
-begin
-end;
-
-
-procedure TThread.SetSuspended(Value: Boolean);
-
-begin
-end;
-
-
-procedure TThread.DoTerminate;
-
-begin
-end;
-
-
-procedure TThread.Synchronize(Method: TThreadMethod);
-
-begin
-end;
-
-
-constructor TThread.Create(CreateSuspended: Boolean);
-
-begin
- {IsMultiThread := TRUE; }
-end;
-
-
-destructor TThread.Destroy;
-
-begin
-end;
-
-
-procedure TThread.Resume;
-
-begin
-end;
-
-
-procedure TThread.Suspend;
-
-begin
-end;
-
-
-procedure TThread.Terminate;
-
-begin
-end;
-
-
-function TThread.WaitFor: Integer;
-
-begin
-  WaitFor:=0;
-end;
-
-
-{
-  $Log$
-  Revision 1.4  2002-09-07 15:15:24  peter
-    * old logs removed and tabs fixed
-
-}

fcl/linux/thread.inc

@@ -1,317 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by Peter Vreman
-
-    Linux TThread implementation
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-type
-  PThreadRec=^TThreadRec;
-  TThreadRec=record
-    thread : TThread;
-    next   : PThreadRec;
-  end;
-
-var
-  ThreadRoot : PThreadRec;
-  ThreadsInited : boolean;
-//  MainThreadID: longint;
-
-Const
-  ThreadCount: longint = 0;
-
-function ThreadSelf:TThread;
-var
-  hp : PThreadRec;
-  sp : longint;
-begin
-  sp:=SPtr;
-  hp:=ThreadRoot;
-  while assigned(hp) do
-   begin
-     if (sp<=hp^.Thread.FStackPointer) and
-        (sp>(hp^.Thread.FStackPointer-hp^.Thread.FStackSize)) then
-      begin
-        Result:=hp^.Thread;
-        exit;
-      end;
-     hp:=hp^.next;
-   end;
-  Result:=nil;
-end;
-
-
-//function SIGCHLDHandler(Sig: longint): longint; cdecl;//this is std linux C declaration as function
-procedure SIGCHLDHandler(Sig: longint); cdecl;
-begin
-  {$ifdef ver1_0}waitpid{$else}fpwaitpid{$endif}(-1, nil, WNOHANG);
-end;
-
-procedure InitThreads;
-var
-  Act, OldAct: PSigActionRec;
-begin
-  ThreadRoot:=nil;
-  ThreadsInited:=true;
-
-
-// This will install SIGCHLD signal handler
-// signal() installs "one-shot" handler,
-// so it is better to install and set up handler with sigaction()
-
-  GetMem(Act, SizeOf(SigActionRec));
-  GetMem(OldAct, SizeOf(SigActionRec));
-
-  Act^.handler.sh := @SIGCHLDHandler;
-  Act^.sa_flags := SA_NOCLDSTOP {or SA_NOMASK or SA_RESTART};
-  Fillchar(Act^.sa_mask,sizeof(Act^.sa_mask),0); //Do not block all signals ??. Don't need if SA_NOMASK in flags
-  {$ifdef ver1_0}
-  SigAction(SIGCHLD, Act, OldAct);
-  {$else}
-  FpSigAction(SIGCHLD, @Act, @OldAct);
-  {$endif}
-
-  FreeMem(Act, SizeOf(SigActionRec));
-  FreeMem(OldAct, SizeOf(SigActionRec));
-end;
-
-
-procedure DoneThreads;
-var
-  hp : PThreadRec;
-begin
-  while assigned(ThreadRoot) do
-   begin
-     ThreadRoot^.Thread.Destroy;
-     hp:=ThreadRoot;
-     ThreadRoot:=ThreadRoot^.Next;
-     dispose(hp);
-   end;
-  ThreadsInited:=false;
-end;
-
-
-procedure AddThread(t:TThread);
-var
-  hp : PThreadRec;
-begin
-  { Need to initialize threads ? }
-  if not ThreadsInited then
-   InitThreads;
-
-  { Put thread in the linked list }
-  new(hp);
-  hp^.Thread:=t;
-  hp^.next:=ThreadRoot;
-  ThreadRoot:=hp;
-
-  inc(ThreadCount, 1);
-end;
-
-
-procedure RemoveThread(t:TThread);
-var
-  lasthp,hp : PThreadRec;
-begin
-  hp:=ThreadRoot;
-  lasthp:=nil;
-  while assigned(hp) do
-   begin
-     if hp^.Thread=t then
-      begin
-        if assigned(lasthp) then
-         lasthp^.next:=hp^.next
-        else
-         ThreadRoot:=hp^.next;
-        dispose(hp);
-        exit;
-      end;
-     lasthp:=hp;
-     hp:=hp^.next;
-   end;
-
-  Dec(ThreadCount, 1);
-  if ThreadCount = 0 then DoneThreads;
-end;
-
-
-{ TThread }
-function ThreadProc(args:pointer): Integer;cdecl;
-var
-  FreeThread: Boolean;
-  Thread : TThread absolute args;
-begin
-  try
-    Thread.Execute;
-  except
-    Thread.FFatalException := TObject(AcquireExceptionObject);
-  end;
-  FreeThread := Thread.FFreeOnTerminate;
-  Result := Thread.FReturnValue;
-  Thread.FFinished := True;
-  Thread.DoTerminate;
-  if FreeThread then
-    Thread.Free;
-  {$ifdef ver1_0}ExitProcess{$else}fpexit{$endif}(Result);
-end;
-
-
-constructor TThread.Create(CreateSuspended: Boolean);
-var
-  Flags: Integer;
-begin
-  inherited Create;
-  AddThread(self);
-  FSuspended := CreateSuspended;
-  Flags := CLONE_VM + CLONE_FS + CLONE_FILES + CLONE_SIGHAND + SIGCHLD;
-  { Setup 16k of stack }
-  FStackSize:=16384;
-  Getmem(pointer(FStackPointer),FStackSize);
-  inc(FStackPointer,FStackSize);
-  FCallExitProcess:=false;
-  { Clone }
-  FHandle:= Clone(@ThreadProc,pointer(FStackPointer),Flags,self);
-  if FSuspended then Suspend;
-  FThreadID := FHandle;
-  IsMultiThread := TRUE;
-  FFatalException := nil;
-end;
-
-
-destructor TThread.Destroy;
-begin
-  if not FFinished and not Suspended then
-   begin
-     Terminate;
-     WaitFor;
-   end;
-  if FHandle <> -1 then
-    {$ifdef ver1_0}Kill{$else}fpkill{$endif}(FHandle, SIGKILL);
-  dec(FStackPointer,FStackSize);
-  Freemem(pointer(FStackPointer),FStackSize);
-  FFatalException.Free;
-  FFatalException := nil;
-  inherited Destroy;
-  RemoveThread(self);
-end;
-
-
-procedure TThread.CallOnTerminate;
-begin
-  FOnTerminate(Self);
-end;
-
-procedure TThread.DoTerminate;
-begin
-  if Assigned(FOnTerminate) then
-    Synchronize(@CallOnTerminate);
-end;
-
-
-const
-{ I Don't know idle or timecritical, value is also 20, so the largest other
-  possibility is 19 (PFV) }
-  Priorities: array [TThreadPriority] of Integer =
-   (-20,-19,-10,9,10,19,20);
-
-function TThread.GetPriority: TThreadPriority;
-var
-  P: Integer;
-  I: TThreadPriority;
-begin
-  P := {$ifdef ver1_0}
-	 Linux.GetPriority(Prio_Process,FHandle);
-       {$else}
-         Unix.fpGetPriority(Prio_Process,FHandle);
-       {$endif}
-  Result := tpNormal;
-  for I := Low(TThreadPriority) to High(TThreadPriority) do
-    if Priorities[I] = P then
-      Result := I;
-end;
-
-
-procedure TThread.SetPriority(Value: TThreadPriority);
-begin
-       {$ifdef ver1_0}
-	 Linux.SetPriority(Prio_Process,FHandle,Priorities[Value]);
-       {$else}
-         Unix.fpSetPriority(Prio_Process,FHandle,Priorities[Value]);
-       {$endif}
-end;
-
-
-procedure TThread.Synchronize(Method: TThreadMethod);
-begin
-  FSynchronizeException := nil;
-  FMethod := Method;
-{  SendMessage(ThreadWindow, CM_EXECPROC, 0, Longint(Self)); }
-  if Assigned(FSynchronizeException) then
-    raise FSynchronizeException;
-end;
-
-
-procedure TThread.SetSuspended(Value: Boolean);
-begin
-  if Value <> FSuspended then
-    if Value then
-      Suspend
-    else
-      Resume;
-end;
-
-
-procedure TThread.Suspend;
-begin
-  {$ifdef ver1_0}Kill{$else}fpkill{$endif}(FHandle, SIGSTOP);
-  FSuspended := true;
-end;
-
-
-procedure TThread.Resume;
-begin
-  {$ifdef ver1_0}Kill{$else}fpkill{$endif}(FHandle, SIGCONT);
-  FSuspended := False;
-end;
-
-
-procedure TThread.Terminate;
-begin
-  FTerminated := True;
-end;
-
-function TThread.WaitFor: Integer;
-var
-  status : longint;
-begin
-  if FThreadID = MainThreadID then
-   {$ifdef ver1_0}waitpid{$else}fpwaitpid{$endif}(0,@status,0)
-  else
-   {$ifdef ver1_0}waitpid{$else}fpwaitpid{$endif}(FHandle,@status,0);
-  Result:=status;
-end;
-
-{
-  $Log$
-  Revision 1.9  2003-10-06 17:06:55  florian
-    * applied Johannes Berg's patch for exception handling in threads
-
-  Revision 1.8  2003/09/20 15:10:30  marco
-   * small fixes. fcl now compiles
-
-  Revision 1.7  2002/12/18 20:44:36  peter
-    * use fillchar to clear sigset
-
-  Revision 1.6  2002/09/07 15:15:27  peter
-    * old logs removed and tabs fixed
-
-}

fcl/os2/thread.inc

@@ -1,255 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2002 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-{****************************************************************************}
-{*                             TThread                                      *}
-{****************************************************************************}
-
-(* OS/2 specific declarations - see unit DosCalls for descriptions *)
-
-type
- TByteArray = array [0..$fff0] of byte;
- PByteArray = ^TByteArray;
-
- TThreadEntry = function (Param: pointer): longint; cdecl;
-
- TSysThreadIB = record
-                 TID, Priority, Version: longint;
-                 MCCount, MCForceFlag: word;
-                end;
- PSysThreadIB = ^TSysThreadIB;
-
- TThreadInfoBlock = record
-                     Exh_Chain, Stack, StackLimit: pointer;
-                     TIB2: PSysThreadIB;
-                     Version, Ordinal: longint;
-                    end;
- PThreadInfoBlock = ^TThreadInfoBlock;
- PPThreadInfoBlock = ^PThreadInfoBlock;
-
- TProcessInfoBlock = record
-                      PID, ParentPID, HMTE: longint;
-                      Cmd, Env: PByteArray;
-                      flStatus, tType: longint;
-                     end;
- PProcessInfoBlock = ^TProcessInfoBlock;
- PPProcessInfoBlock = ^PProcessInfoBlock;
-
-
-const
- deThread = 0;
- deProcess = 1;
-
- dtSuspended = 1;
- dtStack_Commited = 2;
-
- dtWait = 0;
- dtNoWait = 1;
-
-
-procedure DosGetInfoBlocks (PATIB: PPThreadInfoBlock;
-              PAPIB: PPProcessInfoBlock); cdecl; external 'DOSCALLS' index 312;
-
-function DosSetPriority (Scope, TrClass, Delta, PortID: longint): longint;
-                                          cdecl; external 'DOSCALLS' index 236;
-
-procedure DosExit (Action, Result: longint); cdecl;
-                                                 external 'DOSCALLS' index 233;
-
-function DosCreateThread (var TID: longint; Address: TThreadEntry;
-         aParam: pointer; Flags: longint; StackSize: longint): longint; cdecl;
-                                                 external 'DOSCALLS' index 311;
-
-function DosKillThread (TID: longint): longint; cdecl;
-                                                 external 'DOSCALLS' index 111;
-
-function DosResumeThread (TID: longint): longint; cdecl;
-                                                 external 'DOSCALLS' index 237;
-
-function DosSuspendThread (TID: longint): longint; cdecl;
-                                                 external 'DOSCALLS' index 238;
-
-function DosWaitThread (var TID: longint; Option: longint): longint; cdecl;
-                                                 external 'DOSCALLS' index 349;
-
-
-const
- Priorities: array [TThreadPriority] of word = ($100, $200, $207, $20F, $217,
-  $21F, $300);
- ThreadCount: longint = 0;
-
-(* Implementation of exported functions *)
-
-procedure AddThread (T: TThread);
-begin
- Inc (ThreadCount);
-end;
-
-
-procedure RemoveThread (T: TThread);
-begin
- Dec (ThreadCount);
-end;
-
-
-procedure TThread.CallOnTerminate;
-begin
- FOnTerminate (Self);
-end;
-
-
-function TThread.GetPriority: TThreadPriority;
-var
- PTIB: PThreadInfoBlock;
- PPIB: PProcessInfoBlock;
- I: TThreadPriority;
-begin
- DosGetInfoBlocks (@PTIB, @PPIB);
- with PTIB^.TIB2^ do
-  if Priority >= $300 then GetPriority := tpTimeCritical else
-      if Priority < $200 then GetPriority := tpIdle else
-  begin
-   I := Succ (Low (TThreadPriority));
-   while (I < High (TThreadPriority)) and
-    (Priority - Priorities [I] <= Priorities [Succ (I)] - Priority) do Inc (I);
-   GetPriority := I;
-  end;
-end;
-
-
-procedure TThread.SetPriority(Value: TThreadPriority);
-var
- PTIB: PThreadInfoBlock;
- PPIB: PProcessInfoBlock;
-begin
- DosGetInfoBlocks (@PTIB, @PPIB);
-(*
- PTIB^.TIB2^.Priority := Priorities [Value];
-*)
- DosSetPriority (2, High (Priorities [Value]),
-                     Low (Priorities [Value]) - PTIB^.TIB2^.Priority, FHandle);
-end;
-
-
-procedure TThread.SetSuspended(Value: Boolean);
-begin
- if Value <> FSuspended then
- begin
-  if Value then Suspend else Resume;
- end;
-end;
-
-
-procedure TThread.DoTerminate;
-begin
- if Assigned (FOnTerminate) then Synchronize (@CallOnTerminate);
-end;
-
-
-procedure TThread.Synchronize(Method: TThreadMethod);
-begin
-end;
-
-
-function ThreadProc(Args: pointer): Integer; cdecl;
-var
-  FreeThread: Boolean;
-  Thread: TThread absolute Args;
-begin
-  try
-    Thread.Execute;
-  except
-    Thread.FFatalException := TObject(AcquireExceptionObject);
-  end;
-  FreeThread := Thread.FFreeOnTerminate;
-  Result := Thread.FReturnValue;
-  Thread.FFinished := True;
-  Thread.DoTerminate;
-  if FreeThread then Thread.Free;
-  DosExit (deThread, Result);
-end;
-
-constructor TThread.Create(CreateSuspended: Boolean);
-var
-  Flags: Integer;
-begin
-  inherited Create;
-  AddThread (Self);
-  FSuspended := CreateSuspended;
-  Flags := dtStack_Commited;
-  if FSuspended then Flags := Flags or dtSuspended;
-  if DosCreateThread (FThreadID, @ThreadProc, pointer (Self), Flags, 16384)
-                                                                      <> 0 then
-  begin
-   FFinished := true;
-   Destroy;
-  end else FHandle := FThreadID;
-  IsMultiThread := TRUE;
-  FFatalException := nil;
-end;
-
-
-destructor TThread.Destroy;
-begin
- if not FFinished and not Suspended then
- begin
-  Terminate;
-  WaitFor;
- end;
- if FHandle <> -1 then DosKillThread (FHandle);
- FFatalException.Free;
- FFatalException := nil;
- inherited Destroy;
- RemoveThread (Self);
-end;
-
-procedure TThread.Resume;
-begin
- FSuspended := not (DosResumeThread (FHandle) = 0);
-end;
-
-
-procedure TThread.Suspend;
-begin
- FSuspended := DosSuspendThread (FHandle) = 0;
-end;
-
-
-procedure TThread.Terminate;
-begin
- FTerminated := true;
-end;
-
-
-function TThread.WaitFor: Integer;
-
-begin
- WaitFor := DosWaitThread (FHandle, dtWait);
-end;
-
-
-{
-  $Log$
-  Revision 1.8  2003-10-06 17:06:55  florian
-    * applied Johannes Berg's patch for exception handling in threads
-
-  Revision 1.7  2003/02/20 17:12:39  hajny
-    * fixes for OS/2 v2.1 incompatibility
-
-  Revision 1.6  2002/09/07 15:15:27  peter
-    * old logs removed and tabs fixed
-
-  Revision 1.5  2002/02/10 13:38:14  hajny
-    * DosCalls dependency removed to avoid type redefinitions
-
-}

fcl/win32/thread.inc

@@ -1,231 +0,0 @@
-{ Thread management routines }
-
-const
-  CM_EXECPROC = $8FFF;
-  CM_DESTROYWINDOW = $8FFE;
-
-type
-  PRaiseFrame = ^TRaiseFrame;
-  TRaiseFrame = record
-    NextRaise: PRaiseFrame;
-    ExceptAddr: Pointer;
-    ExceptObject: TObject;
-    ExceptionRecord: pointer; {PExceptionRecord}
-  end;
-
-var
-  ThreadWindow: HWND;
-  ThreadCount: Integer;
-
-function ThreadWndProc(Window: HWnd; AMessage:UInt; WParam : WParam; LParam: LParam): Longint; stdcall;
-
-begin
-  case AMessage of
-    CM_EXECPROC:
-      with TThread(lParam) do
-      begin
-        Result := 0;
-        try
-          FSynchronizeException := nil;
-          FMethod;
-        except
-{          if RaiseList <> nil then
-          begin
-            FSynchronizeException := PRaiseFrame(RaiseList)^.ExceptObject;
-            PRaiseFrame(RaiseList)^.ExceptObject := nil;
-          end; }
-        end;
-      end;
-    CM_DESTROYWINDOW:
-      begin
-        DestroyWindow(Window);
-        Result := 0;
-      end;
-  else
-    Result := DefWindowProc(Window, AMessage, wParam, lParam);
-  end;
-end;
-
-const
-  ThreadWindowClass: TWndClass = (
-    style: 0;
-    lpfnWndProc: nil;
-    cbClsExtra: 0;
-    cbWndExtra: 0;
-    hInstance: 0;
-    hIcon: 0;
-    hCursor: 0;
-    hbrBackground: 0;
-    lpszMenuName: nil;
-    lpszClassName: 'TThreadWindow');
-
-procedure AddThread;
-
-  function AllocateWindow: HWND;
-  var
-    TempClass: TWndClass;
-    ClassRegistered: Boolean;
-  begin
-    ThreadWindowClass.hInstance := HInstance;
-    ThreadWindowClass.lpfnWndProc:=WndProc(@ThreadWndProc);
-    ClassRegistered := GetClassInfo(HInstance, ThreadWindowClass.lpszClassName,
-      @TempClass);
-    if not ClassRegistered or (TempClass.lpfnWndProc <> WndProc(@ThreadWndProc)) then
-    begin
-      if ClassRegistered then
-        Windows.UnregisterClass(ThreadWindowClass.lpszClassName, HInstance);
-      Windows.RegisterClass(ThreadWindowClass);
-    end;
-    Result := CreateWindow(ThreadWindowClass.lpszClassName, '', 0,
-      0, 0, 0, 0, 0, 0, HInstance, nil);
-  end;
-
-begin
-  if ThreadCount = 0 then
-    ThreadWindow := AllocateWindow;
-  Inc(ThreadCount);
-end;
-
-procedure RemoveThread;
-begin
-  Dec(ThreadCount);
-  if ThreadCount = 0 then
-    PostMessage(ThreadWindow, CM_DESTROYWINDOW, 0, 0);
-end;
-
-{ TThread }
-
-function ThreadProc(Thread: TThread): Integer;
-var
-  FreeThread: Boolean;
-begin
-  try
-    Thread.Execute;
-  except
-    Thread.FFatalException := TObject(AcquireExceptionObject);
-  end;
-  FreeThread := Thread.FFreeOnTerminate;
-  Result := Thread.FReturnValue;
-  Thread.FFinished := True;
-  Thread.DoTerminate;
-  if FreeThread then Thread.Free;
-  ExitThread(Result);
-end;
-
-constructor TThread.Create(CreateSuspended: Boolean);
-var
-  Flags: Integer;
-begin
-  inherited Create;
-  AddThread;
-  FSuspended := CreateSuspended;
-  Flags := 0;
-  if CreateSuspended then Flags := CREATE_SUSPENDED;
-  IsMultiThread := TRUE;
-  FHandle := CreateThread(nil, 0, @ThreadProc, Pointer(self), Flags, DWord(FThreadID));
-  FFatalException := nil;
-end;
-
-
-destructor TThread.Destroy;
-begin
-  if not FFinished and not Suspended then
-  begin
-    Terminate;
-    WaitFor;
-  end;
-  if FHandle <> 0 then CloseHandle(FHandle);
-  FFatalException.Free;
-  FFatalException := nil;
-  inherited Destroy;
-  RemoveThread;
-end;
-
-procedure TThread.CallOnTerminate;
-begin
-  FOnTerminate(Self);
-end;
-
-procedure TThread.DoTerminate;
-begin
-  if Assigned(FOnTerminate) then
-    Synchronize(@CallOnTerminate);
-end;
-
-const
-  Priorities: array [TThreadPriority] of Integer =
-   (THREAD_PRIORITY_IDLE, THREAD_PRIORITY_LOWEST, THREAD_PRIORITY_BELOW_NORMAL,
-    THREAD_PRIORITY_NORMAL, THREAD_PRIORITY_ABOVE_NORMAL,
-    THREAD_PRIORITY_HIGHEST, THREAD_PRIORITY_TIME_CRITICAL);
-
-function TThread.GetPriority: TThreadPriority;
-var
-  P: Integer;
-  I: TThreadPriority;
-begin
-  P := GetThreadPriority(FHandle);
-  Result := tpNormal;
-  for I := Low(TThreadPriority) to High(TThreadPriority) do
-    if Priorities[I] = P then Result := I;
-end;
-
-procedure TThread.SetPriority(Value: TThreadPriority);
-begin
-  SetThreadPriority(FHandle, Priorities[Value]);
-end;
-
-procedure TThread.Synchronize(Method: TThreadMethod);
-begin
-  FSynchronizeException := nil;
-  FMethod := Method;
-  SendMessage(ThreadWindow, CM_EXECPROC, 0, Longint(Self));
-  if Assigned(FSynchronizeException) then raise FSynchronizeException;
-end;
-
-procedure TThread.SetSuspended(Value: Boolean);
-begin
-  if Value <> FSuspended then
-    if Value then
-      Suspend else
-      Resume;
-end;
-
-procedure TThread.Suspend;
-begin
-  FSuspended := True;
-  SuspendThread(FHandle);
-end;
-
-procedure TThread.Resume;
-begin
-  if ResumeThread(FHandle) = 1 then FSuspended := False;
-end;
-
-procedure TThread.Terminate;
-begin
-  FTerminated := True;
-end;
-
-function TThread.WaitFor: Integer;
-var
-  Msg: TMsg;
-begin
-  if GetCurrentThreadID = MainThreadID then
-    while MsgWaitForMultipleObjects(1, FHandle, False, INFINITE, QS_SENDMESSAGE) = WAIT_OBJECT_0 + 1 do
-      PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE)
-  else
-    WaitForSingleObject(ulong(FHandle), INFINITE);
-  GetExitCodeThread(FHandle, DWord(Result));
-end;
-{
-  $Log$
-  Revision 1.8  2003-10-06 17:06:55  florian
-    * applied Johannes Berg's patch for exception handling in threads
-
-  Revision 1.7  2003/04/23 11:35:30  peter
-    * wndproc definition fix
-
-  Revision 1.6  2002/09/07 15:15:29  peter
-    * old logs removed and tabs fixed
-
-}