Merged revisions 9032-9033,9035,9042,9044,9046,9048,9059,9071,9074,9076-9082,9084,9086,9088-9090,9095-9097,9102,9108,9111-9112,9114,9132-9133,9135,9139,9160,9185,9203,9205,9211-9212,9236-9238,9260,9262,9266,9269-9272,9276-9278,9295,9307-9308,9310,9312,9316,9322,9337,9340,9343-9344,9359,9373-9375,9384,9387-9388,9396-9397,9399,9401-9403,9430-9431,9434,9438-9439,9450-9456,9459-9463,9466-9469,9472-9473,9476-9477,9480-9481,9483,9491-9492,9499-9500,9502-9503,9505-9506,9508,9511-9514,9529,9536,9539,9544-9552,9555,9561-9562,9566-9568,9571,9573-9574,9576-9577,9579,9583,9586-9587,9595-9598,9600 via svnmerge from

http://svn.freepascal.org/svn/fpc/trunk

........
  r9032 | florian | 2007-11-01 12:42:39 +0100 (Thu, 01 Nov 2007) | 2 lines
  
  * finally fixed heaptrc for win64
........
  r9042 | florian | 2007-11-01 15:52:22 +0100 (Thu, 01 Nov 2007) | 2 lines
  
  * more crash fixes
........
  r9044 | yury | 2007-11-01 16:45:33 +0100 (Thu, 01 Nov 2007) | 1 line
  
  * Fixed warnings and notes.
........
  r9046 | yury | 2007-11-01 16:55:54 +0100 (Thu, 01 Nov 2007) | 1 line
  
  * Fixed warnings and notes.
........
  r9048 | yury | 2007-11-01 17:05:46 +0100 (Thu, 01 Nov 2007) | 1 line
  
  * Fixed warnings.
........
  r9071 | peter | 2007-11-02 23:08:17 +0100 (Fri, 02 Nov 2007) | 2 lines
  
    * add DumpExceptionBackTrace
........
  r9095 | yury | 2007-11-03 11:36:27 +0100 (Sat, 03 Nov 2007) | 1 line
  
  * Fixed warnings.
........
  r9097 | yury | 2007-11-03 11:53:08 +0100 (Sat, 03 Nov 2007) | 1 line
  
  * Fixed warnings and notes.
........
  r9102 | yury | 2007-11-03 13:22:54 +0100 (Sat, 03 Nov 2007) | 1 line
  
  * Fixed warnings.
........
  r9111 | yury | 2007-11-03 18:09:39 +0100 (Sat, 03 Nov 2007) | 1 line
  
  * Fixed warnings about EBP based access.
........
  r9112 | yury | 2007-11-03 19:05:12 +0100 (Sat, 03 Nov 2007) | 2 lines
  
  * Fixed warnings about EBP based access.
  * Improved SetJmp and longJmp by not using stack frame.
........
  r9135 | hajny | 2007-11-04 21:06:33 +0100 (Sun, 04 Nov 2007) | 1 line
  
    * aliases for np_ to increase compatibility
........
  r9139 | hajny | 2007-11-04 23:17:29 +0100 (Sun, 04 Nov 2007) | 1 line
  
    + aliases to TPipeSemState field names for improved compatibility and overloaded version of DosQueryNPipeSemState using this type
........
  r9160 | marc | 2007-11-08 00:39:33 +0100 (Thu, 08 Nov 2007) | 1 line
  
  * Added some statusses
........
  r9203 | florian | 2007-11-11 20:22:34 +0100 (Sun, 11 Nov 2007) | 2 lines
  
  * GetKeyEventFromQueueWait waits always till it gets an event
........
  r9205 | florian | 2007-11-11 22:12:32 +0100 (Sun, 11 Nov 2007) | 1 line
  
  * avoid deadlock during ReadConsoleInput, should resolve #10150
........
  r9212 | florian | 2007-11-11 23:27:29 +0100 (Sun, 11 Nov 2007) | 2 lines
  
  * avoid deadlock when shutting down the event handler thread
........
  r9312 | peter | 2007-11-21 22:51:42 +0100 (Wed, 21 Nov 2007) | 2 lines
  
    * fix for relativepath, fixes #10224
........
  r9316 | Almindor | 2007-11-22 10:53:35 +0100 (Thu, 22 Nov 2007) | 2 lines
  
  * add WINSOCK_VERSION to old winsock1 unit
........
  r9384 | peter | 2007-12-02 19:36:20 +0100 (Sun, 02 Dec 2007) | 5 lines
  
    * CompareText for shortstrings added
    * optimize CompareText
    * use CompareText for case-insenstive compares in the RTL
    patches from Sergei Gorelkin
........
  r9388 | michael | 2007-12-04 14:02:24 +0100 (Tue, 04 Dec 2007) | 1 line
  
  * Patch from Giulio Bernardi to allow int64 support in TParser
........
  r9397 | michael | 2007-12-05 21:50:26 +0100 (Wed, 05 Dec 2007) | 7 lines
  
  * Patch from Giulio Bernardi
    * ObjectBinaryToText, ObjectTextToBinary and ObjectTextToResource are
      endian safe and writing and reading extended type is supported on
      machines that don't have an extended type
   - TStream.WriteResourceHeader, TStream.ReadResHeader,
     TStream.FixupResourceHeader are endian safe
........
  r9403 | michael | 2007-12-06 23:07:47 +0100 (Thu, 06 Dec 2007) | 1 line
  
  * Patch from Giulio Bernardi to fix a typo in writewstring
........
  r9430 | Almindor | 2007-12-11 21:34:46 +0100 (Tue, 11 Dec 2007) | 1 line
  
  * use WINSOCK_VERSION in sockets init in windows
........
  r9431 | michael | 2007-12-12 09:43:34 +0100 (Wed, 12 Dec 2007) | 1 line
  
  * Patch from Giulio Bernardi to fix endianness
........
  r9438 | michael | 2007-12-13 10:59:19 +0100 (Thu, 13 Dec 2007) | 1 line
  
  * Patch from Giulio Bernardi to use NtoLE instead of swapendian
........
  r9439 | michael | 2007-12-13 14:41:43 +0100 (Thu, 13 Dec 2007) | 1 line
  
  * Patch from Giulio Bernardi to fix regression and use inline only when allowed
........
  r9467 | michael | 2007-12-15 23:52:46 +0100 (Sat, 15 Dec 2007) | 1 line
  
  * Re-implemented Grow
........
  r9481 | florian | 2007-12-16 14:45:09 +0100 (Sun, 16 Dec 2007) | 3 lines
  
  + WC_NO_BEST_FIT_CHARS
  * use WC_NO_BEST_FIT_CHARS when calling WideCharToMultiByte
  * made tiwde6 more verbose
........
  r9483 | florian | 2007-12-16 18:48:20 +0100 (Sun, 16 Dec 2007) | 2 lines
  
  + useunicodefunctions flag added
........
  r9499 | yury | 2007-12-21 23:17:09 +0100 (Fri, 21 Dec 2007) | 1 line
  
  * Changed debug notes to hints.
........
  r9500 | yury | 2007-12-21 23:32:40 +0100 (Fri, 21 Dec 2007) | 1 line
  
  * Fixed warnings.
........
  r9502 | yury | 2007-12-21 23:37:55 +0100 (Fri, 21 Dec 2007) | 1 line
  
  * Uncomment implementation of VarInRange and VarEnsureRange functions. They are compilable now.
........
  r9503 | yury | 2007-12-21 23:41:53 +0100 (Fri, 21 Dec 2007) | 1 line
  
  * Fixed warnings.
........
  r9505 | yury | 2007-12-21 23:57:59 +0100 (Fri, 21 Dec 2007) | 1 line
  
  * Changed user warnings to notes.
........
  r9506 | yury | 2007-12-22 00:10:33 +0100 (Sat, 22 Dec 2007) | 1 line
  
  * Fixed warnings.
........
  r9508 | yury | 2007-12-22 00:28:36 +0100 (Sat, 22 Dec 2007) | 1 line
  
  * Fixed warnings and notes.
........
  r9511 | yury | 2007-12-22 12:51:37 +0100 (Sat, 22 Dec 2007) | 1 line
  
  * Removed warnings about missing libs.
........
  r9512 | yury | 2007-12-22 12:56:48 +0100 (Sat, 22 Dec 2007) | 1 line
  
  * Really removed warnings about missing libs.
........
  r9513 | yury | 2007-12-22 13:12:25 +0100 (Sat, 22 Dec 2007) | 1 line
  
  * Fixed warnings.
........
  r9514 | yury | 2007-12-22 13:27:03 +0100 (Sat, 22 Dec 2007) | 1 line
  
  * Fixed warnings.
........
  r9539 | yury | 2007-12-26 18:10:53 +0100 (Wed, 26 Dec 2007) | 1 line
  
  * Don't use deprecated functions. 
........
  r9544 | yury | 2007-12-27 23:18:48 +0100 (Thu, 27 Dec 2007) | 1 line
  
  * Removed user defined warning "TextMode not implemented yet!!", since TextMode will not be implemented for Windows anyway...
........
  r9545 | yury | 2007-12-27 23:22:36 +0100 (Thu, 27 Dec 2007) | 1 line
  
  * Converted user defined warnings to comments.
........
  r9546 | yury | 2007-12-27 23:26:27 +0100 (Thu, 27 Dec 2007) | 1 line
  
  * Converted user defined notes to comments.
........
  r9547 | yury | 2007-12-27 23:33:02 +0100 (Thu, 27 Dec 2007) | 1 line
  
  * Removed user defined warnings about GetVariantProp/SetVariantProp is not implemented. I created bug report #10478 instead of these warnings.
........
  r9548 | yury | 2007-12-27 23:49:05 +0100 (Thu, 27 Dec 2007) | 2 lines
  
  * Converted user defined note to info message.
........
  r9549 | yury | 2007-12-27 23:56:19 +0100 (Thu, 27 Dec 2007) | 1 line
  
  * Removed workaround for bug #9827, since it was fixed.
........
  r9551 | yury | 2007-12-28 00:29:52 +0100 (Fri, 28 Dec 2007) | 1 line
  
  * Converted user defined note to info message.
........
  r9552 | yury | 2007-12-28 00:44:53 +0100 (Fri, 28 Dec 2007) | 1 line
  
  * Implemented TFMTBcdFactory.Clear and TFMTBcdFactory.Copy methods.
........
  r9555 | yury | 2007-12-28 01:17:11 +0100 (Fri, 28 Dec 2007) | 2 lines
  
  * Raise range error exception directly to prevent note "Local variable "rcheck" is assigned but never used".
........
  r9561 | yury | 2007-12-28 16:38:03 +0100 (Fri, 28 Dec 2007) | 1 line
  
  * GetVariantProp and SetVariantProp implementation by Anton Kavalenka (mantis #10478).
........
  r9562 | yury | 2007-12-28 21:10:19 +0100 (Fri, 28 Dec 2007) | 1 line
  
  * ifdefed fatal error messages in exception handling to be available only if debugging is needed.
........
  r9574 | michael | 2007-12-29 22:44:17 +0100 (Sat, 29 Dec 2007) | 1 line
  
  * Added textLineBrealStyle property
........
  r9586 | michael | 2007-12-30 21:17:08 +0100 (Sun, 30 Dec 2007) | 1 line
  
  * Fixed bug #10140
........
  r9595 | michael | 2007-12-30 22:45:48 +0100 (Sun, 30 Dec 2007) | 1 line
  
  * Implemented ExtractShortPathName
........
  r9596 | michael | 2007-12-30 22:50:40 +0100 (Sun, 30 Dec 2007) | 1 line
  
  * Added GetModuleName
........
  r9597 | michael | 2007-12-30 23:01:53 +0100 (Sun, 30 Dec 2007) | 1 line
  
  Implemented get/setinterfaceproperty. Needs checking
........
  r9598 | michael | 2007-12-30 23:03:56 +0100 (Sun, 30 Dec 2007) | 1 line
  
  * Added EPropertyConvertError class
........
  r9600 | michael | 2007-12-30 23:20:11 +0100 (Sun, 30 Dec 2007) | 1 line
  
  * Applied patch from Sergei Gorelkin for ComposeDateTime and IncAMonth
........

git-svn-id: branches/fixes_2_2@9850 -

rtl/i386/i386.inc

@@ -1021,7 +1021,7 @@ function fpc_pchar_length(p:pchar):longint;assembler;[public,alias:'FPC_PCHAR_LE
 function get_frame:pointer;assembler;nostackframe;{$ifdef SYSTEMINLINE}inline;{$endif}
 asm
         movl    %ebp,%eax
-end ['EAX'];
+end;
 {$ENDIF not INTERNAL_BACKTRACE}
 
 
@@ -1035,7 +1035,7 @@ asm
         jz      .Lg_a_null
         movl    4(%eax),%eax
 .Lg_a_null:
-end ['EAX'];
+end;
 
 
 {$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
@@ -1048,7 +1048,7 @@ asm
         jz      .Lgnf_null
         movl    (%eax),%eax
 .Lgnf_null:
-end ['EAX'];
+end;
 
 {****************************************************************************
                                  Math
@@ -1063,7 +1063,7 @@ asm
         cltd
         xorl    %edx,%eax
         subl    %edx,%eax
-end ['EAX','EDX'];
+end;
 
 
 {$define FPC_SYSTEM_HAS_SQR_LONGINT}
@@ -1077,7 +1077,7 @@ asm
 {$endif}
 {$endif}
         imull   %eax,%eax
-end ['EAX'];
+end;
 
 
 {$define FPC_SYSTEM_HAS_SPTR}

rtl/i386/math.inc

@@ -151,37 +151,37 @@
     {$define FPC_SYSTEM_HAS_FRAC}
     function fpc_frac_real(d : ValReal) : ValReal;assembler;compilerproc;
       asm
-        subl $16,%esp
-        fnstcw -4(%ebp)
+        subl $4,%esp
+        fnstcw (%esp)
         fwait
-        movw -4(%ebp),%cx
-        orw $0x0f00,%cx
-        movw %cx,-8(%ebp)
-        fldcw -8(%ebp)
+        movw (%esp),%cx
+        orw $0x0f00,(%esp)
+        fldcw (%esp)
         fldt d
         frndint
         fldt d
         fsub %st(1),%st
         fstp %st(1)
-        fldcw -4(%ebp)
+        movw %cx,(%esp)
+        fldcw (%esp)
       end;
 
 
     {$define FPC_SYSTEM_HAS_INT}
     function fpc_int_real(d : ValReal) : ValReal;assembler;compilerproc;
       asm
-        subl $16,%esp
-        fnstcw -4(%ebp)
+        subl $4,%esp
+        fnstcw (%esp)
         fwait
-        movw -4(%ebp),%cx
-        orw $0x0f00,%cx
-        movw %cx,-8(%ebp)
-        fldcw -8(%ebp)
+        movw (%esp),%cx
+        orw $0x0f00,(%esp)
+        fldcw (%esp)
         fwait
         fldt d
         frndint
         fwait
-        fldcw -4(%ebp)
+        movw %cx,(%esp)
+        fldcw (%esp)
       end;
 
 

rtl/i386/mathu.inc

@@ -49,7 +49,7 @@ function cotan(x : float) : float;assembler;
   asm
     fldt X
     fptan
-    fdivp
+    fdivp %st,%st(1)
     fwait
   end;
 

rtl/i386/setjump.inc

@@ -13,46 +13,45 @@
 
  **********************************************************************}
 
-Function SetJmp (Var S : Jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJMP'];
+Function SetJmp (Var S : Jmp_buf) : longint;assembler;nostackframe;[Public, alias : 'FPC_SETJMP'];
 asm
 {$ifndef REGCALL}
-  movl 8(%ebp),%eax
+  movl 4(%esp),%eax
 {$endif}
-  movl %ebx,(%eax)
-  movl %esi,4(%eax)
-  movl %edi,8(%eax)
-  movl 4(%ebp),%edi
-  movl %edi,20(%eax)
-  movl (%ebp),%edi
-  movl %edi,12(%eax)
+  movl %ebx,Jmp_buf.ebx(%eax)
+  movl %esi,Jmp_buf.esi(%eax)
+  movl %edi,Jmp_buf.edi(%eax)
+  movl %ebp,Jmp_buf.bp(%eax)
 {$ifdef REGCALL}
-  leal 8(%ebp),%edi
+  leal 4(%esp),%edi
 {$else}
-  leal 12(%ebp),%edi
+  leal 8(%esp),%edi
 {$endif}
-  movl %edi,16(%eax)
-  movl 8(%eax),%edi
+  movl %edi,Jmp_buf.sp(%eax)
+  movl (%esp),%edi
+  movl %edi,Jmp_buf.pc(%eax)
+  movl Jmp_buf.edi(%eax),%edi
   xorl %eax,%eax
-end['EAX'];
+end;
 
 
-Procedure longJmp (Var S : Jmp_buf; value : longint); assembler;[Public, alias : 'FPC_LONGJMP'];
+Procedure longJmp (Var S : Jmp_buf; value : longint); assembler;nostackframe;[Public, alias : 'FPC_LONGJMP'];
 asm
 {$ifdef REGCALL}
   xchgl %edx,%eax
 {$else}
-  movl 8(%ebp),%edx
-  movl 12(%ebp),%eax
+  movl 4(%esp),%edx
+  movl 8(%esp),%eax
 {$endif}
 
-  movl (%edx),%ebx
-  movl 4(%edx),%esi
-  movl 8(%edx),%edi
-  movl 12(%edx),%ebp
-  movl 16(%edx),%esp
+  movl Jmp_buf.ebx(%edx),%ebx
+  movl Jmp_buf.esi(%edx),%esi
+  movl Jmp_buf.edi(%edx),%edi
+  movl Jmp_buf.bp(%edx),%ebp
+  movl Jmp_buf.sp(%edx),%esp
   // we should also clear the fpu
   // fninit no must be done elsewhere PM
   // or we should reset the control word also
-  jmp 20(%edx)
+  jmp Jmp_buf.pc(%edx)
 end;
 

rtl/inc/cmem.pp

@@ -71,11 +71,7 @@ Function CFreeMemSize(p:pointer;Size:ptrint):ptrint;
 
 begin
   if size<=0 then
-    begin
-      if size<0 then
-        runerror(204);
-      exit;
-    end;
+    exit;
   if (p <> nil) then
     begin
       if (size <> pptrint(p-sizeof(ptrint))^) then

rtl/inc/except.inc

@@ -213,7 +213,9 @@ begin
   hp:=@ExceptAddrStack;
   If hp^=nil then
     begin
+{$ifdef excdebug}
       writeln ('At end of ExceptionAddresStack');
+{$endif}
       halt (255);
     end
   else
@@ -233,8 +235,10 @@ begin
   _ExceptObjectStack:=ExceptObjectStack;
   If _ExceptObjectStack=nil then
     begin
-    writeln ('At end of ExceptionObjectStack');
-    halt (1);
+{$ifdef excdebug}
+      writeln ('At end of ExceptionObjectStack');
+{$endif}
+      halt (1);
     end
   else
     begin
@@ -266,7 +270,9 @@ begin
   If not(assigned(_ExceptObjectStack)) or
      not(assigned(_ExceptObjectStack^.next)) then
     begin
+{$ifdef excdebug}
       writeln ('At end of ExceptionObjectStack');
+{$endif}
       halt (1);
     end
   else
@@ -307,7 +313,9 @@ begin
   _ExceptObjectStack:=ExceptObjectStack;
   If _ExceptObjectStack=Nil then
    begin
+{$ifdef excdebug}
      Writeln ('Internal error.');
+{$endif}
      halt (255);
    end;
   _Objtype := TExceptObjectClass(Objtype);

rtl/inc/genmath.inc

@@ -74,6 +74,7 @@ const
       DP2 =   3.77489470793079817668E-8;
       DP3 =   2.69515142907905952645E-15;
 
+{$if not defined(FPC_SYSTEM_HAS_SIN) or not defined(FPC_SYSTEM_HAS_COS)}
 const sincof : TabCoef = (
                 1.58962301576546568060E-10,
                -2.50507477628578072866E-8,
@@ -88,7 +89,7 @@ const sincof : TabCoef = (
                 2.48015872888517045348E-5,
                -1.38888888888730564116E-3,
                 4.16666666666665929218E-2, 0);
-
+{$endif}
 
 {*
 -------------------------------------------------------------------------------

rtl/inc/getopts.pp

@@ -287,7 +287,7 @@ begin
          begin
            optarg:=strpas(argv[optind]);
            inc(optind);
-           Internal_getopt:=#1;
+           Internal_getopt:=#0;
            exit;
          end;
       end;

rtl/inc/heaptrc.pp

@@ -23,6 +23,7 @@ interface
 
 {$checkpointer off}
 {$goto on}
+{$TYPEDADDRESS on}
 
 {$if defined(win32) or defined(wince)}
   {$define windows}
@@ -422,16 +423,18 @@ begin
   fillchar(p^,size,#255);
   { retrieve backtrace info }
   bp:=get_caller_frame(get_frame);
-  for i:=1 to tracesize do
-   begin
-     { valid bp? }
-     if (bp>=StackBottom) and (bp<(StackBottom + StackLength)) then
+
+  { valid bp? }
+  if (bp>=StackBottom) and (bp<(StackBottom + StackLength)) then
+    for i:=1 to tracesize do
+     begin
        pp^.calls[i]:=get_caller_addr(bp);
-     oldbp:=bp;
-     bp:=get_caller_frame(bp);
-     if (bp<oldbp) or (bp>(StackBottom + StackLength)) then
-       bp:=nil;
-   end;
+       oldbp:=bp;
+       bp:=get_caller_frame(bp);
+       if (bp<oldbp) or (bp>(StackBottom + StackLength)) then
+         break;
+     end;
+
   { insert in the linked list }
   if heap_mem_root<>nil then
    heap_mem_root^.next:=pp;
@@ -535,11 +538,14 @@ begin
   else
     begin
        bp:=get_caller_frame(get_frame);
-       for i:=(tracesize div 2)+1 to tracesize do
-        begin
-          pp^.calls[i]:=get_caller_addr(bp);
-          bp:=get_caller_frame(bp);
-        end;
+       if (bp>=StackBottom) and (bp<(StackBottom + StackLength)) then
+         for i:=(tracesize div 2)+1 to tracesize do
+          begin
+            pp^.calls[i]:=get_caller_addr(bp);
+            bp:=get_caller_frame(bp);
+            if not((bp>=StackBottom) and (bp<(StackBottom + StackLength))) then
+              break;
+          end;
     end;
   inc(freemem_cnt);
   { clear the memory }
@@ -755,14 +761,15 @@ begin
   inc(getmem8_size,((size+7) div 8)*8);
   { generate new backtrace }
   bp:=get_caller_frame(get_frame);
-  for i:=1 to tracesize do
-   begin
-     pp^.calls[i]:=get_caller_addr(bp);
-     oldbp:=bp;
-     bp:=get_caller_frame(bp);
-     if (bp<oldbp) or (bp>(StackBottom + StackLength)) then
-       bp:=nil;
-   end;
+  if (bp>=StackBottom) and (bp<(StackBottom + StackLength)) then
+    for i:=1 to tracesize do
+     begin
+       pp^.calls[i]:=get_caller_addr(bp);
+       oldbp:=bp;
+       bp:=get_caller_frame(bp);
+       if (bp<oldbp) or (bp>(StackBottom + StackLength)) then
+         break;
+     end;
   { regenerate signature }
   if usecrc then
     pp^.sig:=calculate_sig(pp);
@@ -819,7 +826,7 @@ type
   area_id   = Longint;
 
 function area_for(addr : Pointer) : area_id;
-            cdecl; external 'root' name 'area_for'; 
+            cdecl; external 'root' name 'area_for';
 {$endif BEOS}
 
 procedure CheckPointer(p : pointer); [public, alias : 'FPC_CHECKPOINTER'];
@@ -915,10 +922,10 @@ begin
   {$endif}
 
 {$ifdef BEOS}
-  // if we find the address in a known area in our current process, 
+  // if we find the address in a known area in our current process,
   // then it is a valid one
   if area_for(p) <> B_ERROR then
-    goto _exit;  
+    goto _exit;
 {$endif BEOS}
 
   { first try valid list faster }

rtl/inc/lineinfo.pp

@@ -1270,9 +1270,9 @@ begin
   GetLineInfo(ptruint(addr),func,source,line);
 { create string }
   {$ifdef netware}
-  StabBackTraceStr:='  CodeStart + $'+HexStr(ptrint(addr),sizeof(ptrint)*2);
+  StabBackTraceStr:='  CodeStart + $'+HexStr(ptruint(addr),sizeof(ptruint)*2);
   {$else}
-  StabBackTraceStr:='  $'+HexStr(ptrint(addr),sizeof(ptrint)*2);
+  StabBackTraceStr:='  $'+HexStr(ptruint(addr),sizeof(ptruint)*2);
   {$endif}
   if func<>'' then
    StabBackTraceStr:=StabBackTraceStr+'  '+func;

rtl/inc/lnfodwrf.pp

@@ -948,7 +948,7 @@ begin
   BackTraceStrFunc := @SysBackTraceStr;
   GetLineInfo(ptruint(addr), func, source, line);
   { create string }
-  DwarfBackTraceStr :='  $' + HexStr(ptrint(addr), sizeof(ptrint) * 2);
+  DwarfBackTraceStr :='  $' + HexStr(ptruint(addr), sizeof(ptruint) * 2);
   if func<>'' then
    DwarfBackTraceStr := DwarfBackTraceStr + '  ' + func;
 

rtl/inc/objpas.inc

@@ -245,13 +245,11 @@
       class function TObject.MethodAddress(const name : shortstring) : pointer;
 
         var
-           UName : ShortString;
            methodtable : pmethodnametable;
            i : dword;
            vmt : tclass;
 
         begin
-           UName := UpCase(name);
            vmt:=self;
            while assigned(vmt) do
              begin
@@ -259,7 +257,7 @@
                 if assigned(methodtable) then
                   begin
                      for i:=0 to methodtable^.count-1 do
-                       if UpCase(methodtable^.entries[i].name^)=UName then
+                       if ShortCompareText(methodtable^.entries[i].name^, name)=0 then
                          begin
                             MethodAddress:=methodtable^.entries[i].addr;
                             exit;
@@ -323,7 +321,6 @@
            end;
 
         var
-           UName: ShortString;
            CurClassType: TClass;
            FieldTable: PFieldTable;
            FieldInfo: PFieldInfo;
@@ -332,7 +329,6 @@
         begin
            if Length(name) > 0 then
            begin
-             UName := UpCase(name);
              CurClassType := ClassType;
              while CurClassType <> nil do
              begin
@@ -342,7 +338,7 @@
                  FieldInfo := @FieldTable^.Fields[0];
                  for i := 0 to FieldTable^.FieldCount - 1 do
                  begin
-                   if UpCase(FieldInfo^.Name) = UName then
+                   if ShortCompareText(FieldInfo^.Name, name) = 0 then
                    begin
                      fieldaddress := Pointer(Self) + FieldInfo^.FieldOffset;
                      exit;
@@ -384,7 +380,7 @@
       class function TObject.ClassNameIs(const name : string) : boolean;
 
         begin
-           ClassNameIs:=Upcase(ClassName)=Upcase(name);
+           ClassNameIs:=ShortCompareText(ClassName, name) = 0;
         end;
 
       class function TObject.InheritsFrom(aclass : TClass) : Boolean;

rtl/inc/sockets.inc

@@ -46,7 +46,7 @@ begin
 {$ifdef use_readwrite}
               r:=fpwrite(handle,bufptr^,bufpos);
 {$else}
-              r:=send(handle,bufptr^,bufpos,0);
+              r:=fpsend(handle,bufptr,bufpos,0);
 {$endif}
             until (r<>-1) or (SocketError <> EsockEINTR);
             bufend:=r;
@@ -58,7 +58,7 @@ begin
 {$ifdef use_readwrite}
               r:=fpread(handle,bufptr^,bufsize);
 {$else}
-              r:=recv(handle,bufptr^,bufsize,0);
+              r:=fprecv(handle,bufptr,bufsize,0);
 {$endif}
             until (r<>-1) or (SocketError <> EsockEINTR);
             bufend:=r;
@@ -169,15 +169,17 @@ Var AddrLen : Longint;
 
 begin
   AddrLEn:=SizeOf(Addr);
-  DoAccept:=Accept(Sock,Addr,AddrLen);
+  DoAccept:=fpaccept(Sock,@Addr,@AddrLen);
 end;
 
 Function DoConnect(Sock:longint;const addr: TInetSockAddr): Boolean;
 
 begin
-  DoConnect:=Connect(Sock,Addr,SizeOF(TInetSockAddr));
+  DoConnect:=fpconnect(Sock,@Addr,SizeOF(TInetSockAddr)) = 0;
 end;
 
+{$warnings off}
+
 Function Connect(Sock:longint;const addr: TInetSockAddr;var SockIn,SockOut:text):Boolean;
 
 begin
@@ -222,6 +224,8 @@ begin
    Accept:=false;
 end;
 
+{$warnings on}
+
 type thostaddr= packed array[1..4] of byte;
 
 function htonl( host : longint):longint; inline;

rtl/inc/sstrings.inc

@@ -1206,3 +1206,40 @@ begin
     end;
 end;
 
+function ShortCompareText(const S1, S2: shortstring): SizeInt;
+var
+  c1, c2: Byte;
+  i: Integer;
+  L1, L2, Count: SizeInt;
+  P1, P2: PChar;
+begin
+  L1 := Length(S1);
+  L2 := Length(S2);
+  if L1 > L2 then
+    Count := L2
+  else
+    Count := L1;
+  i := 0;
+  P1 := @S1[1];
+  P2 := @S2[1];
+  while i < count do
+  begin
+    c1 := byte(p1^);
+    c2 := byte(p2^);
+    if c1 <> c2 then
+    begin
+      if c1 in [97..122] then
+        Dec(c1, 32);
+      if c2 in [97..122] then
+        Dec(c2, 32);
+      if c1 <> c2 then
+        Break;
+    end;
+    Inc(P1); Inc(P2); Inc(I);
+  end;
+  if i < count then
+    ShortCompareText := c1 - c2
+  else
+    ShortCompareText := L1 - L2;
+end;
+

rtl/inc/system.inc

@@ -967,6 +967,25 @@ Begin
    end;
 {$endif FPC_HAS_FEATURE_EXCEPTIONS}
 End;
+
+
+{$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
+procedure DumpExceptionBackTrace(var f:text);
+var
+  FrameNumber,
+  FrameCount   : longint;
+  Frames       : PPointer;
+begin
+  if RaiseList=nil then
+    exit;
+  WriteLn(f,BackTraceStrFunc(RaiseList^.Addr));
+  FrameCount:=RaiseList^.Framecount;
+  Frames:=RaiseList^.Frames;
+  for FrameNumber := 0 to FrameCount-1 do
+    WriteLn(f,BackTraceStrFunc(Frames[FrameNumber]));
+end;
+{$endif FPC_HAS_FEATURE_EXCEPTIONS}
+
 {$endif FPC_HAS_FEATURE_CONSOLEIO}
 
 

rtl/inc/systemh.inc

@@ -557,6 +557,7 @@ Function  Pos (const Substr : ShortString; const Source : AnsiString) : SizeInt;
 Procedure SetString (out S : AnsiString; Buf : PChar; Len : SizeInt);
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 Procedure SetString (out S : Shortstring; Buf : PChar; Len : SizeInt);
+function  ShortCompareText(const S1, S2: shortstring): SizeInt;
 Function  upCase(const s:shortstring):shortstring;
 Function  lowerCase(const s:shortstring):shortstring; overload;
 Function  Space(b:byte):shortstring;
@@ -787,6 +788,9 @@ Function  ParamStr(l:Longint):string;
 
 {$ifdef FPC_HAS_FEATURE_CONSOLEIO}
 Procedure Dump_Stack(var f : text;bp:pointer);
+{$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
+procedure DumpExceptionBackTrace(var f:text);
+{$endif FPC_HAS_FEATURE_EXCEPTIONS}
 {$endif FPC_HAS_FEATURE_CONSOLEIO}
 
 Procedure RunError(w:Word);

rtl/inc/variant.inc

@@ -783,7 +783,7 @@ operator :=(const source : olevariant) dest : extended;{$ifdef SYSTEMINLINE}inli
 {$ifdef SUPPORT_COMP}
 operator :=(const source : olevariant) dest : comp;{$ifdef SYSTEMINLINE}inline;{$endif}
   begin
-    dest:=variantmanager.vartoreal(variant(tvardata(source)));
+    dest:=comp(variantmanager.vartoreal(variant(tvardata(source))));
   end;
 {$endif SUPPORT_COMP}
 

rtl/inc/wstringh.inc

@@ -41,6 +41,8 @@ procedure DefaultWide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt)
 procedure DefaultAnsi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
 
 Type
+  { hooks for internationalization
+    please add new procedures at the end, it makes it easier to detect new procedures }
   TWideStringManager = record
     Wide2AnsiMoveProc : procedure(source:pwidechar;var dest:ansistring;len:SizeInt);
     Ansi2WideMoveProc : procedure(source:pchar;var dest:widestring;len:SizeInt);

rtl/objpas/classes/streams.inc

@@ -222,17 +222,21 @@
     end;
 
   procedure TStream.WriteResourceHeader(const ResName: string; {!!!: out} var FixupInfo: Integer);
-
+    var
+      ResType, Flags : word;
     begin
+       ResType:=NtoLE(word($000A));
+       Flags:=NtoLE(word($1030));
+       { Note: This is a Windows 16 bit resource }
        { Numeric resource type }
        WriteByte($ff);
        { Application defined data }
-       WriteWord($0a);
+       WriteWord(ResType);
        { write the name as asciiz }
        WriteBuffer(ResName[1],length(ResName));
        WriteByte(0);
        { Movable, Pure and Discardable }
-       WriteWord($1030);
+       WriteWord(Flags);
        { Placeholder for the resource size }
        WriteDWord(0);
        { Return current stream position so that the resource size can be
@@ -243,35 +247,40 @@
   procedure TStream.FixupResourceHeader(FixupInfo: Integer);
 
     var
-       ResSize : Integer;
+       ResSize,TmpResSize : Integer;
 
     begin
 
       ResSize := Position - FixupInfo;
+      TmpResSize := NtoLE(longword(ResSize));
 
       { Insert the correct resource size into the placeholder written by
         WriteResourceHeader }
       Position := FixupInfo - 4;
-      WriteDWord(ResSize);
+      WriteDWord(TmpResSize);
       { Seek back to the end of the resource }
       Position := FixupInfo + ResSize;
 
     end;
 
   procedure TStream.ReadResHeader;
-
+    var
+      ResType, Flags : word;
     begin
        try
+         { Note: This is a Windows 16 bit resource }
          { application specific resource ? }
          if ReadByte<>$ff then
            raise EInvalidImage.Create(SInvalidImage);
-         if ReadWord<>$000a then
+         ResType:=LEtoN(ReadWord);
+         if ResType<>$000a then
            raise EInvalidImage.Create(SInvalidImage);
          { read name }
          while ReadByte<>0 do
            ;
          { check the access specifier }
-         if ReadWord<>$1030 then
+         Flags:=LEtoN(ReadWord);
+         if Flags<>$1030 then
            raise EInvalidImage.Create(SInvalidImage);
          { ignore the size }
          ReadDWord;
@@ -803,7 +812,7 @@ begin
   inherited Destroy;
 end;
   
-  
+{$warnings off}
 function TStreamAdapter.Read(pv: Pointer; cb: DWORD; pcbRead: PDWORD): HResult; stdcall;
 begin
   runerror(217);
@@ -868,3 +877,4 @@ function TStreamAdapter.Clone(out stm: IStream): HResult; stdcall;
 begin
   runerror(217);
 end;
+{$warnings on}

rtl/objpas/fgl.pp

@@ -106,7 +106,7 @@ type
     function IndexOf(const Item: T): Integer;
     procedure Insert(Index: Integer; const Item: T); {$ifdef CLASSESINLINE} inline; {$endif}
     function Last: T; {$ifdef CLASSESINLINE} inline; {$endif}
-    {$warning TODO: fix TFPGList<T>.Assign(TFPGList) to work somehow}
+    {$info FIXME: bug #10479: implement TFPGList<T>.Assign(TFPGList) to work somehow}
     {procedure Assign(Source: TFPGList);}
     function Remove(const Item: T): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
     procedure Sort(Compare: TCompareFunc);
@@ -608,15 +608,11 @@ end;
 function TFPGList.IndexOf(const Item: T): Integer;
 begin
   Result := 0;
-  {$warning TODO: fix inlining to work! InternalItems[Result]^}
+  {$info TODO: fix inlining to work! InternalItems[Result]^}
   while (Result < FCount) and (PT(FList)[Result] <> Item) do
     Inc(Result);
-  {$warning TODO: Result := -1; does not compile }
   if Result = FCount then
-  begin
-    Result := 0;
-    dec(Result);
-  end;
+    Result := -1;
 end;
 
 procedure TFPGList.Insert(Index: Integer; const Item: T);
@@ -689,7 +685,7 @@ begin
   if I >= 0 then
     Result := InternalItems[I]+FKeySize
   else
-    Error(SMapKeyError, PtrInt(AKey));
+    Error(SMapKeyError, PtrUInt(AKey));
 end;
 
 procedure TFPSMap.InitOnPtrCompare;

rtl/objpas/fmtbcd.pp

@@ -16,7 +16,7 @@
 { "Programming is the time between two bugs" }
 {     (last words of the unknown programmer) }
 
-{ this program was a good test for the compiler: some bugs have been found.
+(* this program was a good test for the compiler: some bugs have been found.
 
   1. WITH in inline funcs produces a compiler error AFTER producing an .exe file
      (was already known; I didn't see it in the bug list)
@@ -39,7 +39,7 @@
   6. two range check errors in scanner.pas
      a) array subscripting
      b) value out ouf range
-}
+*)
 
 { $define debug_version}
 
@@ -65,23 +65,23 @@
 { $define BCDgr180} { define this if MCDMaxDigits is greater 180, else undefine! }
 
 {$ifdef BCDgr4}
- {$note BCD Digits > 4}
+ {$hint BCD Digits > 4}
 {$endif}
 
 {$ifdef BCDgr9}
- {$note BCD Digits > 9}
+ {$hint BCD Digits > 9}
 {$endif}
 
 {$ifdef BCDgr18}
- {$note BCD Digits > 18}
+ {$hint BCD Digits > 18}
 {$endif}
 
 {$ifdef BCDgr64}
- {$note BCD Digits > 64}
+ {$hint BCD Digits > 64}
 {$endif}
 
 {$ifdef BCDgr180}
- {$note BCD Digits > 180}
+ {$hint BCD Digits > 180}
 {$endif}
 
 {$ifndef NO_SMART_LINK}
@@ -178,9 +178,9 @@ INTERFACE
 {$endif}
 
 {$ifdef use_ansistring}
-  {$note ansi}
+  {$hint ansi}
 {$else}
-  {$note -ansi}
+  {$hint -ansi}
 {$endif}
 
 {$ifdef integ32}
@@ -791,8 +791,8 @@ INTERFACE
     { in the tBCD_helper the bcd is stored for computations,
       shifted to the right position }
 
-{ {$define __lo_bhb := 1 * ( __lo_bh + __lo_bh ) } }
-{ {$define __hi_bhb := 1 * ( __hi_bh + __hi_bh + 1 ) } }
+// {$define __lo_bhb := 1 * ( __lo_bh + __lo_bh ) }
+// {$define __hi_bhb := 1 * ( __hi_bh + __hi_bh + 1 ) }
   const
     __lo_bhb = __lo_bh + __lo_bh - 1;
     __hi_bhb = __hi_bh + __hi_bh;
@@ -823,14 +823,16 @@ INTERFACE
 IMPLEMENTATION
 
   USES
-    classes;
+    classes {$ifopt r+}, sysconst {$endif};
 
   type
     TFMTBcdFactory = CLASS(TPublishableVarianttype)
     PROTECTED
       function GetInstance(const v : TVarData): tObject; OVERRIDE;
     PUBLIC
-      procedure BinaryOp(var Left: TVarData; const Right: TVarData; const Operation: TVarOp);
+      procedure BinaryOp(var Left: TVarData; const Right: TVarData; const Operation: TVarOp); override;
+      procedure Clear(var V: TVarData); override;
+      procedure Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean); override;
     end;
 
     TFMTBcdVarData = CLASS(TPersistent)
@@ -864,9 +866,10 @@ IMPLEMENTATION
     range_fracdigits = 0..pred ( MaxFmtBCDFractionSize );
 
 {$ifopt r+}
-  var
-    rcheck : 0..0;
-    rbad : Byte = 1;
+  procedure RangeError;
+    begin
+      raise ERangeError.Create(SRangeError);
+    end;
 {$endif}
 
 {$ifndef debug_version}
@@ -1563,7 +1566,6 @@ IMPLEMENTATION
       bh : tBCD_helper;
       v : {$ifopt r+} 0..high ( myInttype ) {$else} Integer {$endif};
       p : {$ifopt r+} low ( bh.Singles ) - 1..0 {$else} Integer {$endif};
-      Error,
       exitloop : Boolean;
 
     begin
@@ -1589,7 +1591,6 @@ IMPLEMENTATION
                 else v := +aValue;
               LDig := 0;
               p := 0;
-              Error := False;
               REPEAT
                 Singles[p] := v MOD 10;
                 v := v DIV 10;
@@ -1598,7 +1599,6 @@ IMPLEMENTATION
                 if p < low ( Singles )
                   then begin
                     exitloop := True;
-                    Error := True;
 (* what to do if error occured? *)
                     RAISE eBCDOverflowException.create ( 'in IntegerToBCD' );
                    end;
@@ -1608,12 +1608,13 @@ IMPLEMENTATION
           pack_BCD ( bh, result );
        _endSELECT;
      end;
-
+{$warnings off}
   function VarToBCD ( const aValue : Variant ) : tBCD;
 
     begin
       not_implemented;
      end;
+{$warnings on}
 
   function CurrToBCD ( const Curr : currency;
                          var BCD : tBCD;
@@ -1986,8 +1987,8 @@ IMPLEMENTATION
     begin
       NormalizeBCD := True;
 {$ifopt r+}
-      if ( Prec < 0 ) OR ( Prec > MaxFmtBCDFractionSize ) then rcheck := rbad;
-      if ( Scale < 0 ) OR ( Prec >= MaxFmtBCDFractionSize ) then rcheck := rbad;
+      if ( Prec < 0 ) OR ( Prec > MaxFmtBCDFractionSize ) then RangeError;
+      if ( Scale < 0 ) OR ( Prec >= MaxFmtBCDFractionSize ) then RangeError;
 {$endif}
       if BCDScale ( InBCD ) > Scale
         then begin
@@ -3680,6 +3681,21 @@ procedure TFMTBcdFactory.BinaryOp(var Left: TVarData; const Right: TVarData; con
       RaiseInvalidOp;
     end;
   end;
+  
+procedure TFMTBcdFactory.Clear(var V: TVarData);
+  begin
+    FreeAndNil(tObject(V.VPointer));
+    V.VType:=varEmpty;
+  end;
+
+procedure TFMTBcdFactory.Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean);
+  begin
+    if Indirect then
+      Dest.VPointer:=Source.VPointer
+    else
+      Dest.VPointer:=TFMTBcdVarData.Create(TFMTBcdVarData(Source.VPointer).BCD);
+    Dest.VType:=Vartype;
+  end;
 
 {$if declared ( myMinIntBCD ) }
 (*

rtl/objpas/strutils.pp

@@ -372,15 +372,14 @@ end;
 
 Function StuffString(const AText: string; AStart, ALength: Cardinal;  const ASubText: string): string;
 
-var i,j : SizeUInt;
-    k   : SizeInt;
+var i,j,k : SizeUInt;
 
 begin
   j:=length(ASubText);
   i:=length(AText);
   if AStart>i then 
     aStart:=i+1;
-  k:=i-AStart+1;
+  k:=i+1-AStart;
   if ALength> k then
     ALength:=k;
   SetLength(Result,i+j-ALength);

rtl/objpas/sysutils/dati.inc

@@ -51,8 +51,8 @@ end;
 function ComposeDateTime(Date,Time : TDateTime) : TDateTime;
 
 begin
-  if Date < 0 then Result := trunc(Date) - frac(Time)
-  else Result := trunc(Date) + frac(Time);
+  if Date < 0 then Result := trunc(Date) - Abs(frac(Time))
+  else Result := trunc(Date) + Abs(frac(Time));
 end;
 
 {   DateTimeToTimeStamp converts DateTime to a TTimeStamp   }
@@ -264,14 +264,23 @@ end;
 
 function IncMonth(const DateTime: TDateTime; NumberOfMonths: integer = 1 ): TDateTime;
 var
-  TempMonth, S: Integer;
   Year, Month, Day : word;
+begin
+  DecodeDate(DateTime, Year, Month, Day);
+  IncAMonth(Year, Month, Day, NumberOfMonths);
+  result := ComposeDateTime(DoEncodeDate(Year, Month, Day), DateTime);
+end ;
+
+{   IncAMonth is the same as IncMonth, but operates on decoded date  }
+
+procedure IncAMonth(var Year, Month, Day: Word; NumberOfMonths: Integer = 1);
+var
+  TempMonth, S: Integer;
 begin
   If NumberOfMonths>=0 then
     s:=1
   else
     s:=-1;
-  DecodeDate(DateTime, Year, Month, Day);
   inc(Year,(NumberOfMonths div 12));
   TempMonth:=Month+(NumberOfMonths mod 12)-1;
   if (TempMonth>11) or
@@ -283,8 +292,7 @@ begin
   Month:=TempMonth+1;          {   Months from 1 to 12   }
   If (Day>MonthDays[IsLeapYear(Year)][Month]) then
     Day:=MonthDays[IsLeapYear(Year)][Month];
-  result := Frac(DateTime) + DoEncodeDate(Year, Month, Day);
-end ;
+end;
 
 {  IsLeapYear returns true if Year is a leap year   }
 
@@ -861,7 +869,7 @@ end;
 
 procedure ReplaceTime(var dati:TDateTime; NewTime : TDateTime);inline;
 begin
-  dati:=trunc(dati)+frac(newtime);
+  dati:= ComposeDateTime(dati, newtime);
 end;
 
 procedure ReplaceDate(var DateTime: TDateTime; const NewDate: TDateTime); inline;

rtl/objpas/sysutils/datih.inc

@@ -113,6 +113,7 @@ function Date: TDateTime;
 function Time: TDateTime;
 function Now: TDateTime;
 function IncMonth(const DateTime: TDateTime; NumberOfMonths: integer = 1 ): TDateTime;
+procedure IncAMonth(var Year, Month, Day: Word; NumberOfMonths: Integer = 1);
 function IsLeapYear(Year: Word): boolean;
 function DateToStr(Date: TDateTime): string;
 function TimeToStr(Time: TDateTime): string;

rtl/objpas/sysutils/fina.inc

@@ -113,9 +113,19 @@ begin
     Result := '';
 end;
 
+function ExtractShortPathName(Const FileName : String) : String;
 
-  type
-    PathStr=string;
+begin
+{$ifdef MSWINDOWS} 
+  SetLength(Result,Max_Path);
+  SetLength(Result,GetShortPathName(PChar(FileName), Pchar(Result),Length(Result)));
+{$else}
+  Result:=FileName;
+{$endif}
+end;
+
+type
+  PathStr=string;
 
 {$DEFINE FPC_FEXPAND_SYSUTILS}
 
@@ -159,12 +169,12 @@ begin
     Result:=DestName;
     exit;
     end;
-  Source:=ExtractFilePath(BaseName);
-  Dest:=ExtractFilePath(DestName);
+  Source:=ExcludeTrailingPathDelimiter(ExtractFilePath(BaseName));
+  Dest:=ExcludeTrailingPathDelimiter(ExtractFilePath(DestName));
   SC:=GetDirs (Source,SD);
   DC:=GetDirs (Dest,DD);
   I:=1;
-  While (I<DC) and (I<SC) do
+  While (I<=DC) and (I<=SC) do
     begin
     If StrIcomp(DD[i],SD[i])=0 then
       Inc(i)
@@ -172,8 +182,8 @@ begin
       Break;
     end;
   Result:='';
-  For J:=I to SC-1 do Result:=Result+OneLevelBack;
-  For J:=I to DC-1 do Result:=Result+DD[J]+PathDelim;
+  For J:=I to SC do Result:=Result+OneLevelBack;
+  For J:=I to DC do Result:=Result+DD[J]+PathDelim;
   Result:=Result+ExtractFileName(DestNAme);
 end;
 

rtl/objpas/sysutils/finah.inc

@@ -30,6 +30,7 @@ function ExtractFileDrive(const FileName: string): string;
 function ExtractFileName(const FileName: string): string;
 function ExtractFileExt(const FileName: string): string;
 function ExtractFileDir(Const FileName : string): string;
+function ExtractShortPathName(Const FileName : String) : String;
 function ExpandFileName (Const FileName : string): String;
 function ExpandUNCFileName (Const FileName : string): String;
 function ExtractRelativepath (Const BaseName,DestNAme : String): String;

rtl/objpas/sysutils/sysformt.inc

@@ -295,7 +295,7 @@ begin
               end;
         'P' : Begin
               CheckArg(vtpointer,true);
-              ToAdd:=HexStr(ptrint(Args[DoArg].VPointer),sizeof(Ptrint)*2);
+              ToAdd:=HexStr(ptruint(Args[DoArg].VPointer),sizeof(Ptruint)*2);
               // Insert ':'. Is this needed in 32 bit ? No it isn't.
               // Insert(':',ToAdd,5);
               end;

rtl/objpas/sysutils/sysstr.inc

@@ -183,28 +183,36 @@ function CompareText(const S1, S2: string): integer;
 
 var
   i, count, count1, count2: integer; Chr1, Chr2: byte;
+  P1, P2: PChar;
 begin
-  result := 0;
   Count1 := Length(S1);
   Count2 := Length(S2);
   if (Count1>Count2) then
     Count := Count2
   else
     Count := Count1;
+  P1 := @S1[1];
+  P2 := @S2[1];
   i := 0;
-  while (result=0) and (i<count) do
+  while i < Count do
+  begin
+    Chr1 := byte(p1^);
+    Chr2 := byte(p2^);
+    if Chr1 <> Chr2 then
     begin
-    inc (i);
-     Chr1 := byte(s1[i]);
-     Chr2 := byte(s2[i]);
-     if Chr1 in [97..122] then
-       dec(Chr1,32);
-     if Chr2 in [97..122] then
-       dec(Chr2,32);
-     result := Chr1 - Chr2;
-     end ;
-  if (result = 0) then
-    result:=(count1-count2);
+      if Chr1 in [97..122] then
+        dec(Chr1,32);
+      if Chr2 in [97..122] then
+        dec(Chr2,32);
+      if Chr1 <> Chr2 then
+        Break;
+    end;
+    Inc(P1); Inc(P2); Inc(I);
+  end;
+  if i < Count then
+    result := Chr1-Chr2
+  else
+    result := count1-count2;
 end;
 
 function SameText(const s1,s2:String):Boolean;
@@ -2166,7 +2174,7 @@ Var
           End;
       End; { Case }
     End; { While .. Begin }
-    Result:=PtrInt(Buf)-PtrInt(Buffer);
+    Result:=PtrUInt(Buf)-PtrUInt(Buffer);
   End;
 
 Begin
@@ -2378,10 +2386,15 @@ for i := 0 to SizeOf(Value) shr 1 - 1 do begin
 end ;
 
 Function LastDelimiter(const Delimiters, S: string): Integer;
-
+var
+  chs: TSysCharSet;
+  I: LongInt;
 begin
+  chs := [];
+  for I := 1 to Length(Delimiters) do
+    Include(chs, Delimiters[I]);
   Result:=Length(S);
-  While (Result>0) and (Pos(S[Result],Delimiters)=0) do
+  While (Result>0) and not (S[Result] in chs) do
     Dec(Result);
 end;
 

rtl/objpas/sysutils/sysstrh.inc

@@ -71,7 +71,7 @@ function LowerCase(const s: string): string; overload;
 { the compiler can't decide else if it should use the char or the ansistring
   version for a variant }
 function LowerCase(const V: variant): string; overload;{$ifdef SYSUTILSINLINE}inline;{$endif}
-function CompareStr(const S1, S2: string): Integer;
+function CompareStr(const S1, S2: string): Integer; overload;
 function CompareMemRange(P1, P2: Pointer; Length: cardinal): integer;
 function CompareMem(P1, P2: Pointer; Length: cardinal): Boolean;
 function CompareText(const S1, S2: string): integer;

rtl/objpas/sysutils/sysutilh.inc

@@ -237,7 +237,9 @@ Type
 
   function SafeLoadLibrary(const FileName: AnsiString;
     ErrorMode: DWord = {$ifdef windows}SEM_NOOPENFILEERRORBOX{$else windows}0{$endif windows}): HMODULE;
-
+    
+  function GetModuleName(Module: HMODULE): string;
+  
 { some packages and unit related constants for compatibility }
 
 const

rtl/objpas/sysutils/sysutils.inc

@@ -232,7 +232,7 @@ Var
   hstdout : ^text;
 begin
   hstdout:=@stdout;
-  Writeln(hstdout^,'An unhandled exception occurred at $',HexStr(Ptrint(Addr),sizeof(PtrInt)*2),' :');
+  Writeln(hstdout^,'An unhandled exception occurred at $',HexStr(PtrUInt(Addr),sizeof(PtrUInt)*2),' :');
   if Obj is exception then
    begin
      Message:=Exception(Obj).ClassName+' : '+Exception(Obj).Message;
@@ -625,3 +625,14 @@ function SafeLoadLibrary(const FileName: AnsiString;
 {$endif}
     end;
   end;
+
+function GetModuleName(Module: HMODULE): string;
+
+begin
+{$ifdef MSWINDOWS}
+  SetLength(Result,MAX_PATH);
+  SetLength(Result,GetModuleFileName(Module, Pchar(Result),Length(Result)));
+{$ELSE}  
+  Result:='';
+{$ENDIF}  
+end;

rtl/objpas/typinfo.pp

@@ -280,6 +280,10 @@ Function  GetVariantProp(Instance: TObject; const PropName: string): Variant;
 Procedure SetVariantProp(Instance: TObject; const PropName: string; const Value: Variant);
 Procedure SetVariantProp(Instance: TObject; PropInfo : PPropInfo; const Value: Variant);
 
+function GetInterfaceProp(Instance: TObject; const PropName: string): IInterface;
+function GetInterfaceProp(Instance: TObject; PropInfo: PPropInfo): IInterface;
+procedure SetInterfaceProp(Instance: TObject; const PropName: string; const Value: IInterface);
+procedure SetInterfaceProp(Instance: TObject; PropInfo: PPropInfo; const Value: IInterface);
 
 // Auxiliary routines, which may be useful
 Function GetEnumName(TypeInfo : PTypeInfo;Value : Integer) : string;
@@ -302,7 +306,9 @@ Type
   TSetPropValue   = Procedure (Instance: TObject; const PropName: string; const Value: Variant);
   TGetVariantProp = Function (Instance: TObject; PropInfo : PPropInfo): Variant;
   TSetVariantProp = Procedure (Instance: TObject; PropInfo : PPropInfo; const Value: Variant);
-
+  
+  EPropertyConvertError = class(Exception); // Not used (yet), but defined for compatibility.
+  
 Const
   OnGetPropValue   : TGetPropValue = Nil;
   OnSetPropValue   : TSetPropValue = Nil;
@@ -354,17 +360,19 @@ Function GetEnumValue(TypeInfo : PTypeInfo;const Name : string) : Integer;
   Var PS : PShortString;
       PT : PTypeData;
       Count : longint;
+      sName: shortstring;
 
 begin
   If Length(Name)=0 then
     exit(-1);
+  sName := Name;
   PT:=GetTypeData(TypeInfo);
   Count:=0;
   Result:=-1;
   PS:=@PT^.NameList;
   While (Result=-1) and (PByte(PS)^<>0) do
     begin
-      If CompareText(PS^, Name) = 0 then
+      If ShortCompareText(PS^, sName) = 0 then
         Result:=Count;
       PS:=PShortString(pointer(PS)+PByte(PS)^+1);
       Inc(Count);
@@ -517,10 +525,10 @@ Function GetPropInfo(TypeInfo : PTypeInfo;const PropName : string) : PPropInfo;
 var
   hp : PTypeData;
   i : longint;
-  p : string;
+  p : shortstring;
   pd : ^TPropData;
 begin
-  P:=UpCase(PropName);
+  P:=PropName;  // avoid Ansi<->short conversion in a loop
   while Assigned(TypeInfo) do
     begin
       // skip the name
@@ -531,7 +539,7 @@ begin
       for i:=1 to pd^.PropCount do
         begin
           // found a property of that name ?
-          if Upcase(Result^.Name)=P then
+          if ShortCompareText(Result^.Name, P) = 0 then
             exit;
           // skip to next property
           Result:=PPropInfo(aligntoptr(pointer(@Result^.Name)+byte(Result^.Name[0])+1));
@@ -602,7 +610,7 @@ var
 begin
   case (PropInfo^.PropProcs shr 4) and 3 of
     ptfield:
-      Result:=PBoolean(Pointer(Instance)+Longint(PropInfo^.StoredProc))^;
+      Result:=PBoolean(Pointer(Instance)+PtrUInt(PropInfo^.StoredProc))^;
     ptconst:
       Result:=LongBool(PropInfo^.StoredProc);
     ptstatic,
@@ -611,7 +619,7 @@ begin
         if (PropInfo^.PropProcs shr 4) and 3=ptstatic then
           AMethod.Code:=PropInfo^.StoredProc
         else
-          AMethod.Code:=ppointer(Pointer(Instance.ClassType)+Longint(PropInfo^.StoredProc))^;
+          AMethod.Code:=ppointer(Pointer(Instance.ClassType)+PtrUInt(PropInfo^.StoredProc))^;
         AMethod.Data:=Instance;
         if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
            Result:=TBooleanIndexFunc(AMethod)(PropInfo^.Index)
@@ -807,17 +815,17 @@ begin
     ptfield:
       if Signed then begin
         case DataSize of
-          1: Result:=PShortInt(Pointer(Instance)+Ptrint(PropInfo^.GetProc))^;
-          2: Result:=PSmallInt(Pointer(Instance)+Ptrint(PropInfo^.GetProc))^;
-          4: Result:=PLongint(Pointer(Instance)+Ptrint(PropInfo^.GetProc))^;
-          8: Result:=PInt64(Pointer(Instance)+Ptrint(PropInfo^.GetProc))^;
+          1: Result:=PShortInt(Pointer(Instance)+PtrUInt(PropInfo^.GetProc))^;
+          2: Result:=PSmallInt(Pointer(Instance)+PtrUInt(PropInfo^.GetProc))^;
+          4: Result:=PLongint(Pointer(Instance)+PtrUInt(PropInfo^.GetProc))^;
+          8: Result:=PInt64(Pointer(Instance)+PtrUInt(PropInfo^.GetProc))^;
         end;
       end else begin
         case DataSize of
-          1: Result:=PByte(Pointer(Instance)+Ptrint(PropInfo^.GetProc))^;
-          2: Result:=PWord(Pointer(Instance)+Ptrint(PropInfo^.GetProc))^;
-          4: Result:=PLongint(Pointer(Instance)+Ptrint(PropInfo^.GetProc))^;
-          8: Result:=PInt64(Pointer(Instance)+Ptrint(PropInfo^.GetProc))^;
+          1: Result:=PByte(Pointer(Instance)+PtrUInt(PropInfo^.GetProc))^;
+          2: Result:=PWord(Pointer(Instance)+PtrUInt(PropInfo^.GetProc))^;
+          4: Result:=PLongint(Pointer(Instance)+PtrUInt(PropInfo^.GetProc))^;
+          8: Result:=PInt64(Pointer(Instance)+PtrUInt(PropInfo^.GetProc))^;
         end;
       end;
     ptstatic,
@@ -826,7 +834,7 @@ begin
         if (PropInfo^.PropProcs and 3)=ptStatic then
           AMethod.Code:=PropInfo^.GetProc
         else
-          AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Ptrint(PropInfo^.GetProc))^;
+          AMethod.Code:=PPointer(Pointer(Instance.ClassType)+PtrUInt(PropInfo^.GetProc))^;
         AMethod.Data:=Instance;
         if ((PropInfo^.PropProcs shr 6) and 1)<>0 then begin
           case DataSize of
@@ -894,10 +902,10 @@ begin
   case (PropInfo^.PropProcs shr 2) and 3 of
     ptfield:
       case DataSize of
-        1: PByte(Pointer(Instance)+Ptrint(PropInfo^.SetProc))^:=Byte(Value);
-        2: PWord(Pointer(Instance)+Ptrint(PropInfo^.SetProc))^:=Word(Value);
-        4: PLongint(Pointer(Instance)+Ptrint(PropInfo^.SetProc))^:=Longint(Value);
-        8: PInt64(Pointer(Instance)+Ptrint(PropInfo^.SetProc))^:=Value;
+        1: PByte(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^:=Byte(Value);
+        2: PWord(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^:=Word(Value);
+        4: PLongint(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^:=Longint(Value);
+        8: PInt64(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^:=Value;
       end;
     ptstatic,
     ptvirtual :
@@ -905,7 +913,7 @@ begin
         if ((PropInfo^.PropProcs shr 2) and 3)=ptStatic then
           AMethod.Code:=PropInfo^.SetProc
         else
-          AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Ptrint(PropInfo^.SetProc))^;
+          AMethod.Code:=PPointer(Pointer(Instance.ClassType)+PtrUInt(PropInfo^.SetProc))^;
         AMethod.Data:=Instance;
         if datasize=8 then
           begin
@@ -1087,6 +1095,42 @@ begin
   Result:=GetTypeData(FindPropInfo(Instance,PropName)^.PropType)^.ClassType;
 end;
 
+{ ---------------------------------------------------------------------
+    Interface wrapprers
+  ---------------------------------------------------------------------}
+
+
+function GetInterfaceProp(Instance: TObject; const PropName: string): IInterface;
+
+begin
+  Result:=GetInterfaceProp(Instance,FindPropInfo(Instance,PropName));
+end;
+
+function GetInterfaceProp(Instance: TObject; PropInfo: PPropInfo): IInterface;
+
+begin
+{$ifdef cpu64}
+  Result:=IInterface(GetInt64Prop(Instance,PropInfo));
+{$else cpu64}
+  Result:=IInterface(PtrInt(GetOrdProp(Instance,PropInfo)));
+{$endif cpu64}
+end;
+
+procedure SetInterfaceProp(Instance: TObject; const PropName: string; const Value: IInterface);
+
+begin
+  SetInterfaceProp(Instance,FindPropInfo(Instance,PropName),Value);
+end;
+
+procedure SetInterfaceProp(Instance: TObject; PropInfo: PPropInfo; const Value: IInterface);
+
+begin
+{$ifdef cpu64}
+  SetInt64Prop(Instance,PropInfo,Int64(Value));
+{$else cpu64}
+  SetOrdProp(Instance,PropInfo,Integer(Value));
+{$endif cpu64}
+end;
 
 { ---------------------------------------------------------------------
   String properties
@@ -1116,7 +1160,7 @@ begin
               if (PropInfo^.PropProcs and 3)=ptStatic then
                 AMethod.Code:=PropInfo^.GetProc
               else
-                AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Ptrint(PropInfo^.GetProc))^;
+                AMethod.Code:=PPointer(Pointer(Instance.ClassType)+PtrUInt(PropInfo^.GetProc))^;
               AMethod.Data:=Instance;
               if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
                 Result:=TGetShortStrProcIndex(AMethod)(PropInfo^.Index)
@@ -1136,7 +1180,7 @@ begin
               if (PropInfo^.PropProcs and 3)=ptStatic then
                 AMethod.Code:=PropInfo^.GetProc
               else
-                AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Ptrint(PropInfo^.GetProc))^;
+                AMethod.Code:=PPointer(Pointer(Instance.ClassType)+PtrUInt(PropInfo^.GetProc))^;
               AMethod.Data:=Instance;
               if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
                 Result:=TGetAnsiStrProcIndex(AMethod)(PropInfo^.Index)
@@ -1172,7 +1216,7 @@ begin
               if (PropInfo^.PropProcs and 3)=ptStatic then
                 AMethod.Code:=PropInfo^.SetProc
               else
-                AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Ptrint(PropInfo^.SetProc))^;
+                AMethod.Code:=PPointer(Pointer(Instance.ClassType)+PtrUInt(PropInfo^.SetProc))^;
               AMethod.Data:=Instance;
               if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
                 TSetShortStrProcIndex(AMethod)(PropInfo^.Index,Value)
@@ -1192,7 +1236,7 @@ begin
               if ((PropInfo^.PropProcs shr 2) and 3)=ptStatic then
                 AMethod.Code:=PropInfo^.SetProc
               else
-                AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Ptrint(PropInfo^.SetProc))^;
+                AMethod.Code:=PPointer(Pointer(Instance.ClassType)+PtrUInt(PropInfo^.SetProc))^;
               AMethod.Data:=Instance;
               if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
                 TSetAnsiStrProcIndex(AMethod)(PropInfo^.Index,Value)
@@ -1321,15 +1365,15 @@ begin
     ptField:
       Case GetTypeData(PropInfo^.PropType)^.FloatType of
        ftSingle:
-         Result:=PSingle(Pointer(Instance)+Ptrint(PropInfo^.GetProc))^;
+         Result:=PSingle(Pointer(Instance)+PtrUInt(PropInfo^.GetProc))^;
        ftDouble:
-         Result:=PDouble(Pointer(Instance)+Ptrint(PropInfo^.GetProc))^;
+         Result:=PDouble(Pointer(Instance)+PtrUInt(PropInfo^.GetProc))^;
        ftExtended:
-         Result:=PExtended(Pointer(Instance)+Ptrint(PropInfo^.GetProc))^;
+         Result:=PExtended(Pointer(Instance)+PtrUInt(PropInfo^.GetProc))^;
        ftcomp:
-         Result:=PComp(Pointer(Instance)+Ptrint(PropInfo^.GetProc))^;
+         Result:=PComp(Pointer(Instance)+PtrUInt(PropInfo^.GetProc))^;
        ftcurr:
-         Result:=PCurrency(Pointer(Instance)+Ptrint(PropInfo^.GetProc))^;
+         Result:=PCurrency(Pointer(Instance)+PtrUInt(PropInfo^.GetProc))^;
        end;
     ptStatic,
     ptVirtual:
@@ -1337,7 +1381,7 @@ begin
         if (PropInfo^.PropProcs and 3)=ptStatic then
           AMethod.Code:=PropInfo^.GetProc
         else
-          AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Ptrint(PropInfo^.GetProc))^;
+          AMethod.Code:=PPointer(Pointer(Instance.ClassType)+PtrUInt(PropInfo^.GetProc))^;
         AMethod.Data:=Instance;
         Case GetTypeData(PropInfo^.PropType)^.FloatType of
           ftSingle:
@@ -1383,20 +1427,20 @@ begin
     ptfield:
       Case GetTypeData(PropInfo^.PropType)^.FloatType of
         ftSingle:
-          PSingle(Pointer(Instance)+Ptrint(PropInfo^.SetProc))^:=Value;
+          PSingle(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^:=Value;
         ftDouble:
-          PDouble(Pointer(Instance)+Ptrint(PropInfo^.SetProc))^:=Value;
+          PDouble(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^:=Value;
         ftExtended:
-          PExtended(Pointer(Instance)+Ptrint(PropInfo^.SetProc))^:=Value;
+          PExtended(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^:=Value;
 {$ifdef FPC_COMP_IS_INT64}
         ftComp:
           PComp(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^:=trunc(Value);
 {$else FPC_COMP_IS_INT64}
         ftComp:
-          PComp(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^:=Value;
+          PComp(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^:=Comp(Value);
 {$endif FPC_COMP_IS_INT64}
         ftCurr:
- 	  PCurrency(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^:=Value;
+          PCurrency(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^:=Value;
        end;
     ptStatic,
     ptVirtual:
@@ -1404,7 +1448,7 @@ begin
         if ((PropInfo^.PropProcs shr 2) and 3)=ptStatic then
           AMethod.Code:=PropInfo^.SetProc
         else
-          AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Ptrint(PropInfo^.SetProc))^;
+          AMethod.Code:=PPointer(Pointer(Instance.ClassType)+PtrUInt(PropInfo^.SetProc))^;
         AMethod.Data:=Instance;
         Case GetTypeData(PropInfo^.PropType)^.FloatType of
           ftSingle:
@@ -1463,7 +1507,7 @@ begin
   case (PropInfo^.PropProcs) and 3 of
     ptfield:
       begin
-        Value:=PMethod(Pointer(Instance)+Ptrint(PropInfo^.GetProc));
+        Value:=PMethod(Pointer(Instance)+PtrUInt(PropInfo^.GetProc));
         if Value<>nil then
           Result:=Value^;
       end;
@@ -1473,7 +1517,7 @@ begin
         if (PropInfo^.PropProcs and 3)=ptStatic then
           AMethod.Code:=PropInfo^.GetProc
         else
-          AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Ptrint(PropInfo^.GetProc))^;
+          AMethod.Code:=PPointer(Pointer(Instance.ClassType)+PtrUInt(PropInfo^.GetProc))^;
         AMethod.Data:=Instance;
         if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
           Result:=TGetMethodProcIndex(AMethod)(PropInfo^.Index)
@@ -1493,14 +1537,14 @@ var
 begin
   case (PropInfo^.PropProcs shr 2) and 3 of
     ptfield:
-      PMethod(Pointer(Instance)+Ptrint(PropInfo^.SetProc))^ := Value;
+      PMethod(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^ := Value;
     ptstatic,
     ptvirtual :
       begin
         if ((PropInfo^.PropProcs shr 2) and 3)=ptStatic then
           AMethod.Code:=PropInfo^.SetProc
         else
-          AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Ptrint(PropInfo^.SetProc))^;
+          AMethod.Code:=PPointer(Pointer(Instance.ClassType)+PtrUInt(PropInfo^.SetProc))^;
         AMethod.Data:=Instance;
         if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
           TSetMethodProcIndex(AMethod)(PropInfo^.Index,Value)

rtl/os2/doscalls.pas

@@ -2912,27 +2912,35 @@ function DosStopSession (Scope, SesID: cardinal): cardinal; cdecl;
 
 ****************************************************************************}
 
-type    TAvailData=record
-            cbPipe,             {Number of bytes in pipe.}
-            cbMessage:word;     {Number of bytes in current message.}
-        end;
+type
+  TAvailData = record
+    cbPipe,              {Number of bytes in pipe.}
+    cbMessage: word;     {Number of bytes in current message.}
+  end;
 
-        TPipeInfo=record
-            cbOut:word;         {Size of outbound data.}
-            cbIn:word;          {Size of inbound data.}
-            MaxInst:byte;       {Maximum number of instances.}
-            CurInst:byte;       {Current number of instances.}
-            Name:string;        {Name of the pipe. You can use @Name[1] if
-                                 you need a PChar to the name; the string is
-                                 always followed by a zero.}
-        end;
+  TPipeInfo = record
+    cbOut: word;         {Size of outbound data.}
+    cbIn: word;          {Size of inbound data.}
+    MaxInst: byte;       {Maximum number of instances.}
+    CurInst: byte;       {Current number of instances.}
+    Name: string;        {Name of the pipe. You can use @Name[1] if
+                          you need a PChar to the name; the string is
+                          always followed by a zero.}
+  end;
 
-        TPipeSemState=record
-            Status:byte;
-            Flag:byte;
-            Key:word;
-            Avail:word;
-        end;
+  TPipeSemState = record
+    case boolean of
+      false: (Status: byte;
+              Flag: byte;
+              Key: word;
+              Avail: word);
+      true:  (fStatus: byte;
+              fFlag: byte;
+              usKey: word;
+              usAvail: word);
+  end;
+  PPipeSemState = ^TPipeSemState;
+  TPipeSemStates = array [0..$FFFF] of TPipeSemState;
 
 {Create an unnamed pipe.
  ReadHandle     = Receives handle for reading from pipe.
@@ -2960,11 +2968,14 @@ const   {np_XXXX constants for openmode.}
                                              stream instead of as a byte
                                              stream.}
         np_ReadMode_Message     = np_ReadMode_Mesg;
+        np_RMesg                = np_ReadMode_Message;
         np_WriteMode_Mesg       = $0400;    {Write the pipe as a message
                                              stream instead of as a byte
                                              stream.}
         np_WriteMode_Message    = np_WriteMode_Mesg;
         np_Type_Message         = np_WriteMode_Mesg;
+        np_WMesg                = np_WriteMode_Mesg;
+        np_Wait                 = 0;        { For compatibility only }
         np_NoWait               = $8000;    {Dosread and Doswrite do not
                                              wait is no data can be read or
                                              written; they return with an
@@ -3061,6 +3072,8 @@ function DosQueryNPipeInfo (Handle: THandle; InfoLevel: cardinal; var Buffer;
  BufSize        = Size of SemArray, in bytes.}
 function DosQueryNPipeSemState (SemHandle: THandle; var SemArray;
                                 BufSize: cardinal): cardinal; cdecl;
+function DosQueryNPipeSemState (SemHandle: THandle; SemArray: PPipeSemState;
+                                           BufSize: cardinal): cardinal; cdecl;
 
 {Resets the blocking mode and state of a named pipe.
  Handle         = Handle to named pipe.
@@ -5085,7 +5098,11 @@ function DosQueryNPipeInfo (Handle: THandle; InfoLevel: cardinal; var Buffer;
 external 'DOSCALLS' index 248;
 
 function DosQueryNPipeSemState (SemHandle: THandle; var SemArray;
-                                BufSize: cardinal): cardinal; cdecl;
+                                           BufSize: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 249;
+
+function DosQueryNPipeSemState (SemHandle: THandle; SemArray: PPipeSemState;
+                                           BufSize: cardinal): cardinal; cdecl;
 external 'DOSCALLS' index 249;
 
 function DosSetNPHState (Handle: THandle; State: cardinal):cardinal; cdecl;

rtl/win/crt.pp

@@ -110,7 +110,6 @@ end;
 
 procedure TextMode (Mode: word);
 begin
-  {$WARNING TextMode not implemented yet!!}
 end;
 
 Procedure TextColor(Color: Byte);

rtl/win/keyboard.pp

@@ -122,7 +122,10 @@ begin
       exit;
     end;
   WaitForSingleObject (newKeyEvent, dword(INFINITE));
-  getKeyEventFromQueueWait := getKeyEventFromQueue (t, false);
+  { force that we read a keyevent }
+  while not(getKeyEventFromQueue (t, false)) do
+    Sleep(0);
+  getKeyEventFromQueueWait:=true;
 end;
 
 { translate win32 shift-state to keyboard shift state }

rtl/win/mouse.pp

@@ -158,7 +158,7 @@ begin
   EnterCriticalSection(ChangeMouseEvents);
   MouseEvent:=PendingMouseHead^;
   inc(PendingMouseHead);
-  if ptrint(PendingMouseHead)=ptrint(@PendingMouseEvent)+sizeof(PendingMouseEvent) then
+  if ptruint(PendingMouseHead)=ptruint(@PendingMouseEvent)+sizeof(PendingMouseEvent) then
    PendingMouseHead:=@PendingMouseEvent[0];
   dec(PendingMouseEvents);
 
@@ -205,7 +205,7 @@ begin
    begin
      PendingMouseTail^:=MouseEvent;
      inc(PendingMouseTail);
-     if ptrint(PendingMouseTail)=ptrint(@PendingMouseEvent)+sizeof(PendingMouseEvent) then
+     if ptruint(PendingMouseTail)=ptruint(@PendingMouseEvent)+sizeof(PendingMouseEvent) then
       PendingMouseTail:=@PendingMouseEvent[0];
       { why isn't this done here ?
         so the win32 version do this by hand:}

rtl/win/sockets.pp

@@ -265,7 +265,7 @@ var
   wsadata : twsadata;
 
 initialization
-  WSAStartUp($2,wsadata);
+  WSAStartUp(WINSOCK_VERSION,wsadata);
 finalization
   WSACleanUp;
 end.

rtl/win/sysutils.pp

@@ -92,8 +92,8 @@ function CheckWin32Version(Major : Integer): Boolean;
 
 function CheckWin32Version(Major,Minor: Integer): Boolean;
   begin
-    Result:=(Win32MajorVersion>Major) or
-            ((Win32MajorVersion=Major) and (Win32MinorVersion>=Minor));
+    Result:=(Win32MajorVersion>dword(Major)) or
+            ((Win32MajorVersion=dword(Major)) and (Win32MinorVersion>=dword(Minor)));
   end;
 
 
@@ -1103,7 +1103,6 @@ end;
                     Target Dependent WideString stuff
 ****************************************************************************}
 
-
 function Win32CompareWideString(const s1, s2 : WideString) : PtrInt;
   begin
     SetLastError(0);
@@ -1206,6 +1205,7 @@ function Win32AnsiStrUpper(Str: PChar): PChar;
   are relevant already for the system unit }
 procedure InitWin32Widestrings;
   begin
+//!!!    CharLengthPCharProc : function(const Str: PChar): PtrInt;
     widestringmanager.CompareWideStringProc:=@Win32CompareWideString;
     widestringmanager.CompareTextWideStringProc:=@Win32CompareTextWideString;
     widestringmanager.UpperAnsiStringProc:=@Win32AnsiUpperCase;

rtl/win/video.pp

@@ -17,6 +17,8 @@ unit Video;
 interface
 
 {$i videoh.inc}
+const
+  useunicodefunctions : boolean = false;
 
 implementation
 
@@ -25,6 +27,278 @@ uses
 
 {$i video.inc}
 
+  type
+    tunicodecharmappingflag = (umf_noinfo,umf_leadbyte,umf_undefined,
+      umf_unused);
+
+    punicodecharmapping = ^tunicodecharmapping;
+    tunicodecharmapping = record
+       unicode : word;
+       flag : tunicodecharmappingflag;
+       reserved : byte;
+    end;
+
+  const
+     mapcp850 : array[0..255] of tunicodecharmapping = (
+       (unicode : 0; flag : umf_noinfo; reserved : 0),
+       (unicode : 1; flag : umf_noinfo; reserved : 0),
+       (unicode : 2; flag : umf_noinfo; reserved : 0),
+       (unicode : 3; flag : umf_noinfo; reserved : 0),
+       (unicode : 4; flag : umf_noinfo; reserved : 0),
+       (unicode : 5; flag : umf_noinfo; reserved : 0),
+       (unicode : 6; flag : umf_noinfo; reserved : 0),
+       (unicode : 7; flag : umf_noinfo; reserved : 0),
+       (unicode : 8; flag : umf_noinfo; reserved : 0),
+       (unicode : 9; flag : umf_noinfo; reserved : 0),
+       (unicode : 10; flag : umf_noinfo; reserved : 0),
+       (unicode : 11; flag : umf_noinfo; reserved : 0),
+       (unicode : 12; flag : umf_noinfo; reserved : 0),
+       (unicode : 13; flag : umf_noinfo; reserved : 0),
+       (unicode : 14; flag : umf_noinfo; reserved : 0),
+       (unicode : 15; flag : umf_noinfo; reserved : 0),
+       (unicode : 16; flag : umf_noinfo; reserved : 0),
+       (unicode : 17; flag : umf_noinfo; reserved : 0),
+       (unicode : 18; flag : umf_noinfo; reserved : 0),
+       (unicode : 19; flag : umf_noinfo; reserved : 0),
+       (unicode : 20; flag : umf_noinfo; reserved : 0),
+       (unicode : 21; flag : umf_noinfo; reserved : 0),
+       (unicode : 22; flag : umf_noinfo; reserved : 0),
+       (unicode : 23; flag : umf_noinfo; reserved : 0),
+       (unicode : 24; flag : umf_noinfo; reserved : 0),
+       (unicode : 25; flag : umf_noinfo; reserved : 0),
+       (unicode : 26; flag : umf_noinfo; reserved : 0),
+       (unicode : 27; flag : umf_noinfo; reserved : 0),
+       (unicode : 28; flag : umf_noinfo; reserved : 0),
+       (unicode : 29; flag : umf_noinfo; reserved : 0),
+       (unicode : 30; flag : umf_noinfo; reserved : 0),
+       (unicode : 31; flag : umf_noinfo; reserved : 0),
+       (unicode : 32; flag : umf_noinfo; reserved : 0),
+       (unicode : 33; flag : umf_noinfo; reserved : 0),
+       (unicode : 34; flag : umf_noinfo; reserved : 0),
+       (unicode : 35; flag : umf_noinfo; reserved : 0),
+       (unicode : 36; flag : umf_noinfo; reserved : 0),
+       (unicode : 37; flag : umf_noinfo; reserved : 0),
+       (unicode : 38; flag : umf_noinfo; reserved : 0),
+       (unicode : 39; flag : umf_noinfo; reserved : 0),
+       (unicode : 40; flag : umf_noinfo; reserved : 0),
+       (unicode : 41; flag : umf_noinfo; reserved : 0),
+       (unicode : 42; flag : umf_noinfo; reserved : 0),
+       (unicode : 43; flag : umf_noinfo; reserved : 0),
+       (unicode : 44; flag : umf_noinfo; reserved : 0),
+       (unicode : 45; flag : umf_noinfo; reserved : 0),
+       (unicode : 46; flag : umf_noinfo; reserved : 0),
+       (unicode : 47; flag : umf_noinfo; reserved : 0),
+       (unicode : 48; flag : umf_noinfo; reserved : 0),
+       (unicode : 49; flag : umf_noinfo; reserved : 0),
+       (unicode : 50; flag : umf_noinfo; reserved : 0),
+       (unicode : 51; flag : umf_noinfo; reserved : 0),
+       (unicode : 52; flag : umf_noinfo; reserved : 0),
+       (unicode : 53; flag : umf_noinfo; reserved : 0),
+       (unicode : 54; flag : umf_noinfo; reserved : 0),
+       (unicode : 55; flag : umf_noinfo; reserved : 0),
+       (unicode : 56; flag : umf_noinfo; reserved : 0),
+       (unicode : 57; flag : umf_noinfo; reserved : 0),
+       (unicode : 58; flag : umf_noinfo; reserved : 0),
+       (unicode : 59; flag : umf_noinfo; reserved : 0),
+       (unicode : 60; flag : umf_noinfo; reserved : 0),
+       (unicode : 61; flag : umf_noinfo; reserved : 0),
+       (unicode : 62; flag : umf_noinfo; reserved : 0),
+       (unicode : 63; flag : umf_noinfo; reserved : 0),
+       (unicode : 64; flag : umf_noinfo; reserved : 0),
+       (unicode : 65; flag : umf_noinfo; reserved : 0),
+       (unicode : 66; flag : umf_noinfo; reserved : 0),
+       (unicode : 67; flag : umf_noinfo; reserved : 0),
+       (unicode : 68; flag : umf_noinfo; reserved : 0),
+       (unicode : 69; flag : umf_noinfo; reserved : 0),
+       (unicode : 70; flag : umf_noinfo; reserved : 0),
+       (unicode : 71; flag : umf_noinfo; reserved : 0),
+       (unicode : 72; flag : umf_noinfo; reserved : 0),
+       (unicode : 73; flag : umf_noinfo; reserved : 0),
+       (unicode : 74; flag : umf_noinfo; reserved : 0),
+       (unicode : 75; flag : umf_noinfo; reserved : 0),
+       (unicode : 76; flag : umf_noinfo; reserved : 0),
+       (unicode : 77; flag : umf_noinfo; reserved : 0),
+       (unicode : 78; flag : umf_noinfo; reserved : 0),
+       (unicode : 79; flag : umf_noinfo; reserved : 0),
+       (unicode : 80; flag : umf_noinfo; reserved : 0),
+       (unicode : 81; flag : umf_noinfo; reserved : 0),
+       (unicode : 82; flag : umf_noinfo; reserved : 0),
+       (unicode : 83; flag : umf_noinfo; reserved : 0),
+       (unicode : 84; flag : umf_noinfo; reserved : 0),
+       (unicode : 85; flag : umf_noinfo; reserved : 0),
+       (unicode : 86; flag : umf_noinfo; reserved : 0),
+       (unicode : 87; flag : umf_noinfo; reserved : 0),
+       (unicode : 88; flag : umf_noinfo; reserved : 0),
+       (unicode : 89; flag : umf_noinfo; reserved : 0),
+       (unicode : 90; flag : umf_noinfo; reserved : 0),
+       (unicode : 91; flag : umf_noinfo; reserved : 0),
+       (unicode : 92; flag : umf_noinfo; reserved : 0),
+       (unicode : 93; flag : umf_noinfo; reserved : 0),
+       (unicode : 94; flag : umf_noinfo; reserved : 0),
+       (unicode : 95; flag : umf_noinfo; reserved : 0),
+       (unicode : 96; flag : umf_noinfo; reserved : 0),
+       (unicode : 97; flag : umf_noinfo; reserved : 0),
+       (unicode : 98; flag : umf_noinfo; reserved : 0),
+       (unicode : 99; flag : umf_noinfo; reserved : 0),
+       (unicode : 100; flag : umf_noinfo; reserved : 0),
+       (unicode : 101; flag : umf_noinfo; reserved : 0),
+       (unicode : 102; flag : umf_noinfo; reserved : 0),
+       (unicode : 103; flag : umf_noinfo; reserved : 0),
+       (unicode : 104; flag : umf_noinfo; reserved : 0),
+       (unicode : 105; flag : umf_noinfo; reserved : 0),
+       (unicode : 106; flag : umf_noinfo; reserved : 0),
+       (unicode : 107; flag : umf_noinfo; reserved : 0),
+       (unicode : 108; flag : umf_noinfo; reserved : 0),
+       (unicode : 109; flag : umf_noinfo; reserved : 0),
+       (unicode : 110; flag : umf_noinfo; reserved : 0),
+       (unicode : 111; flag : umf_noinfo; reserved : 0),
+       (unicode : 112; flag : umf_noinfo; reserved : 0),
+       (unicode : 113; flag : umf_noinfo; reserved : 0),
+       (unicode : 114; flag : umf_noinfo; reserved : 0),
+       (unicode : 115; flag : umf_noinfo; reserved : 0),
+       (unicode : 116; flag : umf_noinfo; reserved : 0),
+       (unicode : 117; flag : umf_noinfo; reserved : 0),
+       (unicode : 118; flag : umf_noinfo; reserved : 0),
+       (unicode : 119; flag : umf_noinfo; reserved : 0),
+       (unicode : 120; flag : umf_noinfo; reserved : 0),
+       (unicode : 121; flag : umf_noinfo; reserved : 0),
+       (unicode : 122; flag : umf_noinfo; reserved : 0),
+       (unicode : 123; flag : umf_noinfo; reserved : 0),
+       (unicode : 124; flag : umf_noinfo; reserved : 0),
+       (unicode : 125; flag : umf_noinfo; reserved : 0),
+       (unicode : 126; flag : umf_noinfo; reserved : 0),
+       (unicode : 127; flag : umf_noinfo; reserved : 0),
+       (unicode : 199; flag : umf_noinfo; reserved : 0),
+       (unicode : 252; flag : umf_noinfo; reserved : 0),
+       (unicode : 233; flag : umf_noinfo; reserved : 0),
+       (unicode : 226; flag : umf_noinfo; reserved : 0),
+       (unicode : 228; flag : umf_noinfo; reserved : 0),
+       (unicode : 224; flag : umf_noinfo; reserved : 0),
+       (unicode : 229; flag : umf_noinfo; reserved : 0),
+       (unicode : 231; flag : umf_noinfo; reserved : 0),
+       (unicode : 234; flag : umf_noinfo; reserved : 0),
+       (unicode : 235; flag : umf_noinfo; reserved : 0),
+       (unicode : 232; flag : umf_noinfo; reserved : 0),
+       (unicode : 239; flag : umf_noinfo; reserved : 0),
+       (unicode : 238; flag : umf_noinfo; reserved : 0),
+       (unicode : 236; flag : umf_noinfo; reserved : 0),
+       (unicode : 196; flag : umf_noinfo; reserved : 0),
+       (unicode : 197; flag : umf_noinfo; reserved : 0),
+       (unicode : 201; flag : umf_noinfo; reserved : 0),
+       (unicode : 230; flag : umf_noinfo; reserved : 0),
+       (unicode : 198; flag : umf_noinfo; reserved : 0),
+       (unicode : 244; flag : umf_noinfo; reserved : 0),
+       (unicode : 246; flag : umf_noinfo; reserved : 0),
+       (unicode : 242; flag : umf_noinfo; reserved : 0),
+       (unicode : 251; flag : umf_noinfo; reserved : 0),
+       (unicode : 249; flag : umf_noinfo; reserved : 0),
+       (unicode : 255; flag : umf_noinfo; reserved : 0),
+       (unicode : 214; flag : umf_noinfo; reserved : 0),
+       (unicode : 220; flag : umf_noinfo; reserved : 0),
+       (unicode : 248; flag : umf_noinfo; reserved : 0),
+       (unicode : 163; flag : umf_noinfo; reserved : 0),
+       (unicode : 216; flag : umf_noinfo; reserved : 0),
+       (unicode : 215; flag : umf_noinfo; reserved : 0),
+       (unicode : 402; flag : umf_noinfo; reserved : 0),
+       (unicode : 225; flag : umf_noinfo; reserved : 0),
+       (unicode : 237; flag : umf_noinfo; reserved : 0),
+       (unicode : 243; flag : umf_noinfo; reserved : 0),
+       (unicode : 250; flag : umf_noinfo; reserved : 0),
+       (unicode : 241; flag : umf_noinfo; reserved : 0),
+       (unicode : 209; flag : umf_noinfo; reserved : 0),
+       (unicode : 170; flag : umf_noinfo; reserved : 0),
+       (unicode : 186; flag : umf_noinfo; reserved : 0),
+       (unicode : 191; flag : umf_noinfo; reserved : 0),
+       (unicode : 174; flag : umf_noinfo; reserved : 0),
+       (unicode : 172; flag : umf_noinfo; reserved : 0),
+       (unicode : 189; flag : umf_noinfo; reserved : 0),
+       (unicode : 188; flag : umf_noinfo; reserved : 0),
+       (unicode : 161; flag : umf_noinfo; reserved : 0),
+       (unicode : 171; flag : umf_noinfo; reserved : 0),
+       (unicode : 187; flag : umf_noinfo; reserved : 0),
+       (unicode : 9617; flag : umf_noinfo; reserved : 0),
+       (unicode : 9618; flag : umf_noinfo; reserved : 0),
+       (unicode : 9619; flag : umf_noinfo; reserved : 0),
+       (unicode : 9474; flag : umf_noinfo; reserved : 0),
+       (unicode : 9508; flag : umf_noinfo; reserved : 0),
+       (unicode : 193; flag : umf_noinfo; reserved : 0),
+       (unicode : 194; flag : umf_noinfo; reserved : 0),
+       (unicode : 192; flag : umf_noinfo; reserved : 0),
+       (unicode : 169; flag : umf_noinfo; reserved : 0),
+       (unicode : 9571; flag : umf_noinfo; reserved : 0),
+       (unicode : 9553; flag : umf_noinfo; reserved : 0),
+       (unicode : 9559; flag : umf_noinfo; reserved : 0),
+       (unicode : 9565; flag : umf_noinfo; reserved : 0),
+       (unicode : 162; flag : umf_noinfo; reserved : 0),
+       (unicode : 165; flag : umf_noinfo; reserved : 0),
+       (unicode : 9488; flag : umf_noinfo; reserved : 0),
+       (unicode : 9492; flag : umf_noinfo; reserved : 0),
+       (unicode : 9524; flag : umf_noinfo; reserved : 0),
+       (unicode : 9516; flag : umf_noinfo; reserved : 0),
+       (unicode : 9500; flag : umf_noinfo; reserved : 0),
+       (unicode : 9472; flag : umf_noinfo; reserved : 0),
+       (unicode : 9532; flag : umf_noinfo; reserved : 0),
+       (unicode : 227; flag : umf_noinfo; reserved : 0),
+       (unicode : 195; flag : umf_noinfo; reserved : 0),
+       (unicode : 9562; flag : umf_noinfo; reserved : 0),
+       (unicode : 9556; flag : umf_noinfo; reserved : 0),
+       (unicode : 9577; flag : umf_noinfo; reserved : 0),
+       (unicode : 9574; flag : umf_noinfo; reserved : 0),
+       (unicode : 9568; flag : umf_noinfo; reserved : 0),
+       (unicode : 9552; flag : umf_noinfo; reserved : 0),
+       (unicode : 9580; flag : umf_noinfo; reserved : 0),
+       (unicode : 164; flag : umf_noinfo; reserved : 0),
+       (unicode : 240; flag : umf_noinfo; reserved : 0),
+       (unicode : 208; flag : umf_noinfo; reserved : 0),
+       (unicode : 202; flag : umf_noinfo; reserved : 0),
+       (unicode : 203; flag : umf_noinfo; reserved : 0),
+       (unicode : 200; flag : umf_noinfo; reserved : 0),
+       (unicode : 305; flag : umf_noinfo; reserved : 0),
+       (unicode : 205; flag : umf_noinfo; reserved : 0),
+       (unicode : 206; flag : umf_noinfo; reserved : 0),
+       (unicode : 207; flag : umf_noinfo; reserved : 0),
+       (unicode : 9496; flag : umf_noinfo; reserved : 0),
+       (unicode : 9484; flag : umf_noinfo; reserved : 0),
+       (unicode : 9608; flag : umf_noinfo; reserved : 0),
+       (unicode : 9604; flag : umf_noinfo; reserved : 0),
+       (unicode : 166; flag : umf_noinfo; reserved : 0),
+       (unicode : 204; flag : umf_noinfo; reserved : 0),
+       (unicode : 9600; flag : umf_noinfo; reserved : 0),
+       (unicode : 211; flag : umf_noinfo; reserved : 0),
+       (unicode : 223; flag : umf_noinfo; reserved : 0),
+       (unicode : 212; flag : umf_noinfo; reserved : 0),
+       (unicode : 210; flag : umf_noinfo; reserved : 0),
+       (unicode : 245; flag : umf_noinfo; reserved : 0),
+       (unicode : 213; flag : umf_noinfo; reserved : 0),
+       (unicode : 181; flag : umf_noinfo; reserved : 0),
+       (unicode : 254; flag : umf_noinfo; reserved : 0),
+       (unicode : 222; flag : umf_noinfo; reserved : 0),
+       (unicode : 218; flag : umf_noinfo; reserved : 0),
+       (unicode : 219; flag : umf_noinfo; reserved : 0),
+       (unicode : 217; flag : umf_noinfo; reserved : 0),
+       (unicode : 253; flag : umf_noinfo; reserved : 0),
+       (unicode : 221; flag : umf_noinfo; reserved : 0),
+       (unicode : 175; flag : umf_noinfo; reserved : 0),
+       (unicode : 180; flag : umf_noinfo; reserved : 0),
+       (unicode : 173; flag : umf_noinfo; reserved : 0),
+       (unicode : 177; flag : umf_noinfo; reserved : 0),
+       (unicode : 8215; flag : umf_noinfo; reserved : 0),
+       (unicode : 190; flag : umf_noinfo; reserved : 0),
+       (unicode : 182; flag : umf_noinfo; reserved : 0),
+       (unicode : 167; flag : umf_noinfo; reserved : 0),
+       (unicode : 247; flag : umf_noinfo; reserved : 0),
+       (unicode : 184; flag : umf_noinfo; reserved : 0),
+       (unicode : 176; flag : umf_noinfo; reserved : 0),
+       (unicode : 168; flag : umf_noinfo; reserved : 0),
+       (unicode : 183; flag : umf_noinfo; reserved : 0),
+       (unicode : 185; flag : umf_noinfo; reserved : 0),
+       (unicode : 179; flag : umf_noinfo; reserved : 0),
+       (unicode : 178; flag : umf_noinfo; reserved : 0),
+       (unicode : 9632; flag : umf_noinfo; reserved : 0),
+       (unicode : 160; flag : umf_noinfo; reserved : 0)
+     );
+
+
 const
     LastCursorType: word = crUnderline;
     OrigScreen: PVideoBuf = nil;
@@ -261,11 +535,6 @@ begin
   UpdateScreen(true);
 end;
 
-{$IFDEF FPC}
-function WriteConsoleOutput(hConsoleOutput:HANDLE; lpBuffer:pointer; dwBufferSize:COORD; dwBufferCoord:COORD;
-   var lpWriteRegion:SMALL_RECT):WINBOOL; stdcall;external 'kernel32' name 'WriteConsoleOutputA';
-{$ENDIF}
-
 procedure SysUpdateScreen(Force: Boolean);
 type TmpRec = Array[0..(1024*32) - 1] of TCharInfo;
 
@@ -338,11 +607,14 @@ begin
                     if LineCounter>y2 then
                       y2:=LineCounter;
                  end;
-               LineBuf^[BufCounter].UniCodeChar := Widechar(WordRec(VideoBuf^[BufCounter]).One);
+               if useunicodefunctions then
+                 LineBuf^[BufCounter].UniCodeChar := Widechar(mapcp850[WordRec(VideoBuf^[BufCounter]).One].unicode)
+               else
+                 LineBuf^[BufCounter].UniCodeChar := Widechar(WordRec(VideoBuf^[BufCounter]).One);
                { If (WordRec(VideoBuf^[BufCounter]).Two and $80)<>0 then
                  LineBuf^[BufCounter].Attributes := $100+WordRec(VideoBuf^[BufCounter]).Two
                else }
-                 LineBuf^[BufCounter].Attributes := WordRec(VideoBuf^[BufCounter]).Two;
+               LineBuf^[BufCounter].Attributes := WordRec(VideoBuf^[BufCounter]).Two;
 
                Inc(BufCounter);
              end; { for }
@@ -377,7 +649,10 @@ begin
       writeln('X2: ',x2);
       writeln('Y2: ',y2);
       }
-      WriteConsoleOutput(TextRec(Output).Handle, LineBuf, BufSize, BufCoord, WriteRegion);
+      if useunicodefunctions then
+        WriteConsoleOutputW(TextRec(Output).Handle, LineBuf, BufSize, BufCoord, WriteRegion)
+      else
+        WriteConsoleOutput(TextRec(Output).Handle, LineBuf, BufSize, BufCoord, WriteRegion);
       Dispose(LineBuf);
 
       move(VideoBuf^,OldVideoBuf^,VideoBufSize);

rtl/win/winevent.pp

@@ -122,55 +122,54 @@ interface
               }
               if not(ExitEventHandleThread) then
                 begin
-                   EnterCriticalSection(HandlerChanging);
-                   { read, but don't remove the event }
                    if ReadConsoleInput(StdInputHandle,ir[0],irsize,dwRead) then
                     begin
                       i:=0;
-                      while (i<dwRead) do
-                       begin
-                       { call the handler }
-                       case ir[i].EventType of
-                        KEY_EVENT:
-                          begin
-                             if assigned(KeyboardEventHandler) then
-                               KeyboardEventHandler(ir[i]);
-                          end;
-
-                        _MOUSE_EVENT:
-                          begin
-                             if assigned(MouseEventHandler) then
-                               MouseEventHandler(ir[i]);
-                          end;
-
-                        WINDOW_BUFFER_SIZE_EVENT:
-                          begin
-                             if assigned(ResizeEventHandler) then
-                               ResizeEventHandler(ir[i]);
-                          end;
-
-                        MENU_EVENT:
-                          begin
-                             if assigned(MenuEventHandler) then
-                               MenuEventHandler(ir[i]);
-                          end;
-
-                        FOCUS_EVENT:
-                          begin
-                             if assigned(FocusEventHandler) then
-                               FocusEventHandler(ir[i]);
-                          end;
-
-                        else
-                          begin
-                             if assigned(UnknownEventHandler) then
-                               UnknownEventHandler(ir[i]);
-                          end;
-                       end;
-                       inc(i);
+                      EnterCriticalSection(HandlerChanging);
+                      while i<dwRead do
+                        begin
+                          { call the handler }
+                          case ir[i].EventType of
+                            KEY_EVENT:
+                              begin
+                                 if assigned(KeyboardEventHandler) then
+                                   KeyboardEventHandler(ir[i]);
+                              end;
+
+                            _MOUSE_EVENT:
+                              begin
+                                 if assigned(MouseEventHandler) then
+                                   MouseEventHandler(ir[i]);
+                              end;
+
+                            WINDOW_BUFFER_SIZE_EVENT:
+                              begin
+                                 if assigned(ResizeEventHandler) then
+                                   ResizeEventHandler(ir[i]);
+                              end;
+
+                            MENU_EVENT:
+                              begin
+                                 if assigned(MenuEventHandler) then
+                                   MenuEventHandler(ir[i]);
+                              end;
+
+                            FOCUS_EVENT:
+                              begin
+                                 if assigned(FocusEventHandler) then
+                                   FocusEventHandler(ir[i]);
+                              end;
+
+                            else
+                              begin
+                                 if assigned(UnknownEventHandler) then
+                                   UnknownEventHandler(ir[i]);
+                              end;
+                           end;
+                         inc(i);
                       end;
+                      LeaveCriticalSection(HandlerChanging);
                     end;
-                   LeaveCriticalSection(HandlerChanging);
                 end;
            end;
         EventHandleThread:=0;
@@ -219,8 +218,8 @@ interface
          EnterCriticalSection(HandlerChanging);
          oldp:=MouseEventHandler;
          MouseEventHandler:=p;
-         NewEventHandlerInstalled(MouseEventHandler,oldp);
          LeaveCriticalSection(HandlerChanging);
+         NewEventHandlerInstalled(MouseEventHandler,oldp);
       end;
 
 
@@ -231,8 +230,8 @@ interface
          EnterCriticalSection(HandlerChanging);
          oldp:=KeyboardEventHandler;
          KeyboardEventHandler:=p;
-         NewEventHandlerInstalled(KeyboardEventHandler,oldp);
          LeaveCriticalSection(HandlerChanging);
+         NewEventHandlerInstalled(KeyboardEventHandler,oldp);
       end;
 
 
@@ -243,8 +242,8 @@ interface
          EnterCriticalSection(HandlerChanging);
          oldp:=FocusEventHandler;
          FocusEventHandler:=p;
-         NewEventHandlerInstalled(FocusEventHandler,oldp);
          LeaveCriticalSection(HandlerChanging);
+         NewEventHandlerInstalled(FocusEventHandler,oldp);
       end;
 
 
@@ -255,8 +254,8 @@ interface
          EnterCriticalSection(HandlerChanging);
          oldp:=MenuEventHandler;
          MenuEventHandler:=p;
-         NewEventHandlerInstalled(MenuEventHandler,oldp);
          LeaveCriticalSection(HandlerChanging);
+         NewEventHandlerInstalled(MenuEventHandler,oldp);
       end;
 
 
@@ -267,8 +266,8 @@ interface
          EnterCriticalSection(HandlerChanging);
          oldp:=ResizeEventHandler;
          ResizeEventHandler:=p;
-         NewEventHandlerInstalled(ResizeEventHandler,oldp);
          LeaveCriticalSection(HandlerChanging);
+         NewEventHandlerInstalled(ResizeEventHandler,oldp);
       end;
 
 
@@ -279,8 +278,8 @@ interface
          EnterCriticalSection(HandlerChanging);
          oldp:=UnknownEventHandler;
          UnknownEventHandler:=p;
-         NewEventHandlerInstalled(UnknownEventHandler,oldp);
          LeaveCriticalSection(HandlerChanging);
+         NewEventHandlerInstalled(UnknownEventHandler,oldp);
       end;
 
 

rtl/win/wininc/defines.inc

@@ -1934,8 +1934,6 @@
      HEAP_GENERATE_EXCEPTIONS = 4;
      HEAP_NO_SERIALIZE = 1;
      HEAP_ZERO_MEMORY = 8;
-     STATUS_NO_MEMORY = $c0000017;
-     STATUS_ACCESS_VIOLATION = $c0000005;
      HEAP_REALLOC_IN_PLACE_ONLY = 16;
   { ImageList_Create  }
      ILC_COLOR = 0;
@@ -2813,6 +2811,7 @@
      WC_DISCARDNS = 16;
      WC_SEPCHARS = 32;
      WC_DEFAULTCHAR = 64;
+     WC_NO_BEST_FIT_CHARS = $400;
   { WinHelp  }
      HELP_COMMAND = $102;
      HELP_CONTENTS = $3;
@@ -5242,6 +5241,7 @@
      META_SETWINDOWORG = $020B;
      META_SETWINDOWEXT = $020C;
      POLYFILL_LAST = 2;
+
      STATUS_WAIT_0 = $00000000;
      STATUS_ABANDONED_WAIT_0 = $00000080;
      STATUS_USER_APC = $000000C0;
@@ -5251,8 +5251,10 @@
      STATUS_DATATYPE_MISALIGNMENT = $80000002;
      STATUS_BREAKPOINT = $80000003;
      STATUS_SINGLE_STEP = $80000004;
+     STATUS_ACCESS_VIOLATION = $C0000005;
      STATUS_IN_PAGE_ERROR = $C0000006;
      STATUS_INVALID_HANDLE = $C0000008;
+     STATUS_NO_MEMORY = $C0000017;
      STATUS_ILLEGAL_INSTRUCTION = $C000001D;
      STATUS_NONCONTINUABLE_EXCEPTION = $C0000025;
      STATUS_INVALID_DISPOSITION = $C0000026;
@@ -5269,6 +5271,13 @@
      STATUS_PRIVILEGED_INSTRUCTION = $C0000096;
      STATUS_STACK_OVERFLOW = $C00000FD;
      STATUS_CONTROL_C_EXIT = $C000013A;
+     STATUS_FLOAT_MULTIPLE_FAULTS = $C00002B4;
+     STATUS_FLOAT_MULTIPLE_TRAPS = $C00002B5;
+     STATUS_REG_NAT_CONSUMPTION = $C00002C9;
+     STATUS_SXS_EARLY_DEACTIVATION = $C015000F;
+     STATUS_SXS_INVALID_DEACTIVATION = $C0150010;
+
+
 {$define EXCEPTION_CTRL_C}
      PROCESSOR_ARCHITECTURE_INTEL = 0;
      PROCESSOR_ARCHITECTURE_MIPS = 1;
@@ -5392,7 +5401,7 @@
      LOGON32_LOGON_NETWORK = $03;
      LOGON32_LOGON_BATCH = $04;
      LOGON32_LOGON_SERVICE = $05;
-     LOGON32_LOGON_UNLOCK  = $07; 
+     LOGON32_LOGON_UNLOCK  = $07;
      LOGON32_LOGON_NETWORK_CLEARTEXT=$08; // $0500+
      LOGON32_LOGON_NEW_CREDENTIALS  =$09; // $0500+
      LOGON32_PROVIDER_DEFAULT = $00;

rtl/win/winsock.pp

@@ -25,6 +25,7 @@ unit winsock;
        windows;
 
     const
+       WINSOCK_VERSION = $0101;
        {
          Default maximium number of sockets.
          this does not

rtl/win32/classes.pp

@@ -180,6 +180,7 @@ function AllocateHWnd(Method: TWndMethod): HWND;
   begin
     { dummy }
     runerror(217);
+    Result:=0;
   end;
 
 

rtl/win32/sysinitgprof.pp

@@ -19,12 +19,6 @@ unit sysinitgprof;
 
   implementation
 
-    {$linklib gmon}
-    {$linklib gcc}
-    {$linklib cygwin}
-    {$linklib user32}
-    {$linklib kernel32}
-
     const
       monstarted : dword = 0;
 
@@ -175,4 +169,11 @@ unit sysinitgprof;
         Cygwin_crt0(@CMainDLL);
       end;
 
+{$warnings off}
+    {$linklib gmon}
+    {$linklib gcc}
+    {$linklib cygwin}
+    {$linklib user32}
+    {$linklib kernel32}
+
 end.

rtl/win32/system.pp

@@ -51,7 +51,7 @@ type
 
 const
 { Default filehandles }
-  UnusedHandle    : THandle = -1;
+  UnusedHandle    : THandle = THandle(-1);
   StdInputHandle  : THandle = 0;
   StdOutputHandle : THandle = 0;
   StdErrorHandle  : THandle = 0;
@@ -446,7 +446,7 @@ function Dll_entry(const info : TEntryInformation) : longbool; [public,alias:'_F
        DLL_THREAD_ATTACH :
          begin
            inclocked(Thread_count);
-{$warning Allocate Threadvars !}
+{ Allocate Threadvars ?!}
            if assigned(Dll_Thread_Attach_Hook) then
              Dll_Thread_Attach_Hook(DllParam);
            Dll_entry:=true; { return value is ignored }
@@ -456,7 +456,7 @@ function Dll_entry(const info : TEntryInformation) : longbool; [public,alias:'_F
            declocked(Thread_count);
            if assigned(Dll_Thread_Detach_Hook) then
              Dll_Thread_Detach_Hook(DllParam);
-{$warning Release Threadvars !}
+{ Release Threadvars ?!}
            Dll_entry:=true; { return value is ignored }
          end;
        DLL_PROCESS_DETACH :
@@ -930,6 +930,7 @@ const
   { MultiByteToWideChar  }
      MB_PRECOMPOSED = 1;
      CP_ACP = 0;
+     WC_NO_BEST_FIT_CHARS = $400;
 
 function MultiByteToWideChar(CodePage:UINT; dwFlags:DWORD; lpMultiByteStr:PChar; cchMultiByte:longint; lpWideCharStr:PWideChar;cchWideChar:longint):longint;
     stdcall; external 'kernel32' name 'MultiByteToWideChar';
@@ -947,10 +948,10 @@ procedure Win32Wide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
   begin
     // retrieve length including trailing #0
     // not anymore, because this must also be usable for single characters
-    destlen:=WideCharToMultiByte(CP_ACP, 0, source, len, nil, 0, nil, nil);
+    destlen:=WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, source, len, nil, 0, nil, nil);
     // this will null-terminate
     setlength(dest, destlen);
-    WideCharToMultiByte(CP_ACP, 0, source, len, @dest[1], destlen, nil, nil);
+    WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, source, len, @dest[1], destlen, nil, nil);
   end;
 
 procedure Win32Ansi2WideMove(source:pchar;var dest:widestring;len:SizeInt);

rtl/win64/system.pp

@@ -952,6 +952,7 @@ const
   { MultiByteToWideChar  }
      MB_PRECOMPOSED = 1;
      CP_ACP = 0;
+     WC_NO_BEST_FIT_CHARS = $400;
 
 function MultiByteToWideChar(CodePage:UINT; dwFlags:DWORD; lpMultiByteStr:PChar; cchMultiByte:longint; lpWideCharStr:PWideChar;cchWideChar:longint):longint;
     stdcall; external 'kernel32' name 'MultiByteToWideChar';
@@ -969,10 +970,10 @@ procedure Win32Wide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
   begin
     // retrieve length including trailing #0
     // not anymore, because this must also be usable for single characters
-    destlen:=WideCharToMultiByte(CP_ACP, 0, source, len, nil, 0, nil, nil);
+    destlen:=WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, source, len, nil, 0, nil, nil);
     // this will null-terminate
     setlength(dest, destlen);
-    WideCharToMultiByte(CP_ACP, 0, source, len, @dest[1], destlen, nil, nil);
+    WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, source, len, @dest[1], destlen, nil, nil);
   end;
 
 procedure Win32Ansi2WideMove(source:pchar;var dest:widestring;len:SizeInt);

rtl/wince/system.pp

@@ -310,6 +310,7 @@ const
      MB_USEGLYPHCHARS = 4;
      CP_ACP = 0;
      CP_OEMCP = 1;
+     WC_NO_BEST_FIT_CHARS = $400;
 
 function MultiByteToWideChar(CodePage:UINT; dwFlags:DWORD; lpMultiByteStr:PChar; cchMultiByte:longint; lpWideCharStr:PWideChar;cchWideChar:longint):longint;
      cdecl; external 'coredll' name 'MultiByteToWideChar';
@@ -336,7 +337,7 @@ end;
 
 function WideToAnsiBuf(WideBuf: PWideChar; WideCharsLen: longint; AnsiBuf: PChar; AnsiBufLen: longint): longint;
 begin
-  Result := WideCharToMultiByte(CP_ACP, 0, WideBuf, WideCharsLen, AnsiBuf, AnsiBufLen, nil, nil);
+  Result := WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, WideBuf, WideCharsLen, AnsiBuf, AnsiBufLen, nil, nil);
   if ((WideCharsLen <> -1) or (Result = 0)) and (AnsiBuf <> nil) then
   begin
     if Result + 1 > AnsiBufLen then
@@ -871,7 +872,7 @@ begin
      DLL_THREAD_ATTACH :
        begin
          inclocked(Thread_count);
-{$note Allocate Threadvars !}
+{ Allocate Threadvars ?!}
          if assigned(Dll_Thread_Attach_Hook) then
            Dll_Thread_Attach_Hook(DllParam);
        end;
@@ -880,7 +881,7 @@ begin
          declocked(Thread_count);
          if assigned(Dll_Thread_Detach_Hook) then
            Dll_Thread_Detach_Hook(DllParam);
-{$note Release Threadvars !}
+{ Release Threadvars ?!}
        end;
      DLL_PROCESS_DETACH :
        begin
@@ -1789,7 +1790,7 @@ begin
 end;
 
 initialization
-  SysResetFPU;    
+  SysResetFPU;
   if not(IsLibrary) then
     SysInitFPU;
   StackLength := CheckInitialStkLen(InitialStkLen);

rtl/wince/winsock.pp

@@ -86,6 +86,7 @@ unit winsock;
 
     const
        winsockdll    = 'ws2.dll';
+       WINSOCK_VERSION = $0101; // hopefully is right for winCE too
 
        {
          Default maximium number of sockets.

tests/test/twide6.pp

@@ -5,6 +5,12 @@ uses
  {$endif}
   sysutils;
 
+procedure doerror(i : integer);
+  begin
+    writeln('Error: ',i);
+    halt(i);
+  end;
+
 
 { normal upper case testing }
 procedure testupper;
@@ -21,6 +27,9 @@ begin
   writeln('original upper: ',w2);
 {$endif print}
   s:=w1;
+{$ifdef print}
+  writeln('ansi: ',s);
+{$endif print}
   w3:=s;
   w4:=AnsiUpperCase(s);
   { filter out unsupported characters }
@@ -33,12 +42,13 @@ begin
   w1:=wideuppercase(w1);
 {$ifdef print}
   writeln('wideupper: ',w1);
+  writeln('original upper: ',w2);
   writeln('ansiupper: ',w4);
 {$endif print}
   if (w1 <> w2) then
-    halt(1);
+    doerror(1);
   if (w4 <> w2) then
-    halt(2);
+    doerror(2);
 
   w1:='aéèàł'#$d87e#$dc04;
   w2:='AÉÈÀŁ'#$d87e#$dc04;
@@ -58,9 +68,9 @@ begin
   writeln('ansistrupper: ',w4);
 {$endif print}
   if (w1 <> w2) then
-    halt(1);
+    doerror(21);
   if (w4 <> w2) then
-    halt(2);
+    doerror(22);
 
 end;
 
@@ -95,9 +105,9 @@ begin
   writeln('ansilower: ',w4);
 {$endif print}
   if (w1 <> w2) then
-    halt(3);
+    doerror(3);
   if (w4 <> w2) then
-    halt(4);
+    doerror(4);
 
 
   w1:='AÉÈÀŁ'#$d87e#$dc04;
@@ -118,9 +128,9 @@ begin
   writeln('ansistrlower: ',w4);
 {$endif print}
   if (w1 <> w2) then
-    halt(3);
+    doerror(3);
   if (w4 <> w2) then
-    halt(4);
+    doerror(4);
 end;
 
 
@@ -156,9 +166,9 @@ begin
   writeln('ansiupper: ',w4);
 {$endif print}
   if (w1 <> w2) then
-    halt(5);
+    doerror(5);
   if (w4 <> w2) then
-    halt(6);
+    doerror(6);
 end;
 
 
@@ -193,9 +203,9 @@ begin
   writeln('ansilower: ',w4);
 {$endif print}
   if (w1 <> w2) then
-    halt(7);
+    doerror(7);
   if (w4 <> w2) then
-    halt(8);
+    doerror(8);
 end;
 
 
@@ -231,9 +241,9 @@ begin
   writeln('ansiupper: ',w4);
 {$endif print}
   if (w1 <> w2) then
-    halt(9);
+    doerror(9);
   if (w4 <> w2) then
-    halt(10);
+    doerror(10);
 end;
 
 
@@ -268,9 +278,9 @@ begin
   writeln('ansilower: ',w4);
 {$endif print}
   if (w1 <> w2) then
-    halt(11);
+    doerror(11);
   if (w4 <> w2) then
-    halt(12);
+    doerror(12);
 end;
 
 
@@ -295,8 +305,8 @@ begin
   { adjust checking values for new length due to corruption }
   if length(w3)<>length(w2) then
     begin
-      setlength(w2,length(w3)); 
-      setlength(w1,length(w3)); 
+      setlength(w2,length(w3));
+      setlength(w1,length(w3));
     end;
   w4:=AnsiUpperCase(s);
   { filter out unsupported characters }
@@ -312,9 +322,9 @@ begin
   writeln('ansiupper: ',w4);
 {$endif print}
   if (w1 <> w2) then
-    halt(13);
+    doerror(13);
   if (w4 <> w2) then
-    halt(14);
+    doerror(14);
 end;
 
 
@@ -339,8 +349,8 @@ begin
   { adjust checking values for new length due to corruption }
   if length(w3)<>length(w2) then
     begin
-      setlength(w2,length(w3)); 
-      setlength(w1,length(w3)); 
+      setlength(w2,length(w3));
+      setlength(w1,length(w3));
     end;
   w4:=AnsiLowerCase(s);
   { filter out unsupported characters }
@@ -356,9 +366,9 @@ begin
   writeln('ansilower: ',w4);
 {$endif print}
   if (w1 <> w2) then
-    halt(15);
+    doerror(15);
   if (w4 <> w2) then
-    halt(16);
+    doerror(16);
 end;