Explorar o código

* synchronized with trunk

git-svn-id: branches/wasm@48846 -
nickysn %!s(int64=4) %!d(string=hai) anos
pai
achega
940738a3a1
Modificáronse 81 ficheiros con 3118 adicións e 425 borrados
  1. 15 0
      .gitattributes
  2. 3 1
      compiler/Makefile
  3. 4 1
      compiler/Makefile.fpc
  4. 10 1
      compiler/aarch64/racpugas.pas
  5. 3 1
      compiler/aasmcnst.pas
  6. 8 7
      compiler/cgexcept.pas
  7. 4 3
      compiler/cutils.pas
  8. 6 0
      compiler/dbgdwarf.pas
  9. 10 2
      compiler/defutil.pas
  10. 1 1
      compiler/i386/n386add.pas
  11. 4 0
      compiler/jvm/hlcgcpu.pas
  12. 2 1
      compiler/jvm/jvmdef.pas
  13. 2 0
      compiler/llvm/llvmpi.pas
  14. 10 14
      compiler/m68k/n68kmem.pas
  15. 41 1
      compiler/nadd.pas
  16. 12 12
      compiler/ncgflw.pas
  17. 9 5
      compiler/ncginl.pas
  18. 3 7
      compiler/ncon.pas
  19. 22 4
      compiler/ngtcon.pas
  20. 11 3
      compiler/nmat.pas
  21. 8 0
      compiler/nset.pas
  22. 36 0
      compiler/nutils.pas
  23. 3 1
      compiler/psabiehpi.pas
  24. 1 0
      compiler/pstatmnt.pas
  25. 1 1
      compiler/psub.pas
  26. 3 1
      compiler/symconst.pas
  27. 13 5
      compiler/symdef.pas
  28. 3 3
      compiler/systems/i_darwin.pas
  29. 5 5
      compiler/systems/i_linux.pas
  30. 2 1
      compiler/utils/ppuutils/ppudump.pp
  31. 247 112
      compiler/x86/aoptx86.pas
  32. 14 8
      installer/install.dat
  33. 1 1
      packages/fcl-db/src/export/fpxmlxsdexport.pp
  34. 18 4
      packages/fcl-net/src/amiga/resolve.inc
  35. 19 4
      packages/fcl-net/src/aros/resolve.inc
  36. 61 11
      packages/fcl-passrc/src/pasresolver.pp
  37. 5 2
      packages/fcl-process/src/amicommon/pipes.inc
  38. 66 11
      packages/fcl-process/src/amicommon/process.inc
  39. 21 1
      packages/fcl-process/src/pipes.pp
  40. 3 2
      packages/fpmkunit/src/fpmkunit.pp
  41. 2 2
      packages/hash/examples/sha1performancetest.pas
  42. 6 61
      packages/pastojs/src/fppas2js.pp
  43. 13 3
      packages/pastojs/tests/tcgenerics.pas
  44. 139 37
      packages/pastojs/tests/tcmodules.pas
  45. 18 4
      packages/rtl-extra/src/amiga/sockets.pp
  46. 30 8
      packages/rtl-extra/src/aros/sockets.pp
  47. 13 0
      packages/rtl-objpas/src/inc/dateutil.inc
  48. 2 4
      packages/rtl-objpas/src/inc/strutils.pp
  49. 15 1
      packages/rtl-unicode/fpmake.pp
  50. 55 0
      packages/rtl-unicode/src/inc/eastasianwidth.pp
  51. 300 0
      packages/rtl-unicode/src/inc/eastasianwidth_code.inc
  52. 180 0
      packages/rtl-unicode/src/inc/graphemebreakproperty.pp
  53. 511 0
      packages/rtl-unicode/src/inc/graphemebreakproperty_code.inc
  54. 1 1
      packages/tplylib/fpmake.pp
  55. 1 1
      rtl/embedded/Makefile
  56. 1 1
      rtl/embedded/Makefile.fpc
  57. 13 1
      rtl/embedded/arm/cortexm4f_start.inc
  58. 13 1
      rtl/freertos/arm/cortexm4f_start.inc
  59. 7 1
      rtl/linux/arm/sighnd.inc
  60. 27 27
      rtl/objpas/math.pp
  61. 34 0
      tests/test/tandorandnot1.pp
  62. 2 2
      tests/test/tmt1.pp
  63. 79 0
      tests/test/units/strutils/tboyer.pp
  64. 8 4
      tests/utils/dotest.pp
  65. 11 0
      tests/webtbf/tw38504.pp
  66. 11 0
      tests/webtbf/tw38504b.pp
  67. 7 0
      tests/webtbs/tw28713.pp
  68. 15 0
      tests/webtbs/tw36250.pp
  69. 24 0
      tests/webtbs/tw38497.pp
  70. 15 0
      tests/webtbs/tw38527.pp
  71. 1 4
      tests/webtbs/tw8177.pp
  72. 1 1
      utils/json2pas/fpmake.pp
  73. 1 1
      utils/unicode/cldrparser.lpr
  74. 7 7
      utils/unicode/data/readme.txt
  75. 58 0
      utils/unicode/eawparser.lpi
  76. 332 0
      utils/unicode/eawparser.lpr
  77. 2 0
      utils/unicode/fpmake.pp
  78. 58 0
      utils/unicode/gbpparser.lpi
  79. 379 0
      utils/unicode/gbpparser.lpr
  80. 8 8
      utils/unicode/parse-collations.bat
  81. 8 8
      utils/unicode/parse-collations.sh

+ 15 - 0
.gitattributes

@@ -9076,7 +9076,11 @@ packages/rtl-unicode/src/inc/cp936.pas svneol=native#text/pascal
 packages/rtl-unicode/src/inc/cp949.pas svneol=native#text/pascal
 packages/rtl-unicode/src/inc/cp949.pas svneol=native#text/pascal
 packages/rtl-unicode/src/inc/cp950.pas svneol=native#text/pascal
 packages/rtl-unicode/src/inc/cp950.pas svneol=native#text/pascal
 packages/rtl-unicode/src/inc/cpbuildu.pp svneol=native#text/plain
 packages/rtl-unicode/src/inc/cpbuildu.pp svneol=native#text/plain
+packages/rtl-unicode/src/inc/eastasianwidth.pp svneol=native#text/plain
+packages/rtl-unicode/src/inc/eastasianwidth_code.inc svneol=native#text/plain
 packages/rtl-unicode/src/inc/freebidi.pp svneol=native#text/plain
 packages/rtl-unicode/src/inc/freebidi.pp svneol=native#text/plain
+packages/rtl-unicode/src/inc/graphemebreakproperty.pp svneol=native#text/plain
+packages/rtl-unicode/src/inc/graphemebreakproperty_code.inc svneol=native#text/plain
 packages/rtl-unicode/src/inc/ucadata.inc svneol=native#text/pascal
 packages/rtl-unicode/src/inc/ucadata.inc svneol=native#text/pascal
 packages/rtl-unicode/src/inc/ucadata_be.inc svneol=native#text/pascal
 packages/rtl-unicode/src/inc/ucadata_be.inc svneol=native#text/pascal
 packages/rtl-unicode/src/inc/ucadata_le.inc svneol=native#text/pascal
 packages/rtl-unicode/src/inc/ucadata_le.inc svneol=native#text/pascal
@@ -14535,6 +14539,7 @@ tests/test/talign1.pp svneol=native#text/plain
 tests/test/talign2.pp svneol=native#text/plain
 tests/test/talign2.pp svneol=native#text/plain
 tests/test/taligned1.pp svneol=native#text/pascal
 tests/test/taligned1.pp svneol=native#text/pascal
 tests/test/tand1.pp svneol=native#text/plain
 tests/test/tand1.pp svneol=native#text/plain
+tests/test/tandorandnot1.pp svneol=native#text/pascal
 tests/test/targ1a.pp svneol=native#text/plain
 tests/test/targ1a.pp svneol=native#text/plain
 tests/test/targ1b.pp svneol=native#text/plain
 tests/test/targ1b.pp svneol=native#text/plain
 tests/test/tarray1.pp svneol=native#text/plain
 tests/test/tarray1.pp svneol=native#text/plain
@@ -16211,6 +16216,7 @@ tests/test/units/strings/tstrings1.pp svneol=native#text/plain
 tests/test/units/strutils/taddchar.pp svneol=native#text/plain
 tests/test/units/strutils/taddchar.pp svneol=native#text/plain
 tests/test/units/strutils/taddcharr.pp svneol=native#text/plain
 tests/test/units/strutils/taddcharr.pp svneol=native#text/plain
 tests/test/units/strutils/tbintohex.pp svneol=native#text/plain
 tests/test/units/strutils/tbintohex.pp svneol=native#text/plain
+tests/test/units/strutils/tboyer.pp svneol=native#text/pascal
 tests/test/units/strutils/tdec2numb.pp svneol=native#text/plain
 tests/test/units/strutils/tdec2numb.pp svneol=native#text/plain
 tests/test/units/strutils/thex2dec.pp svneol=native#text/plain
 tests/test/units/strutils/thex2dec.pp svneol=native#text/plain
 tests/test/units/strutils/thextobin.pp svneol=native#text/plain
 tests/test/units/strutils/thextobin.pp svneol=native#text/plain
@@ -16783,6 +16789,8 @@ tests/webtbf/tw38287.pp svneol=native#text/pascal
 tests/webtbf/tw38289a.pp svneol=native#text/pascal
 tests/webtbf/tw38289a.pp svneol=native#text/pascal
 tests/webtbf/tw38289b.pp svneol=native#text/pascal
 tests/webtbf/tw38289b.pp svneol=native#text/pascal
 tests/webtbf/tw38439.pp svneol=native#text/pascal
 tests/webtbf/tw38439.pp svneol=native#text/pascal
+tests/webtbf/tw38504.pp svneol=native#text/pascal
+tests/webtbf/tw38504b.pp svneol=native#text/pascal
 tests/webtbf/tw3930a.pp svneol=native#text/plain
 tests/webtbf/tw3930a.pp svneol=native#text/plain
 tests/webtbf/tw3931b.pp svneol=native#text/plain
 tests/webtbf/tw3931b.pp svneol=native#text/plain
 tests/webtbf/tw3969.pp svneol=native#text/plain
 tests/webtbf/tw3969.pp svneol=native#text/plain
@@ -18583,6 +18591,7 @@ tests/webtbs/tw36196.pp svneol=native#text/pascal
 tests/webtbs/tw3621.pp svneol=native#text/plain
 tests/webtbs/tw3621.pp svneol=native#text/plain
 tests/webtbs/tw36212.pp svneol=native#text/pascal
 tests/webtbs/tw36212.pp svneol=native#text/pascal
 tests/webtbs/tw36215.pp svneol=native#text/pascal
 tests/webtbs/tw36215.pp svneol=native#text/pascal
+tests/webtbs/tw36250.pp svneol=native#text/plain
 tests/webtbs/tw3628.pp svneol=native#text/plain
 tests/webtbs/tw3628.pp svneol=native#text/plain
 tests/webtbs/tw3634.pp svneol=native#text/plain
 tests/webtbs/tw3634.pp svneol=native#text/plain
 tests/webtbs/tw36381.pp svneol=native#text/plain
 tests/webtbs/tw36381.pp svneol=native#text/plain
@@ -18731,6 +18740,8 @@ tests/webtbs/tw3841.pp svneol=native#text/plain
 tests/webtbs/tw38412.pp svneol=native#text/pascal
 tests/webtbs/tw38412.pp svneol=native#text/pascal
 tests/webtbs/tw38413.pp svneol=native#text/pascal
 tests/webtbs/tw38413.pp svneol=native#text/pascal
 tests/webtbs/tw38429.pp svneol=native#text/pascal
 tests/webtbs/tw38429.pp svneol=native#text/pascal
+tests/webtbs/tw38497.pp svneol=native#text/pascal
+tests/webtbs/tw38527.pp svneol=native#text/plain
 tests/webtbs/tw3863.pp svneol=native#text/plain
 tests/webtbs/tw3863.pp svneol=native#text/plain
 tests/webtbs/tw3864.pp svneol=native#text/plain
 tests/webtbs/tw3864.pp svneol=native#text/plain
 tests/webtbs/tw3865.pp svneol=native#text/plain
 tests/webtbs/tw3865.pp svneol=native#text/plain
@@ -19835,7 +19846,11 @@ utils/unicode/cldrtest.pas svneol=native#text/pascal
 utils/unicode/cldrtxt.pas svneol=native#text/plain
 utils/unicode/cldrtxt.pas svneol=native#text/plain
 utils/unicode/cldrxml.pas svneol=native#text/pascal
 utils/unicode/cldrxml.pas svneol=native#text/pascal
 utils/unicode/data/readme.txt svneol=native#text/plain
 utils/unicode/data/readme.txt svneol=native#text/plain
+utils/unicode/eawparser.lpi svneol=native#text/plain
+utils/unicode/eawparser.lpr svneol=native#text/pascal
 utils/unicode/fpmake.pp svneol=native#text/plain
 utils/unicode/fpmake.pp svneol=native#text/plain
+utils/unicode/gbpparser.lpi svneol=native#text/plain
+utils/unicode/gbpparser.lpr svneol=native#text/pascal
 utils/unicode/grbtree.pas svneol=native#text/pascal
 utils/unicode/grbtree.pas svneol=native#text/pascal
 utils/unicode/helper.pas svneol=native#text/pascal
 utils/unicode/helper.pas svneol=native#text/pascal
 utils/unicode/parse-collations.bat svneol=native#text/plain
 utils/unicode/parse-collations.bat svneol=native#text/plain

+ 3 - 1
compiler/Makefile

@@ -5085,7 +5085,9 @@ endif
 cycledep:
 cycledep:
 	$(MAKE) cycle USEDEPEND=1
 	$(MAKE) cycle USEDEPEND=1
 extcycle:
 extcycle:
-	$(MAKE) cycle OPT="$(OPT) -n -OG2p3 -glttt -CRriot -dEXTDEBUG" ALLOW_WARNINGS=1
+	$(MAKE) cycle OPT="$(OPT) -n -glttt -CRriot -dEXTDEBUG" ALLOW_WARNINGS=1
+extoptcycle:
+	$(MAKE) cycle OPT="$(OPT) -n -glttt -CRriot -dEXTDEBUG -dDEBUG_ALL_OPT" ALLOW_WARNINGS=1
 cvstest:
 cvstest:
 	$(MAKE) cycle 'LOCALOPT=-n -Se' 'RTLOPT=-n -Se'
 	$(MAKE) cycle 'LOCALOPT=-n -Se' 'RTLOPT=-n -Se'
 ifeq ($(findstring -dFPC_SOFT_FPUX80,$(LOCALOPT)),)
 ifeq ($(findstring -dFPC_SOFT_FPUX80,$(LOCALOPT)),)

+ 4 - 1
compiler/Makefile.fpc

@@ -1036,7 +1036,10 @@ cycledep:
 # extcycle should still work, but generates
 # extcycle should still work, but generates
 # lots of warnings, so ALLOW_WARNINGS=1 is required
 # lots of warnings, so ALLOW_WARNINGS=1 is required
 extcycle:
 extcycle:
-        $(MAKE) cycle OPT="$(OPT) -n -OG2p3 -glttt -CRriot -dEXTDEBUG" ALLOW_WARNINGS=1
+        $(MAKE) cycle RTLOPT="$(RTLOPT) -n -glttt -CRriot -dEXTDEBUG" LOCALOPT="$(LOCALOPT) -n -glttt -CRriot -dEXTDEBUG" ALLOW_WARNINGS=1
+
+extoptcycle:
+        $(MAKE) cycle RTLOPT="$(RTLOPT) -n -glttt -CRriot -dEXTDEBUG -dDEBUG_ALL_OPT" LOCALOPT="$(LOCALOPT) -n -glttt -CRriot -dEXTDEBUG -dDEBUG_ALL_OPT" ALLOW_WARNINGS=1
 
 
 cvstest:
 cvstest:
         $(MAKE) cycle 'LOCALOPT=-n -Se' 'RTLOPT=-n -Se'
         $(MAKE) cycle 'LOCALOPT=-n -Se' 'RTLOPT=-n -Se'

+ 10 - 1
compiler/aarch64/racpugas.pas

@@ -556,6 +556,10 @@ Unit racpugas;
 
 
 
 
     function taarch64attreader.ToConditionCode(const hs: string; is_operand: boolean): tasmcond;
     function taarch64attreader.ToConditionCode(const hs: string; is_operand: boolean): tasmcond;
+{$push}{$j-}
+      const
+        extracond2str: array[C_HS..C_LO] of string[2] = ('CS','CC');
+{$pop}
       begin
       begin
         case actopcode of
         case actopcode of
           A_CSEL,A_CSINC,A_CSINV,A_CSNEG,A_CSET,A_CSETM,
           A_CSEL,A_CSINC,A_CSINV,A_CSNEG,A_CSET,A_CSETM,
@@ -568,11 +572,16 @@ Unit racpugas;
                 begin
                 begin
                   { workaround for DFA bug }
                   { workaround for DFA bug }
                   result:=low(tasmcond);
                   result:=low(tasmcond);
-                  for result:=low(tasmcond) to high(tasmcond) do
+                  for result:=low(uppercond2str) to high(uppercond2str) do
                     begin
                     begin
                       if hs=uppercond2str[result] then
                       if hs=uppercond2str[result] then
                         exit;
                         exit;
                     end;
                     end;
+                  for result:=low(extracond2str) to high(extracond2str) do
+                    begin
+                      if hs=extracond2str[result] then
+                        exit;
+                    end;
                 end;
                 end;
             end;
             end;
           else
           else

+ 3 - 1
compiler/aasmcnst.pas

@@ -1584,7 +1584,9 @@ implementation
 
 
    class function ttai_typedconstbuilder.is_smartlink_vectorized_dead_strip: boolean;
    class function ttai_typedconstbuilder.is_smartlink_vectorized_dead_strip: boolean;
      begin
      begin
-       result:=tf_smartlink_sections in target_info.flags;
+       result:=(tf_smartlink_sections in target_info.flags) and
+               (not(target_info.system in systems_darwin) or
+                (tf_supports_symbolorderfile in target_info.flags));
      end;
      end;
 
 
 
 

+ 8 - 7
compiler/cgexcept.pas

@@ -129,12 +129,13 @@ unit cgexcept;
        be modified, all temps should be allocated on the heap instead of the
        be modified, all temps should be allocated on the heap instead of the
        stack. }
        stack. }
 
 
-
     class procedure tcgexceptionstatehandler.get_exception_temps(list:TAsmList;var t:texceptiontemps);
     class procedure tcgexceptionstatehandler.get_exception_temps(list:TAsmList;var t:texceptiontemps);
-     begin
+      begin
+        if not assigned(exceptionreasontype) then
+          exceptionreasontype:=search_system_proc('fpc_setjmp').returndef;
         tg.gethltemp(list,rec_exceptaddr,rec_exceptaddr.size,tt_persistent,t.envbuf);
         tg.gethltemp(list,rec_exceptaddr,rec_exceptaddr.size,tt_persistent,t.envbuf);
         tg.gethltemp(list,rec_jmp_buf,rec_jmp_buf.size,tt_persistent,t.jmpbuf);
         tg.gethltemp(list,rec_jmp_buf,rec_jmp_buf.size,tt_persistent,t.jmpbuf);
-        tg.gethltemp(list,ossinttype,ossinttype.size,tt_persistent,t.reasonbuf);
+        tg.gethltemp(list,exceptionreasontype,exceptionreasontype.size,tt_persistent,t.reasonbuf);
       end;
       end;
 
 
 
 
@@ -207,7 +208,7 @@ unit cgexcept;
         location_reset(tmpresloc,LOC_REGISTER,def_cgsize(setjmpres.def));
         location_reset(tmpresloc,LOC_REGISTER,def_cgsize(setjmpres.def));
         tmpresloc.register:=hlcg.getintregister(list,setjmpres.def);
         tmpresloc.register:=hlcg.getintregister(list,setjmpres.def);
         hlcg.gen_load_cgpara_loc(list,setjmpres.def,setjmpres,tmpresloc,true);
         hlcg.gen_load_cgpara_loc(list,setjmpres.def,setjmpres,tmpresloc,true);
-        hlcg.g_exception_reason_save(list,setjmpres.def,ossinttype,tmpresloc.register,t.reasonbuf);
+        hlcg.g_exception_reason_save(list,setjmpres.def,exceptionreasontype,tmpresloc.register,t.reasonbuf);
         { if we get 1 here in the function result register, it means that we
         { if we get 1 here in the function result register, it means that we
           longjmp'd back here }
           longjmp'd back here }
         hlcg.a_cmp_const_reg_label(list,setjmpres.def,OC_NE,0,tmpresloc.register,exceptstate.exceptionlabel);
         hlcg.a_cmp_const_reg_label(list,setjmpres.def,OC_NE,0,tmpresloc.register,exceptstate.exceptionlabel);
@@ -237,9 +238,9 @@ unit cgexcept;
          popaddrstack(list);
          popaddrstack(list);
          if not onlyfree then
          if not onlyfree then
           begin
           begin
-            reasonreg:=hlcg.getintregister(list,osuinttype);
-            hlcg.g_exception_reason_load(list,osuinttype,osuinttype,t.reasonbuf,reasonreg);
-            hlcg.a_cmp_const_reg_label(list,osuinttype,OC_EQ,a,reasonreg,endexceptlabel);
+            reasonreg:=hlcg.getintregister(list,exceptionreasontype);
+            hlcg.g_exception_reason_load(list,exceptionreasontype,exceptionreasontype,t.reasonbuf,reasonreg);
+            hlcg.a_cmp_const_reg_label(list,exceptionreasontype,OC_EQ,a,reasonreg,endexceptlabel);
           end;
           end;
       end;
       end;
 
 

+ 4 - 3
compiler/cutils.pas

@@ -1298,9 +1298,10 @@ implementation
           { if one of the two is at the end while the other isn't, add a '.0' }
           { if one of the two is at the end while the other isn't, add a '.0' }
           if (i1>length(s1)) and
           if (i1>length(s1)) and
              (i2<=length(s2)) then
              (i2<=length(s2)) then
-            s1:=s1+'.0'
-          else if i2>length(s2) then
-            s2:=s2+'.0';
+            s1:=s1+'.0';
+          if (i2>length(s2)) and
+             (i1<=length(s1)) then
+             s2:=s2+'.0';
           { compare non-numerical characters normally }
           { compare non-numerical characters normally }
           while (i1<=length(s1)) and
           while (i1<=length(s1)) and
                 not(s1[i1] in ['0'..'9']) and
                 not(s1[i1] in ['0'..'9']) and

+ 6 - 0
compiler/dbgdwarf.pas

@@ -4540,6 +4540,12 @@ implementation
 
 
       begin
       begin
         case def.objecttype of
         case def.objecttype of
+          odt_objcclass,
+          odt_objcprotocol:
+            begin
+              inherited;
+              exit
+            end;
           odt_cppclass,
           odt_cppclass,
           odt_object:
           odt_object:
             begin
             begin

+ 10 - 2
compiler/defutil.pas

@@ -149,6 +149,9 @@ interface
     {# Returns true, if p points to an array of const }
     {# Returns true, if p points to an array of const }
     function is_array_of_const(p : tdef) : boolean;
     function is_array_of_const(p : tdef) : boolean;
 
 
+    {# Returns true if p is an arraydef that describes a constant string }
+    function is_conststring_array(p : tdef) : boolean;
+
     {# Returns true, if p points any kind of special array
     {# Returns true, if p points any kind of special array
 
 
        That is if the array is an open array, a variant
        That is if the array is an open array, a variant
@@ -796,8 +799,7 @@ implementation
            range is also -1 ! (PFV) }
            range is also -1 ! (PFV) }
          result:=(p.typ=arraydef) and
          result:=(p.typ=arraydef) and
                  (tarraydef(p).rangedef=sizesinttype) and
                  (tarraydef(p).rangedef=sizesinttype) and
-                 (tarraydef(p).lowrange=0) and
-                 (tarraydef(p).highrange=-1) and
+                 (ado_OpenArray in tarraydef(p).arrayoptions) and
                  ((tarraydef(p).arrayoptions * [ado_IsVariant,ado_IsArrayOfConst,ado_IsConstructor,ado_IsDynamicArray])=[]);
                  ((tarraydef(p).arrayoptions * [ado_IsVariant,ado_IsArrayOfConst,ado_IsConstructor,ado_IsDynamicArray])=[]);
       end;
       end;
 
 
@@ -822,6 +824,12 @@ implementation
                  (ado_IsArrayOfConst in tarraydef(p).arrayoptions);
                  (ado_IsArrayOfConst in tarraydef(p).arrayoptions);
       end;
       end;
 
 
+    function is_conststring_array(p: tdef): boolean;
+      begin
+        result:=(p.typ=arraydef) and
+                (ado_IsConstString in tarraydef(p).arrayoptions);
+      end;
+
     { true, if p points to a special array, bitpacked arrays aren't special in this regard though }
     { true, if p points to a special array, bitpacked arrays aren't special in this regard though }
     function is_special_array(p : tdef) : boolean;
     function is_special_array(p : tdef) : boolean;
       begin
       begin

+ 1 - 1
compiler/i386/n386add.pas

@@ -486,13 +486,13 @@ interface
         begin
         begin
           cg.getcpuregister(current_asmdata.CurrAsmList,NR_EDX);
           cg.getcpuregister(current_asmdata.CurrAsmList,NR_EDX);
           hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,right.resultdef,osuinttype,right.location,NR_EDX);
           hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,right.resultdef,osuinttype,right.location,NR_EDX);
-          cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EDX);
           reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
           reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
           reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
           reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
           if use_ref then
           if use_ref then
             current_asmdata.CurrAsmList.concat(Taicpu.Op_ref_reg_reg(A_MULX,S_L,ref,reglo,reghi))
             current_asmdata.CurrAsmList.concat(Taicpu.Op_ref_reg_reg(A_MULX,S_L,ref,reglo,reghi))
           else
           else
             emit_reg_reg_reg(A_MULX,S_L,reg,reglo,reghi);
             emit_reg_reg_reg(A_MULX,S_L,reg,reglo,reghi);
+          cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EDX);
 
 
           location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
           location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
           location.register64.reglo:=reglo;
           location.register64.reglo:=reglo;

+ 4 - 0
compiler/jvm/hlcgcpu.pas

@@ -2292,6 +2292,10 @@ implementation
       { a constructor doesn't actually return a value in the jvm }
       { a constructor doesn't actually return a value in the jvm }
       if (tabstractprocdef(pd).proctypeoption=potype_constructor) then
       if (tabstractprocdef(pd).proctypeoption=potype_constructor) then
         totalremovesize:=paraheight
         totalremovesize:=paraheight
+      else if jvmimplicitpointertype(realresdef) then
+        totalremovesize:=paraheight-1
+      else if is_void(realresdef) then
+        totalremovesize:=paraheight
       else
       else
         { even a byte takes up a full stackslot -> align size to multiple of 4 }
         { even a byte takes up a full stackslot -> align size to multiple of 4 }
         totalremovesize:=paraheight-(align(realresdef.size,4) shr 2);
         totalremovesize:=paraheight-(align(realresdef.size,4) shr 2);

+ 2 - 1
compiler/jvm/jvmdef.pas

@@ -517,7 +517,8 @@ implementation
             result:=(tarraydef(def).highrange>=tarraydef(def).lowrange) or
             result:=(tarraydef(def).highrange>=tarraydef(def).lowrange) or
                 is_open_array(def) or
                 is_open_array(def) or
                 is_array_of_const(def) or
                 is_array_of_const(def) or
-                is_array_constructor(def);
+                is_array_constructor(def) or
+                is_conststring_array(def);
           filedef,
           filedef,
           recorddef,
           recorddef,
           setdef:
           setdef:

+ 2 - 0
compiler/llvm/llvmpi.pas

@@ -88,6 +88,8 @@ implementation
 
 
       class procedure tllvmexceptionstatehandler.get_exception_temps(list: TAsmList; var t: texceptiontemps);
       class procedure tllvmexceptionstatehandler.get_exception_temps(list: TAsmList; var t: texceptiontemps);
         begin
         begin
+          if not assigned(exceptionreasontype) then
+            exceptionreasontype:=ossinttype;
           tg.gethltemp(list,ossinttype,ossinttype.size,tt_persistent,t.reasonbuf);
           tg.gethltemp(list,ossinttype,ossinttype.size,tt_persistent,t.reasonbuf);
         end;
         end;
 
 

+ 10 - 14
compiler/m68k/n68kmem.pas

@@ -35,7 +35,6 @@ interface
        t68kvecnode = class(tcgvecnode)
        t68kvecnode = class(tcgvecnode)
           procedure update_reference_reg_mul(maybe_const_reg: tregister; regsize: tdef; l: aint); override;
           procedure update_reference_reg_mul(maybe_const_reg: tregister; regsize: tdef; l: aint); override;
           procedure update_reference_reg_packed(maybe_const_reg: tregister; regsize: tdef; l:aint); override;
           procedure update_reference_reg_packed(maybe_const_reg: tregister; regsize: tdef; l:aint); override;
-          function valid_index_size(size: tcgsize): boolean; override;
           //procedure pass_generate_code;override;
           //procedure pass_generate_code;override;
        end;
        end;
 
 
@@ -55,14 +54,6 @@ implementation
                              T68KVECNODE
                              T68KVECNODE
 *****************************************************************************}
 *****************************************************************************}
 
 
-     function t68kvecnode.valid_index_size(size: tcgsize): boolean;
-       begin
-         if (CPUM68K_HAS_INDEXWORD in cpu_capabilities[current_settings.cputype]) then
-           result:=tcgsize2signed[size] in [OS_S16,OS_S32]
-         else
-           result:=inherited;
-       end;
-
     { this routine must, like any other routine, not change the contents }
     { this routine must, like any other routine, not change the contents }
     { of base/index registers of references, as these may be regvars.    }
     { of base/index registers of references, as these may be regvars.    }
     { The register allocator can coalesce one LOC_REGISTER being moved   }
     { The register allocator can coalesce one LOC_REGISTER being moved   }
@@ -75,8 +66,11 @@ implementation
       var
       var
         hreg: tregister;
         hreg: tregister;
         scaled: boolean;
         scaled: boolean;
+        regcgsize: tcgsize;
       begin
       begin
         scaled:=false;
         scaled:=false;
+        regcgsize:=def_cgsize(regsize);
+
         //current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('updref: called')));
         //current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('updref: called')));
         if l<>1 then
         if l<>1 then
           begin
           begin
@@ -86,8 +80,10 @@ implementation
                ((CPUM68K_HAS_INDEXSCALE8 in cpu_capabilities[current_settings.cputype]) and (l in [2,4,8]))) then
                ((CPUM68K_HAS_INDEXSCALE8 in cpu_capabilities[current_settings.cputype]) and (l in [2,4,8]))) then
               begin
               begin
                 //current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('updref: mul')));
                 //current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('updref: mul')));
-                hreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_S32);
-                cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_IMUL,def_cgsize(regsize),l,maybe_const_reg,hreg);
+                hreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR);
+                cg.a_load_reg_reg(current_asmdata.CurrAsmList,regcgsize,OS_ADDR,maybe_const_reg,hreg);
+                cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_IMUL,OS_ADDR,l,hreg);
+                regcgsize:=OS_ADDR;
                 maybe_const_reg:=hreg;
                 maybe_const_reg:=hreg;
               end
               end
             else
             else
@@ -104,7 +100,7 @@ implementation
               begin
               begin
                 //current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('updref: copytoa')));
                 //current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('updref: copytoa')));
                 hreg:=cg.getaddressregister(current_asmdata.CurrAsmList);
                 hreg:=cg.getaddressregister(current_asmdata.CurrAsmList);
-                cg.a_load_reg_reg(current_asmdata.CurrAsmList,def_cgsize(regsize),OS_ADDR,maybe_const_reg,hreg);
+                cg.a_load_reg_reg(current_asmdata.CurrAsmList,regcgsize,OS_ADDR,maybe_const_reg,hreg);
                 maybe_const_reg:=hreg;
                 maybe_const_reg:=hreg;
               end;
               end;
             location.reference.base:=maybe_const_reg;
             location.reference.base:=maybe_const_reg;
@@ -118,13 +114,13 @@ implementation
                 cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,location.reference,hreg);
                 cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,location.reference,hreg);
                 reference_reset_base(location.reference,hreg,0,location.reference.temppos,location.reference.alignment,location.reference.volatility);
                 reference_reset_base(location.reference,hreg,0,location.reference.temppos,location.reference.alignment,location.reference.volatility);
               end;
               end;
-            if def_cgsize(regsize) in [OS_8,OS_16] then
+            if regcgsize in [OS_8,OS_16] then
               begin
               begin
                 { index registers are always sign extended on m68k, so we have to zero extend by hand,
                 { index registers are always sign extended on m68k, so we have to zero extend by hand,
                   if the index variable is unsigned, and its width is less than the whole register }
                   if the index variable is unsigned, and its width is less than the whole register }
                 //current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('updref: index zero extend')));
                 //current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('updref: index zero extend')));
                 hreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR);
                 hreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR);
-                cg.a_load_reg_reg(current_asmdata.CurrAsmList,def_cgsize(regsize),OS_ADDR,maybe_const_reg,hreg);
+                cg.a_load_reg_reg(current_asmdata.CurrAsmList,regcgsize,OS_ADDR,maybe_const_reg,hreg);
                 maybe_const_reg:=hreg;
                 maybe_const_reg:=hreg;
               end;
               end;
             { insert new index register }
             { insert new index register }

+ 41 - 1
compiler/nadd.pas

@@ -489,6 +489,20 @@ implementation
         end;
         end;
 
 
 
 
+      function IsAndOrAndNot(n1,n2,n3,n4 : tnode): Boolean;
+        begin
+          result:=(n4.nodetype=notn) and
+            tnotnode(n4).left.isequal(n2);
+        end;
+
+
+      function TransformAndOrAndNot(n1,n2,n3,n4 : tnode): tnode;
+        begin
+          result:=caddnode.create_internal(xorn,n3.getcopy,
+            caddnode.create_internal(andn,caddnode.create_internal(xorn,n3.getcopy,n1.getcopy),n2.getcopy));
+        end;
+
+
       function SwapRightWithLeftRight : tnode;
       function SwapRightWithLeftRight : tnode;
         var
         var
           hp : tnode;
           hp : tnode;
@@ -1689,6 +1703,28 @@ implementation
                    end;
                    end;
               end;
               end;
 {$endif cpurox}
 {$endif cpurox}
+            { optimize
+
+                (a and b) or (c and not(b))
+
+                into
+
+                c xor ((c xor a) and b)
+            }
+            if (nodetype=orn) and
+             (left.resultdef.typ=orddef) and
+             (left.nodetype=andn) and
+             (right.nodetype=andn) and
+             { this test is not needed but it speeds up the test and allows to bail out early }
+             ((taddnode(left).left.nodetype=notn) or (taddnode(left).right.nodetype=notn) or
+              (taddnode(right).left.nodetype=notn) or (taddnode(right).right.nodetype=notn)
+             ) and
+             not(might_have_sideeffects(self)) then
+             begin
+               if MatchAndTransformNodesCommutative(taddnode(left).left,taddnode(left).right,taddnode(right).left,taddnode(right).right,
+                 @IsAndOrAndNot,@TransformAndOrAndNot,Result) then
+                 exit;
+             end;
           end;
           end;
       end;
       end;
 
 
@@ -1939,7 +1975,11 @@ implementation
               not(tfloatdef(left.resultdef).floattype in [s64comp,s64currency]) then
               not(tfloatdef(left.resultdef).floattype in [s64comp,s64currency]) then
              begin
              begin
                if cs_excessprecision in current_settings.localswitches then
                if cs_excessprecision in current_settings.localswitches then
-                 resultrealdef:=pbestrealtype^
+                 begin
+                   resultrealdef:=pbestrealtype^;
+                   inserttypeconv(right,resultrealdef);
+                   inserttypeconv(left,resultrealdef);
+                 end
                else
                else
                  resultrealdef:=left.resultdef
                  resultrealdef:=left.resultdef
              end
              end

+ 12 - 12
compiler/ncgflw.pas

@@ -547,7 +547,7 @@ implementation
           { we must also destroy the address frame which guards
           { we must also destroy the address frame which guards
             the exception object }
             the exception object }
           cexceptionstatehandler.popaddrstack(list);
           cexceptionstatehandler.popaddrstack(list);
-          hlcg.g_exception_reason_discard(list,osuinttype,excepttemps.reasonbuf);
+          hlcg.g_exception_reason_discard(list,exceptionreasontype,excepttemps.reasonbuf);
           if frametype=ft_except then
           if frametype=ft_except then
             begin
             begin
               cexceptionstatehandler.cleanupobjectstack(list);
               cexceptionstatehandler.cleanupobjectstack(list);
@@ -880,8 +880,8 @@ implementation
     procedure tcgtryfinallynode.emit_jump_out_of_try_finally_frame(list: TasmList; const reason: byte; const finallycodelabel: tasmlabel; var excepttemps: tcgexceptionstatehandler.texceptiontemps; framelabel: tasmlabel);
     procedure tcgtryfinallynode.emit_jump_out_of_try_finally_frame(list: TasmList; const reason: byte; const finallycodelabel: tasmlabel; var excepttemps: tcgexceptionstatehandler.texceptiontemps; framelabel: tasmlabel);
       begin
       begin
          hlcg.a_label(list,framelabel);
          hlcg.a_label(list,framelabel);
-         hlcg.g_exception_reason_discard(list,osuinttype,excepttemps.reasonbuf);
-         hlcg.g_exception_reason_save_const(list,osuinttype,reason,excepttemps.reasonbuf);
+         hlcg.g_exception_reason_discard(list,exceptionreasontype,excepttemps.reasonbuf);
+         hlcg.g_exception_reason_save_const(list,exceptionreasontype,reason,excepttemps.reasonbuf);
          hlcg.a_jmp_always(list,finallycodelabel);
          hlcg.a_jmp_always(list,finallycodelabel);
       end;
       end;
 
 
@@ -941,13 +941,13 @@ implementation
         procedure handle_breakcontinueexit(const finallycode: tasmlabel; doreraise: boolean);
         procedure handle_breakcontinueexit(const finallycode: tasmlabel; doreraise: boolean);
           begin
           begin
             { no exception happened, but maybe break/continue/exit }
             { no exception happened, but maybe break/continue/exit }
-            hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,0,reasonreg,endfinallylabel);
+            hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,exceptionreasontype,OC_EQ,0,reasonreg,endfinallylabel);
             if fc_exit in finallyexceptionstate.newflowcontrol then
             if fc_exit in finallyexceptionstate.newflowcontrol then
-              hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,2,reasonreg,oldCurrExitLabel);
+              hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,exceptionreasontype,OC_EQ,2,reasonreg,oldCurrExitLabel);
             if fc_break in finallyexceptionstate.newflowcontrol then
             if fc_break in finallyexceptionstate.newflowcontrol then
-              hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,3,reasonreg,oldBreakLabel);
+              hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,exceptionreasontype,OC_EQ,3,reasonreg,oldBreakLabel);
             if fc_continue in finallyexceptionstate.newflowcontrol then
             if fc_continue in finallyexceptionstate.newflowcontrol then
-              hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,4,reasonreg,oldContinueLabel);
+              hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,exceptionreasontype,OC_EQ,4,reasonreg,oldContinueLabel);
             if doreraise then
             if doreraise then
               cexceptionstatehandler.handle_reraise(current_asmdata.CurrAsmList,excepttemps,finallyexceptionstate,tek_normalfinally)
               cexceptionstatehandler.handle_reraise(current_asmdata.CurrAsmList,excepttemps,finallyexceptionstate,tek_normalfinally)
             else
             else
@@ -1024,8 +1024,8 @@ implementation
                exit;
                exit;
              if not implicitframe then
              if not implicitframe then
                current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
                current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
-             reasonreg:=hlcg.getintregister(current_asmdata.CurrAsmList,osuinttype);
-             hlcg.g_exception_reason_load(current_asmdata.CurrAsmList,osuinttype,osuinttype,excepttemps.reasonbuf,reasonreg);
+             reasonreg:=hlcg.getintregister(current_asmdata.CurrAsmList,exceptionreasontype);
+             hlcg.g_exception_reason_load(current_asmdata.CurrAsmList,exceptionreasontype,exceptionreasontype,excepttemps.reasonbuf,reasonreg);
              handle_breakcontinueexit(finallyNoExceptionLabel,false);
              handle_breakcontinueexit(finallyNoExceptionLabel,false);
 
 
              current_asmdata.CurrAsmList.concatList(tmplist);
              current_asmdata.CurrAsmList.concatList(tmplist);
@@ -1063,11 +1063,11 @@ implementation
          if not assigned(third) then
          if not assigned(third) then
            begin
            begin
              { the value should now be in the exception handler }
              { the value should now be in the exception handler }
-             reasonreg:=hlcg.getintregister(current_asmdata.CurrAsmList,osuinttype);
-             hlcg.g_exception_reason_load(current_asmdata.CurrAsmList,osuinttype,osuinttype,excepttemps.reasonbuf,reasonreg);
+             reasonreg:=hlcg.getintregister(current_asmdata.CurrAsmList,exceptionreasontype);
+             hlcg.g_exception_reason_load(current_asmdata.CurrAsmList,exceptionreasontype,exceptionreasontype,excepttemps.reasonbuf,reasonreg);
              if implicitframe then
              if implicitframe then
                begin
                begin
-                 hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,0,reasonreg,endfinallylabel);
+                 hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,exceptionreasontype,OC_EQ,0,reasonreg,endfinallylabel);
                  { finally code only needed to be executed on exception (-> in
                  { finally code only needed to be executed on exception (-> in
                    if-branch -> fc_inflowcontrol) }
                    if-branch -> fc_inflowcontrol) }
                  if current_procinfo.procdef.generate_safecall_wrapper then
                  if current_procinfo.procdef.generate_safecall_wrapper then

+ 9 - 5
compiler/ncginl.pas

@@ -888,7 +888,8 @@ implementation
             internalerror(2013120110);
             internalerror(2013120110);
         end;
         end;
 
 
-        hlcg.location_force_reg(current_asmdata.CurrAsmList,op1.location,op1.resultdef,resultdef,true);
+        if not(op1.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+          hlcg.location_force_reg(current_asmdata.CurrAsmList,op1.location,op1.resultdef,resultdef,true);
 
 
         location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
         location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
 {$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
 {$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
@@ -920,8 +921,10 @@ implementation
 {$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
 {$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
                  if def_cgsize(resultdef) in [OS_64,OS_S64] then
                  if def_cgsize(resultdef) in [OS_64,OS_S64] then
                    begin
                    begin
-                     hlcg.location_force_reg(current_asmdata.CurrAsmList,op2.location,
-                                             op2.resultdef,alusinttype,true);
+                     if not(op2.location.loc in [LOC_REGISTER,LOC_CREGISTER]) or
+                       not(equal_defs(op2.resultdef,alusinttype)) then
+                       hlcg.location_force_reg(current_asmdata.CurrAsmList,op2.location,
+                                               op2.resultdef,alusinttype,true);
                      cg64.a_op64_reg_reg_reg(current_asmdata.CurrAsmList,op,def_cgsize(resultdef),
                      cg64.a_op64_reg_reg_reg(current_asmdata.CurrAsmList,op,def_cgsize(resultdef),
                                              joinreg64(op2.location.register,NR_NO),op1.location.register64,
                                              joinreg64(op2.location.register,NR_NO),op1.location.register64,
                                              location.register64);
                                              location.register64);
@@ -929,8 +932,9 @@ implementation
                  else
                  else
 {$endif not cpu64bitalu and not cpuhighleveltarget}
 {$endif not cpu64bitalu and not cpuhighleveltarget}
                    begin
                    begin
-                     hlcg.location_force_reg(current_asmdata.CurrAsmList,op2.location,
-                                             op2.resultdef,resultdef,true);
+                     if not(op2.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+                       hlcg.location_force_reg(current_asmdata.CurrAsmList,op2.location,
+                                               op2.resultdef,resultdef,true);
                      hlcg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,op,resultdef,
                      hlcg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,op,resultdef,
                                            op2.location.register,op1.location.register,
                                            op2.location.register,op1.location.register,
                                            location.register);
                                            location.register);

+ 3 - 7
compiler/ncon.pas

@@ -948,20 +948,15 @@ implementation
          dogetcopy:=n;
          dogetcopy:=n;
       end;
       end;
 
 
+
     function tstringconstnode.pass_typecheck:tnode;
     function tstringconstnode.pass_typecheck:tnode;
-      var
-        l : aint;
       begin
       begin
         result:=nil;
         result:=nil;
         case cst_type of
         case cst_type of
           cst_conststring :
           cst_conststring :
             begin
             begin
               { handle and store as array[0..len-1] of char }
               { handle and store as array[0..len-1] of char }
-              if len>0 then
-                l:=len-1
-              else
-                l:=0;
-              resultdef:=carraydef.create(0,l,s32inttype);
+              resultdef:=carraydef.create(0,len-1,s32inttype);
               tarraydef(resultdef).elementdef:=cansichartype;
               tarraydef(resultdef).elementdef:=cansichartype;
               include(tarraydef(resultdef).arrayoptions,ado_IsConstString);
               include(tarraydef(resultdef).arrayoptions,ado_IsConstString);
             end;
             end;
@@ -981,6 +976,7 @@ implementation
         end;
         end;
       end;
       end;
 
 
+
     function tstringconstnode.pass_1 : tnode;
     function tstringconstnode.pass_1 : tnode;
       begin
       begin
         result:=nil;
         result:=nil;

+ 22 - 4
compiler/ngtcon.pas

@@ -328,6 +328,25 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
 {$push}
 {$push}
 {$r-}
 {$r-}
 {$q-}
 {$q-}
+    { to work around broken x86 shifting, while generating bitmask }
+    function getbitmask(len: byte): aword;
+      begin
+        if len >= (sizeof(result) * 8) then
+          result:=0
+        else
+          result:=aword(1) shl len;
+        result:=aword(result-1);
+      end;
+
+    { shift left, and always pad the right bits with zeroes }
+    function shiftleft(value: aword; count: byte): aword;
+      begin
+        if count >= (sizeof(result) * 8) then
+          result:=0
+        else
+          result:=(value shl count) and (not getbitmask(count));
+      end;
+
     { (values between quotes below refer to fields of bp; fields not         }
     { (values between quotes below refer to fields of bp; fields not         }
     {  mentioned are unused by this routine)                                 }
     {  mentioned are unused by this routine)                                 }
     { bitpacks "value" as bitpacked value of bitsize "packedbitsize" into    }
     { bitpacks "value" as bitpacked value of bitsize "packedbitsize" into    }
@@ -342,16 +361,15 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
         if (target_info.endian=endian_big) then
         if (target_info.endian=endian_big) then
           begin
           begin
             { bitpacked format: left-aligned (i.e., "big endian bitness") }
             { bitpacked format: left-aligned (i.e., "big endian bitness") }
-            { work around broken x86 shifting }
-            if (AIntBits<>bp.packedbitsize) and
+            if (bp.packedbitsize<AIntBits) and
                (bp.curbitoffset<AIntBits) then
                (bp.curbitoffset<AIntBits) then
-              bp.curval:=bp.curval or ((value shl (AIntBits-bp.packedbitsize)) shr bp.curbitoffset);
+              bp.curval:=bp.curval or (shiftleft(value,AIntBits-bp.packedbitsize) shr bp.curbitoffset);
             shiftcount:=((AIntBits-bp.packedbitsize)-bp.curbitoffset);
             shiftcount:=((AIntBits-bp.packedbitsize)-bp.curbitoffset);
             { carry-over to the next element? }
             { carry-over to the next element? }
             if (shiftcount<0) then
             if (shiftcount<0) then
               begin
               begin
                 if shiftcount>=-AIntBits then
                 if shiftcount>=-AIntBits then
-                  bp.nextval:=(value and ((aword(1) shl (-shiftcount))-1)) shl
+                  bp.nextval:=(value and getbitmask(-shiftcount)) shl
                               (AIntBits+shiftcount)
                               (AIntBits+shiftcount)
                 else
                 else
                   bp.nextval:=0;
                   bp.nextval:=0;

+ 11 - 3
compiler/nmat.pas

@@ -97,7 +97,7 @@ implementation
       systems,
       systems,
       verbose,globals,cutils,compinnr,
       verbose,globals,cutils,compinnr,
       globtype,constexp,
       globtype,constexp,
-      symconst,symtype,symdef,
+      symconst,symtype,symdef,symcpu,
       defcmp,defutil,
       defcmp,defutil,
       htypechk,pass_1,
       htypechk,pass_1,
       cgbase,
       cgbase,
@@ -966,10 +966,18 @@ implementation
            exit;
            exit;
 
 
          resultdef:=left.resultdef;
          resultdef:=left.resultdef;
-         if (left.resultdef.typ=floatdef) or
-            is_currency(left.resultdef) then
+         if is_currency(left.resultdef) then
            begin
            begin
            end
            end
+         else if left.resultdef.typ=floatdef then
+           begin
+             if not(tfloatdef(left.resultdef).floattype in [s64comp,s64currency]) and
+               (cs_excessprecision in current_settings.localswitches) then
+               begin
+                 inserttypeconv(left,pbestrealtype^);
+                 resultdef:=left.resultdef
+               end;
+           end
 {$ifdef SUPPORT_MMX}
 {$ifdef SUPPORT_MMX}
          else if (cs_mmx in current_settings.localswitches) and
          else if (cs_mmx in current_settings.localswitches) and
            is_mmx_able_array(left.resultdef) then
            is_mmx_able_array(left.resultdef) then

+ 8 - 0
compiler/nset.pas

@@ -250,6 +250,7 @@ implementation
 
 
       begin
       begin
          result:=nil;
          result:=nil;
+
          resultdef:=pasbool1type;
          resultdef:=pasbool1type;
          typecheckpass(right);
          typecheckpass(right);
          set_varstate(right,vs_read,[vsf_must_be_valid]);
          set_varstate(right,vs_read,[vsf_must_be_valid]);
@@ -272,6 +273,13 @@ implementation
          if not assigned(left.resultdef) then
          if not assigned(left.resultdef) then
            internalerror(20021126);
            internalerror(20021126);
 
 
+         { avoid any problems with type parameters later on }
+         if is_typeparam(left.resultdef) or is_typeparam(right.resultdef) then
+           begin
+             resultdef:=cundefinedtype;
+             exit;
+           end;
+
          t:=self;
          t:=self;
          if isbinaryoverloaded(t,[]) then
          if isbinaryoverloaded(t,[]) then
            begin
            begin

+ 36 - 0
compiler/nutils.pas

@@ -186,11 +186,22 @@ interface
     type
     type
       TMatchProc2 = function(n1,n2 : tnode) : Boolean is nested;
       TMatchProc2 = function(n1,n2 : tnode) : Boolean is nested;
       TTransformProc2 = function(n1,n2 : tnode) : tnode is nested;
       TTransformProc2 = function(n1,n2 : tnode) : tnode is nested;
+      TMatchProc4 = function(n1,n2,n3,n4 : tnode) : Boolean is nested;
+      TTransformProc4 = function(n1,n2,n3,n4 : tnode) : tnode is nested;
 
 
     { calls matchproc with n1 and n2 as parameters, if it returns true, transformproc is called, does the same with the nodes swapped,
     { calls matchproc with n1 and n2 as parameters, if it returns true, transformproc is called, does the same with the nodes swapped,
       the result of transformproc is assigned to res }
       the result of transformproc is assigned to res }
     function MatchAndTransformNodesCommutative(n1,n2 : tnode;matchproc : TMatchProc2;transformproc : TTransformProc2;var res : tnode) : Boolean;
     function MatchAndTransformNodesCommutative(n1,n2 : tnode;matchproc : TMatchProc2;transformproc : TTransformProc2;var res : tnode) : Boolean;
 
 
+    { calls matchproc with n1, n2, n3 and n4 as parameters being considered as the leafs of commutative nodes so all 8 possible
+      combinations are tested, if it returns true, transformproc is called,
+      the result of transformproc is assigned to res
+
+      this allows to find pattern like (3*a)+(3*b) and transfrom them into 3*(a+b)
+    }
+    function MatchAndTransformNodesCommutative(n1,n2,n3,n4 : tnode;matchproc : TMatchProc4;transformproc : TTransformProc4;var res : tnode) : Boolean;
+
+
 implementation
 implementation
 
 
     uses
     uses
@@ -1642,4 +1653,29 @@ implementation
           result:=false;
           result:=false;
       end;
       end;
 
 
+
+    function MatchAndTransformNodesCommutative(n1,n2,n3,n4 : tnode;matchproc : TMatchProc4;transformproc : TTransformProc4;var res : tnode) : Boolean;
+      begin
+        res:=nil;
+        result:=true;
+        if matchproc(n1,n2,n3,n4) then
+          res:=transformproc(n1,n2,n3,n4)
+        else if matchproc(n1,n2,n4,n3) then
+          res:=transformproc(n1,n2,n4,n3)
+        else if matchproc(n2,n1,n3,n4) then
+          res:=transformproc(n2,n1,n3,n4)
+        else if matchproc(n2,n1,n4,n3) then
+          res:=transformproc(n2,n1,n4,n3)
+        else if matchproc(n3,n4,n1,n2) then
+          res:=transformproc(n3,n4,n1,n2)
+        else if matchproc(n4,n3,n1,n2) then
+          res:=transformproc(n4,n3,n1,n2)
+        else if matchproc(n3,n4,n2,n1) then
+          res:=transformproc(n3,n4,n2,n1)
+        else if matchproc(n4,n3,n2,n1) then
+          res:=transformproc(n4,n3,n2,n1)
+        else
+          result:=false;
+      end;
+
 end.
 end.

+ 3 - 1
compiler/psabiehpi.pas

@@ -522,7 +522,9 @@ implementation
 
 
     class procedure tpsabiehexceptionstatehandler.get_exception_temps(list: TAsmList; var t: texceptiontemps);
     class procedure tpsabiehexceptionstatehandler.get_exception_temps(list: TAsmList; var t: texceptiontemps);
       begin
       begin
-        tg.gethltemp(list,ossinttype,ossinttype.size,tt_persistent,t.reasonbuf);
+        if not assigned(exceptionreasontype) then
+          exceptionreasontype:=ossinttype;
+        tg.gethltemp(list,exceptionreasontype,exceptionreasontype.size,tt_persistent,t.reasonbuf);
       end;
       end;
 
 
 
 

+ 1 - 0
compiler/pstatmnt.pas

@@ -991,6 +991,7 @@ implementation
                                sym:=clocalvarsym.create('$exceptsym',vs_value,ot,[]);
                                sym:=clocalvarsym.create('$exceptsym',vs_value,ot,[]);
                             end;
                             end;
                           excepTSymtable:=tstt_excepTSymtable.create;
                           excepTSymtable:=tstt_excepTSymtable.create;
+                          excepTSymtable.defowner:=current_procinfo.procdef;
                           excepTSymtable.insert(sym);
                           excepTSymtable.insert(sym);
                           symtablestack.push(excepTSymtable);
                           symtablestack.push(excepTSymtable);
                        end
                        end

+ 1 - 1
compiler/psub.pas

@@ -466,7 +466,7 @@ implementation
               cifnode.create(caddnode.create(equaln,
               cifnode.create(caddnode.create(equaln,
                 ccallnode.createintern('fpc_setjmp',
                 ccallnode.createintern('fpc_setjmp',
                   ccallparanode.create(cloadnode.create(tlabelsym(p).jumpbuf,tlabelsym(p).jumpbuf.owner),nil)),
                   ccallparanode.create(cloadnode.create(tlabelsym(p).jumpbuf,tlabelsym(p).jumpbuf.owner),nil)),
-                cordconstnode.create(1,sinttype,true))
+                cordconstnode.create(1,search_system_proc('fpc_setjmp').returndef,true))
               ,cgotonode.create(tlabelsym(p)),nil)
               ,cgotonode.create(tlabelsym(p)),nil)
             );
             );
           end;
           end;

+ 3 - 1
compiler/symconst.pas

@@ -574,7 +574,9 @@ type
     ado_IsConstString,      // string constant
     ado_IsConstString,      // string constant
     ado_IsBitPacked,        // bitpacked array
     ado_IsBitPacked,        // bitpacked array
     ado_IsVector,           // Vector
     ado_IsVector,           // Vector
-    ado_IsGeneric           // the index of the array is generic (meaning that the size is not yet known)
+    ado_IsGeneric,          // the index of the array is generic (meaning that the size is not yet known)
+    ado_OpenArray           // open array, replaces the old hack with high being -1 for an open array:
+                            // this is still true, but this flag is set as well
   );
   );
   tarraydefoptions=set of tarraydefoption;
   tarraydefoptions=set of tarraydefoption;
 
 

+ 13 - 5
compiler/symdef.pas

@@ -1213,7 +1213,10 @@ interface
        { several types to simulate more or less C++ objects for GDB }
        { several types to simulate more or less C++ objects for GDB }
        vmttype,
        vmttype,
        vmtarraytype,
        vmtarraytype,
-       pvmttype      : tdef;     { type of classrefs, used for stabs }
+       { type of classrefs, used for stabs }
+       pvmttype,
+       { return type of the setjmp function }
+       exceptionreasontype      : tdef;
 
 
        { pointer to the anchestor of all classes }
        { pointer to the anchestor of all classes }
        class_tobject : tobjectdef;
        class_tobject : tobjectdef;
@@ -4154,6 +4157,7 @@ implementation
          symtable:=tarraysymtable.create(self);
          symtable:=tarraysymtable.create(self);
       end;
       end;
 
 
+
     constructor tarraydef.create_vector(l ,h: asizeint; def: tdef);
     constructor tarraydef.create_vector(l ,h: asizeint; def: tdef);
       begin
       begin
         self.create(l,h,def);
         self.create(l,h,def);
@@ -4163,7 +4167,8 @@ implementation
 
 
     constructor tarraydef.create_openarray;
     constructor tarraydef.create_openarray;
       begin
       begin
-        self.create(0,-1,sizesinttype)
+        self.create(0,-1,sizesinttype);
+        include(arrayoptions,ado_OpenArray);
       end;
       end;
 
 
 
 
@@ -4367,7 +4372,7 @@ implementation
           end;
           end;
 
 
         { Tarraydef.size may never be called for an open array! }
         { Tarraydef.size may never be called for an open array! }
-        if (highrange=-1) and (lowrange=0) then
+        if ado_OpenArray in arrayoptions then
           internalerror(99080501);
           internalerror(99080501);
         if not (ado_IsBitPacked in arrayoptions) then
         if not (ado_IsBitPacked in arrayoptions) then
           cachedelesize:=elesize
           cachedelesize:=elesize
@@ -4383,7 +4388,10 @@ implementation
 
 
         if (cachedelecount = 0) then
         if (cachedelecount = 0) then
           begin
           begin
-            size := -1;
+            if ado_isconststring in arrayoptions then
+              size := 0
+            else
+              size := -1;
             exit;
             exit;
           end;
           end;
 
 
@@ -4472,7 +4480,7 @@ implementation
            end
            end
          else if (ado_IsDynamicArray in arrayoptions) then
          else if (ado_IsDynamicArray in arrayoptions) then
            GetTypeName:='{Dynamic} Array Of '+elementdef.typename
            GetTypeName:='{Dynamic} Array Of '+elementdef.typename
-         else if ((highrange=-1) and (lowrange=0)) then
+         else if (ado_OpenArray in arrayoptions) then
            GetTypeName:='{Open} Array Of '+elementdef.typename
            GetTypeName:='{Open} Array Of '+elementdef.typename
          else
          else
            begin
            begin

+ 3 - 3
compiler/systems/i_darwin.pas

@@ -194,7 +194,7 @@ const
         name         : 'Darwin/iPhoneSim for i386';
         name         : 'Darwin/iPhoneSim for i386';
         shortname    : 'iPhoneSim';
         shortname    : 'iPhoneSim';
         flags        : [tf_p_ext_support,tf_files_case_sensitive,tf_smartlink_sections,tf_dwarf_relative_addresses,tf_dwarf_only_local_labels,
         flags        : [tf_p_ext_support,tf_files_case_sensitive,tf_smartlink_sections,tf_dwarf_relative_addresses,tf_dwarf_only_local_labels,
-                        tf_pic_uses_got,tf_pic_default,tf_has_winlike_resources,tf_use_hlcfi,tf_supports_hidden_symbols];
+                        tf_pic_uses_got,tf_pic_default,tf_has_winlike_resources,tf_use_hlcfi,tf_supports_symbolorderfile,tf_supports_hidden_symbols];
         cpu          : cpu_i386;
         cpu          : cpu_i386;
         unit_env     : 'BSDUNITS';
         unit_env     : 'BSDUNITS';
         extradefines : 'UNIX;BSD;HASUNIX;DARWIN'; // also define darwin for code compatibility
         extradefines : 'UNIX;BSD;HASUNIX;DARWIN'; // also define darwin for code compatibility
@@ -263,7 +263,7 @@ const
         name         : 'Darwin for PowerPC64';
         name         : 'Darwin for PowerPC64';
         shortname    : 'Darwin';
         shortname    : 'Darwin';
         flags        : [tf_p_ext_support,tf_files_case_sensitive,tf_smartlink_sections,tf_dwarf_relative_addresses,tf_dwarf_only_local_labels,
         flags        : [tf_p_ext_support,tf_files_case_sensitive,tf_smartlink_sections,tf_dwarf_relative_addresses,tf_dwarf_only_local_labels,
-                        tf_pic_default,tf_has_winlike_resources,tf_supports_symbolorderfile,tf_supports_hidden_symbols];
+                        tf_pic_default,tf_has_winlike_resources,tf_supports_hidden_symbols];
         cpu          : cpu_powerpc64;
         cpu          : cpu_powerpc64;
         unit_env     : 'BSDUNITS';
         unit_env     : 'BSDUNITS';
         extradefines : 'UNIX;BSD;HASUNIX';
         extradefines : 'UNIX;BSD;HASUNIX';
@@ -400,7 +400,7 @@ const
         name         : 'Darwin/iPhoneSim for x86_64';
         name         : 'Darwin/iPhoneSim for x86_64';
         shortname    : 'iPhoneSim';
         shortname    : 'iPhoneSim';
         flags        : [tf_p_ext_support,tf_files_case_sensitive,tf_smartlink_sections,tf_dwarf_relative_addresses,tf_dwarf_only_local_labels,
         flags        : [tf_p_ext_support,tf_files_case_sensitive,tf_smartlink_sections,tf_dwarf_relative_addresses,tf_dwarf_only_local_labels,
-                        tf_pic_default,tf_has_winlike_resources,tf_use_hlcfi,tf_supports_hidden_symbols];
+                        tf_pic_default,tf_has_winlike_resources,tf_use_hlcfi,tf_supports_symbolorderfile,tf_supports_hidden_symbols];
         cpu          : cpu_x86_64;
         cpu          : cpu_x86_64;
         unit_env     : 'BSDUNITS';
         unit_env     : 'BSDUNITS';
         extradefines : 'UNIX;BSD;HASUNIX;DARWIN'; // also define darwin for code compatibility
         extradefines : 'UNIX;BSD;HASUNIX;DARWIN'; // also define darwin for code compatibility

+ 5 - 5
compiler/systems/i_linux.pas

@@ -227,17 +227,17 @@ unit i_linux;
                 coalescealign   : 0;
                 coalescealign   : 0;
                 coalescealignskipmax: 0;
                 coalescealignskipmax: 0;
                 constalignmin   : 0;
                 constalignmin   : 0;
-                constalignmax   : 4;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmin     : 0;
-                varalignmax     : 4;
+                varalignmax     : 16;
                 localalignmin   : 4;
                 localalignmin   : 4;
-                localalignmax   : 4;
+                localalignmax   : 8;
                 recordalignmin  : 0;
                 recordalignmin  : 0;
-                recordalignmax  : 4;
+                recordalignmax  : 16;
                 maxCrecordalign : 2;
                 maxCrecordalign : 2;
               );
               );
             first_parm_offset : 8;
             first_parm_offset : 8;
-            stacksize    : 32*1024*1024;
+            stacksize    : 8*1024*1024;
             stackalign   : 4;
             stackalign   : 4;
             abi : abi_default;
             abi : abi_default;
             llvmdatalayout : 'todo';
             llvmdatalayout : 'todo';

+ 2 - 1
compiler/utils/ppuutils/ppudump.pp

@@ -3286,7 +3286,8 @@ const
    { ado_IsConstString      } 'ConstString',
    { ado_IsConstString      } 'ConstString',
    { ado_IsBitPacked        } 'BitPacked',
    { ado_IsBitPacked        } 'BitPacked',
    { ado_IsVector           } 'Vector',
    { ado_IsVector           } 'Vector',
-   { ado_IsGeneric          } 'Generic'
+   { ado_IsGeneric          } 'Generic',
+   { ado_OpenArray          } 'OpenArray'
   );
   );
 var
 var
   symoptions: tarraydefoptions;
   symoptions: tarraydefoptions;

+ 247 - 112
compiler/x86/aoptx86.pas

@@ -3360,67 +3360,168 @@ unit aoptx86;
         if (taicpu(p).oper[1]^.reg <> NR_STACK_POINTER_REG) and
         if (taicpu(p).oper[1]^.reg <> NR_STACK_POINTER_REG) and
           GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[1]^.reg) then
           GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[1]^.reg) then
           begin
           begin
-            { changes
-                lea offset1(regX), reg1
-                lea offset2(reg1), reg1
-                to
-                lea offset1+offset2(regX), reg1 }
-
+            { Check common LEA/LEA conditions }
             if MatchInstruction(hp1,A_LEA,[taicpu(p).opsize]) and
             if MatchInstruction(hp1,A_LEA,[taicpu(p).opsize]) and
-              MatchOperand(taicpu(p).oper[1]^,taicpu(hp1).oper[1]^) and
-              (taicpu(p).oper[0]^.ref^.relsymbol=nil) and
-              (taicpu(p).oper[0]^.ref^.segment=NR_NO) and
-              (taicpu(p).oper[0]^.ref^.symbol=nil) and
-              (((taicpu(hp1).oper[0]^.ref^.base=taicpu(p).oper[1]^.reg) and
-                (taicpu(p).oper[0]^.ref^.scalefactor <= 1) and
-                (taicpu(p).oper[0]^.ref^.index=NR_NO) and
-                (taicpu(p).oper[0]^.ref^.index=taicpu(hp1).oper[0]^.ref^.index) and
-                (taicpu(p).oper[0]^.ref^.scalefactor=taicpu(hp1).oper[0]^.ref^.scalefactor)
-               ) or
-               ((taicpu(hp1).oper[0]^.ref^.index=taicpu(p).oper[1]^.reg) and
-                (taicpu(p).oper[0]^.ref^.index=NR_NO)
-               ) or
-               ((taicpu(hp1).oper[0]^.ref^.base=taicpu(p).oper[1]^.reg) and
-                (taicpu(hp1).oper[0]^.ref^.scalefactor <= 1) and
-                ((taicpu(p).oper[0]^.ref^.base=NR_NO) or
-                 ((taicpu(p).oper[0]^.ref^.base=taicpu(p).oper[0]^.ref^.base) and
-                  (taicpu(p).oper[0]^.ref^.index=NR_NO)
-                 )
-                ) and
-                not(RegUsedBetween(taicpu(p).oper[0]^.ref^.index,p,hp1)))
-              ) and
-              not(RegUsedBetween(taicpu(p).oper[0]^.ref^.base,p,hp1)) and
-              (taicpu(p).oper[0]^.ref^.relsymbol=taicpu(hp1).oper[0]^.ref^.relsymbol) and
-              (taicpu(p).oper[0]^.ref^.segment=taicpu(hp1).oper[0]^.ref^.segment) and
-              (taicpu(p).oper[0]^.ref^.symbol=taicpu(hp1).oper[0]^.ref^.symbol) then
+              (taicpu(p).oper[1]^.reg = taicpu(hp1).oper[1]^.reg) and
+              (taicpu(p).oper[0]^.ref^.relsymbol = nil) and
+              (taicpu(p).oper[0]^.ref^.segment = NR_NO) and
+              (taicpu(p).oper[0]^.ref^.symbol = nil) and
+              (taicpu(hp1).oper[0]^.ref^.relsymbol = nil) and
+              (taicpu(hp1).oper[0]^.ref^.segment = NR_NO) and
+              (taicpu(hp1).oper[0]^.ref^.symbol = nil) and
+              (
+                (taicpu(p).oper[0]^.ref^.base = NR_NO) or { Don't call RegModifiedBetween unnecessarily }
+                not(RegModifiedBetween(taicpu(p).oper[0]^.ref^.base,p,hp1))
+              ) and (
+                (taicpu(p).oper[0]^.ref^.index = taicpu(p).oper[0]^.ref^.base) or { Don't call RegModifiedBetween unnecessarily }
+                (taicpu(p).oper[0]^.ref^.index = NR_NO) or
+                not(RegModifiedBetween(taicpu(p).oper[0]^.ref^.index,p,hp1))
+              ) then
               begin
               begin
-                DebugMsg(SPeepholeOptimization + 'LeaLea2Lea done',p);
-                if taicpu(hp1).oper[0]^.ref^.index=taicpu(p).oper[1]^.reg then
+                { changes
+                    lea (regX,scale), reg1
+                    lea offset(reg1,reg1), reg1
+                    to
+                    lea offset(regX,scale*2), reg1
+
+                  and
+                    lea (regX,scale1), reg1
+                    lea offset(reg1,scale2), reg1
+                    to
+                    lea offset(regX,scale1*scale2), reg1
+
+                  ... so long as the final scale does not exceed 8
+
+                  (Similarly, allow the first instruction to be "lea (regX,regX),reg1")
+                  }
+                if (taicpu(p).oper[0]^.ref^.offset = 0) and
+                  (taicpu(hp1).oper[0]^.ref^.index = taicpu(p).oper[1]^.reg) and
+                  (
+                    (
+                      (taicpu(p).oper[0]^.ref^.base = NR_NO)
+                    ) or (
+                      (taicpu(p).oper[0]^.ref^.scalefactor <= 1) and
+                      (
+                        (taicpu(p).oper[0]^.ref^.base = taicpu(p).oper[0]^.ref^.index) and
+                        not(RegUsedBetween(taicpu(p).oper[0]^.ref^.index, p, hp1))
+                      )
+                    )
+                  ) and (
+                    (
+                      { lea (reg1,scale2), reg1 variant }
+                      (taicpu(hp1).oper[0]^.ref^.base = NR_NO) and
+                      (
+                        (
+                          (taicpu(p).oper[0]^.ref^.base = NR_NO) and
+                          (taicpu(hp1).oper[0]^.ref^.scalefactor * taicpu(p).oper[0]^.ref^.scalefactor <= 8)
+                        ) or (
+                          { lea (regX,regX), reg1 variant }
+                          (taicpu(p).oper[0]^.ref^.base <> NR_NO) and
+                          (taicpu(hp1).oper[0]^.ref^.scalefactor <= 4)
+                        )
+                      )
+                    ) or (
+                      { lea (reg1,reg1), reg1 variant }
+                      (taicpu(hp1).oper[0]^.ref^.base = taicpu(p).oper[1]^.reg) and
+                      (taicpu(hp1).oper[0]^.ref^.scalefactor <= 1)
+                    )
+                  ) then
                   begin
                   begin
-                    taicpu(hp1).oper[0]^.ref^.index:=taicpu(p).oper[0]^.ref^.base;
-                    inc(taicpu(hp1).oper[0]^.ref^.offset,taicpu(p).oper[0]^.ref^.offset*max(taicpu(hp1).oper[0]^.ref^.scalefactor,1));
-                    { if the register is used as index and base, we have to increase for base as well
-                      and adapt base }
-                    if taicpu(hp1).oper[0]^.ref^.base=taicpu(p).oper[1]^.reg then
+                    DebugMsg(SPeepholeOptimization + 'LeaLea2Lea 2 done',p);
+
+                    { Make everything homogeneous to make calculations easier }
+                    if (taicpu(p).oper[0]^.ref^.base <> NR_NO) then
                       begin
                       begin
-                        taicpu(hp1).oper[0]^.ref^.base:=taicpu(p).oper[0]^.ref^.base;
-                        inc(taicpu(hp1).oper[0]^.ref^.offset,taicpu(p).oper[0]^.ref^.offset);
+                        if taicpu(p).oper[0]^.ref^.index <> NR_NO then
+                          { Convert lea (regX,regX),reg1 to lea (regX,2),reg1 }
+                          taicpu(p).oper[0]^.ref^.scalefactor := 2
+                        else
+                          taicpu(p).oper[0]^.ref^.index := taicpu(p).oper[0]^.ref^.base;
+
+                        taicpu(p).oper[0]^.ref^.base := NR_NO;
                       end;
                       end;
+
+                    if (taicpu(hp1).oper[0]^.ref^.base = NR_NO) then
+                      begin
+                        { Just to prevent miscalculations }
+                        if (taicpu(hp1).oper[0]^.ref^.scalefactor = 0) then
+                          taicpu(hp1).oper[0]^.ref^.scalefactor := taicpu(p).oper[0]^.ref^.scalefactor
+                        else
+                          taicpu(hp1).oper[0]^.ref^.scalefactor := taicpu(hp1).oper[0]^.ref^.scalefactor * taicpu(p).oper[0]^.ref^.scalefactor;
+                      end
+                    else
+                      begin
+                        taicpu(hp1).oper[0]^.ref^.base := NR_NO;
+                        taicpu(hp1).oper[0]^.ref^.scalefactor := taicpu(p).oper[0]^.ref^.scalefactor * 2;
+                      end;
+
+                    taicpu(hp1).oper[0]^.ref^.index := taicpu(p).oper[0]^.ref^.index;
+                    RemoveCurrentP(p);
+                    result:=true;
+                    exit;
                   end
                   end
-                else
-                  begin
-                    inc(taicpu(hp1).oper[0]^.ref^.offset,taicpu(p).oper[0]^.ref^.offset);
-                    taicpu(hp1).oper[0]^.ref^.base:=taicpu(p).oper[0]^.ref^.base;
-                  end;
-                if taicpu(p).oper[0]^.ref^.index<>NR_NO then
+
+                { changes
+                    lea offset1(regX), reg1
+                    lea offset2(reg1), reg1
+                    to
+                    lea offset1+offset2(regX), reg1 }
+                else if
+                  (
+                    (taicpu(hp1).oper[0]^.ref^.index = taicpu(p).oper[1]^.reg) and
+                    (taicpu(p).oper[0]^.ref^.index = NR_NO)
+                  ) or (
+                    (taicpu(hp1).oper[0]^.ref^.base = taicpu(p).oper[1]^.reg) and
+                    (taicpu(hp1).oper[0]^.ref^.scalefactor <= 1) and
+                    (
+                      (
+                        (taicpu(p).oper[0]^.ref^.index = NR_NO) or
+                        (taicpu(p).oper[0]^.ref^.base = NR_NO)
+                      ) or (
+                        (taicpu(p).oper[0]^.ref^.scalefactor <= 1) and
+                        (
+                          (taicpu(p).oper[0]^.ref^.index = NR_NO) or
+                          (
+                            (taicpu(p).oper[0]^.ref^.index = taicpu(p).oper[0]^.ref^.base) and
+                            (
+                              (taicpu(hp1).oper[0]^.ref^.index = NR_NO) or
+                              (taicpu(hp1).oper[0]^.ref^.base = NR_NO)
+                            )
+                          )
+                        )
+                      )
+                    )
+                  ) then
                   begin
                   begin
-                    taicpu(hp1).oper[0]^.ref^.base:=taicpu(hp1).oper[0]^.ref^.index;
-                    taicpu(hp1).oper[0]^.ref^.index:=taicpu(p).oper[0]^.ref^.index;
-                    taicpu(hp1).oper[0]^.ref^.scalefactor:=taicpu(p).oper[0]^.ref^.scalefactor;
+                    DebugMsg(SPeepholeOptimization + 'LeaLea2Lea 1 done',p);
+
+                    if taicpu(hp1).oper[0]^.ref^.index=taicpu(p).oper[1]^.reg then
+                      begin
+                        taicpu(hp1).oper[0]^.ref^.index:=taicpu(p).oper[0]^.ref^.base;
+                        inc(taicpu(hp1).oper[0]^.ref^.offset,taicpu(p).oper[0]^.ref^.offset*max(taicpu(hp1).oper[0]^.ref^.scalefactor,1));
+                        { if the register is used as index and base, we have to increase for base as well
+                          and adapt base }
+                        if taicpu(hp1).oper[0]^.ref^.base=taicpu(p).oper[1]^.reg then
+                          begin
+                            taicpu(hp1).oper[0]^.ref^.base:=taicpu(p).oper[0]^.ref^.base;
+                            inc(taicpu(hp1).oper[0]^.ref^.offset,taicpu(p).oper[0]^.ref^.offset);
+                          end;
+                      end
+                    else
+                      begin
+                        inc(taicpu(hp1).oper[0]^.ref^.offset,taicpu(p).oper[0]^.ref^.offset);
+                        taicpu(hp1).oper[0]^.ref^.base:=taicpu(p).oper[0]^.ref^.base;
+                      end;
+                    if taicpu(p).oper[0]^.ref^.index<>NR_NO then
+                      begin
+                        taicpu(hp1).oper[0]^.ref^.base:=taicpu(hp1).oper[0]^.ref^.index;
+                        taicpu(hp1).oper[0]^.ref^.index:=taicpu(p).oper[0]^.ref^.index;
+                        taicpu(hp1).oper[0]^.ref^.scalefactor:=taicpu(p).oper[0]^.ref^.scalefactor;
+                      end;
+                    RemoveCurrentP(p);
+                    result:=true;
+                    exit;
                   end;
                   end;
-                RemoveCurrentP(p);
-                result:=true;
-                exit;
               end;
               end;
 
 
             { Change:
             { Change:
@@ -3890,76 +3991,92 @@ unit aoptx86;
       begin
       begin
         Result:=false;
         Result:=false;
 
 
-        if MatchOpType(taicpu(p),top_reg) and
-          GetNextInstruction(p, hp1) and
-          ((MatchInstruction(hp1, A_TEST, [S_B]) and
-           MatchOpType(taicpu(hp1),top_reg,top_reg) and
-           (taicpu(hp1).oper[0]^.reg = taicpu(hp1).oper[1]^.reg)) or
-           (MatchInstruction(hp1, A_CMP, [S_B]) and
-            MatchOpType(taicpu(hp1),top_const,top_reg) and
-            (taicpu(hp1).oper[0]^.val=0))
-          ) and
-          (taicpu(p).oper[0]^.reg = taicpu(hp1).oper[1]^.reg) and
-          GetNextInstruction(hp1, hp2) and
-          MatchInstruction(hp2, A_Jcc, []) then
-          { Change from:             To:
-
-            set(C) %reg              j(~C) label
-            test   %reg,%reg/cmp $0,%reg
-            je     label
-
-
-            set(C) %reg              j(C)  label
-            test   %reg,%reg/cmp $0,%reg
-            jne    label
-          }
+        if MatchOpType(taicpu(p),top_reg) and GetNextInstruction(p, hp1) then
           begin
           begin
-            next := tai(p.Next);
+            if ((MatchInstruction(hp1, A_TEST, [S_B]) and
+               MatchOpType(taicpu(hp1),top_reg,top_reg) and
+               (taicpu(hp1).oper[0]^.reg = taicpu(hp1).oper[1]^.reg)) or
+               (MatchInstruction(hp1, A_CMP, [S_B]) and
+                MatchOpType(taicpu(hp1),top_const,top_reg) and
+                (taicpu(hp1).oper[0]^.val=0))
+              ) and
+              (taicpu(p).oper[0]^.reg = taicpu(hp1).oper[1]^.reg) and
+              GetNextInstruction(hp1, hp2) and
+              MatchInstruction(hp2, A_Jcc, []) then
+              { Change from:             To:
 
 
-            TransferUsedRegs(TmpUsedRegs);
-            UpdateUsedRegs(TmpUsedRegs, next);
-            UpdateUsedRegs(TmpUsedRegs, tai(hp1.next));
+                set(C) %reg              j(~C) label
+                test   %reg,%reg/cmp $0,%reg
+                je     label
 
 
-            JumpC := taicpu(hp2).condition;
-            Unconditional := False;
 
 
-            if conditions_equal(JumpC, C_E) then
-              SetC := inverse_cond(taicpu(p).condition)
-            else if conditions_equal(JumpC, C_NE) then
-              SetC := taicpu(p).condition
-            else
-              { We've got something weird here (and inefficent) }
+                set(C) %reg              j(C)  label
+                test   %reg,%reg/cmp $0,%reg
+                jne    label
+              }
               begin
               begin
-                DebugMsg('DEBUG: Inefficient jump - check code generation', p);
-                SetC := C_NONE;
+                next := tai(p.Next);
+
+                TransferUsedRegs(TmpUsedRegs);
+                UpdateUsedRegs(TmpUsedRegs, next);
+                UpdateUsedRegs(TmpUsedRegs, tai(hp1.next));
 
 
-                { JAE/JNB will always branch (use 'condition_in', since C_AE <> C_NB normally) }
-                if condition_in(C_AE, JumpC) then
-                  Unconditional := True
+                JumpC := taicpu(hp2).condition;
+                Unconditional := False;
+
+                if conditions_equal(JumpC, C_E) then
+                  SetC := inverse_cond(taicpu(p).condition)
+                else if conditions_equal(JumpC, C_NE) then
+                  SetC := taicpu(p).condition
                 else
                 else
-                  { Not sure what to do with this jump - drop out }
-                  Exit;
-              end;
+                  { We've got something weird here (and inefficent) }
+                  begin
+                    DebugMsg('DEBUG: Inefficient jump - check code generation', p);
+                    SetC := C_NONE;
 
 
-            RemoveInstruction(hp1);
+                    { JAE/JNB will always branch (use 'condition_in', since C_AE <> C_NB normally) }
+                    if condition_in(C_AE, JumpC) then
+                      Unconditional := True
+                    else
+                      { Not sure what to do with this jump - drop out }
+                      Exit;
+                  end;
 
 
-            if Unconditional then
-              MakeUnconditional(taicpu(hp2))
-            else
-              begin
-                if SetC = C_NONE then
-                  InternalError(2018061402);
+                RemoveInstruction(hp1);
 
 
-                taicpu(hp2).SetCondition(SetC);
-              end;
+                if Unconditional then
+                  MakeUnconditional(taicpu(hp2))
+                else
+                  begin
+                    if SetC = C_NONE then
+                      InternalError(2018061402);
+
+                    taicpu(hp2).SetCondition(SetC);
+                  end;
+
+                if not RegUsedAfterInstruction(taicpu(p).oper[0]^.reg, hp2, TmpUsedRegs) then
+                  begin
+                    RemoveCurrentp(p, hp2);
+                    Result := True;
+                  end;
 
 
-            if not RegUsedAfterInstruction(taicpu(p).oper[0]^.reg, hp2, TmpUsedRegs) then
+                DebugMsg(SPeepholeOptimization + 'SETcc/TESTCmp/Jcc -> Jcc',p);
+              end
+            else if MatchInstruction(hp1, A_MOV, [S_B]) and
+              MatchOpType(taicpu(hp1),top_reg,top_reg) and
+              MatchOperand(taicpu(p).oper[0]^,taicpu(hp1).oper[0]^) then
               begin
               begin
-                RemoveCurrentp(p, hp2);
-                Result := True;
+                TransferUsedRegs(TmpUsedRegs);
+                UpdateUsedRegs(TmpUsedRegs, tai(p.Next));
+                if not RegUsedAfterInstruction(taicpu(p).oper[0]^.reg, hp1, TmpUsedRegs) then
+                  begin
+                    AllocRegBetween(taicpu(p).oper[0]^.reg,p,hp1,UsedRegs);
+                    taicpu(p).oper[0]^.reg:=taicpu(hp1).oper[1]^.reg;
+                    RemoveInstruction(hp1);
+                    DebugMsg(SPeepholeOptimization + 'SETcc/Mov -> SETcc',p);
+                    Result := true;
+                  end;
               end;
               end;
-
-            DebugMsg(SPeepholeOptimization + 'SETcc/TESTCmp/Jcc -> Jcc',p);
           end;
           end;
       end;
       end;
 
 
@@ -5251,6 +5368,25 @@ unit aoptx86;
                   if not MatchOpType(taicpu(hp1), top_reg, top_reg) then
                   if not MatchOpType(taicpu(hp1), top_reg, top_reg) then
                     Break;
                     Break;
 
 
+                  if not SuperRegistersEqual(taicpu(hp1).oper[0]^.reg, ThisReg) then
+                    begin
+                      { Because hp1 was obtained via GetNextInstructionUsingReg
+                        and ThisReg doesn't appear in the first operand, it
+                        must appear in the second operand and hence gets
+                        overwritten }
+                      if (InstrMax = -1) and
+                        Reg1WriteOverwritesReg2Entirely(taicpu(hp1).oper[1]^.reg, ThisReg) then
+                        begin
+                          { The two MOVZX instructions are adjacent, so remove the first one }
+                          DebugMsg(SPeepholeOptimization + 'Movzx2Nop 5', p);
+                          RemoveCurrentP(p);
+                          Result := True;
+                          Exit;
+                        end;
+
+                      Break;
+                    end;
+
                   { The objective here is to try to find a combination that
                   { The objective here is to try to find a combination that
                     removes one of the MOV/Z instructions. }
                     removes one of the MOV/Z instructions. }
                   case taicpu(hp1).opsize of
                   case taicpu(hp1).opsize of
@@ -5363,8 +5499,7 @@ unit aoptx86;
                     ((TargetSize = S_W) and (taicpu(hp1).opsize in [S_W, S_BW])) then
                     ((TargetSize = S_W) and (taicpu(hp1).opsize in [S_W, S_BW])) then
                     begin
                     begin
                       { Convert the output MOVZX to a MOV }
                       { Convert the output MOVZX to a MOV }
-                      if (taicpu(hp1).oper[0]^.typ = top_reg) and
-                        SuperRegistersEqual(taicpu(hp1).oper[1]^.reg, ThisReg) then
+                      if SuperRegistersEqual(taicpu(hp1).oper[1]^.reg, ThisReg) then
                         begin
                         begin
                           { Or remove it completely! }
                           { Or remove it completely! }
                           DebugMsg(SPeepholeOptimization + 'Movzx2Nop 2', hp1);
                           DebugMsg(SPeepholeOptimization + 'Movzx2Nop 2', hp1);

+ 14 - 8
installer/install.dat

@@ -368,8 +368,6 @@ package=utils-pas2fpmos2.zip[up2fpos2.zip],Generate fpmake.pp for Pascal source
 package=utils-pas2jnios2.zip[p2jnos2.zip],Generate JNI bridge for Pascal code
 package=utils-pas2jnios2.zip[p2jnos2.zip],Generate JNI bridge for Pascal code
 # OS/2 31
 # OS/2 31
 package=utils-pas2utos2.zip[p2utos2.zip],Pascal source to FPC Unit test generator
 package=utils-pas2utos2.zip[p2utos2.zip],Pascal source to FPC Unit test generator
-# OS/2 32
-package=ufcl-pdfos2.zip[ufcpdos2.zip],PDF generating and TTF file info library
 
 
 #
 #
 # OS/2 packages 2nd part
 # OS/2 packages 2nd part
@@ -438,8 +436,6 @@ package=utils-rmwaitos2.zip[rmwos2.zip],Remove (delete) file(s) with optional re
 package=utils-lexyaccos2.zip[lexyos2.zip],Compiler generator for TP and compatibles
 package=utils-lexyaccos2.zip[lexyos2.zip],Compiler generator for TP and compatibles
 # OS/2-2 31
 # OS/2-2 31
 package=utils-fpcmos2.zip[fpcmos2.zip],Generate Makefiles out of Makefile.fpc files
 package=utils-fpcmos2.zip[fpcmos2.zip],Generate Makefiles out of Makefile.fpc files
-# OS/2-2 32
-package=utils-unicodeos2.zip[ucodeos2.zip],Transformation of Unicode consortium data for FPC
 
 
 
 
 
 
@@ -457,6 +453,12 @@ package=utils-pas2jsos2.zip[p2jsos2.zip],Convert Pascal sources to Javascript
 package=utils-webidlos2.zip[widlos2.zip],Web IDL parser and converter to Object Pascal classes
 package=utils-webidlos2.zip[widlos2.zip],Web IDL parser and converter to Object Pascal classes
 # OS/2-3 4
 # OS/2-3 4
 package=utils-json2pasos2.zip[js2pos2.zip],Create Object Pascal classes from JSON files
 package=utils-json2pasos2.zip[js2pos2.zip],Create Object Pascal classes from JSON files
+# OS/2-3 5
+package=ufcl-pdfos2.zip[ufcpdos2.zip],PDF generating and TTF file info library
+# OS/2-2 6
+package=utils-unicodeos2.zip[ucodeos2.zip],Transformation of Unicode consortium data for FPC
+# OS/2-3 7
+package=utplylibos2.zip[utpllos2.zip],Units for sources created with the compiler generator
 
 
 #
 #
 # EMX packages
 # EMX packages
@@ -531,8 +533,6 @@ package=utils-pas2fpmemx.zip[up2fpemx.zip],Generate fpmake.pp for Pascal source
 package=utils-pas2jniemx.zip[p2jnemx.zip],Generate JNI bridge for Pascal code
 package=utils-pas2jniemx.zip[p2jnemx.zip],Generate JNI bridge for Pascal code
 # EMX 31
 # EMX 31
 package=utils-pas2utemx.zip[p2utemx.zip],Pascal source to FPC Unit test generator
 package=utils-pas2utemx.zip[p2utemx.zip],Pascal source to FPC Unit test generator
-# EMX 32
-package=ufcl-pdfemx.zip[ufcpdemx.zip],PDF generating and TTF file info library
 
 
 #
 #
 # EMX packages 2nd part
 # EMX packages 2nd part
@@ -601,8 +601,6 @@ package=utils-rmwaitemx.zip[rmwemx.zip],Remove (delete) file(s) with optional re
 package=utils-lexyaccemx.zip[ulexyemx.zip],Compiler generator for TP and compatibles
 package=utils-lexyaccemx.zip[ulexyemx.zip],Compiler generator for TP and compatibles
 # EMX-2 31
 # EMX-2 31
 package=utils-fpcmemx.zip[fpcmemx.zip],Generate Makefiles out of Makefile.fpc files
 package=utils-fpcmemx.zip[fpcmemx.zip],Generate Makefiles out of Makefile.fpc files
-# EMX-3 32
-package=utils-unicodeemx.zip[ucodeemx.zip],Transformation of Unicode consortium data for FPC
 
 
 
 
 #
 #
@@ -618,6 +616,12 @@ package=utils-pas2jsemx.zip[p2jsemx.zip],Convert Pascal sources to Javascript
 package=utils-webidlemx.zip[widlemx.zip],Web IDL parser and converter to Object Pascal classes
 package=utils-webidlemx.zip[widlemx.zip],Web IDL parser and converter to Object Pascal classes
 # EMX-3 4
 # EMX-3 4
 package=utils-json2pasemx.zip[js2pemx.zip],Create Object Pascal classes from JSON files
 package=utils-json2pasemx.zip[js2pemx.zip],Create Object Pascal classes from JSON files
+# EMX-3 5
+package=ufcl-pdfemx.zip[ufcpdemx.zip],PDF generating and TTF file info library
+# EMX-2 6
+package=utils-unicodeemx.zip[ucodeemx.zip],Transformation of Unicode consortium data for FPC
+# EMX-3 7
+package=utplylibemx.zip[utpllemx.zip],Units for sources created with the compiler generator
 
 
 
 
 #
 #
@@ -743,6 +747,8 @@ package=units-x11-3.3.1.source.zip[ux11src.zip],X Window (X11) interface units
 package=units-fcl-pdf-3.3.1.source.zip[ufcpdsrc.zip],PDF generating and TTF file info library
 package=units-fcl-pdf-3.3.1.source.zip[ufcpdsrc.zip],PDF generating and TTF file info library
 # Source-2 30
 # Source-2 30
 package=units-dblib-3.3.1.source.zip,Headers for the MS SQL Server RDBMS
 package=units-dblib-3.3.1.source.zip,Headers for the MS SQL Server RDBMS
+# Source-2 31
+package=units-tplylib.source.zip[utpllsrc.zip],Units for sources created with the compiler generator
 
 
 
 
 #
 #

+ 1 - 1
packages/fcl-db/src/export/fpxmlxsdexport.pp

@@ -2990,7 +2990,7 @@ begin
   }
   }
 
 
   CreateXSD := True;
   CreateXSD := True;
-  DecimalSeparator := char(''); //Don't override decimal separator by default
+  DecimalSeparator := #0; //Don't override decimal separator by default
 
 
   if Source is TXMLXSDFormatSettings then
   if Source is TXMLXSDFormatSettings then
   begin
   begin

+ 18 - 4
packages/fcl-net/src/amiga/resolve.inc

@@ -48,7 +48,7 @@ Type
 
 
 { remember, classic style calls are also used on MorphOS, so don't test for AMIGA68K }
 { remember, classic style calls are also used on MorphOS, so don't test for AMIGA68K }
 {$ifndef AMIGAOS4}
 {$ifndef AMIGAOS4}
-function gethostbyname(Name: PChar location 'a0'): PHostEntry; syscall SocketBase 210;
+function fpgethostbyname(Name: PChar location 'a0'): PHostEntry; syscall SocketBase 210;
 function getnetbyname(Name: PChar location 'a0'): PNetEntry; syscall SocketBase 222;
 function getnetbyname(Name: PChar location 'a0'): PNetEntry; syscall SocketBase 222;
 function getnetbyaddr(Net: Longint location 'd0'; NetType: Longint location 'd1'): PNetEntry; syscall SocketBase 228;
 function getnetbyaddr(Net: Longint location 'd0'; NetType: Longint location 'd1'): PNetEntry; syscall SocketBase 228;
 function getservbyname(Name: PChar location 'a0'; Protocol: PChar location 'a1'): PServEntry; syscall SocketBase 234;
 function getservbyname(Name: PChar location 'a0'; Protocol: PChar location 'a1'): PServEntry; syscall SocketBase 234;
@@ -63,7 +63,7 @@ function getservent: PServEntry; syscall SocketBase 564;
 
 
 {$else AMIGAOS4}
 {$else AMIGAOS4}
 
 
-function gethostbyname(const Name: PChar): PHostEntry; syscall ISocket 196;
+function fpgethostbyname(const Name: PChar): PHostEntry; syscall ISocket 196;
 function getnetbyname(Name: PChar): PNetEntry; syscall ISocket 204;
 function getnetbyname(Name: PChar): PNetEntry; syscall ISocket 204;
 function getnetbyaddr(Net: Longint; NetType: Longint): PNetEntry; syscall ISocket 208;
 function getnetbyaddr(Net: Longint; NetType: Longint): PNetEntry; syscall ISocket 208;
 function getservbyname(Name: PChar; Protocol: PChar): PServEntry; syscall ISocket 212;
 function getservbyname(Name: PChar; Protocol: PChar): PServEntry; syscall ISocket 212;
@@ -77,12 +77,24 @@ procedure endservent; syscall ISocket 484;
 function getservent: PServEntry; syscall ISocket 488;
 function getservent: PServEntry; syscall ISocket 488;
 {$endif AMIGAOS4}
 {$endif AMIGAOS4}
 
 
+function gethostbyname(Name: PChar): PHostEntry;
+begin
+  if Assigned(SocketBase) then
+    gethostbyname := fpgethostbyname(Name)
+  else
+    gethostbyname := nil;
+end;
+
 function gethostbyaddr(Addr: PChar; Len: Longint; HType: Longint): PHostentry;
 function gethostbyaddr(Addr: PChar; Len: Longint; HType: Longint): PHostentry;
 var
 var
   addr1,
   addr1,
   addr2: in_addr;
   addr2: in_addr;
   IP: PPLongInt;
   IP: PPLongInt;
 begin
 begin
+  gethostbyaddr := nil;
+  if not Assigned(SocketBase) then
+    Exit;
+  //
   Addr1 :=  in_addr(PHostAddr(Addr)^);
   Addr1 :=  in_addr(PHostAddr(Addr)^);
   Addr2.s_addr := htonl(Addr1.s_addr);
   Addr2.s_addr := htonl(Addr1.s_addr);
   gethostbyaddr := Pointer(bsd_GetHostByAddr(Pointer(@Addr2.s_addr), Len, HType));
   gethostbyaddr := Pointer(bsd_GetHostByAddr(Pointer(@Addr2.s_addr), Len, HType));
@@ -101,12 +113,14 @@ end;
 
 
 function  GetDNSError: integer;
 function  GetDNSError: integer;
 begin
 begin
-  GetDNSError:=bsd_Errno;
+  GetDNSError := 0;
+  if assigned(SocketBase) then
+    GetDNSError:=bsd_Errno;
 end;
 end;
 
 
 Function InitResolve : Boolean;
 Function InitResolve : Boolean;
 begin
 begin
-  Result:=True;
+  Result:=Assigned(SocketBase);
 end;
 end;
 
 
 Function FinalResolve : Boolean;
 Function FinalResolve : Boolean;

+ 19 - 4
packages/fcl-net/src/aros/resolve.inc

@@ -48,7 +48,7 @@ Type
 
 
 { C style calls, linked in from Libc }
 { C style calls, linked in from Libc }
 
 
-function gethostbyname(Name: PChar): PHostEntry; syscall SocketBase 35;
+function fpgethostbyname(Name: PChar): PHostEntry; syscall SocketBase 35;
 function getnetbyname(Name: PChar): PNetEntry; syscall SocketBase 37;
 function getnetbyname(Name: PChar): PNetEntry; syscall SocketBase 37;
 function getnetbyaddr(Net: Longint; NetType: Longint): PNetEntry; syscall SocketBase 38;
 function getnetbyaddr(Net: Longint; NetType: Longint): PNetEntry; syscall SocketBase 38;
 function getservbyname(Name: PChar; Protocol: PChar): PServEntry; syscall SocketBase 39;
 function getservbyname(Name: PChar; Protocol: PChar): PServEntry; syscall SocketBase 39;
@@ -61,12 +61,25 @@ procedure setservent(StayOpen: longint); syscall SocketBase 92;
 procedure endservent; syscall SocketBase 93;
 procedure endservent; syscall SocketBase 93;
 function getservent: PServEntry; syscall SocketBase 94;
 function getservent: PServEntry; syscall SocketBase 94;
 
 
+
+function gethostbyname(Name: PChar): PHostEntry;
+begin
+  if Assigned(SocketBase) then
+    gethostbyname := fpgethostbyname(Name)
+  else
+    gethostbyname := nil;
+end;
+
 function gethostbyaddr(Addr: PChar; Len: Longint; HType: Longint): PHostentry;
 function gethostbyaddr(Addr: PChar; Len: Longint; HType: Longint): PHostentry;
 var
 var
   addr1,
   addr1,
   addr2: in_addr;
   addr2: in_addr;
   IP: PPLongInt;
   IP: PPLongInt;
 begin
 begin
+  gethostbyaddr := nil;
+  if not Assigned(SocketBase) then
+    Exit;
+  //
   Addr1 :=  in_addr(PHostAddr(Addr)^);
   Addr1 :=  in_addr(PHostAddr(Addr)^);
   Addr2.s_addr := htonl(Addr1.s_addr);
   Addr2.s_addr := htonl(Addr1.s_addr);
   gethostbyaddr := Pointer(bsd_GetHostByAddr(Pointer(@Addr2.s_addr), Len, HType));
   gethostbyaddr := Pointer(bsd_GetHostByAddr(Pointer(@Addr2.s_addr), Len, HType));
@@ -78,19 +91,21 @@ begin
       repeat
       repeat
         ip^^ := ntohl(ip^^);
         ip^^ := ntohl(ip^^);
         Inc(IP);
         Inc(IP);
-      until ip^ = nil; 
+      until ip^ = nil;
     end;
     end;
   end;
   end;
 end;
 end;
 
 
 function  GetDNSError: integer;
 function  GetDNSError: integer;
 begin
 begin
-  GetDNSError:=bsd_Errno;
+  GetDNSError := 0;
+  if assigned(SocketBase) then
+    GetDNSError := bsd_Errno;
 end;
 end;
 
 
 Function InitResolve : Boolean;
 Function InitResolve : Boolean;
 begin
 begin
-  Result:=True;
+  Result := Assigned(SocketBase);
 end;
 end;
 
 
 Function FinalResolve : Boolean;
 Function FinalResolve : Boolean;

+ 61 - 11
packages/fcl-passrc/src/pasresolver.pp

@@ -6229,16 +6229,43 @@ begin
 end;
 end;
 
 
 procedure TPasResolver.FinishSubElementType(Parent: TPasElement; El: TPasType);
 procedure TPasResolver.FinishSubElementType(Parent: TPasElement; El: TPasType);
+
+  procedure InsertInFront(NewParent: TPasElement; List: TFPList
+    {$IFDEF CheckPasTreeRefCount};const aId: string{$ENDIF});
+  var
+    i: Integer;
+    p: TPasElement;
+  begin
+    p:=El.Parent;
+    if NewParent=p.Parent then
+      begin
+      // e.g. a:array of longint; -> insert a$a in front of a
+      i:=List.Count-1;
+      while (i>=0) and (List[i]<>Pointer(p)) do
+        dec(i);
+      if i<0 then
+        List.Add(El)
+      else
+        List.Insert(i,El);
+      end
+    else
+      begin
+      List.Add(El);
+      end;
+    El.AddRef{$IFDEF CheckPasTreeRefCount}aID{$ENDIF};
+    El.Parent:=NewParent;
+  end;
+
 var
 var
   Decl: TPasDeclarations;
   Decl: TPasDeclarations;
   EnumScope: TPasEnumTypeScope;
   EnumScope: TPasEnumTypeScope;
+  p: TPasElement;
+  MembersType: TPasMembersType;
 begin
 begin
   EmitTypeHints(Parent,El);
   EmitTypeHints(Parent,El);
   if (El.Name<>'') or (AnonymousElTypePostfix='') then exit;
   if (El.Name<>'') or (AnonymousElTypePostfix='') then exit;
   if Parent.Name='' then
   if Parent.Name='' then
     RaiseMsg(20170415165455,nCannotNestAnonymousX,sCannotNestAnonymousX,[GetElementTypeName(El)],El);
     RaiseMsg(20170415165455,nCannotNestAnonymousX,sCannotNestAnonymousX,[GetElementTypeName(El)],El);
-  if not (Parent.Parent is TPasDeclarations) then
-    RaiseMsg(20170416094735,nCannotNestAnonymousX,sCannotNestAnonymousX,[GetElementTypeName(El)],El);
   if El.Parent<>Parent then
   if El.Parent<>Parent then
     RaiseNotYetImplemented(20190215085011,Parent);
     RaiseNotYetImplemented(20190215085011,Parent);
   // give anonymous sub type a name
   // give anonymous sub type a name
@@ -6246,11 +6273,27 @@ begin
   {$IFDEF VerbosePasResolver}
   {$IFDEF VerbosePasResolver}
   writeln('TPasResolver.FinishSubElementType parent="',GetObjName(Parent),'" named anonymous type "',GetObjName(El),'"');
   writeln('TPasResolver.FinishSubElementType parent="',GetObjName(Parent),'" named anonymous type "',GetObjName(El),'"');
   {$ENDIF}
   {$ENDIF}
-  Decl:=TPasDeclarations(Parent.Parent);
-  Decl.Declarations.Add(El);
-  El.AddRef{$IFDEF CheckPasTreeRefCount}('TPasDeclarations.Declarations'){$ENDIF};
-  El.Parent:=Decl;
-  Decl.Types.Add(El);
+
+  p:=Parent.Parent;
+  repeat
+    if p is TPasDeclarations then
+      begin
+      Decl:=TPasDeclarations(p);
+      InsertInFront(Decl,Decl.Declarations{$IFDEF CheckPasTreeRefCount},'TPasDeclarations.Declarations'{$ENDIF});
+      Decl.Types.Add(El);
+      break;
+      end
+    else if p is TPasMembersType then
+      begin
+      MembersType:=TPasMembersType(p);
+      InsertInFront(MembersType,MembersType.Members{$IFDEF CheckPasTreeRefCount},'TPasMembersType.Members'{$ENDIF});
+      break;
+      end
+    else
+      p:=p.Parent;
+    if p=nil then
+      RaiseMsg(20170416094735,nCannotNestAnonymousX,sCannotNestAnonymousX,[GetElementTypeName(El)],El);
+  until false;
   if (El.ClassType=TPasEnumType) and (Parent.ClassType=TPasSetType) then
   if (El.ClassType=TPasEnumType) and (Parent.ClassType=TPasSetType) then
     begin
     begin
     // anonymous enumtype
     // anonymous enumtype
@@ -7819,6 +7862,8 @@ begin
     CheckUseAsType(El.VarType,20190123095916,El);
     CheckUseAsType(El.VarType,20190123095916,El);
     if El.Expr<>nil then
     if El.Expr<>nil then
       CheckAssignCompatibility(El,El.Expr,true);
       CheckAssignCompatibility(El,El.Expr,true);
+    if El.VarType.Parent=El then
+      FinishSubElementType(El,El.VarType);
     end
     end
   else if El.Expr<>nil then
   else if El.Expr<>nil then
     begin
     begin
@@ -12278,12 +12323,17 @@ begin
   {$ENDIF}
   {$ENDIF}
   if not (TopScope is TPasIdentifierScope) then
   if not (TopScope is TPasIdentifierScope) then
     RaiseInvalidScopeForElement(20160929205732,El);
     RaiseInvalidScopeForElement(20160929205732,El);
-  AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
+  if El.Name<>'' then
+    AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple)
+  else
+    begin
+    // anonymous enumtype
+    end;
   EnumScope:=TPasEnumTypeScope(PushScope(El,TPasEnumTypeScope));
   EnumScope:=TPasEnumTypeScope(PushScope(El,TPasEnumTypeScope));
   // add canonical set
   // add canonical set
   if El.Parent is TPasSetType then
   if El.Parent is TPasSetType then
     begin
     begin
-    // anonymous enumtype, e.g. "set of ()"
+    // set of anonymous enumtype, e.g. "set of ()"
     CanonicalSet:=TPasSetType(El.Parent);
     CanonicalSet:=TPasSetType(El.Parent);
     CanonicalSet.AddRef{$IFDEF CheckPasTreeRefCount}('TPasEnumTypeScope.CanonicalSet'){$ENDIF};
     CanonicalSet.AddRef{$IFDEF CheckPasTreeRefCount}('TPasEnumTypeScope.CanonicalSet'){$ENDIF};
     end
     end
@@ -21051,8 +21101,8 @@ begin
       writeln('TPasResolver.FindElement searching scope "',CurName,'" RightPath="',RightPath,'" ...');
       writeln('TPasResolver.FindElement searching scope "',CurName,'" RightPath="',RightPath,'" ...');
     {AllowWriteln-}
     {AllowWriteln-}
     {$ENDIF}
     {$ENDIF}
-    if not IsValidIdent(CurName) then
-      RaiseNotYetImplemented(20170328000033,ErrorEl,CurName);
+    // Note: CurName can be a non Pascal name, when specializing an autogenerated anonymous type
+    //if not IsValidIdent(CurName) then ;
     if CurScopeEl<>nil then
     if CurScopeEl<>nil then
       begin
       begin
       NeedPop:=true;
       NeedPop:=true;

+ 5 - 2
packages/fcl-process/src/amicommon/pipes.inc

@@ -27,9 +27,12 @@ end;
 
 
 
 
 Function TInputPipeStream.GetNumBytesAvailable: DWord;
 Function TInputPipeStream.GetNumBytesAvailable: DWord;
-
+var
+  fib: TFileInfoBlock;
 begin
 begin
   Result := 0;
   Result := 0;
+  if Boolean(ExamineFH(BPTR(Handle), @fib)) then
+    Result := fib.fib_size;
 end;
 end;
 
 
 function TInputPipeStream.GetPosition: Int64;
 function TInputPipeStream.GetPosition: Int64;
@@ -53,5 +56,5 @@ begin
    FileClose(FHandle);
    FileClose(FHandle);
    if DeleteIt then
    if DeleteIt then
      AmigaDos.dosDeleteFile(@(Filename[0]));
      AmigaDos.dosDeleteFile(@(Filename[0]));
- end;  
+ end;
 end;
 end;

+ 66 - 11
packages/fcl-process/src/amicommon/process.inc

@@ -65,6 +65,13 @@ end;
 var
 var
   UID: Integer = 0;
   UID: Integer = 0;
 
 
+{$ifdef MorphOS}
+const
+  BUF_LINE = 0; // flush on \n, etc
+  BUF_FULL = 1; // never flush except when needed
+  BUF_NONE = 2; // no buffering
+{$endif}
+
 Procedure TProcess.Execute;
 Procedure TProcess.Execute;
 var
 var
   I: integer;
   I: integer;
@@ -74,6 +81,10 @@ var
   Params: string;
   Params: string;
   TempName: string;
   TempName: string;
   cos: BPTR;
   cos: BPTR;
+  {$ifdef MorphOS}
+  inA, inB, OutA, OutB: BPTR;
+  Res: Integer;
+  {$endif}
 begin
 begin
   if (ApplicationName = '') and (CommandLine = '') and (Executable = '') then
   if (ApplicationName = '') and (CommandLine = '') and (Executable = '') then
    raise EProcess.Create (SNoCommandline);
    raise EProcess.Create (SNoCommandline);
@@ -114,17 +125,61 @@ begin
     ChDir (FCurrentDirectory);
     ChDir (FCurrentDirectory);
    end;
    end;
   try
   try
-   cos := BPTR(0);
-   repeat
-     Inc(UID);
-     TempName := 'T:PrO_'+ HexStr(FindTask(nil)) + '_' + IntToHex(UID,8);
-   until not FileExists(TempName);
-   //sysdebugln('TProcess start: "' + ExecName + ' ' + Params+'"  >' + TempName);
-   cos := AmigaDos.DosOpen(PChar(TempName), MODE_READWRITE);
-   FExitCode := LongInt(amigados.Execute(PChar(ExecName + ' ' + Params), BPTR(0), cos));
-   DosSeek(cos, 0, OFFSET_BEGINNING);
-   CreateStreams(0, THandle(cos),0);
-   //FExitCode := ExecuteProcess (ExecName, Params);
+    {$ifdef MorphOS}
+    if (poUsePipes in Options) and (not (poWaitOnExit in Options)) then
+    begin
+      FProcessID := 0;
+      // Pipenames, should be unique
+      TempName := 'PIPE:PrO_' + HexStr(Self) + HexStr(GetTickCount, 8);
+      inA := DOSOpen(PChar(TempName), MODE_OLDFILE);
+      inB := DOSOpen(PChar(TempName), MODE_NEWFILE);
+      TempName := TempName + 'o';
+      outA := DOSOpen(PChar(TempName), MODE_OLDFILE);
+      outB := DOSOpen(PChar(TempName), MODE_NEWFILE);
+      // set buffer for all pipes
+      SetVBuf(inA, nil, BUF_NONE, -1);
+      SetVBuf(inB, nil, BUF_LINE, -1);
+      SetVBuf(outA, nil, BUF_NONE, -1);
+      SetVBuf(outB, nil, BUF_LINE, -1);
+      // the actual Start of the command with given parameter and streams
+      Res := SystemTags(PChar(ExecName + ' ' + Params),
+                        [SYS_Input, AsTag(outA),
+                         SYS_Output, AsTag(inB),
+                         SYS_Asynch, AsTag(True),
+                         TAG_END]);
+      // the two streams will be destroyed by system, we do not need to care about
+      // the other two we will destroy when the PipeStreams they are attached to are destroyed
+      if Res <> -1 then
+      begin
+        FProcessID := 1;
+        CreateStreams(THandle(outB), THandle(inA),0);
+      end
+      else
+      begin
+        // if the command did not start, we need to delete all Streams
+        if outB <> BPTR(0) then DosClose(outB);
+        if outA <> BPTR(0) then DosClose(outA);
+        if inB <> BPTR(0) then DosClose(inB);
+        if inA <> BPTR(0) then DosClose(inA);
+      end;
+    end
+    else
+    {$endif}
+    begin
+      // if no streams needed we still use the old sychronous way
+      FProcessID := 0;
+      cos := BPTR(0);
+      repeat
+        Inc(UID);
+        TempName := 'T:PrO_'+ HexStr(FindTask(nil)) + '_' + IntToHex(UID,8);
+      until not FileExists(TempName);
+      //sysdebugln('TProcess start: "' + ExecName + ' ' + Params+'"  >' + TempName);
+      cos := AmigaDos.DosOpen(PChar(TempName), MODE_READWRITE);
+      FExitCode := LongInt(amigados.Execute(PChar(ExecName + ' ' + Params), BPTR(0), cos));
+      DosSeek(cos, 0, OFFSET_BEGINNING);
+      CreateStreams(0, THandle(cos),0);
+    end;
+    //FExitCode := ExecuteProcess (ExecName, Params);
   except
   except
 (* Normalize the raised exception so that it is aligned to other platforms. *)
 (* Normalize the raised exception so that it is aligned to other platforms. *)
     On E: EOSError do
     On E: EOSError do

+ 21 - 1
packages/fcl-process/src/pipes.pp

@@ -91,10 +91,30 @@ begin
 end;
 end;
 
 
 Function TInputPipeStream.Read (Var Buffer; Count : Longint) : longint;
 Function TInputPipeStream.Read (Var Buffer; Count : Longint) : longint;
-
+{$ifdef MorphOS}
+var
+  i: Integer;
+  Runner: PByte;
+{$endif}
 begin
 begin
+  {$ifdef MorphOS}
+  FillChar(Buffer, Count, 0);
+  if FGetS(Handle, @Buffer, Count) = nil then
+    Result := 0
+  else
+  begin
+    Result := 0;
+    Runner := @Buffer;
+    repeat
+      if Runner^ = 0 then
+        Break;
+      Inc(Result);
+    until Result >= Count;
+  end;
+  {$else}
   Result:=Inherited Read(Buffer,Count);
   Result:=Inherited Read(Buffer,Count);
   Inc(FPos,Result);
   Inc(FPos,Result);
+  {$endif}
 end;
 end;
 
 
 function TInputPipeStream.Seek(const Offset: int64; Origin: TSeekOrigin): int64;
 function TInputPipeStream.Seek(const Offset: int64; Origin: TSeekOrigin): int64;

+ 3 - 2
packages/fpmkunit/src/fpmkunit.pp

@@ -7177,8 +7177,9 @@ begin
 
 
   // libc-linker path (always for Linux, since required for LLVM and SEH; this does not
   // libc-linker path (always for Linux, since required for LLVM and SEH; this does not
   // force the linking of anything by itself, but just adds a search directory)
   // force the linking of anything by itself, but just adds a search directory)
-  if APackage.NeedLibC or
-     (Defaults.OS=linux) then
+  // Do not add it if -Xd option is used
+  if (APackage.NeedLibC or (Defaults.OS=linux)) and
+     ((not Defaults.HaveOptions) or (Defaults.Options.IndexOf('-Xd')=-1)) then
     begin
     begin
       if FCachedlibcPath='' then
       if FCachedlibcPath='' then
         begin
         begin

+ 2 - 2
packages/hash/examples/sha1performancetest.pas

@@ -6,7 +6,7 @@ uses
   {$IFDEF UNIX}{$IFDEF UseCThreads}
   {$IFDEF UNIX}{$IFDEF UseCThreads}
   cthreads,
   cthreads,
   {$ENDIF}{$ENDIF}
   {$ENDIF}{$ENDIF}
-  SysUtils,Classes,sha1,dateutils;
+  SysUtils,Classes,sha1;
 
 
 var
 var
   StartTime: TDateTime;
   StartTime: TDateTime;
@@ -24,6 +24,6 @@ begin
     ss := LowerCase(SHA1Print(SHA1string(s)));
     ss := LowerCase(SHA1Print(SHA1string(s)));
   EndTime:=now;
   EndTime:=now;
   writeln('Performance test finished. Elapsed time:');
   writeln('Performance test finished. Elapsed time:');
-  writeln(TimeToStr(EndTime-StartTime));
+  writeln((EndTime-StartTime)*3600*24:0:3,' s');
 end.
 end.
 
 

+ 6 - 61
packages/pastojs/src/fppas2js.pp

@@ -2159,7 +2159,6 @@ type
       AContext: TConvertContext): TJSElement; virtual;
       AContext: TConvertContext): TJSElement; virtual;
     Function CreateRTTIMemberProperty(Members: TFPList; Index: integer;
     Function CreateRTTIMemberProperty(Members: TFPList; Index: integer;
       AContext: TConvertContext): TJSElement; virtual;
       AContext: TConvertContext): TJSElement; virtual;
-    Procedure CreateRTTIAnonymous(El: TPasType; AContext: TConvertContext); virtual;
     Function CreateRTTIMembers(El: TPasMembersType; Src: TJSSourceElements;
     Function CreateRTTIMembers(El: TPasMembersType; Src: TJSSourceElements;
       FuncContext: TFunctionContext; MembersSrc: TJSSourceElements;
       FuncContext: TFunctionContext; MembersSrc: TJSSourceElements;
       MembersFuncContext: TFunctionContext; RTTIExpr: TJSElement;
       MembersFuncContext: TFunctionContext; RTTIExpr: TJSElement;
@@ -9790,15 +9789,12 @@ begin
   if RightRefDecl is TPasProcedure then
   if RightRefDecl is TPasProcedure then
     begin
     begin
     Proc:=TPasProcedure(RightRefDecl);
     Proc:=TPasProcedure(RightRefDecl);
-    if coShortRefGlobals in Options then
+    if not aResolver.ProcHasSelf(Proc) then
       begin
       begin
-      if not aResolver.ProcHasSelf(Proc) then
-        begin
-        // a.StaticProc  ->  $lp(defaultargs)
-        // ToDo: check if left side has only types (no call nor field)
-        Result:=ConvertIdentifierExpr(RightEl,TPrimitiveExpr(RightEl).Value,aContext);
-        exit;
-        end;
+      // a.StaticProc  ->  pas.unit1.aclass.StaticProc(defaultargs)
+      // ToDo: check if left side has only types (no call nor field)
+      Result:=ConvertIdentifierExpr(RightEl,TPrimitiveExpr(RightEl).Value,aContext);
+      exit;
       end;
       end;
     end;
     end;
 
 
@@ -19965,23 +19961,6 @@ var
     ObjLit.Expr:=JS;
     ObjLit.Expr:=JS;
   end;
   end;
 
 
-  function VarTypeInfoAlreadyCreated(VarType: TPasType): boolean;
-  var
-    i: Integer;
-    PrevMember: TPasElement;
-  begin
-    i:=Index-1;
-    while (i>=0) do
-      begin
-      PrevMember:=TPasElement(Members[i]);
-      if (PrevMember is TPasVariable) and (TPasVariable(PrevMember).VarType=VarType)
-          and IsElementUsed(PrevMember) then
-        exit(true);
-      dec(i);
-      end;
-    Result:=false;
-  end;
-
 var
 var
   JSTypeInfo: TJSElement;
   JSTypeInfo: TJSElement;
   aName: String;
   aName: String;
@@ -19994,10 +19973,7 @@ begin
   V:=TPasVariable(Members[Index]);
   V:=TPasVariable(Members[Index]);
   VarType:=V.VarType;
   VarType:=V.VarType;
   if (VarType<>nil) and (VarType.Name='') then
   if (VarType<>nil) and (VarType.Name='') then
-    begin
-    if not VarTypeInfoAlreadyCreated(VarType) then
-      CreateRTTIAnonymous(VarType,AContext);
-    end;
+    RaiseNotSupported(VarType,AContext,20210223022919);
 
 
   JSTypeInfo:=CreateTypeInfoRef(VarType,AContext,V);
   JSTypeInfo:=CreateTypeInfoRef(VarType,AContext,V);
   OptionsEl:=nil;
   OptionsEl:=nil;
@@ -20315,37 +20291,6 @@ begin
   end;
   end;
 end;
 end;
 
 
-procedure TPasToJSConverter.CreateRTTIAnonymous(El: TPasType;
-  AContext: TConvertContext);
-// if El has any anonymous types, create the RTTI
-var
-  C: TClass;
-  JS: TJSElement;
-  GlobalCtx: TFunctionContext;
-  Src: TJSSourceElements;
-begin
-  if El.Name<>'' then
-    RaiseNotSupported(El,AContext,20170905162324,'inconsistency');
-
-  GlobalCtx:=AContext.GetGlobalFunc;
-  if GlobalCtx=nil then
-    RaiseNotSupported(El,AContext,20181229130835);
-  if not (GlobalCtx.JSElement is TJSSourceElements) then
-    begin
-    {$IFDEF VerbosePas2JS}
-    writeln('TPasToJSConverter.CreateRTTIAnonymous GlobalCtx=',GetObjName(GlobalCtx),' JSElement=',GetObjName(GlobalCtx.JSElement));
-    {$ENDIF}
-    RaiseNotSupported(El,AContext,20181229130926);
-    end;
-  Src:=TJSSourceElements(GlobalCtx.JSElement);
-  C:=El.ClassType;
-  if C=TPasArrayType then
-    begin
-    JS:=ConvertArrayType(TPasArrayType(El),AContext);
-    AddToSourceElements(Src,JS);
-    end;
-end;
-
 function TPasToJSConverter.CreateRTTIMembers(El: TPasMembersType;
 function TPasToJSConverter.CreateRTTIMembers(El: TPasMembersType;
   Src: TJSSourceElements; FuncContext: TFunctionContext;
   Src: TJSSourceElements; FuncContext: TFunctionContext;
   MembersSrc: TJSSourceElements; MembersFuncContext: TFunctionContext;
   MembersSrc: TJSSourceElements; MembersFuncContext: TFunctionContext;

+ 13 - 3
packages/pastojs/tests/tcgenerics.pas

@@ -170,8 +170,8 @@ begin
     '']),
     '']),
     LinesToStr([ // $mod.$main
     LinesToStr([ // $mod.$main
     '$mod.TPoint$G1.x = $mod.p.x + 10;',
     '$mod.TPoint$G1.x = $mod.p.x + 10;',
-    '$mod.p.Fly();',
-    '$mod.p.Fly();',
+    '$mod.TPoint$G1.Fly();',
+    '$mod.TPoint$G1.Fly();',
     '']));
     '']));
 end;
 end;
 
 
@@ -256,6 +256,11 @@ begin
     '      this.x = $impl.TBird.$new();',
     '      this.x = $impl.TBird.$new();',
     '      this.a = rtl.arraySetLength(null, $impl.TBird, 2);',
     '      this.a = rtl.arraySetLength(null, $impl.TBird, 2);',
     '    };',
     '    };',
+    '    this.a$a$clone = function (a) {',
+    '      var r = [];',
+    '      for (var i = 0; i < 2; i++) r.push($impl.TBird.$clone(a[i]));',
+    '      return r;',
+    '    };',
     '    this.$eq = function (b) {',
     '    this.$eq = function (b) {',
     '      return true;',
     '      return true;',
     '    };',
     '    };',
@@ -752,7 +757,7 @@ begin
     '    $mod.TPoint$G1.x = this.x + 5;',
     '    $mod.TPoint$G1.x = this.x + 5;',
     '    $mod.TPoint$G1.x = $mod.TPoint$G1.x + 6;',
     '    $mod.TPoint$G1.x = $mod.TPoint$G1.x + 6;',
     '    this.Fly();',
     '    this.Fly();',
-    '    $mod.TPoint$G1.Fly();',
+    '    this.Fly();',
     '    this.Run();',
     '    this.Run();',
     '    $mod.TPoint$G1.Run();',
     '    $mod.TPoint$G1.Run();',
     '  };',
     '  };',
@@ -1169,6 +1174,11 @@ begin
     '      this.x = $impl.TBird.$new();',
     '      this.x = $impl.TBird.$new();',
     '      this.a = rtl.arraySetLength(null, $impl.TBird, 2);',
     '      this.a = rtl.arraySetLength(null, $impl.TBird, 2);',
     '    };',
     '    };',
+    '    this.a$a$clone = function (a) {',
+    '      var r = [];',
+    '      for (var i = 0; i < 2; i++) r.push($impl.TBird.$clone(a[i]));',
+    '      return r;',
+    '    };',
     '  }, "TAnt<UnitA.TBird>");',
     '  }, "TAnt<UnitA.TBird>");',
     '  $mod.$implcode = function () {',
     '  $mod.$implcode = function () {',
     '    rtl.recNewT($impl, "TBird", function () {',
     '    rtl.recNewT($impl, "TBird", function () {',

+ 139 - 37
packages/pastojs/tests/tcmodules.pas

@@ -380,6 +380,7 @@ type
     Procedure TestEnum_ForIn;
     Procedure TestEnum_ForIn;
     Procedure TestEnum_ScopedNumber;
     Procedure TestEnum_ScopedNumber;
     Procedure TestEnum_InFunction;
     Procedure TestEnum_InFunction;
+    Procedure TestEnum_Name_Anonymous_Unit;
     Procedure TestSet_Enum;
     Procedure TestSet_Enum;
     Procedure TestSet_Operators;
     Procedure TestSet_Operators;
     Procedure TestSet_Operator_In;
     Procedure TestSet_Operator_In;
@@ -522,6 +523,7 @@ type
     Procedure TestClasS_CallInheritedConstructor;
     Procedure TestClasS_CallInheritedConstructor;
     Procedure TestClass_ClassVar_Assign;
     Procedure TestClass_ClassVar_Assign;
     Procedure TestClass_CallClassMethod;
     Procedure TestClass_CallClassMethod;
+    Procedure TestClass_CallClassMethodStatic; // ToDo
     Procedure TestClass_Property;
     Procedure TestClass_Property;
     Procedure TestClass_Property_ClassMethod;
     Procedure TestClass_Property_ClassMethod;
     Procedure TestClass_Property_Indexed;
     Procedure TestClass_Property_Indexed;
@@ -5949,6 +5951,34 @@ begin
     '']));
     '']));
 end;
 end;
 
 
+procedure TTestModule.TestEnum_Name_Anonymous_Unit;
+begin
+  StartUnit(true);
+  Add([
+  'interface',
+  'var color: (red, green);',
+  'implementation',
+  'initialization',
+  '  color:=green;',
+  '']);
+  ConvertUnit;
+  CheckSource('TestEnum_Name_Anonymous_Unit',
+    LinesToStr([
+    'this.color$a = {',
+    '  "0": "red",',
+    '  red: 0,',
+    '  "1": "green",',
+    '  green: 1',
+    '};',
+    'this.color = 0;',
+    '']),
+    LinesToStr([ // this.$init
+    '$mod.color = $mod.color$a.green;',
+    '']),
+    LinesToStr([ // implementation
+    '']) );
+end;
+
 procedure TTestModule.TestSet_Enum;
 procedure TTestModule.TestSet_Enum;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -9455,7 +9485,7 @@ begin
   '  arr2[6,3]:=i;',
   '  arr2[6,3]:=i;',
   '  i:=arr2[5,2];',
   '  i:=arr2[5,2];',
   '  arr2:=arr2;',// clone multi dim static array
   '  arr2:=arr2;',// clone multi dim static array
-  //'  arr3:=arr3;',// clone anonymous multi dim static array
+  '  arr3:=arr3;',// clone anonymous multi dim static array
   '']);
   '']);
   ConvertProgram;
   ConvertProgram;
   CheckSource('TestArray_StaticMultiDim',
   CheckSource('TestArray_StaticMultiDim',
@@ -9467,6 +9497,11 @@ begin
     '};',
     '};',
     'this.Arr = rtl.arraySetLength(null, 0, 3);',
     'this.Arr = rtl.arraySetLength(null, 0, 3);',
     'this.Arr2 = rtl.arraySetLength(null, 0, 2, 3);',
     'this.Arr2 = rtl.arraySetLength(null, 0, 2, 3);',
+    'this.Arr3$a$clone = function (a) {',
+    '  var r = [];',
+    '  for (var i = 0; i < 2; i++) r.push(a[i].slice(0));',
+    '  return r;',
+    '};',
     'this.Arr3 = [[11, 12, 13], [21, 22, 23]];',
     'this.Arr3 = [[11, 12, 13], [21, 22, 23]];',
     'this.i = 0;'
     'this.i = 0;'
     ]),
     ]),
@@ -9483,6 +9518,7 @@ begin
     '$mod.Arr2[1][2] = $mod.i;',
     '$mod.Arr2[1][2] = $mod.i;',
     '$mod.i = $mod.Arr2[0][1];',
     '$mod.i = $mod.Arr2[0][1];',
     '$mod.Arr2 = $mod.TArrayArrayInt$clone($mod.Arr2);',
     '$mod.Arr2 = $mod.TArrayArrayInt$clone($mod.Arr2);',
+    '$mod.Arr3 = $mod.Arr3$a$clone($mod.Arr3);',
     '']));
     '']));
 end;
 end;
 
 
@@ -9504,6 +9540,7 @@ begin
   'begin',
   'begin',
   '  arr2[5]:=arr;',
   '  arr2[5]:=arr;',
   '  arr2:=arr2;',// clone multi dim static array
   '  arr2:=arr2;',// clone multi dim static array
+  '  arr3:=arr3;',// clone multi dim anonymous static array
   'end;',
   'end;',
   'begin',
   'begin',
   '']);
   '']);
@@ -9517,6 +9554,11 @@ begin
     '  for (var i = 0; i < 2; i++) r.push(a[i].slice(0));',
     '  for (var i = 0; i < 2; i++) r.push(a[i].slice(0));',
     '  return r;',
     '  return r;',
     '};',
     '};',
+    'var Arr3$a$clone = function (a) {',
+    '  var r = [];',
+    '  for (var i = 0; i < 2; i++) r.push(a[i].slice(0));',
+    '  return r;',
+    '};',
     'this.DoIt = function () {',
     'this.DoIt = function () {',
     '  var Arr = rtl.arraySetLength(null, 0, 3);',
     '  var Arr = rtl.arraySetLength(null, 0, 3);',
     '  var Arr2 = rtl.arraySetLength(null, 0, 2, 3);',
     '  var Arr2 = rtl.arraySetLength(null, 0, 2, 3);',
@@ -9524,6 +9566,7 @@ begin
     '  var i = 0;',
     '  var i = 0;',
     '  Arr2[0] = Arr.slice(0);',
     '  Arr2[0] = Arr.slice(0);',
     '  Arr2 = TArrayArrayInt$1$clone(Arr2);',
     '  Arr2 = TArrayArrayInt$1$clone(Arr2);',
+    '  Arr3 = Arr3$a$clone(Arr3);',
     '};',
     '};',
     '']),
     '']),
     LinesToStr([ // $mod.$main
     LinesToStr([ // $mod.$main
@@ -11157,26 +11200,28 @@ end;
 procedure TTestModule.TestRecord_Assign;
 procedure TTestModule.TestRecord_Assign;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
-  Add('type');
-  Add('  TEnum = (red,green);');
-  Add('  TEnums = set of TEnum;');
-  Add('  TSmallRec = record');
-  Add('    N: longint;');
-  Add('  end;');
-  Add('  TBigRec = record');
-  Add('    Int: longint;');
-  Add('    D: double;');
-  Add('    Arr: array of longint;');
-  Add('    Arr2: array[1..2] of longint;');
-  Add('    Small: TSmallRec;');
-  Add('    Enums: TEnums;');
-  Add('  end;');
-  Add('var');
-  Add('  r, s: TBigRec;');
-  Add('begin');
-  Add('  r:=s;');
-  Add('  r:=default(TBigRec);');
-  Add('  r:=default(s);');
+  Add([
+  'type',
+  '  TEnum = (red,green);',
+  '  TEnums = set of TEnum;',
+  '  TSmallRec = record',
+  '    N: longint;',
+  '  end;',
+  '  TBigRec = record',
+  '    Int: longint;',
+  '    D: double;',
+  '    Arr: array of longint;',
+  '    Arr2: array[1..2] of longint;',
+  '    Small: TSmallRec;',
+  '    Enums: TEnums;',
+  '  end;',
+  'var',
+  '  r, s: TBigRec;',
+  'begin',
+  '  r:=s;',
+  '  r:=default(TBigRec);',
+  '  r:=default(s);',
+  '']);
   ConvertProgram;
   ConvertProgram;
   CheckSource('TestRecord_Assign',
   CheckSource('TestRecord_Assign',
     LinesToStr([ // statements
     LinesToStr([ // statements
@@ -12091,9 +12136,9 @@ begin
     '$mod.TRec.SetInt($mod.TRec.GetInt() + 2);',
     '$mod.TRec.SetInt($mod.TRec.GetInt() + 2);',
     '$mod.TRec.SetInt($mod.TRec.Fx);',
     '$mod.TRec.SetInt($mod.TRec.Fx);',
     '$mod.TRec.Fy = $mod.r.Fx + 1;',
     '$mod.TRec.Fy = $mod.r.Fx + 1;',
-    'if ($mod.r.GetInt() === 2) ;',
-    '$mod.r.SetInt($mod.r.GetInt() + 2);',
-    '$mod.r.SetInt($mod.r.Fx);',
+    'if ($mod.TRec.GetInt() === 2) ;',
+    '$mod.TRec.SetInt($mod.TRec.GetInt() + 2);',
+    '$mod.TRec.SetInt($mod.r.Fx);',
     '']));
     '']));
 end;
 end;
 
 
@@ -12557,8 +12602,8 @@ begin
     '  $mod.TPoint.Fly();',
     '  $mod.TPoint.Fly();',
     '})();',
     '})();',
     '$mod.TPoint.x = $mod.r.x + 10;',
     '$mod.TPoint.x = $mod.r.x + 10;',
-    '$mod.r.Fly();',
-    '$mod.r.Fly();',
+    '$mod.TPoint.Fly();',
+    '$mod.TPoint.Fly();',
     '']));
     '']));
 end;
 end;
 
 
@@ -13474,6 +13519,63 @@ begin
     '']));
     '']));
 end;
 end;
 
 
+procedure TTestModule.TestClass_CallClassMethodStatic;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '  public',
+  '    class function Fly: tobject; static;',
+  '  end;',
+  'class function tobject.Fly: tobject;',
+  'begin',
+  '  Result.Fly;',
+  '  Result.Fly();',
+  '  Fly;',
+  '  Fly();',
+  '  Fly.Fly;',
+  '  Fly.Fly();',
+  'end;',
+  'var Obj: tobject;',
+  'begin',
+  '  obj.Fly;',
+  '  obj.Fly();',
+  '  with obj do begin',
+  '    Fly;',
+  '    Fly();',
+  '  end;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestClass_CallClassMethodStatic',
+    LinesToStr([ // statements
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Fly = function () {',
+    '    var Result = null;',
+    '    $mod.TObject.Fly();',
+    '    $mod.TObject.Fly();',
+    '    $mod.TObject.Fly();',
+    '    $mod.TObject.Fly();',
+    '    $mod.TObject.Fly();',
+    '    $mod.TObject.Fly();',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.Obj = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.TObject.Fly();',
+    '$mod.TObject.Fly();',
+    'var $with = $mod.Obj;',
+    '$with.Fly();',
+    '$with.Fly();',
+    '']));
+end;
+
 procedure TTestModule.TestClass_Property;
 procedure TTestModule.TestClass_Property;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -22610,21 +22712,21 @@ begin
     'this.c = null;',
     'this.c = null;',
     '']),
     '']),
     LinesToStr([ // $mod.$main
     LinesToStr([ // $mod.$main
-    '$mod.b.SetSpeed($mod.b.GetSpeed() + 12);',
+    '$mod.TObject.SetSpeed($mod.TObject.GetSpeed() + 12);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 13);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 13);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 14);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 14);',
     'var $with = $mod.b;',
     'var $with = $mod.b;',
     '$with.SetSpeed($with.GetSpeed() + 32);',
     '$with.SetSpeed($with.GetSpeed() + 32);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 33);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 33);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 34);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 34);',
-    '$mod.c.SetSpeed($mod.c.GetSpeed() + 12);',
+    '$mod.TObject.SetSpeed($mod.TObject.GetSpeed() + 12);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 13);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 13);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 14);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 14);',
     'var $with1 = $mod.c;',
     'var $with1 = $mod.c;',
     '$with1.SetSpeed($with1.GetSpeed() + 32);',
     '$with1.SetSpeed($with1.GetSpeed() + 32);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 33);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 33);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 34);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 34);',
-    '$mod.TBird.SetSpeed($mod.TBird.GetSpeed() + 12);',
+    '$mod.TObject.SetSpeed($mod.TObject.GetSpeed() + 12);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 13);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 13);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 14);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 14);',
     'var $with2 = $mod.TBird;',
     'var $with2 = $mod.TBird;',
@@ -24410,7 +24512,7 @@ begin
     '']),
     '']),
     LinesToStr([ // $mod.$main
     LinesToStr([ // $mod.$main
     '$mod.THelper.Fly.call({',
     '$mod.THelper.Fly.call({',
-    '  p: $mod.o.GetField(),',
+    '  p: $mod.TObject.GetField(),',
     '  get: function () {',
     '  get: function () {',
     '      return this.p;',
     '      return this.p;',
     '    },',
     '    },',
@@ -24428,7 +24530,7 @@ begin
     '      this.p = v;',
     '      this.p = v;',
     '    }',
     '    }',
     '}, 12);',
     '}, 12);',
-    'var $with1 = $mod.o.GetField();',
+    'var $with1 = $mod.TObject.GetField();',
     '$mod.THelper.Fly.call({',
     '$mod.THelper.Fly.call({',
     '  get: function () {',
     '  get: function () {',
     '      return $with1;',
     '      return $with1;',
@@ -29490,6 +29592,9 @@ begin
   CheckSource('TestRTTI_Class_Field',
   CheckSource('TestRTTI_Class_Field',
     LinesToStr([ // statements
     LinesToStr([ // statements
     'rtl.createClass(this, "TObject", null, function () {',
     'rtl.createClass(this, "TObject", null, function () {',
+    '  $mod.$rtti.$DynArray("TObject.ArrB$a", {',
+    '    eltype: rtl.byte',
+    '  });',
     '  this.$init = function () {',
     '  this.$init = function () {',
     '    this.FPropA = "";',
     '    this.FPropA = "";',
     '    this.VarLI = 0;',
     '    this.VarLI = 0;',
@@ -29521,9 +29626,6 @@ begin
     '  $r.addField("VarShI", rtl.shortint);',
     '  $r.addField("VarShI", rtl.shortint);',
     '  $r.addField("VarBy", rtl.byte);',
     '  $r.addField("VarBy", rtl.byte);',
     '  $r.addField("VarExt", rtl.longint);',
     '  $r.addField("VarExt", rtl.longint);',
-    '  $mod.$rtti.$DynArray("TObject.ArrB$a", {',
-    '    eltype: rtl.byte',
-    '  });',
     '  $r.addField("ArrA", $mod.$rtti["TObject.ArrB$a"]);',
     '  $r.addField("ArrA", $mod.$rtti["TObject.ArrB$a"]);',
     '  $r.addField("ArrB", $mod.$rtti["TObject.ArrB$a"]);',
     '  $r.addField("ArrB", $mod.$rtti["TObject.ArrB$a"]);',
     '});',
     '});',
@@ -30558,6 +30660,9 @@ begin
   CheckSource('TestRTTI_Record',
   CheckSource('TestRTTI_Record',
     LinesToStr([ // statements
     LinesToStr([ // statements
     'rtl.recNewT(this, "TFloatRec", function () {',
     'rtl.recNewT(this, "TFloatRec", function () {',
+    '  $mod.$rtti.$DynArray("TFloatRec.d$a", {',
+    '    eltype: rtl.char',
+    '  });',
     '  this.$new = function () {',
     '  this.$new = function () {',
     '    var r = Object.create(this);',
     '    var r = Object.create(this);',
     '    r.c = [];',
     '    r.c = [];',
@@ -30572,9 +30677,6 @@ begin
     '    this.d = rtl.arrayRef(s.d);',
     '    this.d = rtl.arrayRef(s.d);',
     '    return this;',
     '    return this;',
     '  };',
     '  };',
-    '  $mod.$rtti.$DynArray("TFloatRec.d$a", {',
-    '    eltype: rtl.char',
-    '  });',
     '  var $r = $mod.$rtti.$Record("TFloatRec", {});',
     '  var $r = $mod.$rtti.$Record("TFloatRec", {});',
     '  $r.addField("c", $mod.$rtti["TFloatRec.d$a"]);',
     '  $r.addField("c", $mod.$rtti["TFloatRec.d$a"]);',
     '  $r.addField("d", $mod.$rtti["TFloatRec.d$a"]);',
     '  $r.addField("d", $mod.$rtti["TFloatRec.d$a"]);',

+ 18 - 4
packages/rtl-extra/src/amiga/sockets.pp

@@ -201,12 +201,18 @@ end;
 
 
 function fpgeterrno: longint; inline;
 function fpgeterrno: longint; inline;
 begin
 begin
-  fpgeterrno := bsd_Errno;
+  if Assigned(SocketBase) then
+    fpgeterrno := bsd_Errno
+  else
+    fpgeterrno := 0;
 end;
 end;
 
 
 function fpClose(d: LongInt): LongInt; inline;
 function fpClose(d: LongInt): LongInt; inline;
 begin
 begin
-  fpClose := bsd_CloseSocket(d);
+  if Assigned(SocketBase) then
+    fpClose := bsd_CloseSocket(d)
+  else
+    fpClose := -1;
 end;
 end;
 
 
 function fpaccept(s: cint; addrx: PSockaddr; Addrlen: PSocklen): cint;
 function fpaccept(s: cint; addrx: PSockaddr; Addrlen: PSocklen): cint;
@@ -289,8 +295,16 @@ end;
 
 
 function fpsocket(domain: cint; xtype: cint; protocol: cint): cint;
 function fpsocket(domain: cint; xtype: cint; protocol: cint): cint;
 begin
 begin
-  fpsocket := bsd_socket(domain, xtype, protocol);
-  internal_socketerror := fpgeterrno;
+  if Assigned(SocketBase) then
+  begin
+    fpsocket := bsd_socket(domain, xtype, protocol);
+    internal_socketerror := fpgeterrno;
+  end
+  else
+  begin
+    fpsocket := -1;
+    internal_socketerror := ESockEPROTONOSUPPORT;
+  end;
 end;
 end;
 
 
 
 

+ 30 - 8
packages/rtl-extra/src/aros/sockets.pp

@@ -88,7 +88,7 @@ const
   SOL_SOCKET    = $FFFF;
   SOL_SOCKET    = $FFFF;
 
 
 const
 const
-  EsockEINTR            = 4; // EsysEINTR;   
+  EsockEINTR            = 4; // EsysEINTR;
   EsockEBADF            = 9; // EsysEBADF;
   EsockEBADF            = 9; // EsysEBADF;
   EsockEFAULT           = 14; // EsysEFAULT;
   EsockEFAULT           = 14; // EsysEFAULT;
   EsockEINVAL           = 22; //EsysEINVAL;
   EsockEINVAL           = 22; //EsysEINVAL;
@@ -155,18 +155,24 @@ end;
 
 
 function fpgeterrno: longint; inline;
 function fpgeterrno: longint; inline;
 begin
 begin
-  fpgeterrno := bsd_Errno;
+  if Assigned(SocketBase) then
+    fpgeterrno := bsd_Errno
+  else
+    fpgeterrno := 0;
 end;
 end;
 
 
 function fpClose(d: LongInt): LongInt; inline;
 function fpClose(d: LongInt): LongInt; inline;
 begin
 begin
-  fpClose := bsd_CloseSocket(d);
+  if Assigned(SocketBase) then
+    fpClose := bsd_CloseSocket(d)
+  else
+    fpClose := -1;
 end;
 end;
 
 
 function fpaccept(s: cint; addrx: PSockaddr; Addrlen: PSocklen): cint;
 function fpaccept(s: cint; addrx: PSockaddr; Addrlen: PSocklen): cint;
 begin
 begin
   fpaccept := bsd_accept(s,addrx,addrlen);
   fpaccept := bsd_accept(s,addrx,addrlen);
-  internal_socketerror := fpgeterrno; 
+  internal_socketerror := fpgeterrno;
 end;
 end;
 
 
 function fpbind(s:cint; addrx: psockaddr; addrlen: tsocklen): cint;
 function fpbind(s:cint; addrx: psockaddr; addrlen: tsocklen): cint;
@@ -177,8 +183,16 @@ end;
 
 
 function fpconnect(s:cint; name: psockaddr; namelen: tsocklen): cint;
 function fpconnect(s:cint; name: psockaddr; namelen: tsocklen): cint;
 begin
 begin
-  fpconnect := bsd_connect(s, name, namelen);
-  internal_socketerror := fpgeterrno;
+  if Assigned(SocketBase) then
+  begin
+    fpconnect := bsd_connect(s, name, namelen);
+    internal_socketerror := fpgeterrno;
+  end
+  else
+  begin
+    fpconnect := -1;
+    internal_socketerror := ESockEPROTONOSUPPORT;
+  end;
 end;
 end;
 
 
 function fpgetpeername (s:cint; name  : psockaddr; namelen : psocklen):cint;
 function fpgetpeername (s:cint; name  : psockaddr; namelen : psocklen):cint;
@@ -243,8 +257,16 @@ end;
 
 
 function fpsocket(domain: cint; xtype: cint; protocol: cint): cint;
 function fpsocket(domain: cint; xtype: cint; protocol: cint): cint;
 begin
 begin
-  fpsocket := bsd_socket(domain, xtype, protocol);
-  internal_socketerror := fpgeterrno;
+  if Assigned(SocketBase) then
+  begin
+    fpsocket := bsd_socket(domain, xtype, protocol);
+    internal_socketerror := fpgeterrno;
+  end
+  else
+  begin
+    internal_socketerror := ESockEPROTONOSUPPORT;
+    fpsocket := -1;
+  end;
 end;
 end;
 
 
 
 

+ 13 - 0
packages/rtl-objpas/src/inc/dateutil.inc

@@ -44,6 +44,19 @@ const
   DaySaturday  = 6;
   DaySaturday  = 6;
   DaySunday    = 7;
   DaySunday    = 7;
 
 
+  MonthJanuary   = 1;
+  MonthFebruary  = 2;
+  MonthMarch     = 3;
+  MonthApril     = 4;
+  MonthMay       = 5;
+  MonthJune      = 6;
+  MonthJuly      = 7;
+  MonthAugust    = 8;
+  MonthSeptember = 9;
+  MonthOctober   = 10;
+  MonthNovember  = 11;
+  MonthDecember  = 12;
+
   // Fraction of a day
   // Fraction of a day
   OneHour        = TDateTime(1)/HoursPerDay;
   OneHour        = TDateTime(1)/HoursPerDay;
   OneMinute      = TDateTime(1)/MinsPerDay;
   OneMinute      = TDateTime(1)/MinsPerDay;

+ 2 - 4
packages/rtl-objpas/src/inc/strutils.pp

@@ -429,8 +429,7 @@ begin
       AddMatch(i+1);
       AddMatch(i+1);
       //Only first match ?
       //Only first match ?
       if not aMatchAll then break;
       if not aMatchAll then break;
-      inc(i,OldPatternSize);
-      inc(i,OldPatternSize);
+      inc(i,DeltaJumpTable2[0]);
     end else begin
     end else begin
       i:=i + Max(DeltaJumpTable1[ord(s[i])],DeltaJumpTable2[j]);
       i:=i + Max(DeltaJumpTable1[ord(s[i])],DeltaJumpTable2[j]);
     end;
     end;
@@ -582,8 +581,7 @@ begin
       AddMatch(i+1);
       AddMatch(i+1);
       //Only first match ?
       //Only first match ?
       if not aMatchAll then break;
       if not aMatchAll then break;
-      inc(i,OldPatternSize);
-      inc(i,OldPatternSize);
+      inc(i,DeltaJumpTable2[0]);
     end else begin
     end else begin
       i:=i + Max(DeltaJumpTable1[Ord(lCaseArray[Ord(s[i])])],DeltaJumpTable2[j]);
       i:=i + Max(DeltaJumpTable1[Ord(lCaseArray[Ord(s[i])])],DeltaJumpTable2[j]);
     end;
     end;

+ 15 - 1
packages/rtl-unicode/fpmake.pp

@@ -16,11 +16,13 @@ Const
   CPUnits       = [aix,amiga,aros,android,beos,darwin,iphonesim,ios,emx,gba,nds,freebsd,go32v2,haiku,linux,morphos,netbsd,netware,netwlibc,openbsd,os2,solaris,watcom,wii,win32,win64,wince,dragonfly,freertos];
   CPUnits       = [aix,amiga,aros,android,beos,darwin,iphonesim,ios,emx,gba,nds,freebsd,go32v2,haiku,linux,morphos,netbsd,netware,netwlibc,openbsd,os2,solaris,watcom,wii,win32,win64,wince,dragonfly,freertos];
   utf8bidiOSes  = [netware,netwlibc];
   utf8bidiOSes  = [netware,netwlibc];
   freebidiOSes  = [netware,netwlibc];
   freebidiOSes  = [netware,netwlibc];
+  GraphemeBreakPropertyOSes = AllOSes-[embedded,zxspectrum,msxdos,amstradcpc];
+  EastAsianWidthOSes        = AllOSes-[embedded,zxspectrum,msxdos,amstradcpc];
 
 
 // Character not movable because fpwidestring depends on it.
 // Character not movable because fpwidestring depends on it.
 //  CharacterOSes = [android,darwin,freebsd,linux,netbsd,openbsd,solaris,win32,win64,dragonfly];
 //  CharacterOSes = [android,darwin,freebsd,linux,netbsd,openbsd,solaris,win32,win64,dragonfly];
 
 
-  UnicodeAllOSes =   CollationOSes + utf8bidiOSes + freebidiOSes + CPUnits;
+  UnicodeAllOSes =   CollationOSes + utf8bidiOSes + freebidiOSes + CPUnits + GraphemeBreakPropertyOSes + EastAsianWidthOSes;
 
 
 // Amiga has a crt in its RTL dir, but it is commented in the makefile
 // Amiga has a crt in its RTL dir, but it is commented in the makefile
 
 
@@ -138,6 +140,18 @@ begin
     T:=P.Targets.AddImplicitUnit('cp950.pas',CPUnits);
     T:=P.Targets.AddImplicitUnit('cp950.pas',CPUnits);
 
 
 //    T:=P.Targets.AddUnit('character.pp',characterOSes);
 //    T:=P.Targets.AddUnit('character.pp',characterOSes);
+
+    T:=P.Targets.AddUnit('graphemebreakproperty.pp',GraphemeBreakPropertyOSes);
+    with T.Dependencies do
+      begin
+        AddInclude('graphemebreakproperty_code.inc');
+      end;
+
+    T:=P.Targets.AddUnit('eastasianwidth.pp',EastAsianWidthOSes);
+    with T.Dependencies do
+      begin
+        AddInclude('eastasianwidth_code.inc');
+      end;
   end
   end
 end;
 end;
 
 

+ 55 - 0
packages/rtl-unicode/src/inc/eastasianwidth.pp

@@ -0,0 +1,55 @@
+{ EastAsianWidth Unicode data unit.
+
+  Copyright (C) 2021 Nikolay Nikolov <[email protected]>
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  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. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.
+}
+
+unit eastasianwidth;
+
+{$MODE objfpc}
+
+interface
+
+type
+  TEastAsianWidth = (
+    eawN,
+    eawA,
+    eawF,
+    eawH,
+    eawNa,
+    eawW);
+
+function GetEastAsianWidth(Ch: UCS4Char): TEastAsianWidth;
+
+implementation
+
+function GetEastAsianWidth(Ch: UCS4Char): TEastAsianWidth;
+begin
+  {$I eastasianwidth_code.inc}
+end;
+
+end.

+ 300 - 0
packages/rtl-unicode/src/inc/eastasianwidth_code.inc

@@ -0,0 +1,300 @@
+{ do not edit, this file is autogenerated by the eawparser tool }
+if(Ch=12288)or
+((Ch>=65281)and(Ch<=65376))or
+((Ch>=65504)and(Ch<=65510))then result:=eawF else
+if(Ch=8361)or
+((Ch>=65377)and(Ch<=65470))or
+((Ch>=65474)and(Ch<=65479))or
+((Ch>=65482)and(Ch<=65487))or
+((Ch>=65490)and(Ch<=65495))or
+((Ch>=65498)and(Ch<=65500))or
+((Ch>=65512)and(Ch<=65518))then result:=eawH else
+if((Ch>=32)and(Ch<=126))or
+((Ch>=162)and(Ch<=163))or
+((Ch>=165)and(Ch<=166))or
+(Ch=172)or
+(Ch=175)or
+((Ch>=10214)and(Ch<=10221))or
+((Ch>=10629)and(Ch<=10630))then result:=eawNa else
+case Ch of
+161..168,
+170,
+173..180,
+182..186,
+188..191,
+198,
+208,
+215..216,
+222..225,
+230,
+232..234,
+236..237,
+240,
+242..243,
+247..250,
+252,
+254,
+257,
+273,
+275,
+283,
+294..295,
+299,
+305..307,
+312,
+319..322,
+324,
+328..331,
+333,
+338..339,
+358..359,
+363,
+462,
+464,
+466,
+468,
+470,
+472,
+474,
+476,
+593,
+609,
+708,
+711,
+713..715,
+717,
+720,
+728..731,
+733,
+735,
+768..879,
+913..929,
+931..937,
+945..961,
+963..969,
+1025,
+1040..1103,
+1105,
+8208,
+8211..8214,
+8216..8217,
+8220..8221,
+8224..8226,
+8228..8231,
+8240,
+8242..8243,
+8245,
+8251,
+8254,
+8308,
+8319,
+8321..8324,
+8364,
+8451,
+8453,
+8457,
+8467,
+8470,
+8481..8482,
+8486,
+8491,
+8531..8532,
+8539..8542,
+8544..8555,
+8560..8569,
+8585,
+8592..8601,
+8632..8633,
+8658,
+8660,
+8679,
+8704,
+8706..8707,
+8711..8712,
+8715,
+8719,
+8721,
+8725,
+8730,
+8733..8736,
+8739,
+8741,
+8743..8748,
+8750,
+8756..8759,
+8764..8765,
+8776,
+8780,
+8786,
+8800..8801,
+8804..8807,
+8810..8811,
+8814..8815,
+8834..8835,
+8838..8839,
+8853,
+8857,
+8869,
+8895,
+8978,
+9312..9449,
+9451..9547,
+9552..9587,
+9600..9615,
+9618..9621,
+9632..9633,
+9635..9641,
+9650..9651,
+9654..9655,
+9660..9661,
+9664..9665,
+9670..9672,
+9675,
+9678..9681,
+9698..9701,
+9711,
+9733..9734,
+9737,
+9742..9743,
+9756,
+9758,
+9792,
+9794,
+9824..9825,
+9827..9829,
+9831..9834,
+9836..9837,
+9839,
+9886..9887,
+9919,
+9926..9933,
+9935..9939,
+9941..9953,
+9955,
+9960..9961,
+9963..9969,
+9972,
+9974..9977,
+9979..9980,
+9982..9983,
+10045,
+10102..10111,
+11094..11097,
+12872..12879,
+57344..63743,
+65024..65039,
+65533,
+127232..127242,
+127248..127277,
+127280..127337,
+127344..127373,
+127375..127376,
+127387..127404,
+917760..917999,
+983040..1048573,
+1048576..1114109:result:=eawA;
+4352..4447,
+8986..8987,
+9001..9002,
+9193..9196,
+9200,
+9203,
+9725..9726,
+9748..9749,
+9800..9811,
+9855,
+9875,
+9889,
+9898..9899,
+9917..9918,
+9924..9925,
+9934,
+9940,
+9962,
+9970..9971,
+9973,
+9978,
+9981,
+9989,
+9994..9995,
+10024,
+10060,
+10062,
+10067..10069,
+10071,
+10133..10135,
+10160,
+10175,
+11035..11036,
+11088,
+11093,
+11904..11929,
+11931..12019,
+12032..12245,
+12272..12283,
+12289..12350,
+12353..12438,
+12441..12543,
+12549..12589,
+12593..12686,
+12688..12730,
+12736..12771,
+12784..12830,
+12832..12871,
+12880..13054,
+13056..19903,
+19968..42124,
+42128..42182,
+43360..43388,
+44032..55203,
+63744..64255,
+65040..65049,
+65072..65106,
+65108..65126,
+65128..65131,
+94176,
+94208..100332,
+100352..101106,
+110592..110593,
+126980,
+127183,
+127374,
+127377..127386,
+127488..127490,
+127504..127547,
+127552..127560,
+127568..127569,
+127744..127776,
+127789..127797,
+127799..127868,
+127870..127891,
+127904..127946,
+127951..127955,
+127968..127984,
+127988,
+127992..128062,
+128064,
+128066..128252,
+128255..128317,
+128331..128334,
+128336..128359,
+128378,
+128405..128406,
+128420,
+128507..128591,
+128640..128709,
+128716,
+128720..128722,
+128747..128748,
+128756..128758,
+129296..129310,
+129312..129319,
+129328,
+129331..129342,
+129344..129355,
+129360..129374,
+129408..129425,
+129472,
+131072..196605,
+196608..262141:result:=eawW;
+else result:=eawN end

+ 180 - 0
packages/rtl-unicode/src/inc/graphemebreakproperty.pp

@@ -0,0 +1,180 @@
+{ GraphemeBreakProperty Unicode data unit.
+
+  Copyright (C) 2021 Nikolay Nikolov <[email protected]>
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  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. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.
+}
+
+unit graphemebreakproperty;
+
+{$MODE objfpc}
+
+interface
+
+type
+  TGraphemeBreakProperty = (
+    gbpOther,
+    gbpPrepend,
+    gbpCR,
+    gbpLF,
+    gbpControl,
+    gbpExtend,
+    gpbRegional_Indicator,
+    gbpSpacingMark,
+    gbpL,
+    gbpV,
+    gbpT,
+    gbpLV,
+    gbpLVT,
+    gbpE_Base,
+    gbpE_Modifier,
+    gbpZWJ,
+    gbpGlue_After_Zwj,
+    gbpE_Base_GAZ);
+
+  { TUnicodeStringExtendedGraphemeClustersEnumerator }
+
+  TUnicodeStringExtendedGraphemeClustersEnumerator = class
+  private
+    FStr: UnicodeString;
+    FCurrentIndexStart: SizeInt;
+    FCurrentIndexEnd: SizeInt;
+    FNextIndexEnd: SizeInt;
+    FNextGBP: TGraphemeBreakProperty;
+    FNextCodePoint: UCS4Char;
+    FCurrentGBP: TGraphemeBreakProperty;
+    FCurrentCodePoint: UCS4Char;
+    FRI_Sequence_Length: Integer;
+    FE_Base_EBG_Extend_Sequence: Boolean;
+    function GetCurrent: UnicodeString;
+    procedure FetchNextChar;
+  public
+    constructor Create(const S: UnicodeString);
+    function GetEnumerator: TUnicodeStringExtendedGraphemeClustersEnumerator;
+    function MoveNext: Boolean;
+    property Current: UnicodeString read GetCurrent;
+  end;
+
+function GetGraphemeBreakProperty(Ch: UCS4Char): TGraphemeBreakProperty;
+
+implementation
+
+function GetGraphemeBreakProperty(Ch: UCS4Char): TGraphemeBreakProperty;
+begin
+  {$I graphemebreakproperty_code.inc}
+end;
+
+{ TUnicodeStringExtendedGraphemeClustersEnumerator }
+
+function TUnicodeStringExtendedGraphemeClustersEnumerator.GetCurrent: UnicodeString;
+begin
+  Result := Copy(FStr, FCurrentIndexStart, FCurrentIndexEnd - FCurrentIndexStart + 1);
+end;
+
+procedure TUnicodeStringExtendedGraphemeClustersEnumerator.FetchNextChar;
+begin
+  Inc(FNextIndexEnd);
+  if FNextIndexEnd <= Length(FStr) then
+  begin
+    FNextCodePoint := Ord(FStr[FNextIndexEnd]);
+    { high surrogate, followed by low surrogate? }
+    if (FNextCodePoint >= $D800) and (FNextCodePoint <= $DBFF) and ((FNextIndexEnd + 1) <= Length(FStr)) and
+       (Ord(FStr[FNextIndexEnd + 1]) >= $DC00) and (Ord(FStr[FNextIndexEnd + 1]) <= $DFFF) then
+    begin
+      Inc(FNextIndexEnd);
+      FNextCodePoint := $10000 + (((FNextCodePoint - $D800) shl 10) or (Ord(FStr[FNextIndexEnd]) - $DC00));
+    end;
+  end
+  else
+    FNextCodePoint := 0;
+  FNextGBP := GetGraphemeBreakProperty(FNextCodePoint);
+end;
+
+constructor TUnicodeStringExtendedGraphemeClustersEnumerator.Create(const S: UnicodeString);
+begin
+  FStr := S;
+  FCurrentIndexStart := 0;
+  FCurrentIndexEnd := 0;
+  FNextIndexEnd := 0;
+  FRI_Sequence_Length := 0;
+  FE_Base_EBG_Extend_Sequence := False;
+  FetchNextChar;
+end;
+
+function TUnicodeStringExtendedGraphemeClustersEnumerator.GetEnumerator: TUnicodeStringExtendedGraphemeClustersEnumerator;
+begin
+  Result := Self;
+end;
+
+function TUnicodeStringExtendedGraphemeClustersEnumerator.MoveNext: Boolean;
+begin
+  FCurrentIndexStart := FCurrentIndexEnd + 1;
+  if FCurrentIndexStart > Length(FStr) then
+    Exit(false);
+  repeat
+    FCurrentGBP := FNextGBP;
+    FCurrentCodePoint := FNextCodePoint;
+    FCurrentIndexEnd := FNextIndexEnd;
+    if FCurrentGBP = gpbRegional_Indicator then
+      Inc(FRI_Sequence_Length)
+    else
+      FRI_Sequence_Length := 0;
+    FE_Base_EBG_Extend_Sequence := (FCurrentGBP in [gbpE_Base, gbpE_Base_GAZ]) or (FE_Base_EBG_Extend_Sequence and (FCurrentGBP = gbpExtend));
+    FetchNextChar;
+    if FNextIndexEnd > Length(FStr) then
+      Exit(True);
+
+    { Do not break between a CR and LF. Otherwise, break before and after controls. }
+    if (FCurrentGBP = gbpCR) and (FNextGBP = gbpLF) then
+      continue
+    else if (FCurrentGBP in [gbpControl, gbpCR, gbpLF]) or (FNextGBP in [gbpControl, gbpCR, gbpLF]) then
+      Exit(True)
+    { Do not break Hangul syllable sequences. }
+    else if ((FCurrentGBP = gbpL) and (FNextGBP in [gbpL, gbpV, gbpLV, gbpLVT])) or
+            ((FCurrentGBP in [gbpLV, gbpV]) and (FNextGBP in [gbpV, gbpT])) or
+            ((FCurrentGBP in [gbpLVT, gbpT]) and (FNextGBP = gbpT)) then
+      continue
+    { Do not break before extending characters or ZWJ. }
+    else if FNextGBP in [gbpExtend, gbpZWJ] then
+      continue
+    { Only for extended grapheme clusters:
+      Do not break before SpacingMarks, or after Prepend characters. }
+    else if (FCurrentGBP = gbpPrepend) or (FNextGBP = gbpSpacingMark) then
+      continue
+    { Do not break within emoji modifier sequences or emoji zwj sequences. }
+    else if ((FCurrentGBP = gbpZWJ) and (FNextGBP in [gbpGlue_After_Zwj, gbpE_Base_GAZ])) or
+            (FE_Base_EBG_Extend_Sequence and (FNextGBP = gbpE_Modifier)) then
+      continue
+    { Do not break within emoji flag sequences. That is, do not break between regional indicator (RI) symbols if there is an odd number of RI characters before the break point. }
+    else if (FCurrentGBP = gpbRegional_Indicator) and (FNextGBP = gpbRegional_Indicator) and Odd(FRI_Sequence_Length) then
+      continue
+    { Otherwise, break everywhere. }
+    else
+      Exit(True);
+  until False;
+end;
+
+end.

+ 511 - 0
packages/rtl-unicode/src/inc/graphemebreakproperty_code.inc

@@ -0,0 +1,511 @@
+{ do not edit, this file is autogenerated by the gbpparser tool }
+if Ch=13then result:=gbpCR else
+if Ch=10then result:=gbpLF else
+if Ch=8205then result:=gbpZWJ else
+if(Ch>=127462)and(Ch<=127487)then result:=gpbRegional_Indicator else
+if(Ch>=127995)and(Ch<=127999)then result:=gbpE_Modifier else
+if(Ch>=128102)and(Ch<=128105)then result:=gbpE_Base_GAZ else
+if(Ch>=44032)and(Ch<=55203)then begin if((Ch-44032)mod 28)=0then result:=gbpLV else result:=gbpLVT end else
+if((Ch>=4352)and(Ch<=4447))or
+((Ch>=43360)and(Ch<=43388))then result:=gbpL else
+if((Ch>=4448)and(Ch<=4519))or
+((Ch>=55216)and(Ch<=55238))then result:=gbpV else
+if((Ch>=4520)and(Ch<=4607))or
+((Ch>=55243)and(Ch<=55291))then result:=gbpT else
+if(Ch=10084)or
+(Ch=128139)or
+(Ch=128488)then result:=gbpGlue_After_Zwj else
+if((Ch>=1536)and(Ch<=1541))or
+(Ch=1757)or
+(Ch=1807)or
+(Ch=2274)or
+(Ch=3406)or
+(Ch=69821)or
+((Ch>=70082)and(Ch<=70083))then result:=gbpPrepend else
+if((Ch>=0)and(Ch<=31))or
+((Ch>=127)and(Ch<=159))or
+(Ch=173)or
+(Ch=1564)or
+(Ch=6158)or
+(Ch=8203)or
+((Ch>=8206)and(Ch<=8207))or
+((Ch>=8232)and(Ch<=8238))or
+((Ch>=8288)and(Ch<=8303))or
+((Ch>=55296)and(Ch<=57343))or
+(Ch=65279)or
+((Ch>=65520)and(Ch<=65531))or
+((Ch>=113824)and(Ch<=113827))or
+((Ch>=119155)and(Ch<=119162))or
+((Ch>=917504)and(Ch<=917535))or
+((Ch>=917632)and(Ch<=917759))or
+((Ch>=918000)and(Ch<=921599))then result:=gbpControl else
+if(Ch=9757)or
+(Ch=9977)or
+((Ch>=9994)and(Ch<=9997))or
+(Ch=127877)or
+((Ch>=127939)and(Ch<=127940))or
+((Ch>=127946)and(Ch<=127947))or
+((Ch>=128066)and(Ch<=128067))or
+((Ch>=128070)and(Ch<=128080))or
+(Ch=128110)or
+((Ch>=128112)and(Ch<=128120))or
+(Ch=128124)or
+((Ch>=128129)and(Ch<=128131))or
+((Ch>=128133)and(Ch<=128135))or
+(Ch=128170)or
+(Ch=128373)or
+(Ch=128378)or
+(Ch=128400)or
+((Ch>=128405)and(Ch<=128406))or
+((Ch>=128581)and(Ch<=128583))or
+((Ch>=128587)and(Ch<=128591))or
+(Ch=128675)or
+((Ch>=128692)and(Ch<=128694))or
+(Ch=128704)or
+((Ch>=129304)and(Ch<=129310))or
+(Ch=129318)or
+(Ch=129328)or
+((Ch>=129331)and(Ch<=129337))or
+((Ch>=129340)and(Ch<=129342))then result:=gbpE_Base else
+case Ch of
+768..879,
+1155..1161,
+1425..1469,
+1471,
+1473..1474,
+1476..1477,
+1479,
+1552..1562,
+1611..1631,
+1648,
+1750..1756,
+1759..1764,
+1767..1768,
+1770..1773,
+1809,
+1840..1866,
+1958..1968,
+2027..2035,
+2070..2073,
+2075..2083,
+2085..2087,
+2089..2093,
+2137..2139,
+2260..2306,
+2362,
+2364,
+2369..2376,
+2381,
+2385..2391,
+2402..2403,
+2433,
+2492,
+2494,
+2497..2500,
+2509,
+2519,
+2530..2531,
+2561..2562,
+2620,
+2625..2626,
+2631..2632,
+2635..2637,
+2641,
+2672..2673,
+2677,
+2689..2690,
+2748,
+2753..2757,
+2759..2760,
+2765,
+2786..2787,
+2817,
+2876,
+2878..2879,
+2881..2884,
+2893,
+2902..2903,
+2914..2915,
+2946,
+3006,
+3008,
+3021,
+3031,
+3072,
+3134..3136,
+3142..3144,
+3146..3149,
+3157..3158,
+3170..3171,
+3201,
+3260,
+3263,
+3266,
+3270,
+3276..3277,
+3285..3286,
+3298..3299,
+3329,
+3390,
+3393..3396,
+3405,
+3415,
+3426..3427,
+3530,
+3535,
+3538..3540,
+3542,
+3551,
+3633,
+3636..3642,
+3655..3662,
+3761,
+3764..3769,
+3771..3772,
+3784..3789,
+3864..3865,
+3893,
+3895,
+3897,
+3953..3966,
+3968..3972,
+3974..3975,
+3981..3991,
+3993..4028,
+4038,
+4141..4144,
+4146..4151,
+4153..4154,
+4157..4158,
+4184..4185,
+4190..4192,
+4209..4212,
+4226,
+4229..4230,
+4237,
+4253,
+4957..4959,
+5906..5908,
+5938..5940,
+5970..5971,
+6002..6003,
+6068..6069,
+6071..6077,
+6086,
+6089..6099,
+6109,
+6155..6157,
+6277..6278,
+6313,
+6432..6434,
+6439..6440,
+6450,
+6457..6459,
+6679..6680,
+6683,
+6742,
+6744..6750,
+6752,
+6754,
+6757..6764,
+6771..6780,
+6783,
+6832..6846,
+6912..6915,
+6964,
+6966..6970,
+6972,
+6978,
+7019..7027,
+7040..7041,
+7074..7077,
+7080..7081,
+7083..7085,
+7142,
+7144..7145,
+7149,
+7151..7153,
+7212..7219,
+7222..7223,
+7376..7378,
+7380..7392,
+7394..7400,
+7405,
+7412,
+7416..7417,
+7616..7669,
+7675..7679,
+8204,
+8400..8432,
+11503..11505,
+11647,
+11744..11775,
+12330..12335,
+12441..12442,
+42607..42610,
+42612..42621,
+42654..42655,
+42736..42737,
+43010,
+43014,
+43019,
+43045..43046,
+43204..43205,
+43232..43249,
+43302..43309,
+43335..43345,
+43392..43394,
+43443,
+43446..43449,
+43452,
+43493,
+43561..43566,
+43569..43570,
+43573..43574,
+43587,
+43596,
+43644,
+43696,
+43698..43700,
+43703..43704,
+43710..43711,
+43713,
+43756..43757,
+43766,
+44005,
+44008,
+44013,
+64286,
+65024..65039,
+65056..65071,
+65438..65439,
+66045,
+66272,
+66422..66426,
+68097..68099,
+68101..68102,
+68108..68111,
+68152..68154,
+68159,
+68325..68326,
+69633,
+69688..69702,
+69759..69761,
+69811..69814,
+69817..69818,
+69888..69890,
+69927..69931,
+69933..69940,
+70003,
+70016..70017,
+70070..70078,
+70090..70092,
+70191..70193,
+70196,
+70198..70199,
+70206,
+70367,
+70371..70378,
+70400..70401,
+70460,
+70462,
+70464,
+70487,
+70502..70508,
+70512..70516,
+70712..70719,
+70722..70724,
+70726,
+70832,
+70835..70840,
+70842,
+70845,
+70847..70848,
+70850..70851,
+71087,
+71090..71093,
+71100..71101,
+71103..71104,
+71132..71133,
+71219..71226,
+71229,
+71231..71232,
+71339,
+71341,
+71344..71349,
+71351,
+71453..71455,
+71458..71461,
+71463..71467,
+72752..72758,
+72760..72765,
+72767,
+72850..72871,
+72874..72880,
+72882..72883,
+72885..72886,
+92912..92916,
+92976..92982,
+94095..94098,
+113821..113822,
+119141,
+119143..119145,
+119150..119170,
+119173..119179,
+119210..119213,
+119362..119364,
+121344..121398,
+121403..121452,
+121461,
+121476,
+121499..121503,
+121505..121519,
+122880..122886,
+122888..122904,
+122907..122913,
+122915..122916,
+122918..122922,
+125136..125142,
+125252..125258,
+917536..917999:result:=gbpExtend;
+2307,
+2363,
+2366..2368,
+2377..2380,
+2382..2383,
+2434..2435,
+2495..2496,
+2503..2504,
+2507..2508,
+2563,
+2622..2624,
+2691,
+2750..2752,
+2761,
+2763..2764,
+2818..2819,
+2880,
+2887..2888,
+2891..2892,
+3007,
+3009..3010,
+3014..3016,
+3018..3020,
+3073..3075,
+3137..3140,
+3202..3203,
+3262,
+3264..3265,
+3267..3268,
+3271..3272,
+3274..3275,
+3330..3331,
+3391..3392,
+3398..3400,
+3402..3404,
+3458..3459,
+3536..3537,
+3544..3550,
+3570..3571,
+3635,
+3763,
+3902..3903,
+3967,
+4145,
+4155..4156,
+4182..4183,
+4228,
+6070,
+6078..6085,
+6087..6088,
+6435..6438,
+6441..6443,
+6448..6449,
+6451..6456,
+6681..6682,
+6741,
+6743,
+6765..6770,
+6916,
+6965,
+6971,
+6973..6977,
+6979..6980,
+7042,
+7073,
+7078..7079,
+7082,
+7143,
+7146..7148,
+7150,
+7154..7155,
+7204..7211,
+7220..7221,
+7393,
+7410..7411,
+43043..43044,
+43047,
+43136..43137,
+43188..43203,
+43346..43347,
+43395,
+43444..43445,
+43450..43451,
+43453..43456,
+43567..43568,
+43571..43572,
+43597,
+43755,
+43758..43759,
+43765,
+44003..44004,
+44006..44007,
+44009..44010,
+44012,
+69632,
+69634,
+69762,
+69808..69810,
+69815..69816,
+69932,
+70018,
+70067..70069,
+70079..70080,
+70188..70190,
+70194..70195,
+70197,
+70368..70370,
+70402..70403,
+70463,
+70465..70468,
+70471..70472,
+70475..70477,
+70498..70499,
+70709..70711,
+70720..70721,
+70725,
+70833..70834,
+70841,
+70843..70844,
+70846,
+70849,
+71088..71089,
+71096..71099,
+71102,
+71216..71218,
+71227..71228,
+71230,
+71340,
+71342..71343,
+71350,
+71456..71457,
+71462,
+72751,
+72766,
+72873,
+72881,
+72884,
+94033..94078,
+119142,
+119149:result:=gbpSpacingMark;
+else result:=gbpOther end

+ 1 - 1
packages/tplylib/fpmake.pp

@@ -13,7 +13,7 @@ begin
 {$endif ALLPACKAGES}
 {$endif ALLPACKAGES}
 
 
     P:=AddPackage('tplylib');
     P:=AddPackage('tplylib');
-    P.ShortName:='tplylib';
+    P.ShortName:='tpll';
 {$ifdef ALLPACKAGES}
 {$ifdef ALLPACKAGES}
     P.Directory:=ADirectory;
     P.Directory:=ADirectory;
 {$endif ALLPACKAGES}
 {$endif ALLPACKAGES}

+ 1 - 1
rtl/embedded/Makefile

@@ -374,7 +374,7 @@ CPU_SPECIFIC_COMMON_UNITS=
 ifeq ($(ARCH),arm)
 ifeq ($(ARCH),arm)
 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),armv7m)
 ifeq ($(SUBARCH),armv7m)
-CPU_UNITS=lm3fury lm3tempest stm32f10x_ld stm32f10x_md stm32f10x_hd stm32f10x_xl stm32f10x_conn stm32f10x_cl lpc13xx lpc1768 lm4f120 sam3x8e xmc4500 cortexm3 cortexm4 # thumb2_bare
+CPU_UNITS=lm3fury lm3tempest stm32f10x_ld stm32f10x_md stm32f10x_hd stm32f10x_xl stm32f10x_conn stm32f10x_cl lpc13xx lpc1768 sam3x8e xmc4500 cortexm3 cortexm4 # thumb2_bare
 CPU_UNITS_DEFINED=1
 CPU_UNITS_DEFINED=1
 endif
 endif
 ifeq ($(SUBARCH),armv7em)
 ifeq ($(SUBARCH),armv7em)

+ 1 - 1
rtl/embedded/Makefile.fpc

@@ -71,7 +71,7 @@ CPU_SPECIFIC_COMMON_UNITS=
 ifeq ($(ARCH),arm)
 ifeq ($(ARCH),arm)
 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),armv7m)
 ifeq ($(SUBARCH),armv7m)
-CPU_UNITS=lm3fury lm3tempest stm32f10x_ld stm32f10x_md stm32f10x_hd stm32f10x_xl stm32f10x_conn stm32f10x_cl lpc13xx lpc1768 lm4f120 sam3x8e xmc4500 cortexm3 cortexm4 # thumb2_bare
+CPU_UNITS=lm3fury lm3tempest stm32f10x_ld stm32f10x_md stm32f10x_hd stm32f10x_xl stm32f10x_conn stm32f10x_cl lpc13xx lpc1768 sam3x8e xmc4500 cortexm3 cortexm4 # thumb2_bare
 CPU_UNITS_DEFINED=1
 CPU_UNITS_DEFINED=1
 endif
 endif
 ifeq ($(SUBARCH),armv7em)
 ifeq ($(SUBARCH),armv7em)

+ 13 - 1
rtl/embedded/arm/cortexm4f_start.inc

@@ -43,6 +43,14 @@ asm
   str r1, [r0]
   str r1, [r0]
 {$endif REMAP_VECTTAB}
 {$endif REMAP_VECTTAB}
 
 
+{$if defined(FPUARM_HAS_VFP_EXTENSION)}
+  ldr r0, .Lcpacr
+  ldr r1, [r0]
+  orr r1, r1, #0xf00000
+  str r1, [r0]
+  dsb
+  isb
+{$endif defined(FPUARM_HAS_VFP_EXTENSION)}
   bl PASCALMAIN
   bl PASCALMAIN
   b HaltProc
   b HaltProc
 
 
@@ -56,10 +64,14 @@ asm
   .long _data
   .long _data
 .L_edata:
 .L_edata:
   .long _edata
   .long _edata
+{$if defined(FPUARM_HAS_VFP_EXTENSION)}
+.Lcpacr:
+  .long 0xE000ED88
+{$endif defined(FPUARM_HAS_VFP_EXTENSION)}
 {$ifdef REMAP_VECTTAB}
 {$ifdef REMAP_VECTTAB}
 .Lvtor:
 .Lvtor:
   .long 0xE000ED08
   .long 0xE000ED08
 .Ltext_start:
 .Ltext_start:
   .long _text_start
   .long _text_start
 {$endif REMAP_VECTTAB}
 {$endif REMAP_VECTTAB}
-end;
+end;

+ 13 - 1
rtl/freertos/arm/cortexm4f_start.inc

@@ -43,6 +43,14 @@ asm
   str r1, [r0]
   str r1, [r0]
 {$endif REMAP_VECTTAB}
 {$endif REMAP_VECTTAB}
 
 
+{$if defined(FPUARM_HAS_VFP_EXTENSION)}
+  ldr r0, .Lcpacr
+  ldr r1, [r0]
+  orr r1, r1, #0xf00000
+  str r1, [r0]
+  dsb
+  isb
+{$endif defined(FPUARM_HAS_VFP_EXTENSION)}
   bl PASCALMAIN
   bl PASCALMAIN
   b HaltProc
   b HaltProc
 
 
@@ -56,10 +64,14 @@ asm
   .long _data
   .long _data
 .L_edata:
 .L_edata:
   .long _edata
   .long _edata
+{$if defined(FPUARM_HAS_VFP_EXTENSION)}
+.Lcpacr:
+  .long 0xE000ED88
+{$endif defined(FPUARM_HAS_VFP_EXTENSION)}
 {$ifdef REMAP_VECTTAB}
 {$ifdef REMAP_VECTTAB}
 .Lvtor:
 .Lvtor:
   .long 0xE000ED08
   .long 0xE000ED08
 .Ltext_start:
 .Ltext_start:
   .long _text_start
   .long _text_start
 {$endif REMAP_VECTTAB}
 {$endif REMAP_VECTTAB}
-end;
+end;

+ 7 - 1
rtl/linux/arm/sighnd.inc

@@ -41,6 +41,7 @@ end;
 {$endif not(defined(CPUTHUMB)) and not(defined(CPUTHUMB2))}
 {$endif not(defined(CPUTHUMB)) and not(defined(CPUTHUMB2))}
 
 
 {$if FPC_FULLVERSION >= 30200}
 {$if FPC_FULLVERSION >= 30200}
+{$if defined(CPU_HAS_THUMB))}
 Procedure SignalToHandleErrorAddrFrame_Thumb(Errno : longint;addr : CodePointer; frame : Pointer); nostackframe; assembler;
 Procedure SignalToHandleErrorAddrFrame_Thumb(Errno : longint;addr : CodePointer; frame : Pointer); nostackframe; assembler;
 asm
 asm
 .thumb_func
 .thumb_func
@@ -61,7 +62,8 @@ asm
 .code 32
 .code 32
 {$endif not(defined(CPUTHUMB)) and not(defined(CPUTHUMB2))}
 {$endif not(defined(CPUTHUMB)) and not(defined(CPUTHUMB2))}
 end;
 end;
-{$endif}
+{$endif defined(CPU_HAS_THUMB))}
+{$endif FPC_FULLVERSION >= 30200}
 
 
 procedure SignalToRunerror(Sig: longint; { _a2,_a3,_a4 : dword; } SigContext: PSigInfo; uContext : PuContext); public name '_FPC_DEFAULTSIGHANDLER'; cdecl;
 procedure SignalToRunerror(Sig: longint; { _a2,_a3,_a4 : dword; } SigContext: PSigInfo; uContext : PuContext); public name '_FPC_DEFAULTSIGHANDLER'; cdecl;
 var
 var
@@ -110,7 +112,11 @@ begin
       else
       else
 {$endif not(defined(CPUTHUMB)) and not(defined(CPUTHUMB2))}
 {$endif not(defined(CPUTHUMB)) and not(defined(CPUTHUMB2))}
         begin
         begin
+{$if defined(CPU_HAS_THUMB))}
           ucontext^.uc_mcontext.arm_pc:=ptruint(@SignalToHandleErrorAddrFrame_Thumb);
           ucontext^.uc_mcontext.arm_pc:=ptruint(@SignalToHandleErrorAddrFrame_Thumb);
+{$else defined(CPU_HAS_THUMB))}
+          halt(217);
+{$endif defined(CPU_HAS_THUMB))}
         end;
         end;
 {$else}
 {$else}
       ucontext^.uc_mcontext.arm_pc:=ptruint(@SignalToHandleErrorAddrFrame_ARM);
       ucontext^.uc_mcontext.arm_pc:=ptruint(@SignalToHandleErrorAddrFrame_ARM);

+ 27 - 27
rtl/objpas/math.pp

@@ -1159,7 +1159,7 @@ function sum(const data : array of Single) : float;inline;
 
 
 function sum(const data : PSingle;Const N : longint) : float;
 function sum(const data : PSingle;Const N : longint) : float;
   var
   var
-     i : longint;
+     i : SizeInt;
   begin
   begin
      sum:=0.0;
      sum:=0.0;
      for i:=0 to N-1 do
      for i:=0 to N-1 do
@@ -1186,7 +1186,7 @@ function sum(const data : array of Double) : float; inline;
 
 
 function sum(const data : PDouble;Const N : longint) : float;
 function sum(const data : PDouble;Const N : longint) : float;
   var
   var
-     i : longint;
+     i : SizeInt;
   begin
   begin
      sum:=0.0;
      sum:=0.0;
      for i:=0 to N-1 do
      for i:=0 to N-1 do
@@ -1213,7 +1213,7 @@ function sum(const data : array of Extended) : float; inline;
 
 
 function sum(const data : PExtended;Const N : longint) : float;
 function sum(const data : PExtended;Const N : longint) : float;
   var
   var
-     i : longint;
+     i : SizeInt;
   begin
   begin
      sum:=0.0;
      sum:=0.0;
      for i:=0 to N-1 do
      for i:=0 to N-1 do
@@ -1223,7 +1223,7 @@ function sum(const data : PExtended;Const N : longint) : float;
 
 
 function sumInt(const data : PInt64;Const N : longint) : Int64;
 function sumInt(const data : PInt64;Const N : longint) : Int64;
   var
   var
-     i : longint;
+     i : SizeInt;
   begin
   begin
      sumInt:=0;
      sumInt:=0;
      for i:=0 to N-1 do
      for i:=0 to N-1 do
@@ -1248,7 +1248,7 @@ function mean(const data: array of Int64):Float;
 
 
 function sumInt(const data : PInteger; Const N : longint) : Int64;
 function sumInt(const data : PInteger; Const N : longint) : Int64;
 var
 var
-   i : longint;
+   i : SizeInt;
   begin
   begin
      sumInt:=0;
      sumInt:=0;
      for i:=0 to N-1 do
      for i:=0 to N-1 do
@@ -1279,7 +1279,7 @@ function mean(const data: array of Integer):Float;
 
 
  function sumofsquares(const data : PSingle; Const N : Integer) : float;
  function sumofsquares(const data : PSingle; Const N : Integer) : float;
   var
   var
-     i : longint;
+     i : SizeInt;
   begin
   begin
      sumofsquares:=0.0;
      sumofsquares:=0.0;
      for i:=0 to N-1 do
      for i:=0 to N-1 do
@@ -1295,7 +1295,7 @@ end;
 procedure sumsandsquares(const data : PSingle; Const N : Integer;
 procedure sumsandsquares(const data : PSingle; Const N : Integer;
   var sum,sumofsquares : float);
   var sum,sumofsquares : float);
   var
   var
-     i : Integer;
+     i : SizeInt;
      temp : float;
      temp : float;
   begin
   begin
      sumofsquares:=0.0;
      sumofsquares:=0.0;
@@ -1317,7 +1317,7 @@ procedure sumsandsquares(const data : PSingle; Const N : Integer;
 
 
  function sumofsquares(const data : PDouble; Const N : Integer) : float;
  function sumofsquares(const data : PDouble; Const N : Integer) : float;
   var
   var
-     i : longint;
+     i : SizeInt;
   begin
   begin
      sumofsquares:=0.0;
      sumofsquares:=0.0;
      for i:=0 to N-1 do
      for i:=0 to N-1 do
@@ -1333,7 +1333,7 @@ end;
 procedure sumsandsquares(const data : PDouble; Const N : Integer;
 procedure sumsandsquares(const data : PDouble; Const N : Integer;
   var sum,sumofsquares : float);
   var sum,sumofsquares : float);
   var
   var
-     i : Integer;
+     i : SizeInt;
      temp : float;
      temp : float;
   begin
   begin
      sumofsquares:=0.0;
      sumofsquares:=0.0;
@@ -1355,7 +1355,7 @@ procedure sumsandsquares(const data : PDouble; Const N : Integer;
 
 
  function sumofsquares(const data : PExtended; Const N : Integer) : float;
  function sumofsquares(const data : PExtended; Const N : Integer) : float;
   var
   var
-     i : longint;
+     i : SizeInt;
   begin
   begin
      sumofsquares:=0.0;
      sumofsquares:=0.0;
      for i:=0 to N-1 do
      for i:=0 to N-1 do
@@ -1371,7 +1371,7 @@ end;
 procedure sumsandsquares(const data : PExtended; Const N : Integer;
 procedure sumsandsquares(const data : PExtended; Const N : Integer;
   var sum,sumofsquares : float);
   var sum,sumofsquares : float);
   var
   var
-     i : Integer;
+     i : SizeInt;
      temp : float;
      temp : float;
   begin
   begin
      sumofsquares:=0.0;
      sumofsquares:=0.0;
@@ -1411,7 +1411,7 @@ end;
 {$ifdef FPC_HAS_TYPE_SINGLE}
 {$ifdef FPC_HAS_TYPE_SINGLE}
 procedure MeanAndTotalVariance
 procedure MeanAndTotalVariance
   (const data: PSingle; N: LongInt; var mu, variance: float);
   (const data: PSingle; N: LongInt; var mu, variance: float);
-var i: LongInt;
+var i: SizeInt;
 begin
 begin
   mu := Mean( data, N );
   mu := Mean( data, N );
   variance := 0;
   variance := 0;
@@ -1511,7 +1511,7 @@ procedure momentskewkurtosis(
   out kurtosis: float
   out kurtosis: float
 );
 );
 var
 var
-  i: integer;
+  i: SizeInt;
   value : psingle;
   value : psingle;
   deviation, deviation2: single;
   deviation, deviation2: single;
   reciprocalN: float;
   reciprocalN: float;
@@ -1562,7 +1562,7 @@ function norm(const data : PSingle; Const N : Integer) : float;
 {$ifdef FPC_HAS_TYPE_DOUBLE}
 {$ifdef FPC_HAS_TYPE_DOUBLE}
 procedure MeanAndTotalVariance
 procedure MeanAndTotalVariance
   (const data: PDouble; N: LongInt; var mu, variance: float);
   (const data: PDouble; N: LongInt; var mu, variance: float);
-var i: LongInt;
+var i: SizeInt;
 begin
 begin
   mu := Mean( data, N );
   mu := Mean( data, N );
   variance := 0;
   variance := 0;
@@ -1666,7 +1666,7 @@ procedure momentskewkurtosis(
   out kurtosis: float
   out kurtosis: float
 );
 );
 var
 var
-  i: integer;
+  i: SizeInt;
   value : pdouble;
   value : pdouble;
   deviation, deviation2: double;
   deviation, deviation2: double;
   reciprocalN: float;
   reciprocalN: float;
@@ -1717,7 +1717,7 @@ function norm(const data : PDouble; Const N : Integer) : float;
 {$ifdef FPC_HAS_TYPE_EXTENDED}
 {$ifdef FPC_HAS_TYPE_EXTENDED}
 procedure MeanAndTotalVariance
 procedure MeanAndTotalVariance
   (const data: PExtended; N: LongInt; var mu, variance: float);
   (const data: PExtended; N: LongInt; var mu, variance: float);
-var i: LongInt;
+var i: SizeInt;
 begin
 begin
   mu := Mean( data, N );
   mu := Mean( data, N );
   variance := 0;
   variance := 0;
@@ -1810,7 +1810,7 @@ end;
 
 
 procedure momentskewkurtosis(
 procedure momentskewkurtosis(
   const data: pExtended;
   const data: pExtended;
-  Const N: integer;
+  Const N: Integer;
   out m1: float;
   out m1: float;
   out m2: float;
   out m2: float;
   out m3: float;
   out m3: float;
@@ -1870,7 +1870,7 @@ function norm(const data : PExtended; Const N : Integer) : float;
 
 
 function MinIntValue(const Data: array of Integer): Integer;
 function MinIntValue(const Data: array of Integer): Integer;
 var
 var
-  I: Integer;
+  I: SizeInt;
 begin
 begin
   Result := Data[Low(Data)];
   Result := Data[Low(Data)];
   For I := Succ(Low(Data)) To High(Data) Do
   For I := Succ(Low(Data)) To High(Data) Do
@@ -1879,7 +1879,7 @@ end;
 
 
 function MaxIntValue(const Data: array of Integer): Integer;
 function MaxIntValue(const Data: array of Integer): Integer;
 var
 var
-  I: Integer;
+  I: SizeInt;
 begin
 begin
   Result := Data[Low(Data)];
   Result := Data[Low(Data)];
   For I := Succ(Low(Data)) To High(Data) Do
   For I := Succ(Low(Data)) To High(Data) Do
@@ -1893,7 +1893,7 @@ end;
 
 
 function MinValue(const Data: PInteger; Const N : Integer): Integer;
 function MinValue(const Data: PInteger; Const N : Integer): Integer;
 var
 var
-  I: Integer;
+  I: SizeInt;
 begin
 begin
   Result := Data[0];
   Result := Data[0];
   For I := 1 To N-1 do
   For I := 1 To N-1 do
@@ -1907,7 +1907,7 @@ end;
 
 
 function maxvalue(const data : PInteger; Const N : Integer) : Integer;
 function maxvalue(const data : PInteger; Const N : Integer) : Integer;
 var
 var
-   i : longint;
+   i : SizeInt;
 begin
 begin
    { get an initial value }
    { get an initial value }
    maxvalue:=data[0];
    maxvalue:=data[0];
@@ -1924,7 +1924,7 @@ end;
 
 
 function minvalue(const data : PSingle; Const N : Integer) : Single;
 function minvalue(const data : PSingle; Const N : Integer) : Single;
 var
 var
-   i : longint;
+   i : SizeInt;
 begin
 begin
    { get an initial value }
    { get an initial value }
    minvalue:=data[0];
    minvalue:=data[0];
@@ -1941,7 +1941,7 @@ end;
 
 
 function maxvalue(const data : PSingle; Const N : Integer) : Single;
 function maxvalue(const data : PSingle; Const N : Integer) : Single;
 var
 var
-   i : longint;
+   i : SizeInt;
 begin
 begin
    { get an initial value }
    { get an initial value }
    maxvalue:=data[0];
    maxvalue:=data[0];
@@ -1959,7 +1959,7 @@ end;
 
 
 function minvalue(const data : PDouble; Const N : Integer) : Double;
 function minvalue(const data : PDouble; Const N : Integer) : Double;
 var
 var
-   i : longint;
+   i : SizeInt;
 begin
 begin
    { get an initial value }
    { get an initial value }
    minvalue:=data[0];
    minvalue:=data[0];
@@ -1976,7 +1976,7 @@ end;
 
 
 function maxvalue(const data : PDouble; Const N : Integer) : Double;
 function maxvalue(const data : PDouble; Const N : Integer) : Double;
 var
 var
-   i : longint;
+   i : SizeInt;
 begin
 begin
    { get an initial value }
    { get an initial value }
    maxvalue:=data[0];
    maxvalue:=data[0];
@@ -1994,7 +1994,7 @@ end;
 
 
 function minvalue(const data : PExtended; Const N : Integer) : Extended;
 function minvalue(const data : PExtended; Const N : Integer) : Extended;
 var
 var
-   i : longint;
+   i : SizeInt;
 begin
 begin
    { get an initial value }
    { get an initial value }
    minvalue:=data[0];
    minvalue:=data[0];
@@ -2011,7 +2011,7 @@ end;
 
 
 function maxvalue(const data : PExtended; Const N : Integer) : Extended;
 function maxvalue(const data : PExtended; Const N : Integer) : Extended;
 var
 var
-   i : longint;
+   i : SizeInt;
 begin
 begin
    { get an initial value }
    { get an initial value }
    maxvalue:=data[0];
    maxvalue:=data[0];

+ 34 - 0
tests/test/tandorandnot1.pp

@@ -0,0 +1,34 @@
+{ test (a and b) or (c and not(b)) into c xor ((c xor a) and b) optimization with random values }
+var
+  i,a,b,c,_a,_b,_c : word;
+begin
+  for i:=1 to 1000 do
+    begin
+      a:=random(65536);
+      _a:=a;
+      b:=random(65536);
+      _b:=b;
+      c:=random(65536);
+      _c:=c;
+      if (a and b) or (c and not(b))<>_c xor ((_c xor _a) and _b) then
+        begin
+          writeln('Error: ','a=',a,'b=',b,'c=',c);
+          halt(1);
+        end;
+      if (a and b) or (not(b) and c)<>_c xor ((_c xor _a) and _b) then
+        begin
+          writeln('Error: ','a=',a,'b=',b,'c=',c);
+          halt(1);
+        end;
+      if (not(b) and c) or (a and b)<>_c xor ((_c xor _a) and _b) then
+        begin
+          writeln('Error: ','a=',a,'b=',b,'c=',c);
+          halt(1);
+        end;
+      if (not(b) and c) or (b and a)<>_c xor ((_c xor _a) and _b) then
+        begin
+          writeln('Error: ','a=',a,'b=',b,'c=',c);
+          halt(1);
+        end;
+    end;
+end.

+ 2 - 2
tests/test/tmt1.pp

@@ -11,9 +11,9 @@ uses
   ;
   ;
 
 
 const
 const
-{$ifdef cpuarm}
+{$if defined(cpuarm) or defined(cpuavr) or defined(cpui8086) or defined(cpum68k) or defined(cpumips) or defined(cpuz80)}
   {$define slowcpu}
   {$define slowcpu}
-{$endif cpuarm}
+{$endif}
 
 
 {$ifdef slowcpu}
 {$ifdef slowcpu}
    threadcount = 40;
    threadcount = 40;

+ 79 - 0
tests/test/units/strutils/tboyer.pp

@@ -0,0 +1,79 @@
+{$mode objfpc}
+
+uses
+  StrUtils;
+const
+  result1 : array of SizeInt = (1, 4, 7, 10, 13, 16);
+var 
+  a : array of SizeInt;
+  i : LongInt;
+begin
+  if FindMatchesBoyerMooreCaseSensitive('abcabcabcabcabcabcab','abcab',a,false) then
+    begin
+      if Length(a)<>1 then
+        halt(2);
+      if a[0]<>result1[0] then
+        halt(3);
+    end
+  else
+    halt(1);
+
+  if FindMatchesBoyerMooreCaseSensitive('abcabcabcabcabcabcab','abcab',a,true) then
+    begin
+      if Length(a)<>Length(result1) then
+        halt(12);
+      for i:=Low(a) to High(a) do
+        if a[i]<>result1[i] then
+          halt(13);
+    end
+  else
+    halt(11);
+
+  if FindMatchesBoyerMooreCaseInSensitive('abcabcabcabcabcabcab','abcab',a,false) then
+    begin
+      if Length(a)<>1 then
+        halt(22);
+      if a[0]<>result1[0] then
+        halt(23);
+    end
+  else
+    halt(21);
+
+{
+  apparently not working yet:
+  
+  if FindMatchesBoyerMooreCaseInSensitive('abcabcabcabcabcabcab','abcab',a,true) then
+    begin
+      if Length(a)<>Length(result1) then
+        halt(32);
+      for i:=Low(a) to High(a) do
+        if a[i]<>result1[i] then
+          halt(33);
+    end
+  else
+    halt(31);
+
+  if FindMatchesBoyerMooreCaseInSensitive('abcabcabcAbcabcAbcab','abcaB',a,false) then
+    begin
+      if Length(a)<>1 then
+        halt(42);
+      if a[0]<>result1[0] then
+        halt(43);
+    end
+  else
+    halt(41);
+
+  if FindMatchesBoyerMooreCaseInSensitive('abcabCabcAbcabcABcab','abcaB',a,true) then
+    begin
+      if Length(a)<>Length(result1) then
+        halt(52);
+      for i:=Low(a) to High(a) do
+        if a[i]<>result1[i] then
+          halt(53);
+    end
+  else
+    halt(51);
+}
+
+  writeln('ok');
+end.

+ 8 - 4
tests/utils/dotest.pp

@@ -839,7 +839,7 @@ end;
 function RunCompiler(const ExtraPara: string):boolean;
 function RunCompiler(const ExtraPara: string):boolean;
 var
 var
   args,LocalExtraArgs,
   args,LocalExtraArgs,
-  wpoargs : string;
+  wpoargs,wposuffix : string;
   passnr,
   passnr,
   passes  : longint;
   passes  : longint;
   execres : boolean;
   execres : boolean;
@@ -880,6 +880,7 @@ begin
   if Config.NeedOptions<>'' then
   if Config.NeedOptions<>'' then
    AppendOptions(Config.NeedOptions,args);
    AppendOptions(Config.NeedOptions,args);
   wpoargs:='';
   wpoargs:='';
+  wposuffix:='';
   if (Config.WpoPasses=0) or
   if (Config.WpoPasses=0) or
      (Config.WpoParas='') then
      (Config.WpoParas='') then
     passes:=1
     passes:=1
@@ -891,6 +892,7 @@ begin
     begin
     begin
       if (passes>1) then
       if (passes>1) then
         begin
         begin
+          wposuffix:='_'+tostr(passnr);
           wpoargs:=' -OW'+config.wpoparas+' -FW'+TestOutputFileName('',PPFile[current],'wp'+tostr(passnr));
           wpoargs:=' -OW'+config.wpoparas+' -FW'+TestOutputFileName('',PPFile[current],'wp'+tostr(passnr));
           if (passnr>1) then
           if (passnr>1) then
             wpoargs:=wpoargs+' -Ow'+config.wpoparas+' -Fw'+TestOutputFileName('',PPFile[current],'wp'+tostr(passnr-1));
             wpoargs:=wpoargs+' -Ow'+config.wpoparas+' -Fw'+TestOutputFileName('',PPFile[current],'wp'+tostr(passnr-1));
@@ -899,12 +901,12 @@ begin
       { also get the output from as and ld that writes to stderr sometimes }
       { also get the output from as and ld that writes to stderr sometimes }
       StartTicks:=GetMicroSTicks;
       StartTicks:=GetMicroSTicks;
     {$ifndef macos}
     {$ifndef macos}
-      execres:=ExecuteRedir(CompilerBin,args+wpoargs,'',CompilerLogFile,'stdout');
+      execres:=ExecuteRedir(CompilerBin,args+wpoargs,'',CompilerLogFile+wposuffix,'stdout');
     {$else macos}
     {$else macos}
       {Due to that Toolserver is not reentrant, we have to asm and link via script.}
       {Due to that Toolserver is not reentrant, we have to asm and link via script.}
-      execres:=ExecuteRedir(CompilerBin,'-s '+args+wpoargs,'',CompilerLogFile,'stdout');
+      execres:=ExecuteRedir(CompilerBin,'-s '+args+wpoargs,'',CompilerLogFile+wposuffix,'stdout');
       if execres then
       if execres then
-        execres:=ExecuteRedir(TestOutputDir + ':ppas','','',CompilerLogFile,'stdout');
+        execres:=ExecuteRedir(TestOutputDir + ':ppas','','',CompilerLogFile+wpo_suffix,'stdout');
     {$endif macos}
     {$endif macos}
       EndTicks:=GetMicroSTicks;
       EndTicks:=GetMicroSTicks;
       Verbose(V_Debug,'Exitcode '+ToStr(ExecuteResult));
       Verbose(V_Debug,'Exitcode '+ToStr(ExecuteResult));
@@ -913,6 +915,8 @@ begin
           Verbose(V_Normal,'Compilation took '+ToStr(EndTicks-StartTicks)+' us');
           Verbose(V_Normal,'Compilation took '+ToStr(EndTicks-StartTicks)+' us');
         end;
         end;
 
 
+      if passes > 1 then
+        CopyFile(CompilerLogFile+wposuffix,CompilerLogFile,true);
       { Error during execution? }
       { Error during execution? }
       if (not execres) and (ExecuteResult=0) then
       if (not execres) and (ExecuteResult=0) then
         begin
         begin

+ 11 - 0
tests/webtbf/tw38504.pp

@@ -0,0 +1,11 @@
+{ %fail }
+Var
+  MyVar : char;
+
+Procedure MyProc;
+Begin
+  MyVar := ''; (* <-- two single-quotes *)
+End;
+
+Begin
+End.

+ 11 - 0
tests/webtbf/tw38504b.pp

@@ -0,0 +1,11 @@
+{ %fail }
+Var
+  MyVar : char;
+
+Procedure MyProc;
+Begin
+  MyVar := char('');
+End;
+
+Begin
+End.

+ 7 - 0
tests/webtbs/tw28713.pp

@@ -6,7 +6,14 @@ type
   TWordArray = array [0..1023]of Word;
   TWordArray = array [0..1023]of Word;
 
 
   WordRec = packed record
   WordRec = packed record
+{$ifdef FPC}
+{$ifdef FPC_LITTLE_ENDIAN}
     LoByte,HiByte:Byte
     LoByte,HiByte:Byte
+{$endif}
+{$ifdef FPC_BIG_ENDIAN}
+    HiByte,LoByte:Byte
+{$endif}
+{$endif}
   end;
   end;
 
 
 var
 var

+ 15 - 0
tests/webtbs/tw36250.pp

@@ -0,0 +1,15 @@
+{ %norun }
+{ %target=darwin,ios,iphonesim}
+{ %opt=-gw3 }
+
+{$mode objfpc}{$h+}
+{$ModeSwitch objectivec2}
+
+function NSStringToString(ns: NSString): String;
+begin
+    Result := '';
+end;                 
+
+begin
+  WriteLn(NSStringToString(nil));
+end.

+ 24 - 0
tests/webtbs/tw38497.pp

@@ -0,0 +1,24 @@
+program project1;
+
+{$mode delphi}
+
+type
+  TAlphabet = (A, B, C);
+  TAlphabets = set of TAlphabet;
+
+  procedure Test<TEnum, TSet>(E: TEnum; S: TSet);
+  var
+    I: TEnum;
+    B: Boolean;
+  begin
+    B := [E] <= S;
+    if E in S then
+      WriteLn(E);
+    for I := Low(TEnum) to High(TEnum) do
+      if I in S then
+      WriteLn(I);
+  end;
+
+begin
+  Test<TAlphabet, TAlphabets>(A, [A, B]);
+end.

+ 15 - 0
tests/webtbs/tw38527.pp

@@ -0,0 +1,15 @@
+{%OPT=-O2}
+
+{$mode objfpc}
+
+function F(n: SizeUint): SizeUint;
+begin
+    result := 4 * n + 4 * n;
+end;
+
+begin
+    writeln('Reference F(5): ', 4 * 5 + 4 * 5);
+    writeln(' Actual F(5): ', F(5));
+    if (F(5) <> 40) then
+      halt(1);
+end.

+ 1 - 4
tests/webtbs/tw8177.pp

@@ -6,10 +6,7 @@ program ValidateStrToInt;
   {$mode delphi}
   {$mode delphi}
 {$ENDIF}
 {$ENDIF}
 
 
-{$ifdef cpuarm}
-  {$define slowcpu}
-{$endif}
-{$ifdef cpumips}
+{$if defined(cpuarm) or defined(cpuavr) or defined(cpui8086) or defined(cpum68k) or defined(cpumips) or defined(cpuz80)}
   {$define slowcpu}
   {$define slowcpu}
 {$endif}
 {$endif}
 {$ifdef android}
 {$ifdef android}

+ 1 - 1
utils/json2pas/fpmake.pp

@@ -17,7 +17,7 @@ begin
     P:=AddPackage('utils-json2pas');
     P:=AddPackage('utils-json2pas');
     P.Dependencies.Add('fcl-json');
     P.Dependencies.Add('fcl-json');
 
 
-    P.ShortName:='js2p';
+    P.ShortName:='jsnp';
     P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
     P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
     if Defaults.CPU=jvm then
     if Defaults.CPU=jvm then
       P.OSes := P.OSes - [java,android];
       P.OSes := P.OSes - [java,android];

+ 1 - 1
utils/unicode/cldrparser.lpr

@@ -54,7 +54,7 @@ const
     '         <HaltOnFail> may be one of (y, Y, t, T, 1) to halt the execution on the first failing.' + sLineBreak +
     '         <HaltOnFail> may be one of (y, Y, t, T, 1) to halt the execution on the first failing.' + sLineBreak +
     ' ' + sLineBreak +
     ' ' + sLineBreak +
     '  The program expects some files to be present in the <dataDir> folder : ' + sLineBreak +
     '  The program expects some files to be present in the <dataDir> folder : ' + sLineBreak +
-    '     - UCA_Rules_SHORT.xml ' + sLineBreak +
+    '     - UCA_Rules_SHORT.txt ' + sLineBreak +
     '     - allkeys.txt this is the file allkeys_CLDR.txt renamed to allkeys.txt' + sLineBreak +
     '     - allkeys.txt this is the file allkeys_CLDR.txt renamed to allkeys.txt' + sLineBreak +
     '  These files are in the core.zip file of the CLDR release files. The CLDR''version used should be synchronized the' + sLineBreak +
     '  These files are in the core.zip file of the CLDR release files. The CLDR''version used should be synchronized the' + sLineBreak +
     '  version of the Unicode version used, for example for Uniocde 7 it will be CLDR 26.' + sLineBreak +
     '  version of the Unicode version used, for example for Uniocde 7 it will be CLDR 26.' + sLineBreak +

+ 7 - 7
utils/unicode/data/readme.txt

@@ -1,13 +1,13 @@
 This folder requires the next files to be present:
 This folder requires the next files to be present:
 
 
-  Extracted from http://www.unicode.org/Public/6.2.0/ucd/UCD.zip:
-    * UnicodeData.txt 
+  Extracted from https://www.unicode.org/Public/zipped/9.0.0/UCD.zip:
+    * UnicodeData.txt
     * HangulSyllableType.txt
     * HangulSyllableType.txt
     * PropList.txt
     * PropList.txt
 
 
-  Extracted from http://www.unicode.org/Public/UCA/6.2.0/CollationAuxiliary.zip:
-    * allkeys.txt : this file is actually the allkeys_CLDR.txt file renamed. It is the CLDR's root collation.
-    * UCA_Rules_SHORT.xml
+#???  Extracted from http://www.unicode.org/Public/UCA/6.2.0/CollationAuxiliary.zip:
 
 
-  Extracted from http://www.unicode.org/Public/cldr/22/core.zip (see the "common\collation" folder):
-    * all the language specific xml files (de.xml, es.xml, ...)
+  Extracted from https://www.unicode.org/Public/cldr/30/core.zip
+    * allkeys.txt : this file is actually the allkeys_CLDR.txt file renamed. It is the CLDR's root collation.
+    * UCA_Rules_SHORT.txt
+    * all the language specific xml files (de.xml, es.xml, ...) (see the "common\collation" folder):

+ 58 - 0
utils/unicode/eawparser.lpi

@@ -0,0 +1,58 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="eawparser"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="eawparser.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="eawparser"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

+ 332 - 0
utils/unicode/eawparser.lpr

@@ -0,0 +1,332 @@
+{ Parser and code generator for the EastAsianWidth.
+
+  Copyright (C) 2021 Nikolay Nikolov <[email protected]>
+
+  This source is free software; you can redistribute it and/or modify it under
+  the terms of the GNU General Public License as published by the Free
+  Software Foundation; either version 2 of the License, or (at your option)
+  any later version.
+
+  This code 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.  See the GNU General Public License for more
+  details.
+
+  A copy of the GNU General Public License is available on the World Wide Web
+  at <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
+  to the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor,
+  Boston, MA 02110-1335, USA.
+}
+
+program eawparser;
+
+{$mode objfpc}{$H+}
+
+uses
+  SysUtils, StrUtils;
+
+type
+  TEastAsianWidth = (
+    eawN,
+    eawA,
+    eawF,
+    eawH,
+    eawNa,
+    eawW);
+
+  TRange = record
+    RangeLo, RangeHi: UCS4Char;
+  end;
+  TRanges = array of TRange;
+
+var
+  EastAsianWidths: array [UCS4Char] of TEastAsianWidth;
+  EAWStats: array [TEastAsianWidth] of record
+    Exists: Boolean;
+    Handled: Boolean;
+    MinValue: UCS4Char;
+    MaxValue: UCS4Char;
+    Count: LongInt;
+    Ranges: TRanges;
+  end;
+
+function ParseEastAsianWidth(S: string): TEastAsianWidth;
+begin
+  S := Trim(S);
+  case S of
+    'N':
+      Result := eawN;
+    'A':
+      Result := eawA;
+    'F':
+      Result := eawF;
+    'H':
+      Result := eawH;
+    'Na':
+      Result := eawNa;
+    'W':
+      Result := eawW;
+    else
+      raise EArgumentException('Unknown east asian width: ''' + S + '''');
+  end;
+end;
+
+procedure ParseRange(S: string; out RangeLo, RangeHi: UCS4Char);
+var
+  dp: SizeInt;
+begin
+  S := Trim(S);
+  dp := Pos('..', S);
+  if dp > 0 then
+  begin
+    RangeLo := StrToInt('$' + LeftStr(S, dp - 1));
+    RangeHi := StrToInt('$' + Copy(S, dp + 2, Length(S) - dp + 3));
+  end
+  else
+  begin
+    RangeLo := StrToInt('$' + S);
+    RangeHi := RangeLo;
+  end;
+end;
+
+procedure ParseEastAsianWidths(const FileName: string);
+var
+  InF: TextFile;
+  S: string;
+  SplitS: TStringArray;
+  LineNr: Integer = 0;
+  eaw: TEastAsianWidth;
+  RangeLo, RangeHi, R: UCS4Char;
+begin
+  { - All code points, assigned or unassigned, that are not listed
+      explicitly are given the value "N". }
+  for R in UCS4Char do
+    EastAsianWidths[R] := eawN;
+  { - The unassigned code points in the following blocks default to "W":
+           CJK Unified Ideographs Extension A: U+3400..U+4DBF
+           CJK Unified Ideographs:             U+4E00..U+9FFF
+           CJK Compatibility Ideographs:       U+F900..U+FAFF }
+  for R := $3400 to $4DBF do
+    EastAsianWidths[R] := eawW;
+  for R := $4E00 to $9FFF do
+    EastAsianWidths[R] := eawW;
+  for R := $F900 to $FAFF do
+    EastAsianWidths[R] := eawW;
+  { - All undesignated code points in Planes 2 and 3, whether inside or
+        outside of allocated blocks, default to "W":
+           Plane 2:                            U+20000..U+2FFFD
+           Plane 3:                            U+30000..U+3FFFD }
+  for R := $20000 to $2FFFD do
+    EastAsianWidths[R] := eawW;
+  for R := $30000 to $3FFFD do
+    EastAsianWidths[R] := eawW;
+
+  if not FileExists(FileName) then
+  begin
+    Writeln('File doesn''t exist: ', FileName);
+    Halt(1);
+  end;
+  AssignFile(InF, FileName);
+  Reset(InF);
+  while not EoF(InF) do
+  begin
+    Inc(LineNr);
+    Readln(InF, S);
+    S := Trim(S);
+    if Pos('#', S) > 0 then
+      S := LeftStr(S, Pos('#', S) - 1);
+    if S <> '' then
+    begin
+      SplitS := S.Split([';']);
+      if Length(SplitS) <> 2 then
+        raise Exception.Create('Invalid number of ; separators on line ' + IntToStr(LineNr));
+      ParseRange(SplitS[0], RangeLo, RangeHi);
+      eaw := ParseEastAsianWidth(SplitS[1]);
+      for R := RangeLo to RangeHi do
+        EastAsianWidths[R] := eaw;
+    end;
+  end;
+  CloseFile(InF);
+end;
+
+procedure CalcStatsAndRanges;
+var
+  Ch: UCS4Char;
+  eaw, prev_eaw: TEastAsianWidth;
+begin
+  FillChar(EAWStats, SizeOf(EAWStats), 0);
+  eaw := Low(TEastAsianWidth);
+  for Ch := Low(UCS4Char) to High(UCS4Char) do
+  begin
+    prev_eaw := eaw;
+    eaw := EastAsianWidths[Ch];
+    with EAWStats[eaw] do
+    begin
+      if not Exists then
+      begin
+        Exists := True;
+        MinValue := Ch;
+        MaxValue := Ch;
+        Count := 1;
+        SetLength(Ranges, 1);
+        Ranges[0].RangeLo := Ch;
+        Ranges[0].RangeHi := Ch;
+      end
+      else
+      begin
+        MaxValue := Ch;
+        Inc(Count);
+        if prev_eaw <> eaw then
+        begin
+          SetLength(Ranges, Length(Ranges) + 1);
+          with Ranges[High(Ranges)] do
+          begin
+            RangeLo := Ch;
+            RangeHi := Ch;
+          end;
+        end
+        else
+          Ranges[High(Ranges)].RangeHi := Ch;
+      end;
+    end;
+  end;
+end;
+
+procedure MaybeCoalesceRanges(RLo, RHi: UCS4Char);
+var
+  eaw: TEastAsianWidth;
+  RI: Integer;
+begin
+  for eaw := Succ(Low(TEastAsianWidth)) to High(TEastAsianWidth) do
+    if EAWStats[eaw].Exists and (not EAWStats[eaw].Handled) then
+    begin
+      for RI := 0 to High(EAWStats[eaw].Ranges) - 1 do
+        if (EAWStats[eaw].Ranges[RI].RangeHi = (RLo - 1)) and
+           (EAWStats[eaw].Ranges[RI + 1].RangeLo = (RHi + 1)) then
+        begin
+          EAWStats[eaw].Ranges[RI].RangeHi := EAWStats[eaw].Ranges[RI + 1].RangeHi;
+          Delete(EAWStats[eaw].Ranges, RI + 1, 1);
+          exit;
+        end;
+    end;
+end;
+
+function FindMinRangeCount: Integer;
+var
+  eaw: TEastAsianWidth;
+begin
+  Result := High(Integer);
+  for eaw := Succ(Low(TEastAsianWidth)) to High(TEastAsianWidth) do
+    if EAWStats[eaw].Exists and (not EAWStats[eaw].Handled) and (Length(EAWStats[eaw].Ranges) < Result) then
+      Result := Length(EAWStats[eaw].Ranges);
+end;
+
+procedure GenCode(const OutFileName: string);
+const
+  RangeCountThreshold = 30{400};
+var
+  eaw: TEastAsianWidth;
+  RI, NextRangeCount: Integer;
+  OutFile: TextFile;
+begin
+  Writeln('Generating file: ', OutFileName);
+
+  AssignFile(OutFile, OutFileName);
+  Rewrite(OutFile);
+
+  Writeln(OutFile, '{ do not edit, this file is autogenerated by the eawparser tool }');
+
+  { unused properties are already handled }
+  for eaw := Succ(Low(TEastAsianWidth)) to High(TEastAsianWidth) do
+    if not EAWStats[eaw].Exists then
+      EAWStats[eaw].Handled := True;
+
+  { handle single codepoints first }
+  for eaw := Succ(Low(TEastAsianWidth)) to High(TEastAsianWidth) do
+    if (not EAWStats[eaw].Handled) and (EAWStats[eaw].Count = 1) then
+    begin
+      if EAWStats[eaw].MinValue <> EAWStats[eaw].MaxValue then
+        raise Exception.Create('Internal error');
+      Writeln(OutFile, 'if Ch=', EAWStats[eaw].MinValue, 'then result:=',eaw,' else');
+      EAWStats[eaw].Handled := True;
+      MaybeCoalesceRanges(EAWStats[eaw].MinValue, EAWStats[eaw].MaxValue);
+    end;
+
+  { handle single range codepoints next }
+  while FindMinRangeCount = 1 do
+    for eaw := Succ(Low(TEastAsianWidth)) to High(TEastAsianWidth) do
+      if (not EAWStats[eaw].Handled) and (Length(EAWStats[eaw].Ranges) = 1) then
+      begin
+        Writeln(OutFile, 'if(Ch>=', EAWStats[eaw].MinValue, ')and(Ch<=', EAWStats[eaw].MaxValue, ')then result:=',eaw,' else');
+        EAWStats[eaw].Handled := True;
+        MaybeCoalesceRanges(EAWStats[eaw].MinValue, EAWStats[eaw].MaxValue);
+      end;
+
+  repeat
+    NextRangeCount := FindMinRangeCount;
+    if NextRangeCount <= RangeCountThreshold then
+      for eaw := Succ(Low(TEastAsianWidth)) to High(TEastAsianWidth) do
+      begin
+        if not EAWStats[eaw].Handled and (Length(EAWStats[eaw].Ranges) <= NextRangeCount) then
+        begin
+          EAWStats[eaw].Handled := True;
+          Write(OutFile, 'if');
+          for RI := 0 to High(EAWStats[eaw].Ranges) do
+          begin
+            if RI <> 0 then
+              Writeln(OutFile, 'or');
+            with EAWStats[eaw].Ranges[RI] do
+            begin
+              if RangeLo = RangeHi then
+                Write(OutFile, '(Ch=', RangeLo, ')')
+              else
+                Write(OutFile, '((Ch>=', RangeLo, ')and(Ch<=', RangeHi, '))');
+              MaybeCoalesceRanges(RangeLo, RangeHi);
+            end;
+          end;
+          Writeln(OutFile, 'then result:=',eaw,' else');
+        end;
+      end;
+  until NextRangeCount > RangeCountThreshold;
+
+  if NextRangeCount <> High(Integer) then
+  begin
+    //for eaw := Succ(Low(TGraphemeBreakProperty)) to High(TGraphemeBreakProperty) do
+    //  if not EAWStats[eaw].Handled then
+    //    Writeln(eaw, ' ', EAWStats[eaw].MinValue, '..', EAWStats[eaw].MaxValue, ' ', EAWStats[eaw].Count, ' ', Length(EAWStats[eaw].Ranges), ' ', (EAWStats[eaw].MaxValue - EAWStats[eaw].MinValue + 7) div 8);
+    Writeln(OutFile, 'case Ch of');
+    for eaw := Succ(Low(TEastAsianWidth)) to High(TEastAsianWidth) do
+    begin
+      if not EAWStats[eaw].Handled then
+      begin
+        EAWStats[eaw].Handled := True;
+        for RI := 0 to High(EAWStats[eaw].Ranges) do
+        begin
+          if RI <> 0 then
+            Writeln(OutFile, ',');
+          with EAWStats[eaw].Ranges[RI] do
+          begin
+            if RangeLo = RangeHi then
+              Write(OutFile, RangeLo)
+            else
+              Write(OutFile, RangeLo, '..', RangeHi);
+          end;
+        end;
+        Writeln(OutFile, ':result:=', eaw, ';');
+      end;
+    end;
+    Writeln(OutFile, 'else result:=eawN end');
+  end
+  else
+    Writeln(OutFile, 'result:=eawN');
+
+  CloseFile(OutFile);
+end;
+
+begin
+  ParseEastAsianWidths('data/UCD/EastAsianWidth.txt');
+  CalcStatsAndRanges;
+  GenCode('eastasianwidth_code.inc');
+  Writeln('Done');
+end.
+

+ 2 - 0
utils/unicode/fpmake.pp

@@ -60,6 +60,8 @@ begin
 
 
     T:=P.Targets.AddProgram('cldrparser.lpr');
     T:=P.Targets.AddProgram('cldrparser.lpr');
     T:=P.Targets.AddProgram('unihelper.lpr');
     T:=P.Targets.AddProgram('unihelper.lpr');
+    T:=P.Targets.AddProgram('gbpparser.lpr');
+    T:=P.Targets.AddProgram('eawparser.lpr');
 
 
     end;
     end;
 end;
 end;

+ 58 - 0
utils/unicode/gbpparser.lpi

@@ -0,0 +1,58 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="gbpparser"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="gbpparser.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="gbpparser"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

+ 379 - 0
utils/unicode/gbpparser.lpr

@@ -0,0 +1,379 @@
+{ Parser and code generator for the GraphemeBreakProperty.
+
+  Copyright (C) 2021 Nikolay Nikolov <[email protected]>
+
+  This source is free software; you can redistribute it and/or modify it under
+  the terms of the GNU General Public License as published by the Free
+  Software Foundation; either version 2 of the License, or (at your option)
+  any later version.
+
+  This code 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.  See the GNU General Public License for more
+  details.
+
+  A copy of the GNU General Public License is available on the World Wide Web
+  at <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
+  to the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor,
+  Boston, MA 02110-1335, USA.
+}
+
+
+program gbpparser;
+
+{$mode objfpc}{$H+}
+
+uses
+  SysUtils, StrUtils;
+
+type
+  TGraphemeBreakProperty = (
+    gbpOther,
+    gbpPrepend,
+    gbpCR,
+    gbpLF,
+    gbpControl,
+    gbpExtend,
+    gpbRegional_Indicator,
+    gbpSpacingMark,
+    gbpL,
+    gbpV,
+    gbpT,
+    gbpLV,
+    gbpLVT,
+    gbpE_Base,
+    gbpE_Modifier,
+    gbpZWJ,
+    gbpGlue_After_Zwj,
+    gbpE_Base_GAZ);
+
+  TRange = record
+    RangeLo, RangeHi: UCS4Char;
+  end;
+  TRanges = array of TRange;
+
+var
+  GraphemeBreakProperties: array [UCS4Char] of TGraphemeBreakProperty;
+  GBPStats: array [TGraphemeBreakProperty] of record
+    Exists: Boolean;
+    Handled: Boolean;
+    MinValue: UCS4Char;
+    MaxValue: UCS4Char;
+    Count: LongInt;
+    Ranges: TRanges;
+  end;
+
+function ParseGraphemeBreakProperty(S: string): TGraphemeBreakProperty;
+begin
+  S := Trim(S);
+  case S of
+    'Prepend':
+      Result := gbpPrepend;
+    'CR':
+      Result := gbpCR;
+    'LF':
+      Result := gbpLF;
+    'Control':
+      Result := gbpControl;
+    'Extend':
+      Result := gbpExtend;
+    'Regional_Indicator':
+      Result := gpbRegional_Indicator;
+    'SpacingMark':
+      Result := gbpSpacingMark;
+    'L':
+      Result := gbpL;
+    'V':
+      Result := gbpV;
+    'T':
+      Result := gbpT;
+    'LV':
+      Result := gbpLV;
+    'LVT':
+      Result := gbpLVT;
+    'E_Base':
+      Result := gbpE_Base;
+    'E_Modifier':
+      Result := gbpE_Modifier;
+    'ZWJ':
+      Result := gbpZWJ;
+    'Glue_After_Zwj':
+      Result := gbpGlue_After_Zwj;
+    'E_Base_GAZ':
+      Result := gbpE_Base_GAZ;
+    else
+      raise EArgumentException('Unknown grapheme break property: ''' + S + '''');
+  end;
+end;
+
+procedure ParseRange(S: string; out RangeLo, RangeHi: UCS4Char);
+var
+  dp: SizeInt;
+begin
+  S := Trim(S);
+  dp := Pos('..', S);
+  if dp > 0 then
+  begin
+    RangeLo := StrToInt('$' + LeftStr(S, dp - 1));
+    RangeHi := StrToInt('$' + Copy(S, dp + 2, Length(S) - dp + 3));
+  end
+  else
+  begin
+    RangeLo := StrToInt('$' + S);
+    RangeHi := RangeLo;
+  end;
+end;
+
+procedure ParseGraphemeBreakProperties(const FileName: string);
+var
+  InF: TextFile;
+  S: string;
+  SplitS: TStringArray;
+  LineNr: Integer = 0;
+  gbp: TGraphemeBreakProperty;
+  RangeLo, RangeHi, R: UCS4Char;
+begin
+  if not FileExists(FileName) then
+  begin
+    Writeln('File doesn''t exist: ', FileName);
+    Halt(1);
+  end;
+  AssignFile(InF, FileName);
+  Reset(InF);
+  while not EoF(InF) do
+  begin
+    Inc(LineNr);
+    Readln(InF, S);
+    S := Trim(S);
+    if Pos('#', S) > 0 then
+      S := LeftStr(S, Pos('#', S) - 1);
+    if S <> '' then
+    begin
+      SplitS := S.Split([';']);
+      if Length(SplitS) <> 2 then
+        raise Exception.Create('Invalid number of ; separators on line ' + IntToStr(LineNr));
+      ParseRange(SplitS[0], RangeLo, RangeHi);
+      gbp := ParseGraphemeBreakProperty(SplitS[1]);
+      for R := RangeLo to RangeHi do
+        GraphemeBreakProperties[R] := gbp;
+    end;
+  end;
+  CloseFile(InF);
+end;
+
+procedure CalcStatsAndRanges;
+var
+  Ch: UCS4Char;
+  gbp, prev_gbp: TGraphemeBreakProperty;
+begin
+  FillChar(GBPStats, SizeOf(GBPStats), 0);
+  gbp := Low(TGraphemeBreakProperty);
+  for Ch := Low(UCS4Char) to High(UCS4Char) do
+  begin
+    prev_gbp := gbp;
+    gbp := GraphemeBreakProperties[Ch];
+    with GBPStats[gbp] do
+    begin
+      if not Exists then
+      begin
+        Exists := True;
+        MinValue := Ch;
+        MaxValue := Ch;
+        Count := 1;
+        SetLength(Ranges, 1);
+        Ranges[0].RangeLo := Ch;
+        Ranges[0].RangeHi := Ch;
+      end
+      else
+      begin
+        MaxValue := Ch;
+        Inc(Count);
+        if prev_gbp <> gbp then
+        begin
+          SetLength(Ranges, Length(Ranges) + 1);
+          with Ranges[High(Ranges)] do
+          begin
+            RangeLo := Ch;
+            RangeHi := Ch;
+          end;
+        end
+        else
+          Ranges[High(Ranges)].RangeHi := Ch;
+      end;
+    end;
+  end;
+end;
+
+procedure MaybeCoalesceRanges(RLo, RHi: UCS4Char);
+var
+  gbp: TGraphemeBreakProperty;
+  RI: Integer;
+begin
+  for gbp := Succ(Low(TGraphemeBreakProperty)) to High(TGraphemeBreakProperty) do
+    if GBPStats[gbp].Exists and (not GBPStats[gbp].Handled) then
+    begin
+      for RI := 0 to High(GBPStats[gbp].Ranges) - 1 do
+        if (GBPStats[gbp].Ranges[RI].RangeHi = (RLo - 1)) and
+           (GBPStats[gbp].Ranges[RI + 1].RangeLo = (RHi + 1)) then
+        begin
+          GBPStats[gbp].Ranges[RI].RangeHi := GBPStats[gbp].Ranges[RI + 1].RangeHi;
+          Delete(GBPStats[gbp].Ranges, RI + 1, 1);
+          exit;
+        end;
+    end;
+end;
+
+function FindMinRangeCount: Integer;
+var
+  gbp: TGraphemeBreakProperty;
+begin
+  Result := High(Integer);
+  for gbp := Succ(Low(TGraphemeBreakProperty)) to High(TGraphemeBreakProperty) do
+    if GBPStats[gbp].Exists and (not GBPStats[gbp].Handled) and (Length(GBPStats[gbp].Ranges) < Result) then
+      Result := Length(GBPStats[gbp].Ranges);
+end;
+
+function ApplyLV_LVTCompression: Boolean;
+const
+  RangeLo = 44032;
+  RangeHi = 55203;
+var
+  Ch: UCS4Char;
+begin
+  Result := False;
+  if (GBPStats[gbpLV].MinValue <> RangeLo) or (GBPStats[gbpLV].MaxValue <> (RangeHi - 27)) or
+     (GBPStats[gbpLVT].MinValue <> (RangeLo + 1)) or (GBPStats[gbpLVT].MaxValue <> RangeHi) then
+    exit;
+  for Ch := RangeLo to RangeHi do
+  begin
+    if ((Ch - RangeLo) mod 28) = 0 then
+    begin
+      if GraphemeBreakProperties[Ch] <> gbpLV then
+        exit;
+    end
+    else
+    begin
+      if GraphemeBreakProperties[Ch] <> gbpLVT then
+        exit;
+    end;
+  end;
+  Result := True;
+end;
+
+procedure GenCode(const OutFileName: string);
+const
+  RangeCountThreshold = 30{400};
+var
+  gbp: TGraphemeBreakProperty;
+  RI, NextRangeCount: Integer;
+  OutFile: TextFile;
+begin
+  Writeln('Generating file: ', OutFileName);
+
+  AssignFile(OutFile, OutFileName);
+  Rewrite(OutFile);
+
+  Writeln(OutFile, '{ do not edit, this file is autogenerated by the gbpparser tool }');
+
+  { unused properties are already handled }
+  for gbp := Succ(Low(TGraphemeBreakProperty)) to High(TGraphemeBreakProperty) do
+    if not GBPStats[gbp].Exists then
+      GBPStats[gbp].Handled := True;
+
+  { handle single codepoints first }
+  for gbp := Succ(Low(TGraphemeBreakProperty)) to High(TGraphemeBreakProperty) do
+    if (not GBPStats[gbp].Handled) and (GBPStats[gbp].Count = 1) then
+    begin
+      if GBPStats[gbp].MinValue <> GBPStats[gbp].MaxValue then
+        raise Exception.Create('Internal error');
+      Writeln(OutFile, 'if Ch=', GBPStats[gbp].MinValue, 'then result:=',gbp,' else');
+      GBPStats[gbp].Handled := True;
+      MaybeCoalesceRanges(GBPStats[gbp].MinValue, GBPStats[gbp].MaxValue);
+    end;
+
+  { handle single range codepoints next }
+  while FindMinRangeCount = 1 do
+    for gbp := Succ(Low(TGraphemeBreakProperty)) to High(TGraphemeBreakProperty) do
+      if (not GBPStats[gbp].Handled) and (Length(GBPStats[gbp].Ranges) = 1) then
+      begin
+        Writeln(OutFile, 'if(Ch>=', GBPStats[gbp].MinValue, ')and(Ch<=', GBPStats[gbp].MaxValue, ')then result:=',gbp,' else');
+        GBPStats[gbp].Handled := True;
+        MaybeCoalesceRanges(GBPStats[gbp].MinValue, GBPStats[gbp].MaxValue);
+      end;
+
+  if ApplyLV_LVTCompression then
+  begin
+    Writeln(OutFile, 'if(Ch>=44032)and(Ch<=55203)then begin if((Ch-44032)mod 28)=0then result:=gbpLV else result:=gbpLVT end else');
+    GBPStats[gbpLV].Handled := True;
+    GBPStats[gbpLVT].Handled := True;
+  end;
+
+  repeat
+    NextRangeCount := FindMinRangeCount;
+    if NextRangeCount <= RangeCountThreshold then
+      for gbp := Succ(Low(TGraphemeBreakProperty)) to High(TGraphemeBreakProperty) do
+      begin
+        if not GBPStats[gbp].Handled and (Length(GBPStats[gbp].Ranges) <= NextRangeCount) then
+        begin
+          GBPStats[gbp].Handled := True;
+          Write(OutFile, 'if');
+          for RI := 0 to High(GBPStats[gbp].Ranges) do
+          begin
+            if RI <> 0 then
+              Writeln(OutFile, 'or');
+            with GBPStats[gbp].Ranges[RI] do
+            begin
+              if RangeLo = RangeHi then
+                Write(OutFile, '(Ch=', RangeLo, ')')
+              else
+                Write(OutFile, '((Ch>=', RangeLo, ')and(Ch<=', RangeHi, '))');
+              MaybeCoalesceRanges(RangeLo, RangeHi);
+            end;
+          end;
+          Writeln(OutFile, 'then result:=',gbp,' else');
+        end;
+      end;
+  until NextRangeCount > RangeCountThreshold;
+
+  if NextRangeCount <> High(Integer) then
+  begin
+    //for gbp := Succ(Low(TGraphemeBreakProperty)) to High(TGraphemeBreakProperty) do
+    //  if not GBPStats[gbp].Handled then
+    //    Writeln(gbp, ' ', GBPStats[gbp].MinValue, '..', GBPStats[gbp].MaxValue, ' ', GBPStats[gbp].Count, ' ', Length(GBPStats[gbp].Ranges), ' ', (GBPStats[gbp].MaxValue - GBPStats[gbp].MinValue + 7) div 8);
+    Writeln(OutFile, 'case Ch of');
+    for gbp := Succ(Low(TGraphemeBreakProperty)) to High(TGraphemeBreakProperty) do
+    begin
+      if not GBPStats[gbp].Handled then
+      begin
+        GBPStats[gbp].Handled := True;
+        for RI := 0 to High(GBPStats[gbp].Ranges) do
+        begin
+          if RI <> 0 then
+            Writeln(OutFile, ',');
+          with GBPStats[gbp].Ranges[RI] do
+          begin
+            if RangeLo = RangeHi then
+              Write(OutFile, RangeLo)
+            else
+              Write(OutFile, RangeLo, '..', RangeHi);
+          end;
+        end;
+        Writeln(OutFile, ':result:=', gbp, ';');
+      end;
+    end;
+    Writeln(OutFile, 'else result:=gbpOther end');
+  end
+  else
+    Writeln(OutFile, 'result:=gbpOther');
+
+  CloseFile(OutFile);
+end;
+
+begin
+  FillChar(GraphemeBreakProperties, SizeOf(GraphemeBreakProperties), 0);
+  ParseGraphemeBreakProperties('data/UCD/auxiliary/GraphemeBreakProperty.txt');
+  CalcStatsAndRanges;
+  GenCode('graphemebreakproperty_code.inc');
+  Writeln('Done');
+end.
+

+ 8 - 8
utils/unicode/parse-collations.bat

@@ -1,17 +1,17 @@
-cldrparser.exe de.xml -d.\data -o.\data
+cldrparser.exe de -d.\data -o.\data
 echo
 echo
-cldrparser es.xml -d.\data -o.\data
+cldrparser es -d.\data -o.\data
 echo
 echo
-cldrparser fr_CA.xml -d.\data -o.\data
+cldrparser fr_CA -d.\data -o.\data
 echo
 echo
-cldrparser ja.xml -d.\data -o.\data
+cldrparser ja -d.\data -o.\data
 echo
 echo
-cldrparser ko.xml -d.\data -o.\data
+cldrparser ko -d.\data -o.\data
 echo
 echo
-cldrparser ru.xml -d.\data -o.\data
+cldrparser ru -d.\data -o.\data
 echo
 echo
-cldrparser sv.xml -d.\data -o.\data
+cldrparser sv -d.\data -o.\data
 echo
 echo
-cldrparser zh.xml -d.\data -o.\data
+cldrparser zh -d.\data -o.\data
 
 
 pause
 pause

+ 8 - 8
utils/unicode/parse-collations.sh

@@ -1,18 +1,18 @@
 #!/bin/bash
 #!/bin/bash
-./cldrparser de.xml -d./data -o./data
+./cldrparser de -d./data -o./data
 echo
 echo
-./cldrparser es.xml -d./data -o./data
+./cldrparser es -d./data -o./data
 echo
 echo
-./cldrparser fr_CA.xml -d./data -o./data
+./cldrparser fr_CA -d./data -o./data
 echo
 echo
-./cldrparser ja.xml -d./data -o./data
+./cldrparser ja -d./data -o./data
 echo
 echo
-./cldrparser ko.xml -d./data -o./data
+./cldrparser ko -d./data -o./data
 echo
 echo
-./cldrparser ru.xml -d./data -o./data
+./cldrparser ru -d./data -o./data
 echo
 echo
-./cldrparser sv.xml -d./data -o./data
+./cldrparser sv -d./data -o./data
 echo
 echo
-./cldrparser zh.xml -d./data -o./data
+./cldrparser zh -d./data -o./data
 
 
 read -p "Press [Enter] key to continue ..."
 read -p "Press [Enter] key to continue ..."