--- Merging r14900 into '.':

U    rtl/win/video.pp
--- Merging r14901 into '.':
G    rtl/win/video.pp
--- Merging r15851 into '.':
G    rtl/win/video.pp
--- Merging r16263 into '.':
U    rtl/win/syswin.inc
U    rtl/win/systhrd.inc
--- Merging r16599 into '.':
U    utils/delp.pp
--- Merging r16600 into '.':
U    ide/weditor.pas
--- Merging r16601 into '.':
U    rtl/os2/systhrd.inc
--- Merging r16602 into '.':
U    packages/fcl-db/src/sqldb/interbase/ibconnection.pp
--- Merging r16614 into '.':
C    ide/Makefile
U    ide/Makefile.fpc
--- Merging r16615 into '.':
G    ide/weditor.pas
--- Merging r16616 into '.':
U    ide/fpusrscr.pas
Summary of conflicts:
  Text conflicts: 1

# revisions: 14900,14901,15851,16263,16599,16600,16601,16602,16614,16615,16616
------------------------------------------------------------------------
r14900 | marco | 2010-02-13 15:30:07 +0100 (Sat, 13 Feb 2010) | 2 lines
Changed paths:
   M /trunk/rtl/win/video.pp

 * initial x86_64 code for compare videobuffer. To be tested later. Mantis 15700

------------------------------------------------------------------------
------------------------------------------------------------------------
r14901 | marco | 2010-02-13 16:37:07 +0100 (Sat, 13 Feb 2010) | 2 lines
Changed paths:
   M /trunk/rtl/win/video.pp

 * Pascal version for asm code in video (Mantis 15700)

------------------------------------------------------------------------
------------------------------------------------------------------------
r15851 | marco | 2010-08-19 10:52:37 +0200 (Thu, 19 Aug 2010) | 2 lines
Changed paths:
   M /trunk/rtl/win/video.pp

 * corrected wrong register in x86_64 asm

------------------------------------------------------------------------
------------------------------------------------------------------------
r16263 | florian | 2010-10-30 16:37:55 +0200 (Sat, 30 Oct 2010) | 2 lines
Changed paths:
   M /trunk/rtl/win/systhrd.inc
   M /trunk/rtl/win/syswin.inc

o patch from Sven Barth:
  - remove critical section from dll initialization, windows allows only one thread at one to run dllmain, resolves #17858
------------------------------------------------------------------------
------------------------------------------------------------------------
r16599 | michael | 2010-12-19 21:40:37 +0100 (Sun, 19 Dec 2010) | 1 line
Changed paths:
   M /trunk/utils/delp.pp

* Support for multiple directories.
------------------------------------------------------------------------
------------------------------------------------------------------------
r16600 | marco | 2010-12-19 22:59:21 +0100 (Sun, 19 Dec 2010) | 1 line
Changed paths:
   M /trunk/ide/weditor.pas

 * paleobug solved, paste from windows now wraps lines to 200 char. Solves #4943
------------------------------------------------------------------------
------------------------------------------------------------------------
r16601 | hajny | 2010-12-19 23:05:05 +0100 (Sun, 19 Dec 2010) | 1 line
Changed paths:
   M /trunk/rtl/os2/systhrd.inc

  + most of OS/2 threading support implemented; not debugged yet though
------------------------------------------------------------------------
------------------------------------------------------------------------
r16602 | marco | 2010-12-20 16:51:39 +0100 (Mon, 20 Dec 2010) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/interbase/ibconnection.pp

 * patch from Lacak2, use dbconst for errormessage, mantis #0018161

------------------------------------------------------------------------
------------------------------------------------------------------------
r16614 | marco | 2010-12-22 20:27:09 +0100 (Wed, 22 Dec 2010) | 1 line
Changed paths:
   M /trunk/ide/Makefile
   M /trunk/ide/Makefile.fpc

 * switch IDE to external linker on win32/64 for now (mingw linking compat)
------------------------------------------------------------------------
------------------------------------------------------------------------
r16615 | marco | 2010-12-22 22:12:27 +0100 (Wed, 22 Dec 2010) | 2 lines
Changed paths:
   M /trunk/ide/weditor.pas

 * bug #8004. disable ok button if length(texttosearch)=0 in find dialog

------------------------------------------------------------------------
------------------------------------------------------------------------
r16616 | marco | 2010-12-22 22:20:51 +0100 (Wed, 22 Dec 2010) | 2 lines
Changed paths:
   M /trunk/ide/fpusrscr.pas

 * fix for 10758, additional terminal type checked (udev)

------------------------------------------------------------------------

git-svn-id: branches/fixes_2_4@16631 -

ide/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2010/08/25]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2010/11/29]
 #
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-solaris x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded mipsel-linux
@@ -272,6 +272,15 @@ endif
 override NOCPUDEF=1
 override FPCOPT+= -d$(PPC_TARGET)
 ifndef NOGDB
+ifeq ($(FULL_TARGET),i386-win32)
+needlinkparam=1
+endif
+ifeq ($(FULL_TARGET),x86_64-win64)
+needlinkparam=1
+endif
+ifdef needlinkparam
+override SPECIALLINK=-Xe -k--allow-multiple-definition
+endif
 ifdef GDBLIBDIR
 override LIBGDBFILE:=$(firstword $(wildcard $(addsuffix /libgdb.a,$(GDBLIBDIR))))
 endif
@@ -3343,7 +3352,7 @@ compiler/$(FPCMADE):
 compilerclean :
 	$(MAKE) -C compiler clean
 fp$(EXEEXT): $(wildcard *.pas) $(wildcard *.inc)
-	$(COMPILER) $(GDBLIBINCCOND) fp.pas
+	$(COMPILER) $(GDBLIBINCCOND) $(SPECIALLINK) fp.pas
 buildfp:
 	$(MAKE) compilerunits
 	$(MAKE) testgdb

ide/Makefile.fpc

@@ -45,6 +45,18 @@ override FPCOPT+= -d$(PPC_TARGET)
 
 ifndef NOGDB
 
+ifeq ($(FULL_TARGET),i386-win32)
+needlinkparam=1
+endif
+
+
+ifeq ($(FULL_TARGET),x86_64-win64)
+needlinkparam=1
+endif
+
+ifdef needlinkparam
+override SPECIALLINK=-Xe -k--allow-multiple-definition
+endif
 # Try to find GDB library
 # Look for a valid GDBLIBDIR environment variable
 ifdef GDBLIBDIR
@@ -166,7 +178,7 @@ compilerclean :
 # to use.
 #
 fp$(EXEEXT): $(wildcard *.pas) $(wildcard *.inc)
-        $(COMPILER) $(GDBLIBINCCOND) fp.pas
+        $(COMPILER) $(GDBLIBINCCOND) $(SPECIALLINK) fp.pas
 
 buildfp:
         $(MAKE) compilerunits

ide/fpusrscr.pas

@@ -753,7 +753,7 @@ begin
   if Not IsXterm and (IsATTY(stdinputhandle)<>-1) then
     begin
       Console:=TTyNetwork;  {Default: Network or other vtxxx tty}
-      if (Copy(ThisTTY, 1, 8) = '/dev/tty') and (ThisTTY[9]<>'p') Then
+      if ((Copy(ThisTTY, 1, 8) = '/dev/tty') and (ThisTTY[9]<>'p')) or (Copy(ThisTTY,1,8)='/dev/vc/') Then
         begin
           Case ThisTTY[9] of
             '0'..'9' :

ide/weditor.pas

@@ -58,12 +58,12 @@ const
       cmCollapseFold         = 51266;
       cmExpandFold           = 51267;
       cmDelToEndOfWord       = 51268;
-
+      cmInputLineLen         = 51269;
+      
       EditorTextBufSize = 32768;
       MaxLineLength     = 255;
       MaxLineCount      = 2000000;
 
-
       CodeTemplateCursorChar = '|'; { char to signal cursor pos in templates }
 
       efBackupFiles         = $00000001;
@@ -708,10 +708,16 @@ type
     TCodeEditorDialog = function(Dialog: Integer; Info: Pointer): Word;
 
     TEditorInputLine = object(TInputLine)
-      Procedure   HandleEvent(var Event : TEvent);virtual;
+         Procedure   HandleEvent(var Event : TEvent);virtual;
     end;
     PEditorInputLine = ^TEditorInputLine;
+ 
+    TSearchHelperDialog = object(TDialog)
+             OkButton: PButton;
+             Procedure   HandleEvent(var Event : TEvent);virtual;
+    end;
 
+    PSearchHelperDialog = ^TSearchHelperDialog;
 
 const
      { used for ShiftDel and ShiftIns to avoid
@@ -5706,18 +5712,49 @@ begin
 end;
 
 {$ifdef WinClipSupported}
+
+const
+   linelimit = 200;
+
 function TCustomCodeEditor.ClipPasteWin: Boolean;
-var OK: boolean;
-    l,i : longint;
+var
+    StorePos : TPoint;
+    first : boolean;
+
+procedure InsertStringWrap(const s: string; var i : Longint);
+var
+    BPos,EPos: TPoint;
+begin
+  if first then
+    begin
+      { we need to cut the line in two
+      if not at end of line PM }
+      InsertNewLine;
+      SetCurPtr(StorePos.X,StorePos.Y);
+      InsertText(s);
+      first:=false;
+    end
+  else
+    begin
+      Inc(i);
+      InsertLine(i,s);
+      BPos.X:=0;BPos.Y:=i;
+      EPOS.X:=Length(s);EPos.Y:=i;
+      AddAction(eaInsertLine,BPos,EPos,GetDisplayText(i),GetFlags);
+    end;
+end;
+
+var
+    OK: boolean;
+    l,i,len,len10 : longint;
     p,p10,p2,p13 : pchar;
     s : string;
-    BPos,EPos,StorePos : TPoint;
-    first : boolean;
 begin
   Lock;
   OK:=WinClipboardSupported;
   if OK then
     begin
+
       first:=true;
       StorePos:=CurPos;
       i:=CurPos.Y;
@@ -5732,48 +5769,39 @@ begin
             PushInfo(msg_readingwinclipboard);
           AddGroupedAction(eaPasteWin);
           p2:=p;
-          p13:=strpos(p,#13);
-          p10:=strpos(p,#10);
-          while assigned(p10) do
-            begin
-              if p13+1=p10 then
-                p13[0]:=#0
-              else
-                p10[0]:=#0;
-              s:=strpas(p2);
-              if first then
-                begin
-                  { we need to cut the line in two
-                    if not at end of line PM }
-                  InsertNewLine;
-                  SetCurPtr(StorePos.X,StorePos.Y);
-                  InsertText(s);
-                  first:=false;
-                end
-              else
-                begin
-                  Inc(i);
-                  InsertLine(i,s);
-                  BPos.X:=0;BPos.Y:=i;
-                  EPOS.X:=Length(s);EPos.Y:=i;
-                  AddAction(eaInsertLine,BPos,EPos,GetDisplayText(i),GetFlags);
-                end;
-              if p13+1=p10 then
-                p13[0]:=#13
-              else
-                p10[0]:=#10;
-              p2:=@p10[1];
-              p13:=strpos(p2,#13);
-              p10:=strpos(p2,#10);
-            end;
-          if strlen(p2)>0 then
-            begin
-              s:=strpas(p2);
-              if not first then
-                SetCurPtr(0,i+1);
-              InsertText(s);
-            end;
-          SetCurPtr(StorePos.X,StorePos.Y);
+          len:=strlen(p2);
+          // issue lines ((#13)#10 terminated) of maximally "linelimit" chars.
+          // does not take initial X position into account
+          repeat
+            p13:=strpos(p2,#13);
+            p10:=strpos(p2,#10);
+            if len> linelimit then
+              len:=linelimit;
+            if assigned(p10) then
+              begin
+               len10:=p10-p2;
+               if len10<len then
+                 begin
+                   if p13+1=p10 then
+                     dec(len10);
+                   len:=len10;
+                 end
+               else
+                 p10:=nil;  // signal no cleanup
+              end;
+            setlength(s,len);
+            if len>0 then
+              move(p2^,s[1],len);
+            // cleanup
+            if assigned(p10) then
+              p2:=p10+1
+            else
+              inc(p2,len);
+            insertstringwrap(s,i);
+            len:=strlen(p2);
+          until len=0;
+
+          SetCurPtr(StorePos.X,StorePos.Y);  // y+i to get after paste?
           SetModified(true);
           UpdateAttrs(StorePos.Y,attrAll);
           CloseGroupedAction(eaPasteWin);
@@ -6908,15 +6936,36 @@ begin
        End
      else
        Inherited HandleEvent(Event);
+  s:=getstr(data);
+  Message(Owner,evBroadCast,cminputlinelen,pointer(length(s)));
+end;
+
+procedure TSearchHelperDialog.HandleEvent(var Event : TEvent);
+begin
+ case Event.What of
+     evBroadcast :
+           case Event.Command of
+                   cminputlinelen : begin
+                                      if Event.InfoLong=0 then
+                                        okbutton^.DisableCommands([cmok]) 
+                                      else
+                                        okbutton^.EnableCommands([cmok]);
+                                      clearevent(event);
+                                    end;
+             end;      
+       end;
+  inherited HandleEvent(Event);
 end;
 
+
 function CreateFindDialog: PDialog;
 var R,R1,R2: TRect;
-    D: PDialog;
+    D: PSearchHelperDialog;
     IL1: PEditorInputLine;
     Control : PView;
     CB1: PCheckBoxes;
     RB1,RB2,RB3: PRadioButtons;
+    but : PButton;
 begin
   R.Assign(0,0,56,15);
   New(D, Init(R, dialog_find));
@@ -6975,7 +7024,8 @@ begin
     Insert(New(PLabel, Init(R1, label_find_origin, RB3)));
 
     GetExtent(R); R.Grow(-13,-1); R.A.Y:=R.B.Y-2; R.B.X:=R.A.X+10;
-    Insert(New(PButton, Init(R, btn_OK, cmOK, bfDefault)));
+    Okbutton:=New(PButton, Init(R, btn_OK, cmOK, bfDefault));
+    Insert(OkButton);
     R.Move(19,0);
     Insert(New(PButton, Init(R, btn_Cancel, cmCancel, bfNormal)));
   end;

packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -121,7 +121,7 @@ type
 implementation
 
 uses
-  strutils, typinfo;
+  strutils;
 
 type
   TTm = packed record
@@ -954,7 +954,7 @@ begin
         else
           begin
             result := false;
-            databaseerror('Field type '+getenumname(typeinfo(tfieldtype),ord(FieldDef.DataType))+' not supported.');
+            databaseerrorfmt(SUnsupportedFieldType, [Fieldtypenames[FieldDef.DataType], Self]);
           end
       end;  { case }
       end; { if/else }

rtl/os2/systhrd.inc

@@ -1,6 +1,6 @@
 {
     This file is part of the Free Pascal run time library.
-    Copyright (c) 2002-5 by Tomas Hajny,
+    Copyright (c) 2002-2010 by Tomas Hajny,
     member of the Free Pascal development team.
 
     OS/2 threading support implementation
@@ -28,6 +28,11 @@ const
  sem_Indefinite_Wait = cardinal (-1);
  dtSuspended = 1;
  dtStack_Commited = 2;
+ deThread = 0; {DosExit - exit thread only}
+ dcWW_Wait = 0;
+ dcWW_NoWait = 1;
+ dpThread = 2;
+ dpSameClass = 0;
 
 
 { import the necessary stuff from the OS }
@@ -57,14 +62,35 @@ function DosRequestMutExSem (Handle:longint; Timeout: cardinal): cardinal; cdecl
 function DosReleaseMutExSem (Handle: longint): cardinal; cdecl;
                                                  external 'DOSCALLS' index 335;
 
-{
+function DosSuspendThread (TID:cardinal): cardinal; cdecl;
+                                                 external 'DOSCALLS' index 238;
+
+function DosResumeThread (TID: cardinal): cardinal; cdecl;
+                                                 external 'DOSCALLS' index 237;
+
+function DosKillThread (TID: cardinal): cardinal; cdecl;
+                                                 external 'DOSCALLS' index 111;
+
+function DosWaitThread (var TID: cardinal; Option: cardinal): cardinal; cdecl;
+                                                 external 'DOSCALLS' index 349;
+
 function DosEnterCritSec:cardinal; cdecl; external 'DOSCALLS' index 232;
 
 function DosExitCritSec:cardinal; cdecl; external 'DOSCALLS' index 233;
-}
 
 procedure DosSleep (MSec: cardinal); cdecl; external 'DOSCALLS' index 229;
 
+{
+procedure DosExit (Action, Result: cardinal); cdecl;
+                                                 external 'DOSCALLS' index 234;
+
+Already declared in the main part of system.pas...
+}
+
+function DosSetPriority (Scope, TrClass: cardinal; Delta: longint;
+                                           PortID: cardinal): cardinal; cdecl;
+                                                 external 'DOSCALLS' index 236;
+
 
 {*****************************************************************************
                              Threadvar support
@@ -73,11 +99,13 @@ procedure DosSleep (MSec: cardinal); cdecl; external 'DOSCALLS' index 229;
 const
  ThreadVarBlockSize: dword = 0;
 
-var
+
+const
 (* Pointer to an allocated dword space within the local thread *)
 (* memory area. Pointer to the real memory block allocated for *)
 (* thread vars in this block is then stored in this dword.     *)
- DataIndex: PPointer;
+ DataIndex: PPointer = nil;
+
 
 procedure SysInitThreadvar (var Offset: dword; Size: dword);
 begin
@@ -85,10 +113,6 @@ begin
  Inc (ThreadVarBlockSize, Size);
 end;
 
-function SysRelocateThreadVar (Offset: dword): pointer;
-begin
- SysRelocateThreadVar := DataIndex^ + Offset;
-end;
 
 procedure SysAllocateThreadVars;
 begin
@@ -98,16 +122,63 @@ begin
  { these aren't allocated yet ...           }
  { allocate room on the heap for the thread vars }
  if DosAllocMem (DataIndex^, ThreadVarBlockSize, pag_Read or pag_Write
-                                      or pag_Commit) <> 0 then HandleError (8);
+                                                       or pag_Commit) <> 0 then
+  HandleError (8);
+{ The Windows API apparently provides a way to fill the allocated memory with }
+{ zeros; we probably need to do it ourselves for compatibility. }
+ FillChar (DataIndex^^, 0, ThreadVarBlockSize);
 end;
 
+
+function SysRelocateThreadVar (Offset: dword): pointer;
+begin
+{ DataIndex itself not checked for not being nil - expected that this should }
+{ not be necessary because the equivalent check (i.e. TlsKey not being set)  }
+{ is note performed by the Windows implementation.                           }
+  if DataIndex^ = nil then
+   begin
+    SysAllocateThreadVars;
+    InitThread ($1000000);
+   end;
+  SysRelocateThreadVar := DataIndex^ + Offset;
+end;
+
+
+procedure SysInitMultithreading;
+begin
+  { do not check IsMultiThread, as program could have altered it, out of Delphi habit }
+
+  { the thread attach/detach code uses locks to avoid multiple calls of this }
+  if DataIndex = nil then
+   begin
+    { We're still running in single thread mode, setup the TLS }
+    if DosAllocThreadLocalMemory (1, DataIndex) <> 0 then RunError (8);
+    InitThreadVars (@SysRelocateThreadvar);
+    IsMultiThread := true;
+   end;
+end;
+
+
+procedure SysFiniMultithreading;
+begin
+  if IsMultiThread then
+   begin
+    if DosFreeThreadLocalMemory (DataIndex) <> 0 then
+     begin
+{??? What to do if releasing fails?}
+     end;
+    DataIndex := nil;
+   end;
+end;
+
+
 procedure SysReleaseThreadVars;
 begin
-  { release thread vars }
   DosFreeMem (DataIndex^);
-  DosFreeThreadLocalMemory (DataIndex);
+  DataIndex^ := nil;
 end;
 
+
 (*    procedure InitThreadVars;
       begin
         { allocate one ThreadVar entry from the OS, we use this entry }
@@ -178,125 +249,148 @@ end;
       end;
 
 
-    function SysBeginThread(sa : Pointer;stacksize : SizeUInt;
-                         ThreadFunction : tthreadfunc;p : pointer;
-                         creationFlags : dword; var ThreadId : TThreadID) : DWord;
-      var
-        TI: PThreadInfo;
-      begin
-{$ifdef DEBUG_MT}
-        writeln('Creating new thread');
-{$endif DEBUG_MT}
-        { Initialize multithreading if not done }
-        if not IsMultiThread then
-         begin
-           if DosAllocThreadLocalMemory (1, DataIndex) <> 0
-             then RunError (8);
-           InitThreadVars(@SysRelocateThreadVar);
-           IsMultiThread:=true;
-         end;
-        { the only way to pass data to the newly created thread
-          in a MT safe way, is to use the heap }
-        New (TI);
-        TI^.F := ThreadFunction;
-        TI^.P := P;
-        TI^.StkLen := StackSize;
-        { call pthread_create }
+function SysBeginThread (SA: pointer; StackSize : PtrUInt;
+                         ThreadFunction: TThreadFunc; P: pointer;
+                         CreationFlags: cardinal; var ThreadId: TThreadID): DWord;
+var
+  TI: PThreadInfo;
+begin
+{ WriteLn is not a good idea before thread initialization...
+  $ifdef DEBUG_MT}
+  WriteLn ('Creating new thread');
+{ $endif DEBUG_MT}
+{ Initialize multithreading if not done }
+  SysInitMultithreading;
+  InitThreadVars (@SysRelocateThreadVar);
+{ the only way to pass data to the newly created thread
+  in a MT safe way, is to use the heap }
+  New (TI);
+  TI^.F := ThreadFunction;
+  TI^.P := P;
+  TI^.StkLen := StackSize;
 {$ifdef DEBUG_MT}
-        writeln('Starting new thread');
+  WriteLn ('Starting new thread');
 {$endif DEBUG_MT}
-        if DosCreateThread (DWord (ThreadID), @ThreadMain, SA,
-                                           CreationFlags, StackSize) = 0 then
-        SysBeginThread := ThreadID else SysBeginThread := 0;
-      end;
+  ThreadID := 0;
+  if DosCreateThread (cardinal (ThreadID), @ThreadMain, SA,
+                                             CreationFlags, StackSize) = 0 then
+   SysBeginThread := ThreadID
+  else
+   begin
+    SysBeginThread := 0;
+{$IFDEF DEBUG_MT}
+    WriteLn ('Thread creation failed');
+{$ENDIF DEBUG_MT}
+    Dispose (TI);
+   end;
+end;
 
 
-    procedure SysEndThread (ExitCode : DWord);
-      begin
-        DoneThread;
-        DosExit (1, ExitCode);
-      end;
+procedure SysEndThread (ExitCode: cardinal);
+begin
+  DoneThread;
+  DosExit (0, ExitCode);
+end;
 
 
-    procedure SysThreadSwitch;
-    begin
-      DosSleep (0);
-    end;
+procedure SysThreadSwitch;
+begin
+  DosSleep (0);
+end;
 
 
-    function SysSuspendThread (ThreadHandle: dword): dword;
-    begin
- {$WARNING TODO!}
-{     SysSuspendThread := WinSuspendThread(threadHandle);
-}
-    end;
+function SysSuspendThread (ThreadHandle: dword): dword;
+begin
+{$WARNING Check expected return value}
+  SysSuspendThread := DosSuspendThread (ThreadHandle);
+end;
 
 
-    function SysResumeThread (ThreadHandle: dword): dword;
-    begin
-{$WARNING TODO!}
-{      SysResumeThread := WinResumeThread(threadHandle);
-}
-    end;
+function SysResumeThread (ThreadHandle: dword): dword;
+begin
+{$WARNING Check expected return value}
+  SysResumeThread := DosResumeThread (ThreadHandle);
+end;
 
 
-    function SysKillThread (ThreadHandle: dword): dword;
-    var
-      ExitCode: dword;
-    begin
-{$WARNING TODO!}
-{
-      if not TerminateThread (ThreadHandle, ExitCode) then
-        SysKillThread := GetLastError
-      else
-        SysKillThread := 0;
-}
-    end;
+function SysKillThread (ThreadHandle: dword): dword;
+begin
+  SysKillThread := DosKillThread (ThreadHandle);
+end;
 
-    function SysCloseThread (threadHandle : TThreadID) : dword;
-    begin
-      SysCloseThread := 0;
+function SysCloseThread (ThreadHandle: TThreadID): dword;
+begin
+{ Probably not relevant under OS/2? }
 //      SysCloseThread:=CloseHandle(threadHandle);
-    end;
+end;
 
-    function SysWaitForThreadTerminate (ThreadHandle: dword;
+function SysWaitForThreadTerminate (ThreadHandle: dword;
                                                     TimeoutMs: longint): dword;
-    begin
-{$WARNING TODO!}
-{
-      if TimeoutMs = 0 then dec (timeoutMs);  // $ffffffff is INFINITE
-      SysWaitForThreadTerminate := WaitForSingleObject(threadHandle, TimeoutMs);
-}
-    end;
+var
+  RC: cardinal;
+const
+{ Wait at most 100 ms before next check for thread termination }
+  WaitTime = 100;
+begin
+  if TimeoutMs = 0 then
+   RC := DosWaitThread (ThreadHandle, dcWW_Wait)
+  else
+   repeat
+    RC := DosWaitThread (ThreadHandle, dcWW_NoWait);
+    if RC = 294 then
+     begin
+      if TimeoutMs > WaitTime then
+       DosSleep (WaitTime)
+      else
+       begin
+        DosSleep (TimeoutMs);
+        DosWaitThread (ThreadHandle, dcWW_NoWait);
+       end;
+      Dec (TimeoutMs, WaitTime);
+     end;
+   until (RC <> 294) or (TimeoutMs <= 0);
+  SysWaitForThreadTerminate := RC;
+end;
 
 
-    function SysThreadSetPriority (ThreadHandle: dword;
-                                                       Prio: longint): boolean;
-    {-15..+15, 0=normal}
-    begin
+function SysThreadSetPriority (ThreadHandle: dword; Prio: longint): boolean;
+{-15..+15, 0=normal}
+var
+  Delta: longint;
+begin
 {$WARNING TODO!}
 {
       SysThreadSetPriority:=WinThreadSetPriority(threadHandle,Prio);
+
+Find out current priority first using DosGetInfoBlocks, then calculate delta
+(recalculate the scale from -15..+15 on input to -31..+31 used by OS/2).
+
+  SysThreadSetPriority := DosSetPriority (dpThread, dpSameClass, Delta,
+                                                                 ThreadHandle);
 }
-    end;
+end;
 
 
-    function SysThreadGetPriority (ThreadHandle: dword): longint;
-    begin
+function SysThreadGetPriority (ThreadHandle: dword): longint;
+begin
 {$WARNING TODO!}
 {
       SysThreadGetPriority:=WinThreadGetPriority(threadHandle);
+
+  DosGetInfoBlocks - recalculate the scale afterwards to -15..+15
 }
-    end;
+end;
 
 
-    function SysGetCurrentThreadID: dword;
-    begin
+function SysGetCurrentThreadID: dword;
+begin
 {$WARNING TODO!}
 {
       SysGetCurrentThreadId:=WinGetCurrentThreadId;
+
+  DosGetInfoBlocks
 }
-    end;
+end;
 
 
 

rtl/win/systhrd.inc

@@ -92,7 +92,6 @@ CONST
       TLSKey : DWord = $ffffffff;
     var
       MainThreadIdWin32 : DWORD;
-      AttachingThread : TRTLCriticalSection;
 
     procedure SysInitThreadvar(var offset : dword;size : dword);
       begin

rtl/win/syswin.inc

@@ -34,7 +34,6 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
      case DLLreason of
        DLL_PROCESS_ATTACH :
          begin
-           WinInitCriticalSection(AttachingThread);
            MainThreadIdWin32 := Win32GetCurrentThreadId;
 
            If SetJmp(DLLBuf) = 0 then
@@ -53,7 +52,6 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
          begin
            inclocked(Thread_count);
 
-           WinEnterCriticalSection(AttachingThread);
            if Win32GetCurrentThreadId <> MainThreadIdWin32 then
            begin
              { Allocate Threadvars  }
@@ -67,7 +65,6 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
            if assigned(Dll_Thread_Attach_Hook) then
              Dll_Thread_Attach_Hook(DllParam);
            Dll_entry:=true; { return value is ignored }
-           WinLeaveCriticalSection(AttachingThread);
         end;
        DLL_THREAD_DETACH :
          begin
@@ -92,7 +89,6 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
            DoneThread;
            { Free TLS resources used by ThreadVars }
            SysFiniMultiThreading;
-           WinDoneCriticalSection(AttachingThread);
 		   MainThreadIDWin32:=0;
          end;
      end;

rtl/win/video.pp

@@ -551,11 +551,14 @@ var
    ColCounter  : Longint;
    smallforce  : boolean;
    x1,y1,x2,y2 : longint;
+   p1,p2,p3    : PCardinal;
+   j           : integer;
 begin
   if force then
    smallforce:=true
   else
    begin
+    {$ifdef cpui386}
      asm
         pushl   %esi
         pushl   %edi
@@ -569,6 +572,36 @@ begin
         popl    %edi
         popl    %esi
      end;
+   {$else}
+    {$ifdef cpux86_64}
+     asm
+        pushq   %rsi
+        pushq   %rdi
+        xorq    %rcx,%rcx  
+        movq    VideoBuf,%rsi
+        movq    OldVideoBuf,%rdi
+        movl    VideoBufSize,%ecx
+        shrq    $2,%rcx
+        repe
+        cmpsl
+        setne   smallforce
+        popq    %rdi
+        popq    %rsi
+     end;
+    {$else}
+      {$INFO No optimized version for this CPU, reverting to a pascal version}
+       j:=Videobufsize shr 2;
+       smallforce:=false;
+       p1:=pcardinal(VideoBuf);
+       p2:=pcardinal(OldVideoBuf);
+       p3:=@pcardinal(videobuf)[j];
+       while (p1<p3) and (p1^=p2^) do
+         begin
+           inc(p1); inc(p2);
+         end; 
+       smallforce:=p1<>p3;  
+    {$ENDIF}
+   {$endif}
    end;
   if SmallForce then
    begin

utils/delp.pp

@@ -1,5 +1,5 @@
 {
-    Copyright (c) 1999-2000 by Peter Vreman
+    Copyright (c) 1999-2010 by Peter Vreman, Michael Van Canneyt
 
     Deletes all files generated for Pascal (*.exe,units,objects,libs)
 
@@ -19,13 +19,14 @@
 
  ****************************************************************************}
 program Delp;
+
 uses
   dos,getopts;
 
 const
-  Version   = 'Version 1.1';
+  Version   = 'Version 1.2';
   Title     = 'DelPascal';
-  Copyright = 'Copyright (c) 1999-2002 by the Free Pascal Development Team';
+  Copyright = 'Copyright (c) 1999-2010 by the Free Pascal Development Team';
 
 
 function DStr(l:longint):string;
@@ -165,7 +166,7 @@ Var quiet: boolean;
 procedure usage;
 
 begin
-  Writeln('Delp [options] <directory>');
+  Writeln('Delp [options] <directory> [<directory2> [<directory3> ...]');
   Writeln('Where options is one of:');
   writeln('  -e    Delete executables also (Not on Unix)');
   writeln('  -h    Display (this) help message.');
@@ -197,21 +198,20 @@ var
   hp     : pmaskitem;
   found  : boolean;
   basedir : string;
+  i : Integer;
 
 begin
   ProcessOptions;
-  if Optind<>ParamCount then
+  I:=OptInd;
+  if (OptInd=0) or (OptInd>ParamCount) then
     Usage;
-  BaseDir:=Paramstr(OptInd);
-  If BaseDir[Length(BaseDir)]<>DirectorySeparator then
-    BaseDir:=BaseDir+DirectorySeparator;
   { Win32 target }
   AddMask('*.ppw *.ow *.aw *.sw');
   AddMask('ppas.bat ppas.sh link.res fpcmaked fpcmade fpcmade.*');
   AddMask('*.tpu *.tpp *.tpw *.tr');
   AddMask('*.dcu *.dcp *.bpl');
   AddMask('*.log *.bak *.~pas *.~pp *.*~');
-  AddMask('*.ppu *.o *.a *.s');
+  AddMask('*.ppu *.o *.a *.s *.or *.compiled');
   AddMask('*.pp1 *.o1 *.a1 *.s1');
   AddMask('*.ppo *.oo *.ao *.so');
   AddMask('*.rst');
@@ -225,38 +225,46 @@ begin
       writeln(Copyright);
       Writeln;
     end;
-  FindFirst(basedir+'*.*',anyfile,Dir);
   Total:=0;
-  while (doserror=0) do
-   begin
-     hp:=masklist;
-     while assigned(hp) do
+  While (I<=ParamCount) do
+    begin
+    BaseDir:=Paramstr(I);
+    If BaseDir[Length(BaseDir)]<>DirectorySeparator then
+      BaseDir:=BaseDir+DirectorySeparator;
+    FindFirst(basedir+'*.*',anyfile,Dir);
+    while (doserror=0) do
       begin
+      hp:=masklist;
+      while assigned(hp) do
+        begin
         if MatchesMask(Dir.Name,hp^.mask) then
-         begin
-           EraseFile(BaseDir+Dir.Name);
-           inc(hp^.Files);
-           inc(hp^.Size,Dir.Size);
-           break;
-         end;
+          begin
+          EraseFile(BaseDir+Dir.Name);
+          inc(hp^.Files);
+          inc(hp^.Size,Dir.Size);
+          break;
+          end;
         hp:=hp^.next;
+        end;
+        FindNext(Dir);
       end;
-     FindNext(Dir);
-   end;
-{Write Results}
+    FindClose(Dir);
+    Inc(I);
+    end;
+  { Write Results }
   found:=false;
   hp:=masklist;
   while assigned(hp) do
-   begin
-     if hp^.Files>0 then
+    begin
+    if hp^.Files>0 then
       begin
-        if not quiet then
-          WriteLn(' - Removed ',hp^.Files:2,' ',hp^.Mask,' (',DStr(hp^.Size)+' Bytes)');
-        inc(Total,hp^.Size);
-        found:=true;
+      if not quiet then
+        WriteLn(' - Removed ',hp^.Files:2,' ',hp^.Mask,' (',DStr(hp^.Size)+' Bytes)');
+      inc(Total,hp^.Size);
+      found:=true;
       end;
-     hp:=hp^.next;
-   end;
+    hp:=hp^.next;
+    end;
   if not quiet then
     if not found then
       WriteLn(' - No Redundant Files Found!')