Browse Source

--- Merging r16452 into '.':
U packages/fv/src/app.pas
--- Merging r16466 into '.':
U packages/fv/src/drivers.pas
U packages/fv/src/fvcommon.pas
U packages/fv/src/sysmsg.pas
U packages/fv/src/w32smsg.inc
U packages/fv/src/time.pas
U packages/fv/src/platform.inc
U packages/fv/src/stddlg.pas
--- Merging r16468 into '.':
U packages/fcl-base/src/fptimer.pp
--- Merging r16475 into '.':
U rtl/powerpc/powerpc.inc
U rtl/powerpc64/powerpc64.inc
A tests/webtbs/tw18082.pp
--- Merging r16486 into '.':
U rtl/inc/variants.pp
--- Merging r16495 into '.':
U packages/opencl/src/cl.pp
--- Merging r16499 into '.':
U packages/fcl-db/src/base/dbconst.pas
--- Merging r16551 into '.':
U packages/fcl-image/src/ftfont.pp
--- Merging r16564 into '.':
C packages/Makefile
U packages/Makefile.fpc
Summary of conflicts:
Text conflicts: 1

# revisions: 16452,16466,16468,16475,16486,16495,16499,16551,16564
------------------------------------------------------------------------
r16452 | pierre | 2010-11-27 00:34:14 +0100 (Sat, 27 Nov 2010) | 1 line
Changed paths:
M /trunk/packages/fv/src/app.pas

* Try to fix VideoMode change problem
------------------------------------------------------------------------
------------------------------------------------------------------------
r16466 | pierre | 2010-11-28 20:35:43 +0100 (Sun, 28 Nov 2010) | 1 line
Changed paths:
M /trunk/packages/fv/src/drivers.pas
M /trunk/packages/fv/src/fvcommon.pas
M /trunk/packages/fv/src/platform.inc
M /trunk/packages/fv/src/stddlg.pas
M /trunk/packages/fv/src/sysmsg.pas
M /trunk/packages/fv/src/time.pas
M /trunk/packages/fv/src/w32smsg.inc

* First try to support 64-bit cpu's
------------------------------------------------------------------------
------------------------------------------------------------------------
r16468 | michael | 2010-11-28 21:15:22 +0100 (Sun, 28 Nov 2010) | 1 line
Changed paths:
M /trunk/packages/fcl-base/src/fptimer.pp

* Added WaitFor to fix 18044
------------------------------------------------------------------------
------------------------------------------------------------------------
r16475 | jonas | 2010-11-29 13:53:10 +0100 (Mon, 29 Nov 2010) | 5 lines
Changed paths:
M /trunk/rtl/powerpc/powerpc.inc
M /trunk/rtl/powerpc64/powerpc64.inc
A /trunk/tests/webtbs/tw18082.pp

* don't overwrite the target value of interlockedcompareexchange*() if the
value is different from the comparand (patch by "FVI", mantis #18082)
* sign extend the loaded value of interlockedcompareexchange() on PowerPC64,
because the function arguments are longints

------------------------------------------------------------------------
------------------------------------------------------------------------
r16486 | marco | 2010-11-30 21:49:46 +0100 (Tue, 30 Nov 2010) | 2 lines
Changed paths:
M /trunk/rtl/inc/variants.pp

* Initial variantop and compare handlers. Patch from Laaca, bug #16853

------------------------------------------------------------------------
------------------------------------------------------------------------
r16495 | florian | 2010-12-02 18:15:21 +0100 (Thu, 02 Dec 2010) | 4 lines
Changed paths:
M /trunk/packages/opencl/src/cl.pp

o patch for OpenCL package by Denis Golovan, resolves #18119
+ A constant for querying OpenCL version is added.
+ A small function for converting errors code into error texts is added.

------------------------------------------------------------------------
------------------------------------------------------------------------
r16499 | michael | 2010-12-03 09:37:03 +0100 (Fri, 03 Dec 2010) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/dbconst.pas

* Forgot to commit constants used in sqldb logging
------------------------------------------------------------------------
------------------------------------------------------------------------
r16551 | michael | 2010-12-11 15:03:57 +0100 (Sat, 11 Dec 2010) | 1 line
Changed paths:
M /trunk/packages/fcl-image/src/ftfont.pp

* Patch from Darius Blaszijk to make some methods protected, virtual
------------------------------------------------------------------------
------------------------------------------------------------------------
r16564 | marco | 2010-12-14 22:47:49 +0100 (Tue, 14 Dec 2010) | 2 lines
Changed paths:
M /trunk/packages/Makefile
M /trunk/packages/Makefile.fpc

* enabled gdbint for win64 to ease ide testing.

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

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

marco 14 years ago
parent
commit
772a746a42

+ 1 - 0
.gitattributes

@@ -9762,6 +9762,7 @@ tests/webtbs/tw1780.pp svneol=native#text/plain
 tests/webtbs/tw1792.pp svneol=native#text/plain
 tests/webtbs/tw1792a.pp svneol=native#text/plain
 tests/webtbs/tw1798.pp svneol=native#text/plain
+tests/webtbs/tw18082.pp svneol=native#text/plain
 tests/webtbs/tw18113.pp svneol=native#text/plain
 tests/webtbs/tw1820.pp svneol=native#text/plain
 tests/webtbs/tw1825.pp svneol=native#text/plain

+ 2 - 1
packages/Makefile

@@ -394,7 +394,7 @@ ifeq ($(FULL_TARGET),x86_64-darwin)
 override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-js fcl-process unzip regexpr chm fcl-res libgd symbolic bzip2 hermes  fv fcl-web fastcgi fcl-async ibase mysql ncurses zlib oracle odbc postgres sqlite pthreads imagemagick libpng gdbm tcl syslog libcurl bfd aspell utmp fftw pcap openssl numlib iconvenc gmp fcl-extra univint opengl x11 cairo gtk1 gtk2 librsvg fpgtk xforms gnome1 httpd13 httpd20 httpd22 imlib
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
-override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-js fcl-process unzip regexpr chm fcl-res libgd symbolic bzip2 hermes  fv winunits-base winunits-jedi fcl-web fastcgi ibase mysql zlib oracle odbc postgres sqlite imagemagick tcl opengl gtk1 fpgtk fftw sdl openssl cdrom httpd13 httpd20 httpd22 numlib fcl-extra opencl ptc graph
+override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-js fcl-process unzip regexpr chm fcl-res libgd symbolic bzip2 hermes  fv winunits-base winunits-jedi fcl-web fastcgi ibase mysql zlib oracle odbc postgres sqlite imagemagick gdbint tcl opengl gtk1 fpgtk fftw sdl openssl cdrom httpd13 httpd20 httpd22 numlib fcl-extra opencl ptc graph
 endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
 override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-js fcl-process unzip regexpr chm fcl-res libgd symbolic bzip2 hermes
@@ -3859,6 +3859,7 @@ TARGET_DIRS_ODBC=1
 TARGET_DIRS_POSTGRES=1
 TARGET_DIRS_SQLITE=1
 TARGET_DIRS_IMAGEMAGICK=1
+TARGET_DIRS_GDBINT=1
 TARGET_DIRS_TCL=1
 TARGET_DIRS_OPENGL=1
 TARGET_DIRS_GTK1=1

+ 1 - 1
packages/Makefile.fpc

@@ -50,7 +50,7 @@ dirs_win32=fv winunits-base winunits-jedi fcl-web fastcgi ibase mysql zlib oracl
                gdbint libpng mad tcl opengl gtk1 gtk2 librsvg a52 cdrom fpgtk openal fftw lua fcl-extra  \
                oggvorbis sdl openssl graph pcap httpd13 httpd20 httpd22 pxlib numlib winceunits cairo libxml \
                gmp opencl ptc libsee
-dirs_win64=fv winunits-base winunits-jedi fcl-web fastcgi ibase mysql zlib oracle odbc postgres sqlite imagemagick \
+dirs_win64=fv winunits-base winunits-jedi fcl-web fastcgi ibase mysql zlib oracle odbc postgres sqlite imagemagick gdbint \
                tcl opengl gtk1 fpgtk fftw sdl openssl cdrom httpd13 httpd20 httpd22 numlib fcl-extra opencl ptc graph 
 dirs_wince=winceunits httpd22 fcl-web fastcgi tcl fftw unzip zlib sqlite mysql ibase postgres oracle odbc sdl openssl oggvorbis numlib
 dirs_os2=fv zlib libpng x11 tcl fpgtk rexx os2units gtk1 imlib

+ 10 - 1
packages/fcl-base/src/fptimer.pp

@@ -182,6 +182,7 @@ Type
   TFPThreadedTimerDriver = Class(TFPTimerDriver)
   Private
     FThread : TFPTimerThread;
+    Procedure DoNilTimer(Sender : TObject);
   Public
     Procedure StartTimer; override;
     Procedure StopTimer; override;
@@ -242,10 +243,17 @@ end;
     TFPThreadedTimerDriver
   ---------------------------------------------------------------------}
 
+Procedure TFPThreadedTimerDriver.DoNilTimer(Sender : TObject);
+
+begin
+  FThread:=Nil;
+end;
+
 Procedure TFPThreadedTimerDriver.StartTimer; 
 
 begin
   FThread:=TFPTimerThread.CreateTimerThread(Self);
+  FThread.OnTerminate:=@DoNilTimer;
   FThread.Resume;
 end;
 
@@ -253,8 +261,9 @@ Procedure TFPThreadedTimerDriver.StopTimer;
 begin
   FThread.FTimerDriver:=Nil;
   FThread.Terminate; // Will free itself.
-  FThread:=Nil;
   CheckSynchronize; // make sure thread is not stuck at synchronize call.
+  If Assigned(FThread) then
+    Fthread.WaitFor;  
 end;
 
 

+ 4 - 1
packages/fcl-db/src/base/dbconst.pas

@@ -105,7 +105,10 @@ Resourcestring
   SStreamNotRecognised     = 'The data-stream format is not recognized';
   SNoReaderClassRegistered = 'There is no TDatapacketReaderClass registered for this kind of data-stream';
   SErrCircularDataSourceReferenceNotAllowed = 'Circular datasource references are not allowed.';
-  
+  SCommitting              = 'Committing transaction';
+  SRollingBack             = 'Rolling back transaction';
+  SCommitRetaining         = 'Commit and retaining transaction';
+  SRollBackRetaining       = 'Rollback and retaining transaction';
 
 Implementation
 

+ 2 - 2
packages/fcl-image/src/ftfont.pp

@@ -31,10 +31,10 @@ type
     FIndex, FFontID : integer;
     FFace : PFT_Face;
     FAngle : real;
-    procedure DrawChar (x,y:integer; data:PByteArray; pitch, width, height:integer);
-    procedure DrawCharBW (x,y:integer; data:PByteArray; pitch, width, height:integer);
     procedure ClearLastText;
   protected
+    procedure DrawChar (x,y:integer; data:PByteArray; pitch, width, height:integer); virtual;
+    procedure DrawCharBW (x,y:integer; data:PByteArray; pitch, width, height:integer); virtual;
     procedure SetName (AValue:string); override;
     procedure SetIndex (AValue : integer);
     procedure SetSize (AValue : integer); override;

+ 7 - 1
packages/fv/src/app.pas

@@ -900,8 +900,14 @@ begin
   ScreenMode:=Mode;
 {  InitMouse;
   InitMemory;}
-  InitScreen;
+{  InitScreen;
+   Warning: InitScreen calls DetectVideo which
+    resets ScreenMode to old value, call it after
+    video mode was changed instead of before }
   Video.SetVideoMode(Mode);
+
+  { Update ScreenMode to new value }
+  InitScreen;
   ScreenWidth:=Video.ScreenWidth;
   ScreenHeight:=Video.ScreenHeight;
   Buffer := Views.PVideoBuf(VideoBuf);

+ 5 - 5
packages/fv/src/drivers.pas

@@ -1072,10 +1072,10 @@ begin
      keyshift:=KeyBoard.GetKeyEventShiftState(key);
      // some kbds still honour old XT E0 prefix. (org IBM ps/2, win98?) bug #8978
      if (keycode and $FF = $E0) and
-        (byte(keycode shr 8) in  
+        (byte(keycode shr 8) in
               [$1C,$1D,$2A,$35..$38,$46..$49,$4b,$4d,$4f,$50..$53]) Then
           keycode := keycode and $FF00;
-     
+
      { fixup shift-keys }
      if keyshift and kbShift<>0 then
        begin
@@ -1341,10 +1341,10 @@ begin
     exit;
   GetVideoMode(StartupScreenMode);
   GetVideoMode(ScreenMode);
-{$ifdef win32}
+{$ifdef OS_WINDOWS}
   { Force the console to the current screen mode }
   Video.SetVideoMode(ScreenMode);
-{$endif win32}
+{$endif OS_WINDOWS}
 
   If (StoreScreenMode.Col<>0) and
      ((StoreScreenMode.color<>ScreenMode.color) or
@@ -1587,7 +1587,7 @@ BEGIN
    DetectVideo;                                       { Detect video }
 {   InitKeyboard;}
    InitSystemMsg;
-{$ifdef win32}
+{$ifdef OS_WINDOWS}
    SetFileApisToOEM;
 {$endif}
 

+ 4 - 4
packages/fv/src/fvcommon.pas

@@ -61,7 +61,7 @@ UNIT FVCommon;
 {$I platform.inc}
 {====================================================================}
 
-{$ifdef win32}
+{$ifdef OS_WINDOWS}
   uses
     Windows;
 {$endif}
@@ -99,7 +99,7 @@ CONST
 {$IFDEF BIT_16}                                       { 16 BIT DEFINITION }
    MaxBytes = 65520;                                  { Maximum data size }
 {$ENDIF}
-{$IFDEF BIT_32}                                       { 32 BIT DEFINITION }
+{$IFDEF BIT_32_OR_MORE}                                       { 32 BIT DEFINITION }
    MaxBytes = 128*1024*1024;                          { Maximum data size }
 {$ENDIF}
    MaxWords = MaxBytes DIV SizeOf(Word);              { Max words }
@@ -117,7 +117,7 @@ CONST
 {                           CPU TYPE DEFINITIONS                            }
 {---------------------------------------------------------------------------}
 TYPE
-{$IFDEF BIT_32}                                       { 32 BIT CODE }
+{$IFDEF BIT_32_OR_MORE}                               { 32 BIT CODE }
    CPUWord = Longint;                                 { CPUWord is 32 bit }
    CPUInt = Longint;                                  { CPUInt is 32 bit }
 {$ELSE}                                               { 16 BIT CODE }
@@ -133,7 +133,7 @@ TYPE
    Sw_Word    = Word;                                 { Standard word }
    Sw_Integer = Integer;                              { Standard integer }
 {$ENDIF}
-{$IFDEF BIT_32}                                       { 32 BIT DEFINITIONS }
+{$IFDEF BIT_32_OR_MORE}                               { 32 BIT DEFINITIONS }
    Sw_Word    = Cardinal;                             { Long integer now }
    Sw_Integer = LongInt;                              { Long integer now }
 {$ENDIF}

+ 44 - 2
packages/fv/src/platform.inc

@@ -31,9 +31,12 @@
 {                 - Virtual Pascal 2.0+     (32 Bit)       }
 {                 - Speedsoft Sybil 2.0+    (32 Bit)       }
 {                 - FPC 0.9912+             (32 Bit)       }
+{       WIN64     - FPC 2.4.3               (64 Bit)       }
 {        OS2      - Virtual Pascal 1.0+     (32 Bit)       }
 {                 - C'T patch to BP         (16 Bit)       }
 {        LINUX    - FPC 0.9912+             (32 Bit)       }
+{        LINUX    - FPC 2.4.3               (64 Bit)       }
+{        LINUX    - FPC 2.4.3               (64 Bit)       }
 {                                                          }
 {******************[ REVISION HISTORY ]********************}
 {  Version  Date      Who    Fix                           }
@@ -55,6 +58,7 @@
 {  1.32    04 Nov 99  LdB    Delphi 5 definitions added    }
 {  1.33    16 Oct 00  LdB    WIN32/WIN16 defines added     }
 {  1.34    02 May 02  MvdV   FreeBSD, NetBSD, OS_UNIX      }
+{  1.35    28 Nov 10  PM     64 bit OS Linux, Win64, FreeBSD }
 {**********************************************************}
 
 { ****************************************************************************
@@ -84,9 +88,11 @@
                       FPC      PPC_FPC      PROC_Protected  BIT_32  ASM_FPC
 
  LINUX    OS_LINUX    FPC      PPC_FPC      PROC_Protected  BIT_32  ASM_FPC
+ LINUX    OS_LINUX    FPC      PPC_FPC      PROC_Protected  BIT_64  ASM_FPC
           OS_UNIX
 
  FREEBSD  OS_FREEBSD  FPC      PPC_FPC      PROC_Protected  BIT_32  ASM_FPC
+ FREEBSD  OS_FREEBSD  FPC      PPC_FPC      PROC_Protected  BIT_64  ASM_FPC
           OS_UNIX
 
  NETBSD   OS_NETBSD   FPC      PPC_FPC      PROC_Protected  BIT_32  ASM_FPC
@@ -103,6 +109,7 @@
                       VIRTUAL  PPC_VIRTUAL  PROC_Protected  BIT 32  ASM_BP
                       SYBIL2   PPC_SPEED    PROC_Protected  BIT_32  ASM_BP
                       FPC      PPC_FPC      PROC_Protected  BIT_32  ASM_FPC
+ WINDOWS 64-BITS      FPC      PPC_FPC      PROC_Protected  BIT_64  ASM_FPC
 
  OS2      OS_OS2      BPOS2    PPC_BPOS2    PROC_Protected  BIT_16  ASM_BP
                       VIRTUAL  PPC_VIRTUAL  PROC_Protected  BIT_32  ASM_BP
@@ -153,6 +160,7 @@ FOR FPC THESE ARE THE TRANSLATIONS
 
 {---------------------------------------------------------------------------}
 {  FPC 32 BIT COMPILER changes ASM, 32 bits etc - Updated 27Aug98 LdB       }
+{  FPC 64 BIT COMPILER added - Update 28Nov2010 PM                          }
 {---------------------------------------------------------------------------}
 {$IFDEF FPC}
   {$mode fpc}
@@ -160,7 +168,13 @@ FOR FPC THESE ARE THE TRANSLATIONS
   {$UNDEF PROC_Real}
   {$DEFINE PROC_Protected}
   {$UNDEF BIT_16}
-  {$DEFINE BIT_32}
+  {$IFDEF CPU64}
+    {$UNDEF BIT_32}
+    {$DEFINE BIT_64}
+  {$ELSE}
+    {$DEFINE BIT_32}
+    {$UNDEF BIT_64}
+  {$ENDIF}
   {$UNDEF PPC_BP}
   {$DEFINE PPC_FPC}
   {$UNDEF ASM_BP}
@@ -244,6 +258,18 @@ FOR FPC THESE ARE THE TRANSLATIONS
   {$DEFINE BIT_32}
 {$ENDIF}
 
+{---------------------------------------------------------------------------}
+{  64 BIT WINDOWS COMPILERS changes bit size - Updated 28Nov10 PM           }
+{---------------------------------------------------------------------------}
+{$IFDEF WIN64}
+  {$IFNDEF WINDOWS}
+    {$DEFINE WINDOWS}
+  {$ENDIF}
+  {$UNDEF BIT_16}
+  {$UNDEF BIT_32}
+  {$DEFINE BIT_64}
+{$ENDIF}
+
 {---------------------------------------------------------------------------}
 {  WINDOWS COMPILERS change op system and proc mode - Updated 03Nov99 LdB   }
 {---------------------------------------------------------------------------}
@@ -253,7 +279,7 @@ FOR FPC THESE ARE THE TRANSLATIONS
   {$UNDEF PROC_Real}
   {$DEFINE PROC_Protected}
   {$IFDEF FPC}
-    {$DEFINE WIN32}
+    // {$DEFINE WIN32}
   {$ENDIF}
 {$ENDIF}
 
@@ -413,6 +439,7 @@ FOR FPC THESE ARE THE TRANSLATIONS
 
 {---------------------------------------------------------------------------}
 {  WIN16 AND WIN32 set if in windows - Updated 16Oct2000 LdB                }
+{  WIN64 added - Update 28Nov2010 PM                                        }
 {---------------------------------------------------------------------------}
 {$IFDEF OS_WINDOWS}                                   { WINDOWS SYSTEM }
   {$IFDEF BIT_16}
@@ -421,7 +448,22 @@ FOR FPC THESE ARE THE TRANSLATIONS
   {$IFDEF BIT_32}
     {$DEFINE WIN32}                                   { 32 BIT WINDOWS }
   {$ENDIF}
+  {$IFDEF BIT_64}
+    {$DEFINE WIN64}                                   { 64 BIT WINDOWS }
+  {$ENDIF}
 {$ENDIF}
 
 
+{---------------------------------------------------------------------------}
+{  BIT_32_OR_MORE                                                           }
+{---------------------------------------------------------------------------}
+
+{$ifdef BIT_16}
+  {$UNDEF BIT_32_OR_MORE}
+{$ELSE}
+  {$DEFINE BIT_32_OR_MORE}
+{$ENDIF}
+
+
+
 

+ 6 - 6
packages/fv/src/stddlg.pas

@@ -619,9 +619,9 @@ resourcestring  sChangeDirectory='Change Directory';
 {$ifdef go32v2}
 {$define NetDrive}
 {$endif go32v2}
-{$ifdef win32}
+{$ifdef OS_WINDOWS}
 {$define NetDrive}
-{$endif win32}
+{$endif OS_WINDOWS}
 
 procedure RemoveDoubleDirSep(var ExpPath : PathStr);
 var
@@ -671,7 +671,7 @@ begin
     // This function is called on current directories.
     // If the current dir starts with a . on Linux it is is hidden.
     // That's why we allow hidden dirs below (bug 6173)
-    FindFirst(ExpPath, Directory+hidden, SR); 
+    FindFirst(ExpPath, Directory+hidden, SR);
     PathValid := (DosError = 0) and (SR.Attr and Directory <> 0);
 {$ifdef NetDrive}
     if (DosError<>0) and (length(ExpPath)>2) and
@@ -2746,11 +2746,11 @@ begin
   else
     IllegalChars := ';,=+<>|"[] '+DirSeparator;
 {$else not go32v2}
-{$ifdef win32}
+{$ifdef OS_WINDOWS}
     IllegalChars := ';,=+<>|"[]'+DirSeparator;
-{$else not go32v2 and not win32 }
+{$else not go32v2 and not OS_WINDOWS }
     IllegalChars := ';,=+<>|"[] '+DirSeparator;
-{$endif not win32}
+{$endif not OS_WINDOWS}
 {$endif not go32v2}
 {$else not PPC_FPC}
   IllegalChars := ';,=+<>|"[] '+DirSeparator;

+ 2 - 2
packages/fv/src/sysmsg.pas

@@ -74,10 +74,10 @@ implementation
 {$i go32smsg.inc}
 {$define HAS_SYSMSG}
 {$endif go32v2}
-{$ifdef win32}
+{$ifdef OS_WINDOWS}
 {$i w32smsg.inc}
 {$define HAS_SYSMSG}
-{$endif win32}
+{$endif OS_WINDOWS}
 {$ifdef unix}
 {$i unixsmsg.inc}
 {$define HAS_SYSMSG}

+ 4 - 4
packages/fv/src/time.pas

@@ -292,13 +292,13 @@ PROCEDURE SetTime (Hour, Minute, Second, Sec100: Word);
      POP BP;                                          { Restore register }
    END;
    {$ENDIF}
-   {$IFDEF BIT_32}                                    { 32 BIT WINDOWS CODE }
+   {$IFDEF BIT_32_OR_MORE}                            { 32 BIT WINDOWS CODE }
    VAR DT: TSystemTime;
    BEGIN
      {$IFDEF PPC_FPC}                                 { FPC WINDOWS COMPILER }
-     GetLocalTime(@DT);                              { Get the date/time }
+     GetLocalTime(@DT);                               { Get the date/time }
      {$ELSE}                                          { OTHER COMPILERS }
-     GetLocalTime(DT);                               { Get the date/time }
+     GetLocalTime(DT);                                { Get the date/time }
      {$ENDIF}
      DT.wHour := Hour;                                { Transfer hour }
      DT.wMinute := Minute;                            { Transfer minute }
@@ -417,7 +417,7 @@ PROCEDURE GetTime (Var Hour, Minute, Second, Sec100: Word);
      STOSW;                                           { Return hours }
    END;
    {$ENDIF}
-   {$IFDEF BIT_32}                                    { 32 BIT WINDOWS CODE }
+   {$IFDEF BIT_32_OR_MORE}                            { 32 BIT WINDOWS CODE }
    VAR DT: TSystemTime;
    BEGIN
      {$IFDEF PPC_FPC}                                 { FPC WINDOWS COMPILER }

+ 1 - 1
packages/fv/src/w32smsg.inc

@@ -1,5 +1,5 @@
 {
-   System independent system interface for win32
+   System independent system interface for win32/win64
 
    Copyright (c) 2000 by Pierre Muller
 

+ 57 - 0
packages/opencl/src/cl.pp

@@ -407,6 +407,7 @@ const
   CL_DEVICE_VERSION                           = $102F;
   CL_DEVICE_EXTENSIONS                        = $1030;
   CL_DEVICE_PLATFORM                          = $1031;
+  CL_DEVICE_OPENCL_C_VERSION                  = $103D;
 
 // cl_device_address_info - bitfield
   CL_DEVICE_ADDRESS_32_BITS                   = (1 shl 0);
@@ -1161,6 +1162,62 @@ function clEnqueueBarrier(command_queue: cl_command_queue
   ): cl_int; extdecl;
   external {$ifdef DYNLINK}opencllib{$endif} name 'clEnqueueBarrier';
 
+function clErrorText(err:cl_int):string;
+
 implementation
 
+function clErrorText(err:cl_int):string;
+begin
+  case err of
+    CL_DEVICE_NOT_FOUND : clErrorText:='CL_DEVICE_NOT_FOUND';
+    CL_DEVICE_NOT_AVAILABLE : clErrorText:='CL_DEVICE_NOT_AVAILABLE';
+    CL_DEVICE_COMPILER_NOT_AVAILABLE : clErrorText:='CL_DEVICE_COMPILER_NOT_AVAILABLE';
+    CL_MEM_OBJECT_ALLOCATION_FAILURE : clErrorText:='CL_MEM_OBJECT_ALLOCATION_FAILURE';
+    CL_OUT_OF_RESOURCES : clErrorText:='CL_OUT_OF_RESOURCES';
+    CL_OUT_OF_HOST_MEMORY : clErrorText:='CL_OUT_OF_HOST_MEMORY';
+    CL_PROFILING_INFO_NOT_AVAILABLE : clErrorText:='CL_PROFILING_INFO_NOT_AVAILABLE';
+    CL_MEM_COPY_OVERLAP : clErrorText:='CL_MEM_COPY_OVERLAP';
+    CL_IMAGE_FORMAT_MISMATCH : clErrorText:='CL_IMAGE_FORMAT_MISMATCH';
+    CL_IMAGE_FORMAT_NOT_SUPPORTED : clErrorText:='CL_IMAGE_FORMAT_NOT_SUPPORTED';
+    CL_BUILD_PROGRAM_FAILURE : clErrorText:='CL_BUILD_PROGRAM_FAILURE';
+    CL_MAP_FAILURE : clErrorText:='CL_MAP_FAILURE';
+
+    CL_INVALID_VALUE : clErrorText:='CL_INVALID_VALUE';
+    CL_INVALID_DEVICE_TYPE : clErrorText:='CL_INVALID_DEVICE_TYPE';
+    CL_INVALID_PLATFORM : clErrorText:='CL_INVALID_PLATFORM';
+    CL_INVALID_DEVICE : clErrorText:='CL_INVALID_DEVICE';
+    CL_INVALID_CONTEXT : clErrorText:='CL_INVALID_CONTEXT';
+    CL_INVALID_QUEUE_PROPERTIES : clErrorText:='CL_INVALID_QUEUE_PROPERTIES';
+    CL_INVALID_COMMAND_QUEUE : clErrorText:='CL_INVALID_COMMAND_QUEUE';
+    CL_INVALID_HOST_PTR : clErrorText:='CL_INVALID_HOST_PTR';
+    CL_INVALID_MEM_OBJECT : clErrorText:='CL_INVALID_MEM_OBJECT';
+    CL_INVALID_IMAGE_FORMAT_DESCRIPTOR : clErrorText:='CL_INVALID_IMAGE_FORMAT_DESCRIPTOR';
+    CL_INVALID_IMAGE_SIZE : clErrorText:='CL_INVALID_IMAGE_SIZE';
+    CL_INVALID_SAMPLER : clErrorText:='CL_INVALID_SAMPLER';
+    CL_INVALID_BINARY : clErrorText:='CL_INVALID_BINARY';
+    CL_INVALID_BUILD_OPTIONS : clErrorText:='CL_INVALID_BUILD_OPTIONS';
+    CL_INVALID_PROGRAM : clErrorText:='CL_INVALID_PROGRAM';
+    CL_INVALID_PROGRAM_EXECUTABLE : clErrorText:='CL_INVALID_PROGRAM_EXECUTABLE';
+    CL_INVALID_KERNEL_NAME : clErrorText:='CL_INVALID_KERNEL_NAME';
+    CL_INVALID_KERNEL_DEFINITION : clErrorText:='CL_INVALID_KERNEL_DEFINITION';
+    CL_INVALID_KERNEL : clErrorText:='CL_INVALID_KERNEL';
+    CL_INVALID_ARG_INDEX : clErrorText:='CL_INVALID_ARG_INDEX';
+    CL_INVALID_ARG_VALUE : clErrorText:='CL_INVALID_ARG_VALUE';
+    CL_INVALID_ARG_SIZE : clErrorText:='CL_INVALID_ARG_SIZE';
+    CL_INVALID_KERNEL_ARGS : clErrorText:='CL_INVALID_KERNEL_ARGS';
+    CL_INVALID_WORK_DIMENSION : clErrorText:='CL_INVALID_WORK_DIMENSION';
+    CL_INVALID_WORK_GROUP_SIZE : clErrorText:='CL_INVALID_WORK_GROUP_SIZE';
+    CL_INVALID_WORK_ITEM_SIZE : clErrorText:='CL_INVALID_WORK_ITEM_SIZE';
+    CL_INVALID_GLOBAL_OFFSET : clErrorText:='CL_INVALID_GLOBAL_OFFSET';
+    CL_INVALID_EVENT_WAIT_LIST : clErrorText:='CL_INVALID_EVENT_WAIT_LIST';
+    CL_INVALID_EVENT : clErrorText:='CL_INVALID_EVENT';
+    CL_INVALID_OPERATION : clErrorText:='CL_INVALID_OPERATION';
+    CL_INVALID_GL_OBJECT : clErrorText:='CL_INVALID_GL_OBJECT';
+    CL_INVALID_BUFFER_SIZE : clErrorText:='CL_INVALID_BUFFER_SIZE';
+    CL_INVALID_MIP_LEVEL : clErrorText:='CL_INVALID_MIP_LEVEL';
+  else
+     clErrorText:='Unknown OpenCL error';
+  end;
+end;
+
 end.

+ 38 - 3
rtl/inc/variants.pp

@@ -1226,10 +1226,40 @@ begin
 end;
 
 function DoVarCmpComplex(const Left, Right: TVarData; const OpCode: TVarOp): ShortInt;
+var Handler: TCustomVariantType;
+    CmpRes: boolean;
 begin
-  {!! custom variants? }
+  if FindCustomVariantType(Left.vType, Handler) then
+    CmpRes := Handler.CompareOp(Left, Right, OpCode)
+  else if FindCustomVariantType(Right.vType, Handler) then
+    CmpRes := Handler.CompareOp(Left, Right, OpCode)
+  else
   VarInvalidOp(Left.vType, Right.vType, OpCode);
-  Result:=0;
+
+  case OpCode of
+    opCmpEq:
+      if CmpRes then
+        Result:=0
+      else
+        Result:=1;
+    opCmpNe:
+      if CmpRes then
+        Result:=1
+      else
+        Result:=0;
+    opCmpLt,
+    opCmpLe:
+      if CmpRes then
+        Result:=-1
+      else
+        Result:=1;
+    opCmpGt,
+    opCmpGe:
+      if CmpRes then
+        Result:=1
+      else
+        Result:=-1;
+  end;
 end;
 
 
@@ -1611,8 +1641,13 @@ begin
 end;
 
 procedure DoVarOpComplex(var vl : TVarData; const vr : TVarData; const OpCode : TVarOp);
+var Handler: TCustomVariantType;
 begin
-  {custom Variant support? }
+  if FindCustomVariantType(vl.vType, Handler) then
+    Handler.BinaryOp(vl, vr, OpCode)
+  else if FindCustomVariantType(vr.vType, Handler) then
+    Handler.BinaryOp(vl, vr, OpCode)
+  else
    VarInvalidOp(vl.vType, vr.vType, OpCode);
 end;
 

+ 1 - 1
rtl/powerpc/powerpc.inc

@@ -1170,7 +1170,7 @@ asm
   addic  r9,r9,-1
   subfe  r9,r9,r9
   and    r8,r4,r9
-  andc   r7,r5,r9
+  andc   r7,r10,r9
   or     r6,r7,r8
   stwcx. r6,0,r3
   bne .LInterlockedCompareExchangeLoop

+ 5 - 2
rtl/powerpc64/powerpc64.inc

@@ -674,11 +674,14 @@ function InterlockedCompareExchange(var Target: longint; NewValue: longint; Comp
 asm
 .LInterlockedCompareExchangeLoop:
   lwarx  r10,0,r3
+  // lwarx performs an unsigned load -> sign extend since arguments are
+  // longints
+  extsw  r10,r10
   sub    r9,r10,r5
   addic  r9,r9,-1
   subfe  r9,r9,r9
   and    r8,r4,r9
-  andc   r7,r5,r9
+  andc   r7,r10,r9
   or     r6,r7,r8
   stwcx. r6,0,r3
   bne .LInterlockedCompareExchangeLoop
@@ -750,7 +753,7 @@ asm
   addic  r9,r9,-1
   subfe  r9,r9,r9
   and    r8,r4,r9
-  andc   r7,r5,r9
+  andc   r7,r10,r9
   or     r6,r7,r8
   stdcx. r6,0,r3
   bne .LInterlockedCompareExchangeLoop

+ 29 - 0
tests/webtbs/tw18082.pp

@@ -0,0 +1,29 @@
+var
+  l: longint;
+{$ifdef cpu64}
+  i: int64;
+{$endif}
+
+begin
+  l:=-123;
+  if interlockedcompareexchange(l,-1,124)<>-123 then
+    halt(1);
+  if l<>-123 then
+    halt(2);
+  if interlockedcompareexchange(l,-1,-123)<>-123 then
+    halt(3);
+  if l<>-1 then
+    halt(4);
+
+{$ifdef cpu64}
+  i:=-123;
+  if interlockedcompareexchange64(i,-1,124)<>-123 then
+    halt(5);
+  if i<>-123 then
+    halt(6);
+  if interlockedcompareexchange64(i,-1,-123)<>-123 then
+    halt(7);
+  if i<>-1 then
+    halt(8);
+{$endif}
+end.