Browse Source

Merge branch 'main' into val_range_check

# Conflicts:
#	rtl/inc/sstrings.inc
florian 3 years ago
parent
commit
07cd469ade
51 changed files with 854 additions and 273 deletions
  1. 2 2
      compiler/msg/errorct.msg
  2. 2 2
      compiler/msg/errord.msg
  3. 1 1
      compiler/msg/errorda.msg
  4. 2 2
      compiler/msg/errordu.msg
  5. 1 1
      compiler/msg/errore.msg
  6. 1 1
      compiler/msg/errores.msg
  7. 1 1
      compiler/msg/errorf.msg
  8. 1 1
      compiler/msg/errorfi.msg
  9. 1 1
      compiler/msg/errorhe.msg
  10. 1 1
      compiler/msg/errorheu.msg
  11. 1 1
      compiler/msg/errorid.msg
  12. 1 1
      compiler/msg/erroriu.msg
  13. 1 1
      compiler/msg/errorn.msg
  14. 1 1
      compiler/msg/errorpl.msg
  15. 1 1
      compiler/msg/errorpli.msg
  16. 1 1
      compiler/msg/errorpt.msg
  17. 1 1
      compiler/msg/errorptu.msg
  18. 1 1
      compiler/msg/errorr.msg
  19. 1 1
      compiler/msg/errorru.msg
  20. 1 1
      compiler/msg/errorues.msg
  21. 1 1
      compiler/msgtxt.inc
  22. 5 13
      compiler/optdfa.pas
  23. 17 19
      compiler/optutils.pas
  24. 4 2
      compiler/pmodules.pas
  25. 4 2
      compiler/systems/t_freertos.pas
  26. 115 89
      compiler/x86/aoptx86.pas
  27. 3 1
      packages/fcl-db/src/base/bufdataset.pas
  28. 58 7
      packages/fcl-db/src/base/db.pas
  29. 21 0
      packages/fcl-db/src/base/dsparams.inc
  30. 237 34
      packages/fcl-db/src/base/fields.inc
  31. 6 1
      packages/fcl-db/src/dbase/dbf_fields.pas
  32. 10 2
      packages/fcl-db/src/memds/memds.pp
  33. 5 3
      packages/fcl-db/tests/bufdatasettoolsunit.pas
  34. 8 0
      packages/fcl-db/tests/memdstoolsunit.pas
  35. 1 1
      packages/fcl-db/tests/sqldbtoolsunit.pas
  36. 56 21
      packages/fcl-db/tests/testdbbasics.pas
  37. 3 0
      packages/fcl-db/tests/toolsunit.pas
  38. 1 1
      packages/fcl-web/examples/websocket/client/wsclient.lpr
  39. 84 0
      packages/paszlib/src/zipper.pp
  40. BIN
      packages/paszlib/tests/test.zip
  41. 57 0
      packages/paszlib/tests/testsingle.lpi
  42. 19 0
      packages/paszlib/tests/testsingle.pas
  43. 31 26
      packages/wasmtime/Makefile
  44. 1 1
      rtl/freertos/Makefile
  45. 1 1
      rtl/freertos/Makefile.fpc
  46. 43 0
      rtl/freertos/xtensa/espidf_40100.pp
  47. 14 17
      rtl/inc/sstrings.inc
  48. 2 0
      rtl/objpas/classes/compon.inc
  49. 1 1
      tests/bench/bval.pp
  50. 2 2
      utils/pas2js/compileserver.lpi
  51. 21 5
      utils/pas2js/httpcompiler.pp

+ 2 - 2
compiler/msg/errorct.msg

@@ -1,6 +1,6 @@
 #
 #
 #   This file is part of the Free Pascal Compiler
 #   This file is part of the Free Pascal Compiler
-#   Copyright (c) 1993-2021 by the Free Pascal Development team
+#   Copyright (c) 1993-2022 by the Free Pascal Development team
 #
 #
 #   Catalan Language File for Free Pascal
 #   Catalan Language File for Free Pascal
 #
 #
@@ -2103,7 +2103,7 @@ option_code_page_not_available=11039_E_La p
 #
 #
 option_logo=11023_[
 option_logo=11023_[
 Free Pascal Compiler versió $FPCFULLVERSION [$FPCDATE] per $FPCCPU
 Free Pascal Compiler versió $FPCFULLVERSION [$FPCDATE] per $FPCCPU
-Copyright (c) 1993-2021 per Florian Klaempfl and others
+Copyright (c) 1993-2022 per Florian Klaempfl and others
 ]
 ]
 
 
 #
 #

+ 2 - 2
compiler/msg/errord.msg

@@ -6,7 +6,7 @@
 #   Based on errore.msg of git commit ce1f9cce, 27 Jun, 2021
 #   Based on errore.msg of git commit ce1f9cce, 27 Jun, 2021
 #
 #
 #   This file is part of the Free Pascal Compiler
 #   This file is part of the Free Pascal Compiler
-#   Copyright (c) 1998-2021 by the Free Pascal Development team
+#   Copyright (c) 1998-2022 by the Free Pascal Development team
 #
 #
 #   See the file COPYING.v2, included in this distribution,
 #   See the file COPYING.v2, included in this distribution,
 #   for details about the copyright.
 #   for details about the copyright.
@@ -3810,7 +3810,7 @@ package_u_ppl_filename=13029_U_PPL Dateiname $1
 #
 #
 option_logo=11023_[
 option_logo=11023_[
 Free Pascal Compiler Version $FPCFULLVERSION [$FPCDATE] f�r $FPCTARGET
 Free Pascal Compiler Version $FPCFULLVERSION [$FPCDATE] f�r $FPCTARGET
-Copyright (c) 1993-2021 Florian Kl„mpfl und andere
+Copyright (c) 1993-2022 Florian Kl„mpfl und andere
 ]
 ]
 
 
 #
 #

+ 1 - 1
compiler/msg/errorda.msg

@@ -3535,7 +3535,7 @@ wpo_cant_create_feedback_file=12019_E_Cannot create specified whole program opti
 #
 #
 option_logo=11023_[
 option_logo=11023_[
 Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] til $FPCTARGET
 Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] til $FPCTARGET
-Copyright (c) 1993-2021 Florian Klaempfl and others
+Copyright (c) 1993-2022 Florian Klaempfl and others
 ]
 ]
 
 
 #
 #

+ 2 - 2
compiler/msg/errordu.msg

@@ -6,7 +6,7 @@
 #   Based on errore.msg of git commit ce1f9cce, 27 Jun, 2021
 #   Based on errore.msg of git commit ce1f9cce, 27 Jun, 2021
 #
 #
 #   This file is part of the Free Pascal Compiler
 #   This file is part of the Free Pascal Compiler
-#   Copyright (c) 1998-2021 by the Free Pascal Development team
+#   Copyright (c) 1998-2022 by the Free Pascal Development team
 #
 #
 #   See the file COPYING.v2, included in this distribution,
 #   See the file COPYING.v2, included in this distribution,
 #   for details about the copyright.
 #   for details about the copyright.
@@ -3809,7 +3809,7 @@ package_u_ppl_filename=13029_U_PPL Dateiname $1
 #
 #
 option_logo=11023_[
 option_logo=11023_[
 Free Pascal Compiler Version $FPCFULLVERSION [$FPCDATE] für $FPCTARGET
 Free Pascal Compiler Version $FPCFULLVERSION [$FPCDATE] für $FPCTARGET
-Copyright (c) 1993-2021 Florian Klämpfl und andere
+Copyright (c) 1993-2022 Florian Klämpfl und andere
 ]
 ]
 
 
 #
 #

+ 1 - 1
compiler/msg/errore.msg

@@ -3784,7 +3784,7 @@ package_u_ppl_filename=13029_U_PPL filename $1
 #
 #
 option_logo=11023_[
 option_logo=11023_[
 Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPCCPU
 Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPCCPU
-Copyright (c) 1993-2021 by Florian Klaempfl and others
+Copyright (c) 1993-2022 by Florian Klaempfl and others
 ]
 ]
 
 
 #
 #

+ 1 - 1
compiler/msg/errores.msg

@@ -3477,7 +3477,7 @@ wpo_cant_create_feedback_file=12019_E_Cannot create specified whole program opti
 #
 #
 option_logo=11023_[
 option_logo=11023_[
 Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPCCPU
 Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPCCPU
-Copyright (c) 1993-2021 by Florian Klaempfl and others
+Copyright (c) 1993-2022 by Florian Klaempfl and others
 ]
 ]
 
 
 #
 #

+ 1 - 1
compiler/msg/errorf.msg

@@ -1715,7 +1715,7 @@ option_asm_forced=11022_W_"$1" assembler use forced
 #
 #
 option_logo=11023_[
 option_logo=11023_[
 Compilateur Free Pascal version $FPCFULLVERSION [$FPCDATE] pour $FPCTARGET
 Compilateur Free Pascal version $FPCFULLVERSION [$FPCDATE] pour $FPCTARGET
-Copyright (c) 1993-2021 by Florian Klaempfl and others
+Copyright (c) 1993-2022 by Florian Klaempfl and others
 ]
 ]
 
 
 #
 #

+ 1 - 1
compiler/msg/errorfi.msg

@@ -3499,7 +3499,7 @@ wpo_cant_create_feedback_file=12019_E_Cannot create specified whole program opti
 # Logo (option -l)
 # Logo (option -l)
 #
 #
 option_logo=11023_[ Compilateur Free Pascal version $FPCFULLVERSION [$FPCDATE] for $FPCCPU
 option_logo=11023_[ Compilateur Free Pascal version $FPCFULLVERSION [$FPCDATE] for $FPCCPU
-Copyright (c) 1993-2021, Florian Klaempfl and others]
+Copyright (c) 1993-2022, Florian Klaempfl and others]
 #
 #
 # Info (option -i)
 # Info (option -i)
 #
 #

+ 1 - 1
compiler/msg/errorhe.msg

@@ -2407,7 +2407,7 @@ option_confict_asm_debug=11041_W_
 #
 #
 option_logo=11023_[
 option_logo=11023_[
 Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPCCPU
 Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPCCPU
-Copyright (c) 1993-2021 by Florian Klaempfl and others
+Copyright (c) 1993-2022 by Florian Klaempfl and others
 ]
 ]
 
 
 #
 #

+ 1 - 1
compiler/msg/errorheu.msg

@@ -3496,7 +3496,7 @@ wpo_cant_create_feedback_file=12019_E_Cannot create specified whole program opti
 #
 #
 option_logo=11023_[
 option_logo=11023_[
 Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPCCPU
 Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPCCPU
-Copyright (c) 1993-2021 by Florian Klaempfl and others
+Copyright (c) 1993-2022 by Florian Klaempfl and others
 ]
 ]
 
 
 #
 #

+ 1 - 1
compiler/msg/errorid.msg

@@ -3504,7 +3504,7 @@ wpo_cant_create_feedback_file=12019_E_Cannot create specified whole program opti
 #
 #
 option_logo=11023_[
 option_logo=11023_[
 Free Pascal Compiler versi $FPCFULLVERSION [$FPCDATE] untuk $FPCCPU
 Free Pascal Compiler versi $FPCFULLVERSION [$FPCDATE] untuk $FPCCPU
-Hak Cipta (c) 1993-2021 oleh Florian Klaempfl and others
+Hak Cipta (c) 1993-2022 oleh Florian Klaempfl and others
 ]
 ]
 
 
 #
 #

+ 1 - 1
compiler/msg/erroriu.msg

@@ -2693,7 +2693,7 @@ wpo_cant_create_feedback_file=12019_E_Impossibile creare il file di feedback "$1
 #
 #
 option_logo=11023_[
 option_logo=11023_[
 Compilatore Free Pascal, versione $FPCFULLVERSION [$FPCDATE] per $FPCCPU
 Compilatore Free Pascal, versione $FPCFULLVERSION [$FPCDATE] per $FPCCPU
-Copyright (c) 1993-2021 di Florian Klaempfl and others
+Copyright (c) 1993-2022 di Florian Klaempfl and others
 ]
 ]
 
 
 #
 #

+ 1 - 1
compiler/msg/errorn.msg

@@ -3485,7 +3485,7 @@ wpo_cant_create_feedback_file=12019_E_Cannot create specified whole program opti
 #
 #
 option_logo=11023_[
 option_logo=11023_[
 Free Pascal Compiler versie $FPCFULLVERSION [$FPCDATE] voor $FPCTARGET
 Free Pascal Compiler versie $FPCFULLVERSION [$FPCDATE] voor $FPCTARGET
-Copyright (c) 1993-2021 door Florian Klaempfl en anderen
+Copyright (c) 1993-2022 door Florian Klaempfl en anderen
 ]
 ]
 #
 #
 # Info (option -i)
 # Info (option -i)

+ 1 - 1
compiler/msg/errorpl.msg

@@ -2119,7 +2119,7 @@ option_code_page_not_available=11039_E_Nieznana strona kodowa
 #
 #
 option_logo=11023_[
 option_logo=11023_[
 Free Pascal Compiler wersja $FPCFULLVERSION [$FPCDATE] dla $FPCCPU
 Free Pascal Compiler wersja $FPCFULLVERSION [$FPCDATE] dla $FPCCPU
-Copyright (c) 1993-2021 by Florian Klaempfl and others
+Copyright (c) 1993-2022 by Florian Klaempfl and others
 ]
 ]
 
 
 #
 #

+ 1 - 1
compiler/msg/errorpli.msg

@@ -2119,7 +2119,7 @@ option_code_page_not_available=11039_E_Nieznana strona kodowa
 #
 #
 option_logo=11023_[
 option_logo=11023_[
 Free Pascal Compiler wersja $FPCFULLVERSION [$FPCDATE] dla $FPCCPU
 Free Pascal Compiler wersja $FPCFULLVERSION [$FPCDATE] dla $FPCCPU
-Copyright (c) 1993-2021 by Florian Klaempfl and others
+Copyright (c) 1993-2022 by Florian Klaempfl and others
 ]
 ]
 
 
 #
 #

+ 1 - 1
compiler/msg/errorpt.msg

@@ -3086,7 +3086,7 @@ wpo_cant_create_feedback_file=12019_E_Imposs
 #
 #
 option_logo=11023_[
 option_logo=11023_[
 Compilador Free Pascal versÆo $FPCFULLVERSION [$FPCDATE] para $FPCCPU
 Compilador Free Pascal versÆo $FPCFULLVERSION [$FPCDATE] para $FPCCPU
-Copyright (c) 1993-2021 by Florian Klaempfl and others
+Copyright (c) 1993-2022 by Florian Klaempfl and others
 ]
 ]
 
 
 #
 #

+ 1 - 1
compiler/msg/errorptu.msg

@@ -3514,7 +3514,7 @@ wpo_cant_create_feedback_file=12019_E_Impossível criar arquivo retorno otimiza
 #
 #
 option_logo=11023_[
 option_logo=11023_[
 Compilador Free Pascal versão $FPCFULLVERSION [$FPCDATE] para $FPCCPU
 Compilador Free Pascal versão $FPCFULLVERSION [$FPCDATE] para $FPCCPU
-Copyright (c) 1993-2021 by Florian Klaempfl and others
+Copyright (c) 1993-2022 by Florian Klaempfl and others
 ]
 ]
 
 
 #
 #

+ 1 - 1
compiler/msg/errorr.msg

@@ -2506,7 +2506,7 @@ wpo_cant_create_feedback_file=12019_E_
 #
 #
 option_logo=11023_[
 option_logo=11023_[
 Š®¬¯¨«ïâ®à Free Pascal ¢¥àᨨ $FPCFULLVERSION [$FPCDATE] ¤«ï $FPCCPU
 Š®¬¯¨«ïâ®à Free Pascal ¢¥àᨨ $FPCFULLVERSION [$FPCDATE] ¤«ï $FPCCPU
-Copyright (c) 1993-2021 by Florian Klaempfl and others
+Copyright (c) 1993-2022 by Florian Klaempfl and others
 ]
 ]
 
 
 #
 #

+ 1 - 1
compiler/msg/errorru.msg

@@ -3387,7 +3387,7 @@ wpo_cant_create_feedback_file=12019_E_Невозможно создать фай
 #
 #
 option_logo=11023_[
 option_logo=11023_[
 Компилятор Free Pascal версии $FPCFULLVERSION [$FPCDATE] для $FPCCPU
 Компилятор Free Pascal версии $FPCFULLVERSION [$FPCDATE] для $FPCCPU
-Copyright (c) 1993-2021 by Florian Klaempfl and others
+Copyright (c) 1993-2022 by Florian Klaempfl and others
 ]
 ]
 
 
 #
 #

+ 1 - 1
compiler/msg/errorues.msg

@@ -3471,7 +3471,7 @@ wpo_cant_create_feedback_file=12019_E_Cannot create specified whole program opti
 #
 #
 option_logo=11023_[
 option_logo=11023_[
 Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPCCPU
 Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPCCPU
-Copyright (c) 1993-2021 by Florian Klaempfl and others
+Copyright (c) 1993-2022 by Florian Klaempfl and others
 ]
 ]
 
 
 #
 #

+ 1 - 1
compiler/msgtxt.inc

@@ -1412,7 +1412,7 @@ const msgtxt : array[0..000371,1..240] of char=(
   '13029_U_PPL filename $1'#000+
   '13029_U_PPL filename $1'#000+
   '11023_Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPC'+
   '11023_Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPC'+
   'CPU'#010+
   'CPU'#010+
-  'Copyright (c) 1993-2021 by Florian Klaempfl and other','s'#000+
+  'Copyright (c) 1993-2022 by Florian Klaempfl and other','s'#000+
   '11024_Free Pascal Compiler version $FPCVERSION'#010+
   '11024_Free Pascal Compiler version $FPCVERSION'#010+
   #010+
   #010+
   'Compiler date      : $FPCDATE'#010+
   'Compiler date      : $FPCDATE'#010+

+ 5 - 13
compiler/optdfa.pas

@@ -185,7 +185,7 @@ unit optdfa;
         { update life entry of a node with l, set changed if this changes
         { update life entry of a node with l, set changed if this changes
           life info for the node
           life info for the node
         }
         }
-        procedure updatelifeinfo(n : tnode;l : TDFASet);
+        procedure updatelifeinfo(n : tnode;const l : TDFASet);
           var
           var
             b : boolean;
             b : boolean;
           begin
           begin
@@ -675,12 +675,6 @@ unit optdfa;
         inherited destroy;
         inherited destroy;
       end;
       end;
 
 
-    var
-      { we have to pass the address of SearchNode in a call inside of SearchNode:
-        @SearchNode does not work because the compiler thinks we take the address of the result
-        so store the address from outside }
-      SearchNodeProcPointer : function(var n: tnode; arg: pointer): foreachnoderesult;
-
     type
     type
       { helper structure to be able to pass more than one variable to the iterator function }
       { helper structure to be able to pass more than one variable to the iterator function }
       TSearchNodeInfo = record
       TSearchNodeInfo = record
@@ -775,8 +769,8 @@ unit optdfa;
             begin
             begin
               { take care of short boolean evaluation: if the expression to be search is found in left,
               { take care of short boolean evaluation: if the expression to be search is found in left,
                 we do not need to search right }
                 we do not need to search right }
-              if foreachnodestatic(pm_postprocess,taddnode(n).left,SearchNodeProcPointer,arg) or
-                foreachnodestatic(pm_postprocess,taddnode(n).right,SearchNodeProcPointer,arg) then
+              if foreachnodestatic(pm_postprocess,taddnode(n).left,@optdfa.SearchNode,arg) or
+                foreachnodestatic(pm_postprocess,taddnode(n).right,@optdfa.SearchNode,arg) then
                 result:=fen_norecurse_true
                 result:=fen_norecurse_true
               else
               else
                 result:=fen_norecurse_false;
                 result:=fen_norecurse_false;
@@ -809,8 +803,8 @@ unit optdfa;
                       { don't warn about the method pointer }
                       { don't warn about the method pointer }
                       AddFilepos(hpt.fileinfo);
                       AddFilepos(hpt.fileinfo);
 
 
-                      if not(foreachnodestatic(pm_postprocess,tcallnode(n).left,SearchNodeProcPointer,arg)) then
-                        foreachnodestatic(pm_postprocess,tcallnode(n).right,SearchNodeProcPointer,arg);
+                      if not(foreachnodestatic(pm_postprocess,tcallnode(n).left,@optdfa.SearchNode,arg)) then
+                        foreachnodestatic(pm_postprocess,tcallnode(n).right,@optdfa.SearchNode,arg);
                       result:=fen_norecurse_true
                       result:=fen_norecurse_true
                     end;
                     end;
                  end;
                  end;
@@ -1005,6 +999,4 @@ unit optdfa;
       end;
       end;
 
 
 
 
-begin
-  SearchNodeProcPointer:=@SearchNode;
 end.
 end.

+ 17 - 19
compiler/optutils.pas

@@ -402,37 +402,34 @@ unit optutils;
         BreakContinueStack.Done;
         BreakContinueStack.Done;
       end;
       end;
 
 
-    var
-      defsum : TDFASet;
 
 
     function adddef(var n: tnode; arg: pointer): foreachnoderesult;
     function adddef(var n: tnode; arg: pointer): foreachnoderesult;
+      var
+        defsum : PDFASet absolute arg;
       begin
       begin
         if assigned(n.optinfo) then
         if assigned(n.optinfo) then
           begin
           begin
-            DFASetIncludeSet(defsum,n.optinfo^.def);
+            DFASetIncludeSet(defsum^,n.optinfo^.def);
             { for nodes itself do not necessarily expose the definition of the counter as
             { for nodes itself do not necessarily expose the definition of the counter as
               the counter might be undefined after the for loop, so include here the counter
               the counter might be undefined after the for loop, so include here the counter
               explicitly }
               explicitly }
             if (n.nodetype=forn) and assigned(tfornode(n).left.optinfo) then
             if (n.nodetype=forn) and assigned(tfornode(n).left.optinfo) then
-              DFASetInclude(defsum,tfornode(n).left.optinfo^.index);
+              DFASetInclude(defsum^,tfornode(n).left.optinfo^.index);
           end;
           end;
         Result:=fen_false;
         Result:=fen_false;
       end;
       end;
 
 
 
 
     procedure CalcDefSum(p : tnode);
     procedure CalcDefSum(p : tnode);
+      var
+        defsum : PDFASet;
       begin
       begin
         p.allocoptinfo;
         p.allocoptinfo;
-        if not assigned(p.optinfo^.defsum) then
-          begin
-            defsum:=nil;
-            foreachnodestatic(pm_postprocess,p,@adddef,nil);
-            p.optinfo^.defsum:=defsum;
-          end;
+        defsum:[email protected]^.defsum;
+        if not assigned(defsum^) then
+            foreachnodestatic(pm_postprocess,p,@adddef,defsum);
       end;
       end;
 
 
-    var
-      usesum : TDFASet;
 
 
     function SetExecutionWeight(var n: tnode; arg: pointer): foreachnoderesult;
     function SetExecutionWeight(var n: tnode; arg: pointer): foreachnoderesult;
       var
       var
@@ -481,22 +478,23 @@ unit optutils;
 
 
 
 
     function adduse(var n: tnode; arg: pointer): foreachnoderesult;
     function adduse(var n: tnode; arg: pointer): foreachnoderesult;
+      var
+        usesum : PDFASet absolute arg;
       begin
       begin
         if assigned(n.optinfo) then
         if assigned(n.optinfo) then
-          DFASetIncludeSet(usesum,n.optinfo^.use);
+          DFASetIncludeSet(usesum^,n.optinfo^.use);
         Result:=fen_false;
         Result:=fen_false;
       end;
       end;
 
 
 
 
     procedure CalcUseSum(p : tnode);
     procedure CalcUseSum(p : tnode);
+      var
+        usesum : PDFASet;
       begin
       begin
         p.allocoptinfo;
         p.allocoptinfo;
-        if not assigned(p.optinfo^.usesum) then
-          begin
-            usesum:=nil;
-            foreachnodestatic(pm_postprocess,p,@adduse,nil);
-            p.optinfo^.usesum:=usesum;
-          end;
+        usesum:[email protected]^.usesum;
+        if not assigned(usesum^) then
+            foreachnodestatic(pm_postprocess,p,@adduse,usesum);
       end;
       end;
 
 
 
 

+ 4 - 2
compiler/pmodules.pas

@@ -417,14 +417,16 @@ implementation
         if not(current_module.is_unit) and (target_info.system=system_xtensa_freertos) then
         if not(current_module.is_unit) and (target_info.system=system_xtensa_freertos) then
           if (current_settings.controllertype=ct_esp32) then
           if (current_settings.controllertype=ct_esp32) then
             begin
             begin
-              if idf_version>=40200 then
+              if (idf_version>=40100) and (idf_version<40200) then
+                AddUnit('espidf_40100')
+              else if idf_version>=40200 then
                 AddUnit('espidf_40200')
                 AddUnit('espidf_40200')
               else
               else
                 Comment(V_Warning, 'Unsupported esp-idf version');
                 Comment(V_Warning, 'Unsupported esp-idf version');
             end
             end
           else if (current_settings.controllertype=ct_esp8266) then
           else if (current_settings.controllertype=ct_esp8266) then
             begin
             begin
-              if idf_version=30300 then
+              if (idf_version>=30300) and (idf_version<30400) then
                 AddUnit('esp8266rtos_30300')
                 AddUnit('esp8266rtos_30300')
               else if idf_version>=30400 then
               else if idf_version>=30400 then
                 AddUnit('esp8266rtos_30400')
                 AddUnit('esp8266rtos_30400')

+ 4 - 2
compiler/systems/t_freertos.pas

@@ -1176,6 +1176,7 @@ begin
   S:=FindUtil(utilsprefix+'objdump');
   S:=FindUtil(utilsprefix+'objdump');
   if (current_settings.controllertype = ct_esp32) then
   if (current_settings.controllertype = ct_esp32) then
     begin
     begin
+      out_ld_filename:=outputexedir+'/esp32_out.ld';
       project_ld_filename:=outputexedir+'/esp32.project.ld';
       project_ld_filename:=outputexedir+'/esp32.project.ld';
       cmdstr:={$ifndef UNIX}'$IDF_PATH/tools/ldgen/ldgen.py '+{$endif UNIX}
       cmdstr:={$ifndef UNIX}'$IDF_PATH/tools/ldgen/ldgen.py '+{$endif UNIX}
               '--config $OUTPUT/sdkconfig '+
               '--config $OUTPUT/sdkconfig '+
@@ -1193,6 +1194,7 @@ begin
     end
     end
   else
   else
     begin
     begin
+      out_ld_filename:=outputexedir+'/esp8266_out.ld';
       project_ld_filename:=outputexedir+'/esp8266.project.ld';
       project_ld_filename:=outputexedir+'/esp8266.project.ld';
       cmdstr:={$ifndef UNIX}'$IDF_PATH/tools/ldgen/ldgen.py '+{$endif UNIX}
       cmdstr:={$ifndef UNIX}'$IDF_PATH/tools/ldgen/ldgen.py '+{$endif UNIX}
               '--config $OUTPUT/sdkconfig '+
               '--config $OUTPUT/sdkconfig '+
@@ -1271,8 +1273,8 @@ begin
        '-T esp32.rom.ld -T esp32.rom.libgcc.ld -T esp32.rom.newlib-data.ld -T esp32.rom.syscalls.ld -T esp32.rom.newlib-funcs.ld '+
        '-T esp32.rom.ld -T esp32.rom.libgcc.ld -T esp32.rom.newlib-data.ld -T esp32.rom.syscalls.ld -T esp32.rom.newlib-funcs.ld '+
        '-T '+esp_out_ld_filename+' -T '+esp_project_ld_filename+' '+
        '-T '+esp_out_ld_filename+' -T '+esp_project_ld_filename+' '+
        '-L $IDF_PATH/components/esp32/ld -T esp32.peripherals.ld';
        '-L $IDF_PATH/components/esp32/ld -T esp32.peripherals.ld';
-      if idf_version>=40200 then
-        Info.ExeCmd[1]:=Info.ExeCmd[1]+' -L $IDF_PATH/components/esp32_rom/esp32/ld -T esp32.rom.api.ld';
+      if idf_version>=40300 then
+        Info.ExeCmd[1]:=Info.ExeCmd[1]+' -T esp32.rom.api.ld';
     end
     end
   else
   else
     begin
     begin

+ 115 - 89
compiler/x86/aoptx86.pas

@@ -2092,7 +2092,38 @@ unit aoptx86;
                         RemoveInstruction(hp2);
                         RemoveInstruction(hp2);
                         result:=true;
                         result:=true;
                       end;
                       end;
-                  end;
+                  end
+                else if (hp1.typ = ait_instruction) and
+                  (((taicpu(p).opcode=A_VMOVAPD) and
+                    (taicpu(hp1).opcode=A_VCOMISD)) or
+                   ((taicpu(p).opcode=A_VMOVAPS) and
+                    ((taicpu(hp1).opcode=A_VCOMISS))
+                   )
+                  ) and not(OpsEqual(taicpu(hp1).oper[1]^,taicpu(hp1).oper[0]^)) then
+                  { change
+                             movapX    reg,reg2
+                             addsX/subsX/... reg3, reg2
+                             movapX    reg2,reg
+                    to
+                             addsX/subsX/... reg3,reg
+                  }
+                  begin
+                    TransferUsedRegs(TmpUsedRegs);
+                    UpdateUsedRegs(TmpUsedRegs, tai(p.next));
+                    If not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp1,TmpUsedRegs)) then
+                      begin
+                        DebugMsg(SPeepholeOptimization + 'MovapXComisX2ComisX2 ('+
+                              debug_op2str(taicpu(p).opcode)+' '+
+                              debug_op2str(taicpu(hp1).opcode)+') done',p);
+                        if OpsEqual(taicpu(p).oper[1]^,taicpu(hp1).oper[0]^) then
+                          taicpu(hp1).loadoper(0, taicpu(p).oper[1]^);
+                        if OpsEqual(taicpu(p).oper[1]^,taicpu(hp1).oper[1]^) then
+                          taicpu(hp1).loadoper(1, taicpu(p).oper[1]^);
+                        RemoveCurrentP(p, nil);
+                        result:=true;
+                        exit;
+                      end;
+                  end
               end;
               end;
           end;
           end;
       end;
       end;
@@ -8228,6 +8259,65 @@ unit aoptx86;
               end;
               end;
           end;
           end;
 
 
+        function AdjustInitialLoad: Boolean;
+          begin
+            Result := False;
+
+            if not p_removed then
+              begin
+                if TargetSize = MinSize then
+                  begin
+                    { Convert the input MOVZX to a MOV }
+                    if (taicpu(p).oper[0]^.typ = top_reg) and
+                      SuperRegistersEqual(taicpu(p).oper[0]^.reg, ThisReg) then
+                      begin
+                        { Or remove it completely! }
+                        DebugMsg(SPeepholeOptimization + 'Movzx2Nop 1', p);
+                        RemoveCurrentP(p);
+                        p_removed := True;
+                      end
+                    else
+                      begin
+                        DebugMsg(SPeepholeOptimization + 'Movzx2Mov 1', p);
+                        taicpu(p).opcode := A_MOV;
+                        taicpu(p).oper[1]^.reg := ThisReg;
+                        taicpu(p).opsize := TargetSize;
+                      end;
+
+                    Result := True;
+                  end
+                else if TargetSize <> MaxSize then
+                  begin
+
+                    case MaxSize of
+                      S_L:
+                        if TargetSize = S_W then
+                          begin
+                            DebugMsg(SPeepholeOptimization + 'movzbl2movzbw', p);
+                            taicpu(p).opsize := S_BW;
+                            taicpu(p).oper[1]^.reg := ThisReg;
+                            Result := True;
+                          end
+                        else
+                          InternalError(2020112341);
+
+                      S_W:
+                        if TargetSize = S_L then
+                          begin
+                            DebugMsg(SPeepholeOptimization + 'movzbw2movzbl', p);
+                            taicpu(p).opsize := S_BL;
+                            taicpu(p).oper[1]^.reg := ThisReg;
+                            Result := True;
+                          end
+                        else
+                          InternalError(2020112342);
+                      else
+                        ;
+                    end;
+                  end;
+              end;
+          end;
+
         procedure AdjustFinalLoad;
         procedure AdjustFinalLoad;
           begin
           begin
             if ((TargetSize = S_L) and (taicpu(hp1).opsize in [S_L, S_BL, S_WL])) or
             if ((TargetSize = S_L) and (taicpu(hp1).opsize in [S_L, S_BL, S_WL])) or
@@ -8453,60 +8543,7 @@ unit aoptx86;
             else
             else
               AdjustFinalLoad;
               AdjustFinalLoad;
 
 
-            if not p_removed then
-              begin
-                if TargetSize = MinSize then
-                  begin
-                    { Convert the input MOVZX to a MOV }
-                    if (taicpu(p).oper[0]^.typ = top_reg) and
-                      SuperRegistersEqual(taicpu(p).oper[0]^.reg, ThisReg) then
-                      begin
-                        { Or remove it completely! }
-                        DebugMsg(SPeepholeOptimization + 'Movzx2Nop 1', p);
-                        DebugMsg(SPeepholeOptimization + tostr(InstrMax), p);
-                        RemoveCurrentP(p);
-                        p_removed := True;
-                      end
-                    else
-                      begin
-                        DebugMsg(SPeepholeOptimization + 'Movzx2Mov 1', p);
-                        taicpu(p).opcode := A_MOV;
-                        taicpu(p).oper[1]^.reg := ThisReg;
-                        taicpu(p).opsize := TargetSize;
-                      end;
-
-                    Result := True;
-                  end
-                else if TargetSize <> MaxSize then
-                  begin
-
-                    case MaxSize of
-                      S_L:
-                        if TargetSize = S_W then
-                          begin
-                            DebugMsg(SPeepholeOptimization + 'movzbl2movzbw', p);
-                            taicpu(p).opsize := S_BW;
-                            taicpu(p).oper[1]^.reg := ThisReg;
-                            Result := True;
-                          end
-                        else
-                          InternalError(2020112341);
-
-                      S_W:
-                        if TargetSize = S_L then
-                          begin
-                            DebugMsg(SPeepholeOptimization + 'movzbw2movzbl', p);
-                            taicpu(p).opsize := S_BL;
-                            taicpu(p).oper[1]^.reg := ThisReg;
-                            Result := True;
-                          end
-                        else
-                          InternalError(2020112342);
-                      else
-                        ;
-                    end;
-                  end;
-              end;
+            Result := AdjustInitialLoad or Result;
 
 
             { Now go through every instruction we found and change the
             { Now go through every instruction we found and change the
               size. If TargetSize = MaxSize, then almost no changes are
               size. If TargetSize = MaxSize, then almost no changes are
@@ -8820,50 +8857,39 @@ unit aoptx86;
                           InternalError(2021051002);
                           InternalError(2021051002);
                       end;
                       end;
 
 
-                      { Update the register to its new size }
-                      setsubreg(ThisReg, TargetSubReg);
+		       if TargetSize <> MaxSize then
+		         begin
+                          { Update the register to its new size }
+                          setsubreg(ThisReg, TargetSubReg);
 
 
-                      taicpu(hp1).oper[1]^.reg := ThisReg;
-                      taicpu(hp1).opsize := MinSize;
+                          DebugMsg(SPeepholeOptimization + 'CMP instruction resized thanks to register size optimisation (see MOV/Z assignment above)', hp1);
+                          taicpu(hp1).oper[1]^.reg := ThisReg;
+                          taicpu(hp1).opsize := TargetSize;
 
 
-                      { Convert the input MOVZX to a MOV }
-                      if (taicpu(p).oper[0]^.typ = top_reg) and
-                        SuperRegistersEqual(taicpu(p).oper[0]^.reg, ThisReg) then
-                        begin
-                          { Or remove it completely! }
-                          DebugMsg(SPeepholeOptimization + 'Movzx2Nop 1a', p);
-                          RemoveCurrentP(p);
-                          p_removed := True;
-                        end
-                      else
-                        begin
-                          DebugMsg(SPeepholeOptimization + 'Movzx2Mov 1a', p);
-                          taicpu(p).opcode := A_MOV;
-                          taicpu(p).oper[1]^.reg := ThisReg;
-                          taicpu(p).opsize := MinSize;
-                        end;
+                          { Convert the input MOVZX to a MOV if necessary }
+                          AdjustInitialLoad;
 
 
-                      if (InstrMax >= 0) then
-                        begin
-                          for Index := 0 to InstrMax do
+                          if (InstrMax >= 0) then
                             begin
                             begin
+                              for Index := 0 to InstrMax do
+                                 begin
 
 
-                              { If p_removed is true, then the original MOV/Z was removed
-                                and removing the AND instruction may not be safe if it
-                                appears first }
-                              if (InstrList[Index].oper[InstrList[Index].ops - 1]^.typ <> top_reg) then
-                                InternalError(2020112311);
+                                  { If p_removed is true, then the original MOV/Z was removed
+                                    and removing the AND instruction may not be safe if it
+                                    appears first }
+                                  if (InstrList[Index].oper[InstrList[Index].ops - 1]^.typ <> top_reg) then
+                                    InternalError(2020112311);
 
 
-                              if InstrList[Index].oper[0]^.typ = top_reg then
-                                InstrList[Index].oper[0]^.reg := ThisReg;
+                                  if InstrList[Index].oper[0]^.typ = top_reg then
+                                    InstrList[Index].oper[0]^.reg := ThisReg;
 
 
-                              InstrList[Index].oper[InstrList[Index].ops - 1]^.reg := ThisReg;
-                              InstrList[Index].opsize := MinSize;
+                                  InstrList[Index].oper[InstrList[Index].ops - 1]^.reg := ThisReg;
+                                  InstrList[Index].opsize := MinSize;
+                                end;
                             end;
                             end;
 
 
+                          Result := True;
                         end;
                         end;
-
-                      Result := True;
                       Exit;
                       Exit;
                     end;
                     end;
                 end;
                 end;

+ 3 - 1
packages/fcl-db/src/base/bufdataset.pas

@@ -1644,6 +1644,7 @@ begin
                  ftCurrency : F1.AsCurrency:=F2.AsCurrency;
                  ftCurrency : F1.AsCurrency:=F2.AsCurrency;
                  ftBCD,
                  ftBCD,
                  ftFmtBCD   : F1.AsBCD:=F2.AsBCD;
                  ftFmtBCD   : F1.AsBCD:=F2.AsBCD;
+                 ftExtended : F1.AsExtended:=F2.AsExtended;
             else
             else
               if (F1.DataType in UseStreams) then
               if (F1.DataType in UseStreams) then
                 begin
                 begin
@@ -2536,7 +2537,8 @@ begin
       ftTypedBinary,
       ftTypedBinary,
       ftOraBlob,
       ftOraBlob,
       ftOraClob,
       ftOraClob,
-      ftWideMemo : result := sizeof(TBufBlobField)
+      ftWideMemo : result := sizeof(TBufBlobField);
+    ftExtended   : Result := sizeof(Extended);
   else
   else
     DatabaseErrorFmt(SUnsupportedFieldType,[Fieldtypenames[FieldDef.DataType]]);
     DatabaseErrorFmt(SUnsupportedFieldType,[Fieldtypenames[FieldDef.DataType]]);
   end;
   end;

+ 58 - 7
packages/fcl-db/src/base/db.pas

@@ -350,14 +350,16 @@ type
     function GetAsBoolean: Boolean; virtual;
     function GetAsBoolean: Boolean; virtual;
     function GetAsBytes: TBytes; virtual;
     function GetAsBytes: TBytes; virtual;
     function GetAsCurrency: Currency; virtual;
     function GetAsCurrency: Currency; virtual;
-    function GetAsLargeInt: Largeint; virtual;
     function GetAsDateTime: TDateTime; virtual;
     function GetAsDateTime: TDateTime; virtual;
+    function GetAsExtended: Extended; virtual;
     function GetAsFloat: Double; virtual;
     function GetAsFloat: Double; virtual;
+    function GetAsLargeInt: Largeint; virtual;
     function GetAsLongint: Longint; virtual;
     function GetAsLongint: Longint; virtual;
     function GetAsLongWord: LongWord; virtual;
     function GetAsLongWord: LongWord; virtual;
     function GetAsInteger: Longint; virtual;
     function GetAsInteger: Longint; virtual;
     function GetAsVariant: variant; virtual;
     function GetAsVariant: variant; virtual;
     function GetOldValue: variant; virtual;
     function GetOldValue: variant; virtual;
+    function GetAsSingle: Single; virtual;
     function GetAsString: string; virtual;
     function GetAsString: string; virtual;
     function GetAsAnsiString: AnsiString; virtual;
     function GetAsAnsiString: AnsiString; virtual;
     function GetAsUnicodeString: UnicodeString; virtual;
     function GetAsUnicodeString: UnicodeString; virtual;
@@ -382,12 +384,14 @@ type
     procedure SetAsBytes(const AValue: TBytes); virtual;
     procedure SetAsBytes(const AValue: TBytes); virtual;
     procedure SetAsCurrency(AValue: Currency); virtual;
     procedure SetAsCurrency(AValue: Currency); virtual;
     procedure SetAsDateTime(AValue: TDateTime); virtual;
     procedure SetAsDateTime(AValue: TDateTime); virtual;
+    procedure SetAsExtended(AValue: Extended); virtual;
     procedure SetAsFloat(AValue: Double); virtual;
     procedure SetAsFloat(AValue: Double); virtual;
+    procedure SetAsLargeInt(AValue: Largeint); virtual;
     procedure SetAsLongint(AValue: Longint); virtual;
     procedure SetAsLongint(AValue: Longint); virtual;
     procedure SetAsLongWord(AValue: LongWord); virtual;
     procedure SetAsLongWord(AValue: LongWord); virtual;
     procedure SetAsInteger(AValue: Longint); virtual;
     procedure SetAsInteger(AValue: Longint); virtual;
-    procedure SetAsLargeInt(AValue: Largeint); virtual;
     procedure SetAsVariant(const AValue: variant); virtual;
     procedure SetAsVariant(const AValue: variant); virtual;
+    procedure SetAsSingle(AValue: Single); virtual;
     procedure SetAsString(const AValue: string); virtual;
     procedure SetAsString(const AValue: string); virtual;
     procedure SetAsAnsiString(const AValue: AnsiString); virtual;
     procedure SetAsAnsiString(const AValue: AnsiString); virtual;
     procedure SetAsUnicodeString(const AValue: UnicodeString); virtual;
     procedure SetAsUnicodeString(const AValue: UnicodeString); virtual;
@@ -422,11 +426,13 @@ type
     property AsBytes: TBytes read GetAsBytes write SetAsBytes;
     property AsBytes: TBytes read GetAsBytes write SetAsBytes;
     property AsCurrency: Currency read GetAsCurrency write SetAsCurrency;
     property AsCurrency: Currency read GetAsCurrency write SetAsCurrency;
     property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
     property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
+    property AsExtended: Extended read GetAsExtended write SetAsExtended;
     property AsFloat: Double read GetAsFloat write SetAsFloat;
     property AsFloat: Double read GetAsFloat write SetAsFloat;
     property AsLongint: Longint read GetAsLongint write SetAsLongint;
     property AsLongint: Longint read GetAsLongint write SetAsLongint;
     property AsLongWord: LongWord read GetAsLongWord write SetAsLongWord;
     property AsLongWord: LongWord read GetAsLongWord write SetAsLongWord;
     property AsLargeInt: LargeInt read GetAsLargeInt write SetAsLargeInt;
     property AsLargeInt: LargeInt read GetAsLargeInt write SetAsLargeInt;
     property AsInteger: Longint read GetAsInteger write SetAsInteger;
     property AsInteger: Longint read GetAsInteger write SetAsInteger;
+    property AsSingle: Single read GetAsSingle write SetAsSingle;
     property AsString: string read GetAsString write SetAsString;
     property AsString: string read GetAsString write SetAsString;
     property AsAnsiString: AnsiString read GetAsAnsiString write SetAsAnsiString;
     property AsAnsiString: AnsiString read GetAsAnsiString write SetAsAnsiString;
     property AsUnicodeString: UnicodeString read GetAsUnicodeString write SetAsUnicodeString;
     property AsUnicodeString: UnicodeString read GetAsUnicodeString write SetAsUnicodeString;
@@ -570,7 +576,7 @@ type
     FEditFormat : String;
     FEditFormat : String;
   protected
   protected
     class procedure CheckTypeSize(AValue: Longint); override;
     class procedure CheckTypeSize(AValue: Longint); override;
-    procedure RangeError(AValue, Min, Max: Double);
+    procedure RangeError(const AValue, Min, Max: Extended);
     procedure SetDisplayFormat(const AValue: string);
     procedure SetDisplayFormat(const AValue: string);
     procedure SetEditFormat(const AValue: string);
     procedure SetEditFormat(const AValue: string);
     function  GetAsBoolean: Boolean; override;
     function  GetAsBoolean: Boolean; override;
@@ -748,8 +754,8 @@ type
     function GetAsLargeInt: LargeInt; override;
     function GetAsLargeInt: LargeInt; override;
     function GetAsLongWord: LongWord; override;
     function GetAsLongWord: LongWord; override;
     function GetAsInteger: Longint; override;
     function GetAsInteger: Longint; override;
-    function GetAsVariant: variant; override;
     function GetAsString: string; override;
     function GetAsString: string; override;
+    function GetAsVariant: variant; override;
     function GetDataSize: Integer; override;
     function GetDataSize: Integer; override;
     procedure GetText(var AText: string; ADisplayText: Boolean); override;
     procedure GetText(var AText: string; ADisplayText: Boolean); override;
     procedure SetAsBCD(const AValue: TBCD); override;
     procedure SetAsBCD(const AValue: TBCD); override;
@@ -761,7 +767,7 @@ type
     procedure SetVarValue(const AValue: Variant); override;
     procedure SetVarValue(const AValue: Variant); override;
   public
   public
     constructor Create(AOwner: TComponent); override;
     constructor Create(AOwner: TComponent); override;
-    Function CheckRange(AValue : Double) : Boolean;
+    function CheckRange(AValue: Double) : Boolean;
     property Value: Double read GetAsFloat write SetAsFloat;
     property Value: Double read GetAsFloat write SetAsFloat;
 
 
   published
   published
@@ -780,6 +786,46 @@ type
     property Currency default True;
     property Currency default True;
   end;
   end;
 
 
+{ TExtendedField }
+
+  TExtendedField = class(TNumericField)
+  private
+    FCurrency: Boolean;
+    FMaxValue: Extended;
+    FMinValue: Extended;
+    FPrecision: Longint;
+    procedure SetCurrency(const AValue: Boolean);
+    procedure SetPrecision(const AValue: Longint);
+  protected
+    function GetAsBCD: TBCD; override;
+    function GetAsExtended: Extended; override;
+    function GetAsFloat: Double; override;
+    function GetAsLargeInt: LargeInt; override;
+    function GetAsLongWord: LongWord; override;
+    function GetAsInteger: Longint; override;
+    function GetAsString: string; override;
+    function GetAsVariant: variant; override;
+    function GetDataSize: Integer; override;
+    procedure GetText(var AText: string; ADisplayText: Boolean); override;
+    procedure SetAsBCD(const AValue: TBCD); override;
+    procedure SetAsExtended(AValue: Extended); override;
+    procedure SetAsFloat(AValue: Double); override;
+    procedure SetAsLargeInt(AValue: LargeInt); override;
+    procedure SetAsLongWord(AValue: LongWord); override;
+    procedure SetAsInteger(AValue: Longint); override;
+    procedure SetAsString(const AValue: string); override;
+    procedure SetVarValue(const AValue: Variant); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    function CheckRange(AValue: Extended) : Boolean;
+    property Value: Extended read GetAsExtended write SetAsExtended;
+  published
+    property Currency: Boolean read FCurrency write SetCurrency default False;
+    property MaxValue: Extended read FMaxValue write FMaxValue;
+    property MinValue: Extended read FMinValue write FMinValue;
+    property Precision: Longint read FPrecision write SetPrecision default 15;
+  end;
+
 { TBooleanField }
 { TBooleanField }
 
 
   TBooleanField = class(TField)
   TBooleanField = class(TField)
@@ -1312,6 +1358,7 @@ type
     Function GetAsLargeInt: LargeInt;
     Function GetAsLargeInt: LargeInt;
     Function GetAsLongWord: LongWord;
     Function GetAsLongWord: LongWord;
     Function GetAsMemo: string;
     Function GetAsMemo: string;
+    Function GetAsSingle: Single;
     Function GetAsString: string;
     Function GetAsString: string;
     Function GetAsAnsiString: AnsiString;
     Function GetAsAnsiString: AnsiString;
     Function GetAsUnicodeString: UnicodeString;
     Function GetAsUnicodeString: UnicodeString;
@@ -1335,6 +1382,8 @@ type
     Procedure SetAsLargeInt(AValue: LargeInt);
     Procedure SetAsLargeInt(AValue: LargeInt);
     Procedure SetAsLongWord(AValue: LongWord);
     Procedure SetAsLongWord(AValue: LongWord);
     Procedure SetAsMemo(const AValue: string);
     Procedure SetAsMemo(const AValue: string);
+    Procedure SetAsShortInt(const AValue: LongInt);
+    Procedure SetAsSingle(AValue: Single);
     Procedure SetAsSmallInt(AValue: LongInt);
     Procedure SetAsSmallInt(AValue: LongInt);
     Procedure SetAsString(const AValue: string);
     Procedure SetAsString(const AValue: string);
     Procedure SetAsAnsiString(const AValue: AnsiString);
     Procedure SetAsAnsiString(const AValue: AnsiString);
@@ -1375,6 +1424,8 @@ type
     Property AsLargeInt : LargeInt read GetAsLargeInt write SetAsLargeInt;
     Property AsLargeInt : LargeInt read GetAsLargeInt write SetAsLargeInt;
     Property AsLongWord: LongWord read GetAsLongWord write SetAsLongWord;
     Property AsLongWord: LongWord read GetAsLongWord write SetAsLongWord;
     Property AsMemo : string read GetAsMemo write SetAsMemo;
     Property AsMemo : string read GetAsMemo write SetAsMemo;
+    Property AsShortInt : LongInt read GetAsInteger write SetAsShortInt;
+    Property AsSingle : Single read GetAsSingle write SetAsSingle;
     Property AsSmallInt : LongInt read GetAsInteger write SetAsSmallInt;
     Property AsSmallInt : LongInt read GetAsInteger write SetAsSmallInt;
     Property AsString : string read GetAsString write SetAsString;
     Property AsString : string read GetAsString write SetAsString;
     Property AsAnsiString : AnsiString read GetAsAnsiString write SetAsAnsiString;
     Property AsAnsiString : AnsiString read GetAsAnsiString write SetAsAnsiString;
@@ -2326,7 +2377,7 @@ Const
 const
 const
   DefaultFieldClasses : Array [TFieldType] of TFieldClass =
   DefaultFieldClasses : Array [TFieldType] of TFieldClass =
     (
     (
-      { ftUnknown} Tfield,
+      { ftUnknown} TField,
       { ftString} TStringField,
       { ftString} TStringField,
       { ftSmallint} TSmallIntField,
       { ftSmallint} TSmallIntField,
       { ftInteger} TLongintField,
       { ftInteger} TLongintField,
@@ -2371,7 +2422,7 @@ const
       { ftLongWord} TLongWordField,
       { ftLongWord} TLongWordField,
       { ftShortint} TShortintField,
       { ftShortint} TShortintField,
       { ftByte} TByteField,
       { ftByte} TByteField,
-      { ftExtended} nil
+      { ftExtended} TExtendedField
     );
     );
 
 
   dsEditModes = [dsEdit, dsInsert, dsSetKey];
   dsEditModes = [dsEdit, dsInsert, dsSetKey];

+ 21 - 0
packages/fcl-db/src/base/dsparams.inc

@@ -642,6 +642,14 @@ begin
     Result:=FValue;
     Result:=FValue;
 end;
 end;
 
 
+Function TParam.GetAsSingle: Single;
+begin
+  If IsNull then
+    Result:=0.0
+  else
+    Result:=FValue;
+end;
+
 Function TParam.GetAsString: string;
 Function TParam.GetAsString: string;
 var P: Pointer;
 var P: Pointer;
 begin
 begin
@@ -808,6 +816,17 @@ begin
   Value:=AValue;
   Value:=AValue;
 end;
 end;
 
 
+Procedure TParam.SetAsShortInt(const AValue: LongInt);
+begin
+  FDataType:=ftShortInt;
+  Value:=AValue;
+end;
+
+Procedure TParam.SetAsSingle(AValue: Single);
+begin
+  FDataType:=ftFloat; // we doesn't have ftSingle ATM
+  Value:=AValue;
+end;
 
 
 Procedure TParam.SetAsSmallInt(AValue: LongInt);
 Procedure TParam.SetAsSmallInt(AValue: LongInt);
 begin
 begin
@@ -974,6 +993,7 @@ begin
   if Assigned(Field) then
   if Assigned(Field) then
     case FDataType of
     case FDataType of
       ftUnknown  : DatabaseErrorFmt(SUnknownParamFieldType,[Name],DataSet);
       ftUnknown  : DatabaseErrorFmt(SUnknownParamFieldType,[Name],DataSet);
+      ftShortInt : Field.AsInteger:=AsShortInt;
       ftByte     : Field.AsInteger:=AsByte;
       ftByte     : Field.AsInteger:=AsByte;
       // Need TField.AsSmallInt
       // Need TField.AsSmallInt
       ftSmallint : Field.AsInteger:=AsSmallInt;
       ftSmallint : Field.AsInteger:=AsSmallInt;
@@ -1016,6 +1036,7 @@ begin
     FDataType:=Field.DataType;
     FDataType:=Field.DataType;
     case Field.DataType of
     case Field.DataType of
       ftUnknown  : DatabaseErrorFmt(SUnknownParamFieldType,[Name],DataSet);
       ftUnknown  : DatabaseErrorFmt(SUnknownParamFieldType,[Name],DataSet);
+      ftShortInt : AsShortInt:=Field.AsInteger;
       ftByte     : AsByte:=Field.AsInteger;
       ftByte     : AsByte:=Field.AsInteger;
       // Need TField.AsSmallInt
       // Need TField.AsSmallInt
       ftSmallint : AsSmallint:=Field.AsInteger;
       ftSmallint : AsSmallint:=Field.AsInteger;

+ 237 - 34
packages/fcl-db/src/base/fields.inc

@@ -549,7 +549,12 @@ end;
 function TField.GetAsDateTime: TDateTime;
 function TField.GetAsDateTime: TDateTime;
 
 
 begin
 begin
-  raise AccessError(SdateTime);
+  raise AccessError(SDateTime);
+end;
+
+function TField.GetAsExtended: Extended;
+begin
+  Result := GetAsFloat;
 end;
 end;
 
 
 function TField.GetAsFloat: Double;
 function TField.GetAsFloat: Double;
@@ -558,6 +563,11 @@ begin
   raise AccessError(SDateTime);
   raise AccessError(SDateTime);
 end;
 end;
 
 
+function TField.GetAsSingle: Single;
+begin
+  Result := GetAsFloat;
+end;
+
 function TField.GetAsLargeInt: Largeint;
 function TField.GetAsLargeInt: Largeint;
 begin
 begin
   Raise AccessError(SLargeInt);
   Raise AccessError(SLargeInt);
@@ -586,7 +596,6 @@ begin
   raise AccessError(SVariant);
   raise AccessError(SVariant);
 end;
 end;
 
 
-
 function TField.GetAsString: string;
 function TField.GetAsString: string;
 begin
 begin
   Result := GetClassDesc
   Result := GetClassDesc
@@ -907,6 +916,16 @@ begin
   Raise AccessError(SDateTime);
   Raise AccessError(SDateTime);
 end;
 end;
 
 
+procedure TField.SetAsSingle(AValue: Single);
+begin
+  SetAsFloat(AValue);
+end;
+
+procedure TField.SetAsExtended(AValue: Extended);
+begin
+  SetAsFloat(AValue);
+end;
+
 procedure TField.SetAsFloat(AValue: Double);
 procedure TField.SetAsFloat(AValue: Double);
 
 
 begin
 begin
@@ -1579,10 +1598,10 @@ begin
     DatabaseErrorFmt(SInvalidFieldSize,[AValue]);
     DatabaseErrorFmt(SInvalidFieldSize,[AValue]);
 end;
 end;
 
 
-procedure TNumericField.RangeError(AValue, Min, Max: Double);
+procedure TNumericField.RangeError(const AValue, Min, Max: Extended);
 
 
 begin
 begin
-  DatabaseErrorFmt(SFieldError+SRangeError2,[DisplayName,AValue,Min,Max]);
+  DatabaseErrorFmt(SFieldError+SRangeError2, [DisplayName,AValue,Min,Max]);
 end;
 end;
 
 
 procedure TNumericField.SetDisplayFormat(const AValue: string);
 procedure TNumericField.SetDisplayFormat(const AValue: string);
@@ -2216,17 +2235,6 @@ begin
     Result:=0.0;
     Result:=0.0;
 end;
 end;
 
 
-function TFloatField.GetAsVariant: Variant;
-
-var f : Double;
-
-begin
-  If GetData(@f) then
-    Result := f
-  else
-    Result:=Null;
-end;
-
 function TFloatField.GetAsLargeInt: LargeInt;
 function TFloatField.GetAsLargeInt: LargeInt;
 begin
 begin
   Result:=Round(GetAsFloat);
   Result:=Round(GetAsFloat);
@@ -2254,6 +2262,17 @@ begin
     Result:='';
     Result:='';
 end;
 end;
 
 
+function TFloatField.GetAsVariant: Variant;
+
+var f : Double;
+
+begin
+  If GetData(@f) then
+    Result := f
+  else
+    Result:=Null;
+end;
+
 function TFloatField.GetDataSize: Integer;
 function TFloatField.GetDataSize: Integer;
 
 
 begin
 begin
@@ -2263,15 +2282,15 @@ end;
 procedure TFloatField.GetText(var AText: string; ADisplayText: Boolean);
 procedure TFloatField.GetText(var AText: string; ADisplayText: Boolean);
 
 
 Var
 Var
-    fmt : string;
-    E : Double;
-    Digits : integer;
-    ff: TFloatFormat;
+  Fmt : string;
+  f : Double;
+  Digits : integer;
+  ff: TFloatFormat;
 
 
 begin
 begin
   AText:='';
   AText:='';
-  If Not GetData(@E) then exit;
-  If ADisplayText or (Length(FEditFormat) = 0) Then
+  if not GetData(@f) then exit;
+  if ADisplayText or (Length(FEditFormat) = 0) Then
     Fmt:=FDisplayFormat
     Fmt:=FDisplayFormat
   else
   else
     Fmt:=FEditFormat;
     Fmt:=FEditFormat;
@@ -2281,18 +2300,17 @@ begin
     ff := ffGeneral
     ff := ffGeneral
   else
   else
     begin
     begin
-    Digits := CurrencyDecimals;
+    Digits := DefaultFormatSettings.CurrencyDecimals;
     if ADisplayText then
     if ADisplayText then
       ff := ffCurrency
       ff := ffCurrency
     else
     else
       ff := ffFixed;
       ff := ffFixed;
     end;
     end;
 
 
-
-  If fmt<>'' then
-    AText:=FormatFloat(fmt,E)
+  if Fmt<>'' then
+    AText:=FormatFloat(Fmt, f)
   else
   else
-    AText:=FloatToStrF(E,ff,FPrecision,Digits);
+    AText:=FloatToStrF(f, ff, FPrecision, Digits);
 end;
 end;
 
 
 procedure TFloatField.SetAsBCD(const AValue: TBCD);
 procedure TFloatField.SetAsBCD(const AValue: TBCD);
@@ -2351,13 +2369,13 @@ begin
   Inherited Create(AOwner);
   Inherited Create(AOwner);
   SetDataType(ftFloat);
   SetDataType(ftFloat);
   FPrecision:=15;
   FPrecision:=15;
-  FValidChars := [DecimalSeparator, '+', '-', '0'..'9', 'E', 'e'];
+  FValidChars := [DefaultFormatSettings.DecimalSeparator, '+', '-', '0'..'9', 'E', 'e'];
 end;
 end;
 
 
-Function TFloatField.CheckRange(AValue : Double) : Boolean;
+function TFloatField.CheckRange(AValue : Double) : Boolean;
 
 
 begin
 begin
-  If (FMinValue<>0) or (FMaxValue<>0) then
+  if (FMinValue<>0) or (FMaxValue<>0) then
     Result:=(AValue>=FMinValue) and (AValue<=FMaxValue)
     Result:=(AValue>=FMinValue) and (AValue<=FMaxValue)
   else
   else
     Result:=True;
     Result:=True;
@@ -2373,6 +2391,182 @@ begin
   Currency := True;
   Currency := True;
 end;
 end;
 
 
+{ TExtendedField }
+
+constructor TExtendedField.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  SetDataType(ftExtended);
+  FPrecision:=15;
+  FValidChars := [DefaultFormatSettings.DecimalSeparator, '+', '-', '0'..'9', 'E', 'e'];
+end;
+
+procedure TExtendedField.SetCurrency(const AValue: Boolean);
+begin
+  if FCurrency=AValue then Exit;
+  FCurrency:=AValue;
+end;
+
+procedure TExtendedField.SetPrecision(const AValue: Longint);
+begin
+  if (AValue = -1) or (AValue > 1) then
+    FPrecision := AValue
+  else
+    FPrecision := 2;
+end;
+
+function TExtendedField.GetAsBCD: TBCD;
+var e: Extended;
+begin
+  if GetData(@e) then
+    Result := DoubleToBCD(e)
+  else
+    Result := NullBCD;
+end;
+
+function TExtendedField.GetAsExtended: Extended;
+var e: Extended;
+begin
+  if GetData(@e) then
+    Result := e
+  else
+    Result := 0.0;
+end;
+
+function TExtendedField.GetAsFloat: Double;
+begin
+  Result := GetAsExtended;
+end;
+
+function TExtendedField.GetAsLargeInt: LargeInt;
+begin
+  Result := Round(GetAsExtended);
+end;
+
+function TExtendedField.GetAsLongWord: LongWord;
+begin
+  Result := Round(GetAsExtended);
+end;
+
+function TExtendedField.GetAsInteger: Longint;
+begin
+  Result := Round(GetAsExtended);
+end;
+
+function TExtendedField.GetAsString: string;
+var e: Extended;
+begin
+  if GetData(@e) then
+    Result := FloatToStr(e)
+  else
+    Result := '';
+end;
+
+function TExtendedField.GetAsVariant: Variant;
+var e: Extended;
+begin
+  if GetData(@e) then
+    Result := e
+  else
+    Result := Null;
+end;
+
+function TExtendedField.GetDataSize: Integer;
+begin
+  Result:=SizeOf(Extended);
+end;
+
+procedure TExtendedField.GetText(var AText: string; ADisplayText: Boolean);
+var
+  Fmt: string;
+  e: Extended;
+  Digits: integer;
+  ff: TFloatFormat;
+begin
+  AText:='';
+  if not GetData(@e) then Exit;
+  if ADisplayText or (FEditFormat = '') then
+    Fmt := FDisplayFormat
+  else
+    Fmt := FEditFormat;
+
+  Digits := 0;
+  if not FCurrency then
+    ff := ffGeneral
+  else
+    begin
+    Digits := DefaultFormatSettings.CurrencyDecimals;
+    if ADisplayText then
+      ff := ffCurrency
+    else
+      ff := ffFixed;
+    end;
+
+  if Fmt<>'' then
+    AText := FormatFloat(Fmt, e)
+  else
+    AText := FloatToStrF(e, ff, FPrecision, Digits);
+end;
+
+procedure TExtendedField.SetAsBCD(const AValue: TBCD);
+begin
+  SetAsExtended(BCDToDouble(AValue));
+end;
+
+procedure TExtendedField.SetAsExtended(AValue: Extended);
+begin
+  if CheckRange(AValue) then
+    SetData(@AValue)
+  else
+    RangeError(AValue,FMinValue,FMaxValue);
+end;
+
+procedure TExtendedField.SetAsFloat(AValue: Double);
+begin
+  SetAsExtended(AValue);
+end;
+
+procedure TExtendedField.SetAsLargeInt(AValue: LargeInt);
+begin
+  SetAsExtended(AValue);
+end;
+
+procedure TExtendedField.SetAsLongWord(AValue: LongWord);
+begin
+  SetAsExtended(AValue);
+end;
+
+procedure TExtendedField.SetAsInteger(AValue: Longint);
+begin
+  SetAsExtended(AValue);
+end;
+
+procedure TExtendedField.SetAsString(const AValue: string);
+var e: Extended;
+begin
+  if AValue='' then
+    Clear
+  else
+    begin
+    if not TryStrToFloat(AValue, e) then
+      DatabaseErrorFmt(SNotAFloat, [AValue]);
+    SetAsExtended(e);
+    end;
+end;
+
+procedure TExtendedField.SetVarValue(const AValue: Variant);
+begin
+  SetAsExtended(AValue);
+end;
+
+function TExtendedField.CheckRange(AValue: Extended) : Boolean;
+begin
+  if (FMinValue<>0) or (FMaxValue<>0) then
+    Result := (AValue>=FMinValue) and (AValue<=FMaxValue)
+  else
+    Result := True;
+end;
+
 { TBooleanField }
 { TBooleanField }
 
 
 function TBooleanField.GetAsBoolean: Boolean;
 function TBooleanField.GetAsBoolean: Boolean;
@@ -2448,7 +2642,14 @@ var Temp : string;
 begin
 begin
   Temp:=UpperCase(AValue);
   Temp:=UpperCase(AValue);
   if Temp='' then
   if Temp='' then
-    Clear
+    begin
+    if FDisplays[True,True]='' then
+      SetAsBoolean(True)
+    else if FDisplays[True,False]='' then
+      SetAsBoolean(False)
+    else
+      Clear
+    end
   else if pos(Temp, FDisplays[True,True])=1 then
   else if pos(Temp, FDisplays[True,True])=1 then
     SetAsBoolean(True)
     SetAsBoolean(True)
   else if pos(Temp, FDisplays[True,False])=1 then
   else if pos(Temp, FDisplays[True,False])=1 then
@@ -2475,11 +2676,13 @@ Procedure TBooleanField.SetDisplayValues(const AValue : String);
 var I : longint;
 var I : longint;
 
 
 begin
 begin
+  if aValue='' then
+    DatabaseErrorFmt(SFieldError+SInvalidDisplayValues,[DisplayName,AValue]);
   If FDisplayValues<>AValue then
   If FDisplayValues<>AValue then
     begin
     begin
     I:=Pos(';',AValue);
     I:=Pos(';',AValue);
-    If (I<2) or (I=Length(AValue)) then
-      DatabaseErrorFmt(SFieldError+SInvalidDisplayValues,[DisplayName,AValue]);
+    If I=0 then
+      I:=Length(aValue)+1;
     FdisplayValues:=AValue;
     FdisplayValues:=AValue;
     // Store display values and their uppercase equivalents;
     // Store display values and their uppercase equivalents;
     FDisplays[False,True]:=Copy(AValue,1,I-1);
     FDisplays[False,True]:=Copy(AValue,1,I-1);
@@ -2976,7 +3179,7 @@ begin
   Inherited Create(AOwner);
   Inherited Create(AOwner);
   FMaxValue := 0;
   FMaxValue := 0;
   FMinValue := 0;
   FMinValue := 0;
-  FValidChars := [DecimalSeparator, '+', '-', '0'..'9'];
+  FValidChars := [DefaultFormatSettings.DecimalSeparator, '+', '-', '0'..'9'];
   SetDataType(ftBCD);
   SetDataType(ftBCD);
   Precision := 18;
   Precision := 18;
   Size := 4;
   Size := 4;
@@ -2996,7 +3199,7 @@ begin
   Inherited Create(AOwner);
   Inherited Create(AOwner);
   FMaxValue := 0;
   FMaxValue := 0;
   FMinValue := 0;
   FMinValue := 0;
-  FValidChars := [DecimalSeparator, '+', '-', '0'..'9'];
+  FValidChars := [DefaultFormatSettings.DecimalSeparator, '+', '-', '0'..'9'];
   SetDataType(ftFMTBCD);
   SetDataType(ftFMTBCD);
 // Max.precision for NUMERIC,DECIMAL datatypes supported by some databases:
 // Max.precision for NUMERIC,DECIMAL datatypes supported by some databases:
 //  Firebird-18; Oracle,SqlServer-38; MySQL-65; PostgreSQL-1000
 //  Firebird-18; Oracle,SqlServer-38; MySQL-65; PostgreSQL-1000

+ 6 - 1
packages/fcl-db/src/dbase/dbf_fields.pas

@@ -477,7 +477,7 @@ begin
       , ftLargeInt
       , ftLargeInt
 {$endif}
 {$endif}
 {$ifdef SUPPORT_LONGWORD}
 {$ifdef SUPPORT_LONGWORD}
-      , ftLongWord, ftShortInt, ftByte
+      , ftLongWord, ftShortInt, ftByte, ftExtended
 {$endif}
 {$endif}
                :
                :
       FNativeFieldType := 'N'; //numerical
       FNativeFieldType := 'N'; //numerical
@@ -576,6 +576,11 @@ begin
         FSize := 3;
         FSize := 3;
         FPrecision := 0;
         FPrecision := 0;
       end;
       end;
+    ftExtended:
+      begin
+        FSize := 19;
+        FPrecision := 8;
+      end;
 {$endif}
 {$endif}
     ftString {$ifdef SUPPORT_FIELDTYPES_V4}, ftFixedChar, ftWideString{$endif}:
     ftString {$ifdef SUPPORT_FIELDTYPES_V4}, ftFixedChar, ftWideString{$endif}:
       begin
       begin

+ 10 - 2
packages/fcl-db/src/memds/memds.pp

@@ -486,6 +486,10 @@ begin
   ftVarBytes: result := FD.Size + SizeOf(Word);
   ftVarBytes: result := FD.Size + SizeOf(Word);
   ftBlob, ftMemo, ftWideMemo:
   ftBlob, ftMemo, ftWideMemo:
               result := SizeOf(TMDSBlobField);
               result := SizeOf(TMDSBlobField);
+  ftLongWord: Result := SizeOf(LongWord);
+  ftShortInt: Result := SizeOf(ShortInt);
+  ftByte:     Result := SizeOf(Byte);
+  ftExtended: Result := SizeOf(Extended);
  else
  else
   RaiseError(SErrFieldTypeNotSupported,[FD.Name]);
   RaiseError(SErrFieldTypeNotSupported,[FD.Name]);
  end;
  end;
@@ -1171,11 +1175,15 @@ begin
                   ftBoolean  : F1.AsBoolean:=F2.AsBoolean;
                   ftBoolean  : F1.AsBoolean:=F2.AsBoolean;
                   ftFloat    : F1.AsFloat:=F2.AsFloat;
                   ftFloat    : F1.AsFloat:=F2.AsFloat;
                   ftLargeInt : F1.AsLargeInt:=F2.AsLargeInt;
                   ftLargeInt : F1.AsLargeInt:=F2.AsLargeInt;
-                  ftSmallInt : F1.AsInteger:=F2.AsInteger;
-                  ftInteger  : F1.AsInteger:=F2.AsInteger;
+                  ftSmallInt,
+                  ftInteger,
+                  ftShortInt,
+                  ftByte     : F1.AsInteger:=F2.AsInteger;
                   ftDate     : F1.AsDateTime:=F2.AsDateTime;
                   ftDate     : F1.AsDateTime:=F2.AsDateTime;
                   ftTime     : F1.AsDateTime:=F2.AsDateTime;
                   ftTime     : F1.AsDateTime:=F2.AsDateTime;
                   ftDateTime : F1.AsDateTime:=F2.AsDateTime;
                   ftDateTime : F1.AsDateTime:=F2.AsDateTime;
+                  ftLongWord : F1.AsLongWord:=F2.AsLongWord;
+                  ftExtended : F1.AsExtended:=F2.AsExtended;
                   else         F1.AsString:=F2.AsString;
                   else         F1.AsString:=F2.AsString;
                 end;
                 end;
               end;
               end;

+ 5 - 3
packages/fcl-db/tests/bufdatasettoolsunit.pas

@@ -90,9 +90,9 @@ begin
 end;
 end;
 
 
 function TbufdatasetDBConnector.InternalGetNDataset(n: integer): TDataset;
 function TbufdatasetDBConnector.InternalGetNDataset(n: integer): TDataset;
-var BufDataset  : TPersistentBufDataSet;
-    i      : integer;
-
+var
+  BufDataset : TPersistentBufDataSet;
+  i : integer;
 begin
 begin
   BufDataset := TPersistentBufDataSet.Create(nil);
   BufDataset := TPersistentBufDataSet.Create(nil);
   with BufDataset do
   with BufDataset do
@@ -158,6 +158,7 @@ begin
     FieldDefs.Add('FLONGWORD',ftLongWord);
     FieldDefs.Add('FLONGWORD',ftLongWord);
     FieldDefs.Add('FSHORTINT',ftShortInt);
     FieldDefs.Add('FSHORTINT',ftShortInt);
     FieldDefs.Add('FBYTE',ftByte);
     FieldDefs.Add('FBYTE',ftByte);
+    FieldDefs.Add('FEXTENDED',ftExtended);
     CreateDataset;
     CreateDataset;
     Open;
     Open;
     for i := 0 to testValuesCount-1 do
     for i := 0 to testValuesCount-1 do
@@ -189,6 +190,7 @@ begin
       FieldByName('FLONGWORD').AsLongWord := testLongWordValues[i];
       FieldByName('FLONGWORD').AsLongWord := testLongWordValues[i];
       FieldByName('FSHORTINT').AsInteger := testShortIntValues[i];
       FieldByName('FSHORTINT').AsInteger := testShortIntValues[i];
       FieldByName('FBYTE').AsInteger := testByteValues[i];
       FieldByName('FBYTE').AsInteger := testByteValues[i];
+      FieldByName('FEXTENDED').AsExtended := testFloatValues[i];
       Post;
       Post;
     end;
     end;
     MergeChangeLog;
     MergeChangeLog;

+ 8 - 0
packages/fcl-db/tests/memdstoolsunit.pas

@@ -105,6 +105,10 @@ begin
     FieldDefs.Add('FWIDESTRING',ftWideString);
     FieldDefs.Add('FWIDESTRING',ftWideString);
     FieldDefs.Add('FFIXEDWIDECHAR',ftFixedWideChar);
     FieldDefs.Add('FFIXEDWIDECHAR',ftFixedWideChar);
     FieldDefs.Add('FWIDEMEMO',ftWideMemo);
     FieldDefs.Add('FWIDEMEMO',ftWideMemo);
+    FieldDefs.Add('FLONGWORD',ftLongWord);
+    FieldDefs.Add('FSHORTINT',ftShortInt);
+    FieldDefs.Add('FBYTE',ftByte);
+    FieldDefs.Add('FEXTENDED',ftExtended);
     CreateTable;
     CreateTable;
     Open;
     Open;
     for i := 0 to testValuesCount-1 do
     for i := 0 to testValuesCount-1 do
@@ -130,6 +134,10 @@ begin
       FieldByName('FWIDESTRING').AsWideString := testValues[ftWideString, i];
       FieldByName('FWIDESTRING').AsWideString := testValues[ftWideString, i];
       FieldByName('FFIXEDWIDECHAR').AsWideString := testValues[ftFixedWideChar, i];
       FieldByName('FFIXEDWIDECHAR').AsWideString := testValues[ftFixedWideChar, i];
       FieldByName('FWIDEMEMO').AsWideString := testValues[ftWideMemo, i];
       FieldByName('FWIDEMEMO').AsWideString := testValues[ftWideMemo, i];
+      FieldByName('FLONGWORD').AsLongWord := testLongWordValues[i];
+      FieldByName('FSHORTINT').AsInteger := testShortIntValues[i];
+      FieldByName('FBYTE').AsInteger := testByteValues[i];
+      FieldByName('FEXTENDED').AsExtended := testFloatValues[i];
       Post;
       Post;
       end;
       end;
     Close;
     Close;

+ 1 - 1
packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -150,7 +150,7 @@ const
 
 
   // fall back mapping (e.g. in case GetConnectionInfo(citServerType) is not implemented)
   // fall back mapping (e.g. in case GetConnectionInfo(citServerType) is not implemented)
   SQLConnTypeToServerTypeMap : array[TSQLConnType] of TSQLServerType =
   SQLConnTypeToServerTypeMap : array[TSQLConnType] of TSQLServerType =
-    (ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssMysql,ssPostgreSQL,ssFirebird,ssUnknown,ssOracle,ssSQLite,ssMSSQL,ssSybase);
+    (ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssPostgreSQL,ssFirebird,ssUnknown,ssOracle,ssSQLite,ssMSSQL,ssSybase);
 
 
 
 
 function IdentifierCase(const s: string): string;
 function IdentifierCase(const s: string): string;

+ 56 - 21
packages/fcl-db/tests/testdbbasics.pas

@@ -20,6 +20,7 @@ type
 
 
   TTestDBBasics = class(TDBBasicsTestCase)
   TTestDBBasics = class(TDBBasicsTestCase)
   private
   private
+    procedure TestFieldDefinition(AFieldType: TFieldType; ADataSize: integer); overload;
     procedure TestFieldDefinition(AFieldType : TFieldType; ADataSize : integer; out ADS : TDataset; out AFld : TField); overload;
     procedure TestFieldDefinition(AFieldType : TFieldType; ADataSize : integer; out ADS : TDataset; out AFld : TField); overload;
     procedure TestFieldDefinition(AFld: TField; AFieldType : TFieldType; ADataSize : integer); overload;
     procedure TestFieldDefinition(AFld: TField; AFieldType : TFieldType; ADataSize : integer); overload;
     procedure TestCalculatedField_OnCalcfields(DataSet: TDataSet);
     procedure TestCalculatedField_OnCalcfields(DataSet: TDataSet);
@@ -35,6 +36,7 @@ type
     procedure TestSupportWordFields;
     procedure TestSupportWordFields;
     procedure TestSupportStringFields;
     procedure TestSupportStringFields;
     procedure TestSupportBooleanFields;
     procedure TestSupportBooleanFields;
+    procedure TestSupportBooleanFieldDisplayValue;
     procedure TestSupportFloatFields;
     procedure TestSupportFloatFields;
     procedure TestSupportLargeIntFields;
     procedure TestSupportLargeIntFields;
     procedure TestSupportDateFields;
     procedure TestSupportDateFields;
@@ -46,6 +48,9 @@ type
     procedure TestSupportFixedStringFields;
     procedure TestSupportFixedStringFields;
     procedure TestSupportBlobFields;
     procedure TestSupportBlobFields;
     procedure TestSupportMemoFields;
     procedure TestSupportMemoFields;
+    procedure TestSupportByteFields;
+    procedure TestSupportShortIntFields;
+    procedure TestSupportExtendedFields;
 
 
     procedure TestBlobBlobType; //bug 26064
     procedure TestBlobBlobType; //bug 26064
 
 
@@ -2587,6 +2592,22 @@ begin
     end;
     end;
 end;
 end;
 
 
+procedure TTestDBBasics.TestFieldDefinition(AFieldType: TFieldType; ADataSize: integer);
+var
+  ADataSet: TDataset;
+  AField: TField;
+  i: integer;
+begin
+  TestFieldDefinition(AFieldType, ADataSize, ADataSet, AField);
+
+  for i := 0 to testValuesCount-1 do
+    begin
+    CheckEquals(testValues[AFieldType,i], AField.AsString);
+    ADataSet.Next;
+    end;
+  ADataSet.Close;
+end;
+
 procedure TTestDBBasics.TestFieldDefinition(AFieldType: TFieldType; ADataSize: integer; out ADS: TDataset; out AFld: TField);
 procedure TTestDBBasics.TestFieldDefinition(AFieldType: TFieldType; ADataSize: integer; out ADS: TDataset; out AFld: TField);
 begin
 begin
   ADS := DBConnector.GetFieldDataset;
   ADS := DBConnector.GetFieldDataset;
@@ -2716,6 +2737,26 @@ begin
   ds.Close;
   ds.Close;
 end;
 end;
 
 
+procedure TTestDBBasics.TestSupportBooleanFieldDisplayValue;
+var i          : byte;
+    ds         : TDataset;
+    Fld        : TField;
+    BoolFld : TBooleanField absolute Fld;
+begin
+  TestFieldDefinition(ftBoolean,2,ds,Fld);
+  CheckEquals(TBooleanField,Fld.ClassType,'Correct class');
+  BoolFld.DisplayValues:='+';
+  ds.Edit;
+  Fld.AsBoolean:=True;
+  CheckEquals('+',Fld.DisplayText,'Correct true');
+  Fld.AsBoolean:=False;
+  CheckEquals('',Fld.DisplayText,'Correct false');
+  Fld.AsString:='+';
+  CheckEquals(true,Fld.AsBoolean,'Correct true');
+  Fld.AsString:='';
+  CheckEquals(False,Fld.AsBoolean,'Correct False');
+end;
+
 procedure TTestDBBasics.TestSupportFloatFields;
 procedure TTestDBBasics.TestSupportFloatFields;
 
 
 var i          : byte;
 var i          : byte;
@@ -2890,34 +2931,28 @@ begin
 end;
 end;
 
 
 procedure TTestDBBasics.TestSupportBlobFields;
 procedure TTestDBBasics.TestSupportBlobFields;
+begin
+  TestFieldDefinition(ftBlob,0);
+end;
 
 
-var i          : byte;
-    ds         : TDataset;
-    Fld        : TField;
+procedure TTestDBBasics.TestSupportMemoFields;
 begin
 begin
-  TestFieldDefinition(ftBlob,0,ds,Fld);
+  TestFieldDefinition(ftMemo,0);
+end;
 
 
-  for i := 0 to testValuesCount-1 do
-    begin
-    CheckEquals(testValues[ftBlob,i],Fld.AsString);
-    ds.Next;
-    end;
-  ds.Close;
+procedure TTestDBBasics.TestSupportByteFields;
+begin
+  TestFieldDefinition(ftByte, SizeOf(Byte));
 end;
 end;
 
 
-procedure TTestDBBasics.TestSupportMemoFields;
-var i          : byte;
-    ds         : TDataset;
-    Fld        : TField;
+procedure TTestDBBasics.TestSupportShortIntFields;
 begin
 begin
-  TestFieldDefinition(ftMemo,0,ds,Fld);
+  TestFieldDefinition(ftShortInt, SizeOf(ShortInt));
+end;
 
 
-  for i := 0 to testValuesCount-1 do
-    begin
-    CheckEquals(testValues[ftMemo,i],Fld.AsString);
-    ds.Next;
-    end;
-  ds.Close;
+procedure TTestDBBasics.TestSupportExtendedFields;
+begin
+  TestFieldDefinition(ftExtended, SizeOf(Extended));
 end;
 end;
 
 
 procedure TTestDBBasics.TestBlobBlobType;
 procedure TTestDBBasics.TestBlobBlobType;

+ 3 - 0
packages/fcl-db/tests/toolsunit.pas

@@ -577,6 +577,9 @@ begin
       testValues[ftDateTime,i] := testDateValues[i] + ' ' + testTimeValues[i]
       testValues[ftDateTime,i] := testDateValues[i] + ' ' + testTimeValues[i]
     else
     else
       testValues[ftDateTime,i] := testDateValues[i];
       testValues[ftDateTime,i] := testDateValues[i];
+    testValues[ftShortInt,i] := IntToStr(testShortIntValues[i]);
+    testValues[ftByte,i] := IntToStr(testByteValues[i]);
+    testValues[ftExtended,i] := FloatToStr(testFloatValues[i]);
     end;
     end;
 
 
   if dbconnectorname = '' then raise Exception.Create('There is no db connector specified');
   if dbconnectorname = '' then raise Exception.Create('There is no db connector specified');

+ 1 - 1
packages/fcl-web/examples/websocket/client/wsclient.lpr

@@ -6,7 +6,7 @@ uses
   {$IFDEF UNIX}
   {$IFDEF UNIX}
   cthreads,
   cthreads,
   {$ENDIF}
   {$ENDIF}
-  Classes, jsonparser, fpJSON,SysUtils, StrUtils, CustApp, uriparser, httpprotocol, fphttpclient;
+  Classes, jsonparser, fpJSON,SysUtils, StrUtils, CustApp, uriparser, httpprotocol, fpwebsocketclient, fpwebsocket;
 
 
 type
 type
 
 

+ 84 - 0
packages/paszlib/src/zipper.pp

@@ -585,9 +585,12 @@ Type
     Class Procedure Unzip(const AZipFileName : RawByteString);
     Class Procedure Unzip(const AZipFileName : RawByteString);
     // Unzip a single file.
     // Unzip a single file.
     Class Procedure Unzip(const AZipFileName : RawByteString;aExtractFileName : RawByteString);
     Class Procedure Unzip(const AZipFileName : RawByteString;aExtractFileName : RawByteString);
+    Class Procedure UnZip(const AZipFileName, aExtractFileName: RawByteString; aOutputFileName : string);
     // Unzip several files
     // Unzip several files
     Class Procedure Unzip(const AZipFileName : RawByteString; aFileList : Array of RawByteString);
     Class Procedure Unzip(const AZipFileName : RawByteString; aFileList : Array of RawByteString);
     Class Procedure Unzip(const AZipFileName : RawByteString; aFileList : TStrings);
     Class Procedure Unzip(const AZipFileName : RawByteString; aFileList : TStrings);
+    Class Procedure Unzip(const AZipFileName : RawByteString; aFileList : Array of RawByteString; aOutputDir : RawByteString; aFlat : Boolean = false);
+    Class Procedure Unzip(const AZipFileName : RawByteString; aFileList : TStrings; aOutputDir : RawByteString; aFlat : Boolean = false);
     Procedure Clear;
     Procedure Clear;
     Procedure Examine;
     Procedure Examine;
     Procedure Terminate;
     Procedure Terminate;
@@ -3020,6 +3023,62 @@ begin
     end;
     end;
 end;
 end;
 
 
+Type
+
+  { TCustomExtractor }
+
+  TCustomExtractor = Class(TObject)
+  Private
+    FStream : TStream;
+    FunZipper  : TUnzipper;
+    procedure DoCreateStream(Sender: TObject; var AStream: TStream; AItem: TFullZipFileEntry);
+  Public
+    Constructor Create(aUnZipper : TUnzipper);
+    Destructor Destroy; override;
+    Procedure UnZip(const AZipFileName, aExtractFileName: RawByteString; aOutputFileName: string);
+  end;
+
+{ TCustomExtractor }
+
+procedure TCustomExtractor.DoCreateStream(Sender: TObject; var AStream: TStream; AItem: TFullZipFileEntry);
+begin
+  aStream:=FStream;
+  FStream:=Nil;
+end;
+
+constructor TCustomExtractor.Create(aUnZipper: TUnzipper);
+begin
+  FStream:=Nil;
+  FUnzipper:=aUnzipper;
+end;
+
+destructor TCustomExtractor.Destroy;
+begin
+  FreeAndNil(FUnZipper);
+  FreeAndNil(FStream);
+  Inherited;
+end;
+
+procedure TCustomExtractor.UnZip(const AZipFileName, aExtractFileName: RawByteString; aOutputFileName: string);
+begin
+  FStream:=TFileStream.Create(aOutputFileName,fmCreate);
+  FUnZipper.OnCreateStream:=@DoCreateStream;
+  FUnzipper.UnzipFile(aZipFileName,aExtractFileName);
+end;
+
+class procedure TUnZipper.UnZip(const AZipFileName, aExtractFileName: RawByteString; aOutputFileName: string);
+
+
+
+begin
+  With TCustomExtractor.Create(Self.Create) do
+    try
+      Unzip(aZipFileName,aExtractFileName,aOutputFileName);
+    Finally
+      Free;
+    end;
+end;
+
 class procedure TUnZipper.Unzip(const AZipFileName: RawByteString; aFileList: array of RawByteString);
 class procedure TUnZipper.Unzip(const AZipFileName: RawByteString; aFileList: array of RawByteString);
 begin
 begin
   With Self.Create do
   With Self.Create do
@@ -3040,6 +3099,31 @@ begin
     end;
     end;
 end;
 end;
 
 
+class procedure TUnZipper.Unzip(const AZipFileName: RawByteString; aFileList: array of RawByteString; aOutputDir: RawByteString;
+  aFlat: Boolean);
+begin
+  With Self.Create do
+    try
+      Flat:=aFlat;
+      OutputPath:=aOutputDir;
+      UnZipFiles(aZipFileName,aFileList);
+    finally
+      Free;
+    end;
+end;
+
+class procedure TUnZipper.Unzip(const AZipFileName: RawByteString; aFileList: TStrings; aOutputDir: RawByteString; aFlat: Boolean);
+begin
+  With Self.Create do
+    try
+      Flat:=aFlat;
+      OutputPath:=aOutputDir;
+      UnZipFiles(aZipFileName,aFileList);
+    finally
+      Free;
+    end;
+end;
+
 procedure TUnZipper.DoEndOfFile;
 procedure TUnZipper.DoEndOfFile;
 
 
 Var
 Var

BIN
packages/paszlib/tests/test.zip


+ 57 - 0
packages/paszlib/tests/testsingle.lpi

@@ -0,0 +1,57 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="testsingle"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <Units>
+      <Unit>
+        <Filename Value="testsingle.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="testsingle"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../src"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

+ 19 - 0
packages/paszlib/tests/testsingle.pas

@@ -0,0 +1,19 @@
+program testsingle;
+
+uses sysutils, zipper;
+
+Var
+  FN : String;
+
+begin
+  FN:=GetTempFileName;
+  TUnzipper.Unzip('test.zip','files/file1.txt',FN);
+  if not FileExists(FN) then
+    Writeln('Error: no file named ',FN)
+  else
+    begin
+//    DeleteFile(FN);
+    Writeln('OK for ',fn);
+    end;
+end.
+

+ 31 - 26
packages/wasmtime/Makefile

@@ -2,7 +2,7 @@
 # Don't edit, this file is generated by FPCMake Version 2.0.0
 # Don't edit, this file is generated by FPCMake Version 2.0.0
 #
 #
 default: all
 default: all
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-netbsd m68k-amiga m68k-atari m68k-palmos m68k-macosclassic m68k-embedded m68k-sinclairql powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macosclassic powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-haiku x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-android x86_64-aros x86_64-dragonfly arm-linux arm-netbsd arm-palmos arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android arm-aros arm-freertos arm-ios powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android mips64el-linux jvm-java jvm-android i8086-embedded i8086-msdos i8086-win16 aarch64-linux aarch64-freebsd aarch64-darwin aarch64-win64 aarch64-android aarch64-ios wasm32-embedded wasm32-wasi sparc64-linux riscv32-linux riscv32-embedded riscv64-linux riscv64-embedded xtensa-linux xtensa-embedded xtensa-freertos z80-embedded z80-zxspectrum z80-msxdos z80-amstradcpc
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-netbsd m68k-amiga m68k-atari m68k-palmos m68k-macosclassic m68k-embedded m68k-sinclairql powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macosclassic powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-haiku x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-android x86_64-aros x86_64-dragonfly arm-linux arm-netbsd arm-palmos arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android arm-aros arm-freertos arm-ios powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android mips64el-linux jvm-java jvm-android i8086-embedded i8086-msdos i8086-win16 aarch64-linux aarch64-freebsd aarch64-darwin aarch64-win64 aarch64-embedded aarch64-android aarch64-ios wasm32-embedded wasm32-wasi sparc64-linux riscv32-linux riscv32-embedded riscv64-linux riscv64-embedded xtensa-linux xtensa-embedded xtensa-freertos z80-embedded z80-zxspectrum z80-msxdos z80-amstradcpc
 BSDs = freebsd netbsd openbsd darwin dragonfly
 BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
 UNIXs = linux $(BSDs) solaris qnx haiku aix
 LIMIT83fs = go32v2 os2 emx watcom msdos win16 atari
 LIMIT83fs = go32v2 os2 emx watcom msdos win16 atari
@@ -58,7 +58,7 @@ SRCBATCHEXT=.bat
 endif
 endif
 endif
 endif
 ifdef COMSPEC
 ifdef COMSPEC
-ifneq ($(findstring $(OS_SOURCE),$(OSNeedsComspecToRunBatch)),)
+ifneq ($(filter $(OS_SOURCE),$(OSNeedsComspecToRunBatch)),)
 ifndef RUNBATCH
 ifndef RUNBATCH
 RUNBATCH=$(COMSPEC) /C
 RUNBATCH=$(COMSPEC) /C
 endif
 endif
@@ -178,6 +178,8 @@ else
 ARCH=$(CPU_TARGET)
 ARCH=$(CPU_TARGET)
 endif
 endif
 endif
 endif
+ifeq ($(FULL_TARGET),aarch64-embedded)
+endif
 ifeq ($(FULL_TARGET),arm-embedded)
 ifeq ($(FULL_TARGET),arm-embedded)
 ifeq ($(SUBARCH),)
 ifeq ($(SUBARCH),)
 $(error When compiling for arm-embedded, a sub-architecture (e.g. SUBARCH=armv4t or SUBARCH=armv7m) must be defined)
 $(error When compiling for arm-embedded, a sub-architecture (e.g. SUBARCH=armv4t or SUBARCH=armv7m) must be defined)
@@ -214,11 +216,11 @@ $(error When compiling for arm-freertos, a sub-architecture (e.g. SUBARCH=armv6m
 endif
 endif
 override FPCOPT+=-Cp$(SUBARCH)
 override FPCOPT+=-Cp$(SUBARCH)
 endif
 endif
-ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+ifneq ($(filter $(OS_SOURCE),$(LIMIT83fs)),)
 TARGETSUFFIX=$(OS_TARGET)
 TARGETSUFFIX=$(OS_TARGET)
 SOURCESUFFIX=$(OS_SOURCE)
 SOURCESUFFIX=$(OS_SOURCE)
 else
 else
-ifneq ($(findstring $(OS_TARGET),$(LIMIT83fs)),)
+ifneq ($(filter $(OS_TARGET),$(LIMIT83fs)),)
 TARGETSUFFIX=$(OS_TARGET)
 TARGETSUFFIX=$(OS_TARGET)
 else
 else
 TARGETSUFFIX=$(FULL_TARGET)
 TARGETSUFFIX=$(FULL_TARGET)
@@ -229,11 +231,11 @@ ifneq ($(FULL_TARGET),$(FULL_SOURCE))
 CROSSCOMPILE=1
 CROSSCOMPILE=1
 endif
 endif
 ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
 ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
-ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
+ifeq ($(filter $(FULL_TARGET),$(MAKEFILETARGETS)),)
 $(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
 $(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
 endif
 endif
 endif
 endif
-ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
+ifneq ($(filter $(OS_TARGET),$(BSDs)),)
 BSDhier=1
 BSDhier=1
 endif
 endif
 ifeq ($(OS_TARGET),linux)
 ifeq ($(OS_TARGET),linux)
@@ -287,8 +289,8 @@ endif
 ifndef CROSSBINDIR
 ifndef CROSSBINDIR
 CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
 CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
 endif
 endif
-ifneq ($(findstring $(OS_TARGET),darwin iphonesim ios),)
-ifneq ($(findstring $(OS_SOURCE),darwin ios),)
+ifneq ($(filter $(OS_TARGET),darwin iphonesim ios),)
+ifneq ($(filter $(OS_SOURCE),darwin ios),)
 DARWIN2DARWIN=1
 DARWIN2DARWIN=1
 endif
 endif
 endif
 endif
@@ -365,11 +367,11 @@ ifdef REQUIRE_PACKAGESDIR
 override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
 override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
 endif
 endif
 ifdef ZIPINSTALL
 ifdef ZIPINSTALL
-ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
+ifneq ($(filter $(OS_TARGET),$(UNIXs)),)
 UNIXHier=1
 UNIXHier=1
 endif
 endif
 else
 else
-ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
+ifneq ($(filter $(OS_SOURCE),$(UNIXs)),)
 UNIXHier=1
 UNIXHier=1
 endif
 endif
 endif
 endif
@@ -557,7 +559,7 @@ endif
 ifeq ($(OS_SOURCE),linux)
 ifeq ($(OS_SOURCE),linux)
 ifndef GCCLIBDIR
 ifndef GCCLIBDIR
 ifeq ($(CPU_TARGET),i386)
 ifeq ($(CPU_TARGET),i386)
-ifneq ($(findstring x86_64,$(shell uname -a)),)
+ifneq ($(filter x86_64,$(shell uname -a)),)
 ifeq ($(BINUTILSPREFIX),)
 ifeq ($(BINUTILSPREFIX),)
 GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`)
 GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`)
 else
 else
@@ -580,11 +582,11 @@ CROSSGCCOPT=-m64
 endif
 endif
 endif
 endif
 ifeq ($(CPU_TARGET),sparc)
 ifeq ($(CPU_TARGET),sparc)
-ifneq ($(findstring sparc64,$(shell uname -a)),)
+ifneq ($(filter sparc64,$(shell uname -a)),)
 ifeq ($(BINUTILSPREFIX),)
 ifeq ($(BINUTILSPREFIX),)
 GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`)
 GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`)
 else
 else
-ifneq ($(findstring $(FPCFPMAKE_CPU_OPT),mips mipsel),)
+ifneq ($(filter $(FPCFPMAKE_CPU_OPT),mips mipsel),)
 CROSSGCCOPT=-mabi=32
 CROSSGCCOPT=-mabi=32
 else
 else
 CROSSGCCOPT=-m32
 CROSSGCCOPT=-m32
@@ -598,19 +600,19 @@ FPCFPMAKE_CPU_TARGET=$(shell $(FPCFPMAKE) -iTP)
 ifeq ($(CPU_TARGET),$(FPCFPMAKE_CPU_TARGET))
 ifeq ($(CPU_TARGET),$(FPCFPMAKE_CPU_TARGET))
 FPCMAKEGCCLIBDIR:=$(GCCLIBDIR)
 FPCMAKEGCCLIBDIR:=$(GCCLIBDIR)
 else
 else
-ifneq ($(findstring $(FPCFPMAKE_CPU_TARGET),aarch64 powerpc64 riscv64 sparc64 x86_64),)
+ifneq ($(filter $(FPCFPMAKE_CPU_TARGET),aarch64 powerpc64 riscv64 sparc64 x86_64),)
 FPCMAKE_CROSSGCCOPT=-m64
 FPCMAKE_CROSSGCCOPT=-m64
 else
 else
-ifneq ($(findstring $(FPCFPMAKE_CPU_OPT),mips64 mips64el),)
+ifneq ($(filter $(FPCFPMAKE_CPU_OPT),mips64 mips64el),)
 FPCMAKE_CROSSGCCOPT=-mabi=64
 FPCMAKE_CROSSGCCOPT=-mabi=64
 else
 else
-ifneq ($(findstring $(FPCFPMAKE_CPU_OPT),mips mipsel),)
+ifneq ($(filter $(FPCFPMAKE_CPU_OPT),mips mipsel),)
 FPCMAKE_CROSSGCCOPT=-mabi=32
 FPCMAKE_CROSSGCCOPT=-mabi=32
 else
 else
-ifneq ($(findstring $(FPCFPMAKE_CPU_OPT),riscv64),)
+ifeq ($(FPCFPMAKE_CPU_OPT),riscv64)
 FPCMAKE_CROSSGCCOPT=-mabi=lp64
 FPCMAKE_CROSSGCCOPT=-mabi=lp64
 else
 else
-ifneq ($(findstring $(FPCFPMAKE_CPU_OPT),riscv32),)
+ifeq ($(FPCFPMAKE_CPU_OPT),riscv32)
 FPCMAKE_CROSSGCCOPT=-mabi=ilp32
 FPCMAKE_CROSSGCCOPT=-mabi=ilp32
 else
 else
 FPCMAKE_CROSSGCCOPT=-m32
 FPCMAKE_CROSSGCCOPT=-m32
@@ -789,7 +791,7 @@ DEBUGSYMEXT=.xcoff
 SHORTSUFFIX=mac
 SHORTSUFFIX=mac
 IMPORTLIBPREFIX=imp
 IMPORTLIBPREFIX=imp
 endif
 endif
-ifneq ($(findstring $(OS_TARGET),darwin iphonesim ios),)
+ifneq ($(filter $(OS_TARGET),darwin iphonesim ios),)
 BATCHEXT=.sh
 BATCHEXT=.sh
 EXEEXT=
 EXEEXT=
 HASSHAREDLIB=1
 HASSHAREDLIB=1
@@ -868,7 +870,7 @@ endif
 ifeq ($(OS_TARGET),wasi)
 ifeq ($(OS_TARGET),wasi)
 EXEEXT=.wasm
 EXEEXT=.wasm
 endif
 endif
-ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+ifneq ($(filter $(OS_SOURCE),$(LIMIT83fs)),)
 FPCMADE=fpcmade.$(SHORTSUFFIX)
 FPCMADE=fpcmade.$(SHORTSUFFIX)
 ZIPSUFFIX=$(SHORTSUFFIX)
 ZIPSUFFIX=$(SHORTSUFFIX)
 ZIPCROSSPREFIX=
 ZIPCROSSPREFIX=
@@ -1393,6 +1395,9 @@ endif
 ifeq ($(FULL_TARGET),aarch64-win64)
 ifeq ($(FULL_TARGET),aarch64-win64)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_RTL=1
 endif
 endif
+ifeq ($(FULL_TARGET),aarch64-embedded)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),aarch64-android)
 ifeq ($(FULL_TARGET),aarch64-android)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_RTL=1
 endif
 endif
@@ -1586,8 +1591,8 @@ ifdef SYSROOTPATH
 override FPCOPT+=-XR$(SYSROOTPATH)
 override FPCOPT+=-XR$(SYSROOTPATH)
 else
 else
 ifeq ($(OS_TARGET),$(OS_SOURCE))
 ifeq ($(OS_TARGET),$(OS_SOURCE))
-ifneq ($(findstring $(OS_TARGET),darwin),)
-ifneq ($(findstring $(CPU_TARGET),aarch64),)
+ifeq ($(OS_TARGET),darwin)
+ifeq ($(CPU_TARGET),aarch64)
 ifneq ($(wildcard /Library/Developer/CommandLineTools/SDKs/MacOSX.sdk),)
 ifneq ($(wildcard /Library/Developer/CommandLineTools/SDKs/MacOSX.sdk),)
 override FPCOPT+=-XR/Library/Developer/CommandLineTools/SDKs/MacOSX.sdk
 override FPCOPT+=-XR/Library/Developer/CommandLineTools/SDKs/MacOSX.sdk
 endif
 endif
@@ -1598,8 +1603,8 @@ endif
 ifdef CREATESHARED
 ifdef CREATESHARED
 override FPCOPT+=-Cg
 override FPCOPT+=-Cg
 endif
 endif
-ifneq ($(findstring $(OS_TARGET),dragonfly freebsd openbsd netbsd linux solaris),)
-ifneq ($(findstring $(CPU_TARGET),x86_64 mips mipsel riscv64),)
+ifneq ($(filter $(OS_TARGET),dragonfly freebsd openbsd netbsd linux solaris),)
+ifneq ($(filter $(CPU_TARGET),x86_64 mips mipsel riscv64 powerpc64),)
 override FPCOPT+=-Cg
 override FPCOPT+=-Cg
 endif
 endif
 endif
 endif
@@ -1642,10 +1647,10 @@ ifdef ACROSSCOMPILE
 override FPCOPT+=$(CROSSOPT)
 override FPCOPT+=$(CROSSOPT)
 endif
 endif
 override COMPILER:=$(strip $(FPC) $(FPCOPT))
 override COMPILER:=$(strip $(FPC) $(FPCOPT))
-ifneq (,$(findstring -sh ,$(COMPILER)))
+ifneq (,$(filter -sh,$(COMPILER)))
 UseEXECPPAS=1
 UseEXECPPAS=1
 endif
 endif
-ifneq (,$(findstring -s ,$(COMPILER)))
+ifneq (,$(filter -s,$(COMPILER)))
 ifeq ($(FULL_SOURCE),$(FULL_TARGET))
 ifeq ($(FULL_SOURCE),$(FULL_TARGET))
 UseEXECPPAS=1
 UseEXECPPAS=1
 endif
 endif

+ 1 - 1
rtl/freertos/Makefile

@@ -517,7 +517,7 @@ endif
 ifeq ($(ARCH),xtensa)
 ifeq ($(ARCH),xtensa)
 CPU_SPECIFIC_COMMON_UNITS=sysutils math classes fgl macpas typinfo types rtlconsts getopts lineinfo
 CPU_SPECIFIC_COMMON_UNITS=sysutils math classes fgl macpas typinfo types rtlconsts getopts lineinfo
 ifeq ($(SUBARCH),lx6)
 ifeq ($(SUBARCH),lx6)
-CPU_UNITS=esp32 espidf_40200
+CPU_UNITS=esp32 espidf_40100 espidf_40200
 CPU_UNITS_DEFINED=1
 CPU_UNITS_DEFINED=1
 endif
 endif
 ifeq ($(SUBARCH),lx106)
 ifeq ($(SUBARCH),lx106)

+ 1 - 1
rtl/freertos/Makefile.fpc

@@ -227,7 +227,7 @@ endif
 ifeq ($(ARCH),xtensa)
 ifeq ($(ARCH),xtensa)
 CPU_SPECIFIC_COMMON_UNITS=sysutils math classes fgl macpas typinfo types rtlconsts getopts lineinfo
 CPU_SPECIFIC_COMMON_UNITS=sysutils math classes fgl macpas typinfo types rtlconsts getopts lineinfo
 ifeq ($(SUBARCH),lx6)
 ifeq ($(SUBARCH),lx6)
-CPU_UNITS=esp32 espidf_40200
+CPU_UNITS=esp32 espidf_40100 espidf_40200
 CPU_UNITS_DEFINED=1
 CPU_UNITS_DEFINED=1
 endif
 endif
 ifeq ($(SUBARCH),lx106)
 ifeq ($(SUBARCH),lx106)

+ 43 - 0
rtl/freertos/xtensa/espidf_40100.pp

@@ -0,0 +1,43 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2021 by Florian Klaempfl
+    member of the Free Pascal development team.
+
+    System unit for FreeRTOS systems
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit espidf_40100;
+
+interface
+
+{$linklib esp32,static}
+{$linklib soc,static}
+{$linklib driver,static}
+{$linklib freertos,static}
+{$linklib log,static}
+{$linklib esp_common,static}
+{$linklib heap,static}
+{$linklib newlib,static}
+{$linklib vfs,static}
+{$linklib esp_ringbuf,static}
+{$linklib spi_flash,static}
+{$linklib app_update,static}
+{$linklib xtensa,static}
+{$linklib bootloader_support,static}
+{$linklib pthread,static}
+{$linklib hal,static}
+{$linklib libm,static}
+{$linklib libg,static}
+{$linklib c,static}
+{$linklib esp_event,static}
+
+implementation
+
+end.

+ 14 - 17
rtl/inc/sstrings.inc

@@ -1523,17 +1523,18 @@ end;
 
 
   Function fpc_val_smallint_shortstr(Const S: ShortString; out Code: ValSInt): SmallInt; [public, alias:'FPC_VAL_SMALLINT_SHORTSTR']; compilerproc;
   Function fpc_val_smallint_shortstr(Const S: ShortString; out Code: ValSInt): SmallInt; [public, alias:'FPC_VAL_SMALLINT_SHORTSTR']; compilerproc;
 
 
-  var  u, temp, prev, maxprevvalue, maxnewvalue : word;
+  var  u, temp, prev, maxprevvalue : word;
        base : byte;
        base : byte;
        negative : boolean;
        negative : boolean;
-
-  const maxlongint=longword($7fffffff);
-        maxlongword=longword($ffffffff);
-
+       UnsignedUpperLimit: ValUInt;
   begin
   begin
     fpc_val_smallint_shortstr := 0;
     fpc_val_smallint_shortstr := 0;
     Temp:=0;
     Temp:=0;
     Code:=InitVal(s,negative,base);
     Code:=InitVal(s,negative,base);
+    if (base=10) or negative then
+      UnsignedUpperLimit := Word(High(SmallInt))+Ord(negative)
+    else
+      UnsignedUpperLimit := High(Word);
     if Code>length(s) then
     if Code>length(s) then
      exit;
      exit;
     if (s[Code]=#0) then
     if (s[Code]=#0) then
@@ -1542,11 +1543,7 @@ end;
           Code:=0;
           Code:=0;
         exit;
         exit;
       end;
       end;
-    maxprevvalue := maxlongword div base;
-    if (base = 10) then
-      maxnewvalue := maxlongint + ord(negative)
-    else
-      maxnewvalue := maxlongword;
+    maxprevvalue := High(Word) div base;
 
 
     while Code<=Length(s) do
     while Code<=Length(s) do
      begin
      begin
@@ -1561,17 +1558,17 @@ end;
        Prev:=Temp;
        Prev:=Temp;
        Temp:=Temp*longword(base);
        Temp:=Temp*longword(base);
        If (u >= base) or
        If (u >= base) or
-         (longword(maxnewvalue-u) < temp) or
-         (prev > maxprevvalue) Then
-         Begin
-           fpc_val_smallint_shortstr := 0;
-           Exit
-         End;
+        (prev > maxPrevValue) or
+        ((Temp)>(UnsignedUpperLimit-u)) Then
+       Begin
+         fpc_val_smallint_shortstr := 0;
+         Exit
+       End;
        Temp:=Temp+u;
        Temp:=Temp+u;
        inc(code);
        inc(code);
      end;
      end;
     code:=0;
     code:=0;
-    fpc_val_smallint_shortstr:=longint(Temp);
+    fpc_val_smallint_shortstr:=SmallInt(Temp);
     If Negative Then
     If Negative Then
       fpc_val_smallint_shortstr:=-fpc_val_smallint_shortstr;
       fpc_val_smallint_shortstr:=-fpc_val_smallint_shortstr;
   end;
   end;

+ 2 - 0
rtl/objpas/classes/compon.inc

@@ -603,6 +603,8 @@ Procedure TComponent.InsertComponent(AComponent: TComponent);
 begin
 begin
   AComponent.ValidateContainer(Self);
   AComponent.ValidateContainer(Self);
   ValidateRename(AComponent,'',AComponent.FName);
   ValidateRename(AComponent,'',AComponent.FName);
+  If AComponent.FOwner<>Nil then
+    AComponent.FOwner.Remove(AComponent);
   Insert(AComponent);
   Insert(AComponent);
   AComponent.SetReference(True);
   AComponent.SetReference(True);
   If csDesigning in FComponentState then
   If csDesigning in FComponentState then

+ 1 - 1
tests/bench/bval.pp

@@ -5,7 +5,7 @@ const
   chars : shortstring = ('0123456789AbCdEf');
   chars : shortstring = ('0123456789AbCdEf');
   signs : shortstring = (' -');
   signs : shortstring = (' -');
 var
 var
-  vals : array[0..1000] of shortstring;
+  vals : array[0..1000] of string;
   base,len,baseindex : byte;
   base,len,baseindex : byte;
   li,i,j : longint;
   li,i,j : longint;
   code : word;
   code : word;

+ 2 - 2
utils/pas2js/compileserver.lpi

@@ -1,15 +1,15 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
 <CONFIG>
   <ProjectOptions>
   <ProjectOptions>
-    <Version Value="11"/>
+    <Version Value="12"/>
     <General>
     <General>
       <Flags>
       <Flags>
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasTitleStatement Value="False"/>
         <MainUnitHasTitleStatement Value="False"/>
         <MainUnitHasScaledStatement Value="False"/>
         <MainUnitHasScaledStatement Value="False"/>
+        <CompatibilityMode Value="True"/>
       </Flags>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
       <SessionStorage Value="InProjectDir"/>
-      <MainUnit Value="0"/>
       <Title Value="compileserver"/>
       <Title Value="compileserver"/>
       <UseAppBundle Value="False"/>
       <UseAppBundle Value="False"/>
       <ResourceType Value="res"/>
       <ResourceType Value="res"/>

+ 21 - 5
utils/pas2js/httpcompiler.pp

@@ -9,10 +9,12 @@ uses
   {$ifdef unix}baseunix,{$endif}
   {$ifdef unix}baseunix,{$endif}
   sysutils, classes, fpjson, contnrs, syncobjs, fpmimetypes, custhttpapp, inifiles,
   sysutils, classes, fpjson, contnrs, syncobjs, fpmimetypes, custhttpapp, inifiles,
   fpwebproxy, webutil, fpwebfile, httproute, httpdefs, dirwatch, Pas2JSFSCompiler,
   fpwebproxy, webutil, fpwebfile, httproute, httpdefs, dirwatch, Pas2JSFSCompiler,
-  Pas2JSCompilerCfg;
+  Pas2JSCompilerCfg, ssockets;
 
 
 Const
 Const
+  HTTPCompilerVersion = '1.0';
   nErrTooManyThreads = -1;
   nErrTooManyThreads = -1;
+  nExitCodeSocketError = 1;
 
 
 Type
 Type
   TDirWatcher = Class;
   TDirWatcher = Class;
@@ -51,7 +53,6 @@ Type
      Property Compiles[AIndex : Integer] : TCompileItem Read GetC; default;
      Property Compiles[AIndex : Integer] : TCompileItem Read GetC; default;
   end;
   end;
 
 
-
   { TCompileThread }
   { TCompileThread }
 
 
   TCompileThread = class(TThread)
   TCompileThread = class(TThread)
@@ -275,6 +276,7 @@ begin
   {AllowWriteln}
   {AllowWriteln}
   if (Msg<>'') then
   if (Msg<>'') then
     Writeln('Error: ',Msg);
     Writeln('Error: ',Msg);
+  Writeln('Version ',HTTPCompilerVersion);
   Writeln('Usage ',ExtractFileName(ParamStr(0)),' [options] ');
   Writeln('Usage ',ExtractFileName(ParamStr(0)),' [options] ');
   Writeln('Where options is one or more of : ');
   Writeln('Where options is one or more of : ');
   Writeln('-A --api=location,secret Enable location management API.');
   Writeln('-A --api=location,secret Enable location management API.');
@@ -766,9 +768,15 @@ Var
   S : String;
   S : String;
 
 
 begin
 begin
-  S:=Checkoptions('shqd:ni:p:wP::cm:A:',['help','quiet','noindexpage','directory:','port:','indexpage:','watch','project::','config:','simpleserver','mimetypes:','api:']);
+  S:=Checkoptions('shqVd:ni:p:wP::cm:A:I:',['help','quiet','version','noindexpage','directory:','port:','indexpage:','watch','project::','config:','simpleserver','mimetypes:','api:','interface:']);
   if (S<>'') or HasOption('h','help') then
   if (S<>'') or HasOption('h','help') then
-    usage(S);
+    Usage(S);
+  if HasOption('V','version') then
+    begin
+    writeln(HTTPCompilerVersion);
+    Terminate;
+    exit;
+    end;
   if HasOption('c','config') then
   if HasOption('c','config') then
     ConfigFile:=GetOptionValue('c','config')
     ConfigFile:=GetOptionValue('c','config')
   else
   else
@@ -813,7 +821,15 @@ begin
   TSimpleFileModule.RegisterDefaultRoute;
   TSimpleFileModule.RegisterDefaultRoute;
   if InterfaceAddress<>'' then
   if InterfaceAddress<>'' then
     HTTPHandler.Address:=InterfaceAddress;
     HTTPHandler.Address:=InterfaceAddress;
-  inherited;
+  try
+    inherited DoRun;
+  except
+    on E: ESocketError do begin
+      Log(etError,E.ClassName+': '+E.Message);
+      ExitCode:=nExitCodeSocketError;
+      Terminate;
+    end;
+  end;
 end;
 end;
 
 
 end.
 end.