Sfoglia il codice sorgente

* synchronized with trunk

git-svn-id: branches/wasm@48846 -
nickysn 4 anni fa
parent
commit
940738a3a1
81 ha cambiato i file con 3118 aggiunte e 425 eliminazioni
  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/cp950.pas svneol=native#text/pascal
 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/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_be.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/taligned1.pp svneol=native#text/pascal
 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/targ1b.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/taddcharr.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/thex2dec.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/tw38289b.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/tw3931b.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/tw36212.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/tw3634.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/tw38413.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/tw3864.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/cldrxml.pas svneol=native#text/pascal
 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/gbpparser.lpi svneol=native#text/plain
+utils/unicode/gbpparser.lpr svneol=native#text/pascal
 utils/unicode/grbtree.pas svneol=native#text/pascal
 utils/unicode/helper.pas svneol=native#text/pascal
 utils/unicode/parse-collations.bat svneol=native#text/plain

+ 3 - 1
compiler/Makefile

@@ -5085,7 +5085,9 @@ endif
 cycledep:
 	$(MAKE) cycle USEDEPEND=1
 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:
 	$(MAKE) cycle 'LOCALOPT=-n -Se' 'RTLOPT=-n -Se'
 ifeq ($(findstring -dFPC_SOFT_FPUX80,$(LOCALOPT)),)

+ 4 - 1
compiler/Makefile.fpc

@@ -1036,7 +1036,10 @@ cycledep:
 # extcycle should still work, but generates
 # lots of warnings, so ALLOW_WARNINGS=1 is required
 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:
         $(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;
+{$push}{$j-}
+      const
+        extracond2str: array[C_HS..C_LO] of string[2] = ('CS','CC');
+{$pop}
       begin
         case actopcode of
           A_CSEL,A_CSINC,A_CSINV,A_CSNEG,A_CSET,A_CSETM,
@@ -568,11 +572,16 @@ Unit racpugas;
                 begin
                   { workaround for DFA bug }
                   result:=low(tasmcond);
-                  for result:=low(tasmcond) to high(tasmcond) do
+                  for result:=low(uppercond2str) to high(uppercond2str) do
                     begin
                       if hs=uppercond2str[result] then
                         exit;
                     end;
+                  for result:=low(extracond2str) to high(extracond2str) do
+                    begin
+                      if hs=extracond2str[result] then
+                        exit;
+                    end;
                 end;
             end;
           else

+ 3 - 1
compiler/aasmcnst.pas

@@ -1584,7 +1584,9 @@ implementation
 
    class function ttai_typedconstbuilder.is_smartlink_vectorized_dead_strip: boolean;
      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;
 
 

+ 8 - 7
compiler/cgexcept.pas

@@ -129,12 +129,13 @@ unit cgexcept;
        be modified, all temps should be allocated on the heap instead of the
        stack. }
 
-
     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_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;
 
 
@@ -207,7 +208,7 @@ unit cgexcept;
         location_reset(tmpresloc,LOC_REGISTER,def_cgsize(setjmpres.def));
         tmpresloc.register:=hlcg.getintregister(list,setjmpres.def);
         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
           longjmp'd back here }
         hlcg.a_cmp_const_reg_label(list,setjmpres.def,OC_NE,0,tmpresloc.register,exceptstate.exceptionlabel);
@@ -237,9 +238,9 @@ unit cgexcept;
          popaddrstack(list);
          if not onlyfree then
           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;
 

+ 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 (i1>length(s1)) and
              (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 }
           while (i1<=length(s1)) and
                 not(s1[i1] in ['0'..'9']) and

+ 6 - 0
compiler/dbgdwarf.pas

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

+ 10 - 2
compiler/defutil.pas

@@ -149,6 +149,9 @@ interface
     {# Returns true, if p points to an array of const }
     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
 
        That is if the array is an open array, a variant
@@ -796,8 +799,7 @@ implementation
            range is also -1 ! (PFV) }
          result:=(p.typ=arraydef) 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])=[]);
       end;
 
@@ -822,6 +824,12 @@ implementation
                  (ado_IsArrayOfConst in tarraydef(p).arrayoptions);
       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 }
     function is_special_array(p : tdef) : boolean;
       begin

+ 1 - 1
compiler/i386/n386add.pas

@@ -486,13 +486,13 @@ interface
         begin
           cg.getcpuregister(current_asmdata.CurrAsmList,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);
           reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
           if use_ref then
             current_asmdata.CurrAsmList.concat(Taicpu.Op_ref_reg_reg(A_MULX,S_L,ref,reglo,reghi))
           else
             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.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 }
       if (tabstractprocdef(pd).proctypeoption=potype_constructor) then
         totalremovesize:=paraheight
+      else if jvmimplicitpointertype(realresdef) then
+        totalremovesize:=paraheight-1
+      else if is_void(realresdef) then
+        totalremovesize:=paraheight
       else
         { even a byte takes up a full stackslot -> align size to multiple of 4 }
         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
                 is_open_array(def) or
                 is_array_of_const(def) or
-                is_array_constructor(def);
+                is_array_constructor(def) or
+                is_conststring_array(def);
           filedef,
           recorddef,
           setdef:

+ 2 - 0
compiler/llvm/llvmpi.pas

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

+ 10 - 14
compiler/m68k/n68kmem.pas

@@ -35,7 +35,6 @@ interface
        t68kvecnode = class(tcgvecnode)
           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;
-          function valid_index_size(size: tcgsize): boolean; override;
           //procedure pass_generate_code;override;
        end;
 
@@ -55,14 +54,6 @@ implementation
                              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 }
     { of base/index registers of references, as these may be regvars.    }
     { The register allocator can coalesce one LOC_REGISTER being moved   }
@@ -75,8 +66,11 @@ implementation
       var
         hreg: tregister;
         scaled: boolean;
+        regcgsize: tcgsize;
       begin
         scaled:=false;
+        regcgsize:=def_cgsize(regsize);
+
         //current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('updref: called')));
         if l<>1 then
           begin
@@ -86,8 +80,10 @@ implementation
                ((CPUM68K_HAS_INDEXSCALE8 in cpu_capabilities[current_settings.cputype]) and (l in [2,4,8]))) then
               begin
                 //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;
               end
             else
@@ -104,7 +100,7 @@ implementation
               begin
                 //current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('updref: copytoa')));
                 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;
               end;
             location.reference.base:=maybe_const_reg;
@@ -118,13 +114,13 @@ implementation
                 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);
               end;
-            if def_cgsize(regsize) in [OS_8,OS_16] then
+            if regcgsize in [OS_8,OS_16] then
               begin
                 { 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 }
                 //current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('updref: index zero extend')));
                 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;
               end;
             { insert new index register }

+ 41 - 1
compiler/nadd.pas

@@ -489,6 +489,20 @@ implementation
         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;
         var
           hp : tnode;
@@ -1689,6 +1703,28 @@ implementation
                    end;
               end;
 {$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;
 
@@ -1939,7 +1975,11 @@ implementation
               not(tfloatdef(left.resultdef).floattype in [s64comp,s64currency]) then
              begin
                if cs_excessprecision in current_settings.localswitches then
-                 resultrealdef:=pbestrealtype^
+                 begin
+                   resultrealdef:=pbestrealtype^;
+                   inserttypeconv(right,resultrealdef);
+                   inserttypeconv(left,resultrealdef);
+                 end
                else
                  resultrealdef:=left.resultdef
              end

+ 12 - 12
compiler/ncgflw.pas

@@ -547,7 +547,7 @@ implementation
           { we must also destroy the address frame which guards
             the exception object }
           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
             begin
               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);
       begin
          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);
       end;
 
@@ -941,13 +941,13 @@ implementation
         procedure handle_breakcontinueexit(const finallycode: tasmlabel; doreraise: boolean);
           begin
             { 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
-              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
-              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
-              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
               cexceptionstatehandler.handle_reraise(current_asmdata.CurrAsmList,excepttemps,finallyexceptionstate,tek_normalfinally)
             else
@@ -1024,8 +1024,8 @@ implementation
                exit;
              if not implicitframe then
                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);
 
              current_asmdata.CurrAsmList.concatList(tmplist);
@@ -1063,11 +1063,11 @@ implementation
          if not assigned(third) then
            begin
              { 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
                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
                    if-branch -> fc_inflowcontrol) }
                  if current_procinfo.procdef.generate_safecall_wrapper then

+ 9 - 5
compiler/ncginl.pas

@@ -888,7 +888,8 @@ implementation
             internalerror(2013120110);
         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));
 {$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
@@ -920,8 +921,10 @@ implementation
 {$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
                  if def_cgsize(resultdef) in [OS_64,OS_S64] then
                    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),
                                              joinreg64(op2.location.register,NR_NO),op1.location.register64,
                                              location.register64);
@@ -929,8 +932,9 @@ implementation
                  else
 {$endif not cpu64bitalu and not cpuhighleveltarget}
                    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,
                                            op2.location.register,op1.location.register,
                                            location.register);

+ 3 - 7
compiler/ncon.pas

@@ -948,20 +948,15 @@ implementation
          dogetcopy:=n;
       end;
 
+
     function tstringconstnode.pass_typecheck:tnode;
-      var
-        l : aint;
       begin
         result:=nil;
         case cst_type of
           cst_conststring :
             begin
               { 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;
               include(tarraydef(resultdef).arrayoptions,ado_IsConstString);
             end;
@@ -981,6 +976,7 @@ implementation
         end;
       end;
 
+
     function tstringconstnode.pass_1 : tnode;
       begin
         result:=nil;

+ 22 - 4
compiler/ngtcon.pas

@@ -328,6 +328,25 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
 {$push}
 {$r-}
 {$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         }
     {  mentioned are unused by this routine)                                 }
     { 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
           begin
             { 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.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);
             { carry-over to the next element? }
             if (shiftcount<0) then
               begin
                 if shiftcount>=-AIntBits then
-                  bp.nextval:=(value and ((aword(1) shl (-shiftcount))-1)) shl
+                  bp.nextval:=(value and getbitmask(-shiftcount)) shl
                               (AIntBits+shiftcount)
                 else
                   bp.nextval:=0;

+ 11 - 3
compiler/nmat.pas

@@ -97,7 +97,7 @@ implementation
       systems,
       verbose,globals,cutils,compinnr,
       globtype,constexp,
-      symconst,symtype,symdef,
+      symconst,symtype,symdef,symcpu,
       defcmp,defutil,
       htypechk,pass_1,
       cgbase,
@@ -966,10 +966,18 @@ implementation
            exit;
 
          resultdef:=left.resultdef;
-         if (left.resultdef.typ=floatdef) or
-            is_currency(left.resultdef) then
+         if is_currency(left.resultdef) then
            begin
            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}
          else if (cs_mmx in current_settings.localswitches) and
            is_mmx_able_array(left.resultdef) then

+ 8 - 0
compiler/nset.pas

@@ -250,6 +250,7 @@ implementation
 
       begin
          result:=nil;
+
          resultdef:=pasbool1type;
          typecheckpass(right);
          set_varstate(right,vs_read,[vsf_must_be_valid]);
@@ -272,6 +273,13 @@ implementation
          if not assigned(left.resultdef) then
            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;
          if isbinaryoverloaded(t,[]) then
            begin

+ 36 - 0
compiler/nutils.pas

@@ -186,11 +186,22 @@ interface
     type
       TMatchProc2 = function(n1,n2 : tnode) : Boolean 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,
       the result of transformproc is assigned to res }
     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
 
     uses
@@ -1642,4 +1653,29 @@ implementation
           result:=false;
       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.

+ 3 - 1
compiler/psabiehpi.pas

@@ -522,7 +522,9 @@ implementation
 
     class procedure tpsabiehexceptionstatehandler.get_exception_temps(list: TAsmList; var t: texceptiontemps);
       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;
 
 

+ 1 - 0
compiler/pstatmnt.pas

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

+ 1 - 1
compiler/psub.pas

@@ -466,7 +466,7 @@ implementation
               cifnode.create(caddnode.create(equaln,
                 ccallnode.createintern('fpc_setjmp',
                   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)
             );
           end;

+ 3 - 1
compiler/symconst.pas

@@ -574,7 +574,9 @@ type
     ado_IsConstString,      // string constant
     ado_IsBitPacked,        // bitpacked array
     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;
 

+ 13 - 5
compiler/symdef.pas

@@ -1213,7 +1213,10 @@ interface
        { several types to simulate more or less C++ objects for GDB }
        vmttype,
        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 }
        class_tobject : tobjectdef;
@@ -4154,6 +4157,7 @@ implementation
          symtable:=tarraysymtable.create(self);
       end;
 
+
     constructor tarraydef.create_vector(l ,h: asizeint; def: tdef);
       begin
         self.create(l,h,def);
@@ -4163,7 +4167,8 @@ implementation
 
     constructor tarraydef.create_openarray;
       begin
-        self.create(0,-1,sizesinttype)
+        self.create(0,-1,sizesinttype);
+        include(arrayoptions,ado_OpenArray);
       end;
 
 
@@ -4367,7 +4372,7 @@ implementation
           end;
 
         { 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);
         if not (ado_IsBitPacked in arrayoptions) then
           cachedelesize:=elesize
@@ -4383,7 +4388,10 @@ implementation
 
         if (cachedelecount = 0) then
           begin
-            size := -1;
+            if ado_isconststring in arrayoptions then
+              size := 0
+            else
+              size := -1;
             exit;
           end;
 
@@ -4472,7 +4480,7 @@ implementation
            end
          else if (ado_IsDynamicArray in arrayoptions) then
            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
          else
            begin

+ 3 - 3
compiler/systems/i_darwin.pas

@@ -194,7 +194,7 @@ const
         name         : 'Darwin/iPhoneSim for i386';
         shortname    : 'iPhoneSim';
         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;
         unit_env     : 'BSDUNITS';
         extradefines : 'UNIX;BSD;HASUNIX;DARWIN'; // also define darwin for code compatibility
@@ -263,7 +263,7 @@ const
         name         : 'Darwin for PowerPC64';
         shortname    : 'Darwin';
         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;
         unit_env     : 'BSDUNITS';
         extradefines : 'UNIX;BSD;HASUNIX';
@@ -400,7 +400,7 @@ const
         name         : 'Darwin/iPhoneSim for x86_64';
         shortname    : 'iPhoneSim';
         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;
         unit_env     : 'BSDUNITS';
         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;
                 coalescealignskipmax: 0;
                 constalignmin   : 0;
-                constalignmax   : 4;
+                constalignmax   : 16;
                 varalignmin     : 0;
-                varalignmax     : 4;
+                varalignmax     : 16;
                 localalignmin   : 4;
-                localalignmax   : 4;
+                localalignmax   : 8;
                 recordalignmin  : 0;
-                recordalignmax  : 4;
+                recordalignmax  : 16;
                 maxCrecordalign : 2;
               );
             first_parm_offset : 8;
-            stacksize    : 32*1024*1024;
+            stacksize    : 8*1024*1024;
             stackalign   : 4;
             abi : abi_default;
             llvmdatalayout : 'todo';

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

@@ -3286,7 +3286,8 @@ const
    { ado_IsConstString      } 'ConstString',
    { ado_IsBitPacked        } 'BitPacked',
    { ado_IsVector           } 'Vector',
-   { ado_IsGeneric          } 'Generic'
+   { ado_IsGeneric          } 'Generic',
+   { ado_OpenArray          } 'OpenArray'
   );
 var
   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
           GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[1]^.reg) then
           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
-              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
-                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
-                    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
-                        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;
+
+                    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
-                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
-                    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;
-                RemoveCurrentP(p);
-                result:=true;
-                exit;
               end;
 
             { Change:
@@ -3890,76 +3991,92 @@ unit aoptx86;
       begin
         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
-            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
-                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
-                  { 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
-                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;
-
-            DebugMsg(SPeepholeOptimization + 'SETcc/TESTCmp/Jcc -> Jcc',p);
           end;
       end;
 
@@ -5251,6 +5368,25 @@ unit aoptx86;
                   if not MatchOpType(taicpu(hp1), top_reg, top_reg) then
                     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
                     removes one of the MOV/Z instructions. }
                   case taicpu(hp1).opsize of
@@ -5363,8 +5499,7 @@ unit aoptx86;
                     ((TargetSize = S_W) and (taicpu(hp1).opsize in [S_W, S_BW])) then
                     begin
                       { 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
                           { Or remove it completely! }
                           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
 # OS/2 31
 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
@@ -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
 # OS/2-2 31
 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
 # OS/2-3 4
 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
@@ -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
 # EMX 31
 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
@@ -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
 # EMX-2 31
 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
 # EMX-3 4
 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
 # Source-2 30
 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;
-  DecimalSeparator := char(''); //Don't override decimal separator by default
+  DecimalSeparator := #0; //Don't override decimal separator by default
 
   if Source is TXMLXSDFormatSettings then
   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 }
 {$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 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;
@@ -63,7 +63,7 @@ function getservent: PServEntry; syscall SocketBase 564;
 
 {$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 getnetbyaddr(Net: Longint; NetType: Longint): PNetEntry; syscall ISocket 208;
 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;
 {$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;
 var
   addr1,
   addr2: in_addr;
   IP: PPLongInt;
 begin
+  gethostbyaddr := nil;
+  if not Assigned(SocketBase) then
+    Exit;
+  //
   Addr1 :=  in_addr(PHostAddr(Addr)^);
   Addr2.s_addr := htonl(Addr1.s_addr);
   gethostbyaddr := Pointer(bsd_GetHostByAddr(Pointer(@Addr2.s_addr), Len, HType));
@@ -101,12 +113,14 @@ end;
 
 function  GetDNSError: integer;
 begin
-  GetDNSError:=bsd_Errno;
+  GetDNSError := 0;
+  if assigned(SocketBase) then
+    GetDNSError:=bsd_Errno;
 end;
 
 Function InitResolve : Boolean;
 begin
-  Result:=True;
+  Result:=Assigned(SocketBase);
 end;
 
 Function FinalResolve : Boolean;

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

@@ -48,7 +48,7 @@ Type
 
 { 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 getnetbyaddr(Net: Longint; NetType: Longint): PNetEntry; syscall SocketBase 38;
 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;
 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;
 var
   addr1,
   addr2: in_addr;
   IP: PPLongInt;
 begin
+  gethostbyaddr := nil;
+  if not Assigned(SocketBase) then
+    Exit;
+  //
   Addr1 :=  in_addr(PHostAddr(Addr)^);
   Addr2.s_addr := htonl(Addr1.s_addr);
   gethostbyaddr := Pointer(bsd_GetHostByAddr(Pointer(@Addr2.s_addr), Len, HType));
@@ -78,19 +91,21 @@ begin
       repeat
         ip^^ := ntohl(ip^^);
         Inc(IP);
-      until ip^ = nil; 
+      until ip^ = nil;
     end;
   end;
 end;
 
 function  GetDNSError: integer;
 begin
-  GetDNSError:=bsd_Errno;
+  GetDNSError := 0;
+  if assigned(SocketBase) then
+    GetDNSError := bsd_Errno;
 end;
 
 Function InitResolve : Boolean;
 begin
-  Result:=True;
+  Result := Assigned(SocketBase);
 end;
 
 Function FinalResolve : Boolean;

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

@@ -6229,16 +6229,43 @@ begin
 end;
 
 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
   Decl: TPasDeclarations;
   EnumScope: TPasEnumTypeScope;
+  p: TPasElement;
+  MembersType: TPasMembersType;
 begin
   EmitTypeHints(Parent,El);
   if (El.Name<>'') or (AnonymousElTypePostfix='') then exit;
   if Parent.Name='' then
     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
     RaiseNotYetImplemented(20190215085011,Parent);
   // give anonymous sub type a name
@@ -6246,11 +6273,27 @@ begin
   {$IFDEF VerbosePasResolver}
   writeln('TPasResolver.FinishSubElementType parent="',GetObjName(Parent),'" named anonymous type "',GetObjName(El),'"');
   {$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
     begin
     // anonymous enumtype
@@ -7819,6 +7862,8 @@ begin
     CheckUseAsType(El.VarType,20190123095916,El);
     if El.Expr<>nil then
       CheckAssignCompatibility(El,El.Expr,true);
+    if El.VarType.Parent=El then
+      FinishSubElementType(El,El.VarType);
     end
   else if El.Expr<>nil then
     begin
@@ -12278,12 +12323,17 @@ begin
   {$ENDIF}
   if not (TopScope is TPasIdentifierScope) then
     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));
   // add canonical set
   if El.Parent is TPasSetType then
     begin
-    // anonymous enumtype, e.g. "set of ()"
+    // set of anonymous enumtype, e.g. "set of ()"
     CanonicalSet:=TPasSetType(El.Parent);
     CanonicalSet.AddRef{$IFDEF CheckPasTreeRefCount}('TPasEnumTypeScope.CanonicalSet'){$ENDIF};
     end
@@ -21051,8 +21101,8 @@ begin
       writeln('TPasResolver.FindElement searching scope "',CurName,'" RightPath="',RightPath,'" ...');
     {AllowWriteln-}
     {$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
       begin
       NeedPop:=true;

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

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

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

@@ -65,6 +65,13 @@ end;
 var
   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;
 var
   I: integer;
@@ -74,6 +81,10 @@ var
   Params: string;
   TempName: string;
   cos: BPTR;
+  {$ifdef MorphOS}
+  inA, inB, OutA, OutB: BPTR;
+  Res: Integer;
+  {$endif}
 begin
   if (ApplicationName = '') and (CommandLine = '') and (Executable = '') then
    raise EProcess.Create (SNoCommandline);
@@ -114,17 +125,61 @@ begin
     ChDir (FCurrentDirectory);
    end;
   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
 (* Normalize the raised exception so that it is aligned to other platforms. *)
     On E: EOSError do

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

@@ -91,10 +91,30 @@ begin
 end;
 
 Function TInputPipeStream.Read (Var Buffer; Count : Longint) : longint;
-
+{$ifdef MorphOS}
+var
+  i: Integer;
+  Runner: PByte;
+{$endif}
 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);
   Inc(FPos,Result);
+  {$endif}
 end;
 
 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
   // 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
       if FCachedlibcPath='' then
         begin

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

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

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

@@ -2159,7 +2159,6 @@ type
       AContext: TConvertContext): TJSElement; virtual;
     Function CreateRTTIMemberProperty(Members: TFPList; Index: integer;
       AContext: TConvertContext): TJSElement; virtual;
-    Procedure CreateRTTIAnonymous(El: TPasType; AContext: TConvertContext); virtual;
     Function CreateRTTIMembers(El: TPasMembersType; Src: TJSSourceElements;
       FuncContext: TFunctionContext; MembersSrc: TJSSourceElements;
       MembersFuncContext: TFunctionContext; RTTIExpr: TJSElement;
@@ -9790,15 +9789,12 @@ begin
   if RightRefDecl is TPasProcedure then
     begin
     Proc:=TPasProcedure(RightRefDecl);
-    if coShortRefGlobals in Options then
+    if not aResolver.ProcHasSelf(Proc) then
       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;
 
@@ -19965,23 +19961,6 @@ var
     ObjLit.Expr:=JS;
   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
   JSTypeInfo: TJSElement;
   aName: String;
@@ -19994,10 +19973,7 @@ begin
   V:=TPasVariable(Members[Index]);
   VarType:=V.VarType;
   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);
   OptionsEl:=nil;
@@ -20315,37 +20291,6 @@ begin
   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;
   Src: TJSSourceElements; FuncContext: TFunctionContext;
   MembersSrc: TJSSourceElements; MembersFuncContext: TFunctionContext;

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

@@ -170,8 +170,8 @@ begin
     '']),
     LinesToStr([ // $mod.$main
     '$mod.TPoint$G1.x = $mod.p.x + 10;',
-    '$mod.p.Fly();',
-    '$mod.p.Fly();',
+    '$mod.TPoint$G1.Fly();',
+    '$mod.TPoint$G1.Fly();',
     '']));
 end;
 
@@ -256,6 +256,11 @@ begin
     '      this.x = $impl.TBird.$new();',
     '      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) {',
     '      return true;',
     '    };',
@@ -752,7 +757,7 @@ begin
     '    $mod.TPoint$G1.x = this.x + 5;',
     '    $mod.TPoint$G1.x = $mod.TPoint$G1.x + 6;',
     '    this.Fly();',
-    '    $mod.TPoint$G1.Fly();',
+    '    this.Fly();',
     '    this.Run();',
     '    $mod.TPoint$G1.Run();',
     '  };',
@@ -1169,6 +1174,11 @@ begin
     '      this.x = $impl.TBird.$new();',
     '      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>");',
     '  $mod.$implcode = function () {',
     '    rtl.recNewT($impl, "TBird", function () {',

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

@@ -380,6 +380,7 @@ type
     Procedure TestEnum_ForIn;
     Procedure TestEnum_ScopedNumber;
     Procedure TestEnum_InFunction;
+    Procedure TestEnum_Name_Anonymous_Unit;
     Procedure TestSet_Enum;
     Procedure TestSet_Operators;
     Procedure TestSet_Operator_In;
@@ -522,6 +523,7 @@ type
     Procedure TestClasS_CallInheritedConstructor;
     Procedure TestClass_ClassVar_Assign;
     Procedure TestClass_CallClassMethod;
+    Procedure TestClass_CallClassMethodStatic; // ToDo
     Procedure TestClass_Property;
     Procedure TestClass_Property_ClassMethod;
     Procedure TestClass_Property_Indexed;
@@ -5949,6 +5951,34 @@ begin
     '']));
 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;
 begin
   StartProgram(false);
@@ -9455,7 +9485,7 @@ begin
   '  arr2[6,3]:=i;',
   '  i:=arr2[5,2];',
   '  arr2:=arr2;',// clone multi dim static array
-  //'  arr3:=arr3;',// clone anonymous multi dim static array
+  '  arr3:=arr3;',// clone anonymous multi dim static array
   '']);
   ConvertProgram;
   CheckSource('TestArray_StaticMultiDim',
@@ -9467,6 +9497,11 @@ begin
     '};',
     'this.Arr = rtl.arraySetLength(null, 0, 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.i = 0;'
     ]),
@@ -9483,6 +9518,7 @@ begin
     '$mod.Arr2[1][2] = $mod.i;',
     '$mod.i = $mod.Arr2[0][1];',
     '$mod.Arr2 = $mod.TArrayArrayInt$clone($mod.Arr2);',
+    '$mod.Arr3 = $mod.Arr3$a$clone($mod.Arr3);',
     '']));
 end;
 
@@ -9504,6 +9540,7 @@ begin
   'begin',
   '  arr2[5]:=arr;',
   '  arr2:=arr2;',// clone multi dim static array
+  '  arr3:=arr3;',// clone multi dim anonymous static array
   'end;',
   'begin',
   '']);
@@ -9517,6 +9554,11 @@ begin
     '  for (var i = 0; i < 2; i++) r.push(a[i].slice(0));',
     '  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 () {',
     '  var Arr = rtl.arraySetLength(null, 0, 3);',
     '  var Arr2 = rtl.arraySetLength(null, 0, 2, 3);',
@@ -9524,6 +9566,7 @@ begin
     '  var i = 0;',
     '  Arr2[0] = Arr.slice(0);',
     '  Arr2 = TArrayArrayInt$1$clone(Arr2);',
+    '  Arr3 = Arr3$a$clone(Arr3);',
     '};',
     '']),
     LinesToStr([ // $mod.$main
@@ -11157,26 +11200,28 @@ end;
 procedure TTestModule.TestRecord_Assign;
 begin
   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;
   CheckSource('TestRecord_Assign',
     LinesToStr([ // statements
@@ -12091,9 +12136,9 @@ begin
     '$mod.TRec.SetInt($mod.TRec.GetInt() + 2);',
     '$mod.TRec.SetInt($mod.TRec.Fx);',
     '$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;
 
@@ -12557,8 +12602,8 @@ begin
     '  $mod.TPoint.Fly();',
     '})();',
     '$mod.TPoint.x = $mod.r.x + 10;',
-    '$mod.r.Fly();',
-    '$mod.r.Fly();',
+    '$mod.TPoint.Fly();',
+    '$mod.TPoint.Fly();',
     '']));
 end;
 
@@ -13474,6 +13519,63 @@ begin
     '']));
 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;
 begin
   StartProgram(false);
@@ -22610,21 +22712,21 @@ begin
     'this.c = null;',
     '']),
     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() + 14);',
     'var $with = $mod.b;',
     '$with.SetSpeed($with.GetSpeed() + 32);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 33);',
     '$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() + 14);',
     'var $with1 = $mod.c;',
     '$with1.SetSpeed($with1.GetSpeed() + 32);',
     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 33);',
     '$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() + 14);',
     'var $with2 = $mod.TBird;',
@@ -24410,7 +24512,7 @@ begin
     '']),
     LinesToStr([ // $mod.$main
     '$mod.THelper.Fly.call({',
-    '  p: $mod.o.GetField(),',
+    '  p: $mod.TObject.GetField(),',
     '  get: function () {',
     '      return this.p;',
     '    },',
@@ -24428,7 +24530,7 @@ begin
     '      this.p = v;',
     '    }',
     '}, 12);',
-    'var $with1 = $mod.o.GetField();',
+    'var $with1 = $mod.TObject.GetField();',
     '$mod.THelper.Fly.call({',
     '  get: function () {',
     '      return $with1;',
@@ -29490,6 +29592,9 @@ begin
   CheckSource('TestRTTI_Class_Field',
     LinesToStr([ // statements
     'rtl.createClass(this, "TObject", null, function () {',
+    '  $mod.$rtti.$DynArray("TObject.ArrB$a", {',
+    '    eltype: rtl.byte',
+    '  });',
     '  this.$init = function () {',
     '    this.FPropA = "";',
     '    this.VarLI = 0;',
@@ -29521,9 +29626,6 @@ begin
     '  $r.addField("VarShI", rtl.shortint);',
     '  $r.addField("VarBy", rtl.byte);',
     '  $r.addField("VarExt", rtl.longint);',
-    '  $mod.$rtti.$DynArray("TObject.ArrB$a", {',
-    '    eltype: rtl.byte',
-    '  });',
     '  $r.addField("ArrA", $mod.$rtti["TObject.ArrB$a"]);',
     '  $r.addField("ArrB", $mod.$rtti["TObject.ArrB$a"]);',
     '});',
@@ -30558,6 +30660,9 @@ begin
   CheckSource('TestRTTI_Record',
     LinesToStr([ // statements
     'rtl.recNewT(this, "TFloatRec", function () {',
+    '  $mod.$rtti.$DynArray("TFloatRec.d$a", {',
+    '    eltype: rtl.char',
+    '  });',
     '  this.$new = function () {',
     '    var r = Object.create(this);',
     '    r.c = [];',
@@ -30572,9 +30677,6 @@ begin
     '    this.d = rtl.arrayRef(s.d);',
     '    return this;',
     '  };',
-    '  $mod.$rtti.$DynArray("TFloatRec.d$a", {',
-    '    eltype: rtl.char',
-    '  });',
     '  var $r = $mod.$rtti.$Record("TFloatRec", {});',
     '  $r.addField("c", $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;
 begin
-  fpgeterrno := bsd_Errno;
+  if Assigned(SocketBase) then
+    fpgeterrno := bsd_Errno
+  else
+    fpgeterrno := 0;
 end;
 
 function fpClose(d: LongInt): LongInt; inline;
 begin
-  fpClose := bsd_CloseSocket(d);
+  if Assigned(SocketBase) then
+    fpClose := bsd_CloseSocket(d)
+  else
+    fpClose := -1;
 end;
 
 function fpaccept(s: cint; addrx: PSockaddr; Addrlen: PSocklen): cint;
@@ -289,8 +295,16 @@ end;
 
 function fpsocket(domain: cint; xtype: cint; protocol: cint): cint;
 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;
 
 

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

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

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

@@ -44,6 +44,19 @@ const
   DaySaturday  = 6;
   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
   OneHour        = TDateTime(1)/HoursPerDay;
   OneMinute      = TDateTime(1)/MinsPerDay;

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

@@ -429,8 +429,7 @@ begin
       AddMatch(i+1);
       //Only first match ?
       if not aMatchAll then break;
-      inc(i,OldPatternSize);
-      inc(i,OldPatternSize);
+      inc(i,DeltaJumpTable2[0]);
     end else begin
       i:=i + Max(DeltaJumpTable1[ord(s[i])],DeltaJumpTable2[j]);
     end;
@@ -582,8 +581,7 @@ begin
       AddMatch(i+1);
       //Only first match ?
       if not aMatchAll then break;
-      inc(i,OldPatternSize);
-      inc(i,OldPatternSize);
+      inc(i,DeltaJumpTable2[0]);
     end else begin
       i:=i + Max(DeltaJumpTable1[Ord(lCaseArray[Ord(s[i])])],DeltaJumpTable2[j]);
     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];
   utf8bidiOSes  = [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.
 //  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
 
@@ -138,6 +140,18 @@ begin
     T:=P.Targets.AddImplicitUnit('cp950.pas',CPUnits);
 
 //    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;
 

+ 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}
 
     P:=AddPackage('tplylib');
-    P.ShortName:='tplylib';
+    P.ShortName:='tpll';
 {$ifdef ALLPACKAGES}
     P.Directory:=ADirectory;
 {$endif ALLPACKAGES}

+ 1 - 1
rtl/embedded/Makefile

@@ -374,7 +374,7 @@ CPU_SPECIFIC_COMMON_UNITS=
 ifeq ($(ARCH),arm)
 CPU_SPECIFIC_COMMON_UNITS=sysutils math classes fgl macpas typinfo types rtlconsts getopts lineinfo
 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
 endif
 ifeq ($(SUBARCH),armv7em)

+ 1 - 1
rtl/embedded/Makefile.fpc

@@ -71,7 +71,7 @@ CPU_SPECIFIC_COMMON_UNITS=
 ifeq ($(ARCH),arm)
 CPU_SPECIFIC_COMMON_UNITS=sysutils math classes fgl macpas typinfo types rtlconsts getopts lineinfo
 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
 endif
 ifeq ($(SUBARCH),armv7em)

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

@@ -43,6 +43,14 @@ asm
   str r1, [r0]
 {$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
   b HaltProc
 
@@ -56,10 +64,14 @@ asm
   .long _data
 .L_edata:
   .long _edata
+{$if defined(FPUARM_HAS_VFP_EXTENSION)}
+.Lcpacr:
+  .long 0xE000ED88
+{$endif defined(FPUARM_HAS_VFP_EXTENSION)}
 {$ifdef REMAP_VECTTAB}
 .Lvtor:
   .long 0xE000ED08
 .Ltext_start:
   .long _text_start
 {$endif REMAP_VECTTAB}
-end;
+end;

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

@@ -43,6 +43,14 @@ asm
   str r1, [r0]
 {$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
   b HaltProc
 
@@ -56,10 +64,14 @@ asm
   .long _data
 .L_edata:
   .long _edata
+{$if defined(FPUARM_HAS_VFP_EXTENSION)}
+.Lcpacr:
+  .long 0xE000ED88
+{$endif defined(FPUARM_HAS_VFP_EXTENSION)}
 {$ifdef REMAP_VECTTAB}
 .Lvtor:
   .long 0xE000ED08
 .Ltext_start:
   .long _text_start
 {$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))}
 
 {$if FPC_FULLVERSION >= 30200}
+{$if defined(CPU_HAS_THUMB))}
 Procedure SignalToHandleErrorAddrFrame_Thumb(Errno : longint;addr : CodePointer; frame : Pointer); nostackframe; assembler;
 asm
 .thumb_func
@@ -61,7 +62,8 @@ asm
 .code 32
 {$endif not(defined(CPUTHUMB)) and not(defined(CPUTHUMB2))}
 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;
 var
@@ -110,7 +112,11 @@ begin
       else
 {$endif not(defined(CPUTHUMB)) and not(defined(CPUTHUMB2))}
         begin
+{$if defined(CPU_HAS_THUMB))}
           ucontext^.uc_mcontext.arm_pc:=ptruint(@SignalToHandleErrorAddrFrame_Thumb);
+{$else defined(CPU_HAS_THUMB))}
+          halt(217);
+{$endif defined(CPU_HAS_THUMB))}
         end;
 {$else}
       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;
   var
-     i : longint;
+     i : SizeInt;
   begin
      sum:=0.0;
      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;
   var
-     i : longint;
+     i : SizeInt;
   begin
      sum:=0.0;
      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;
   var
-     i : longint;
+     i : SizeInt;
   begin
      sum:=0.0;
      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;
   var
-     i : longint;
+     i : SizeInt;
   begin
      sumInt:=0;
      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;
 var
-   i : longint;
+   i : SizeInt;
   begin
      sumInt:=0;
      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;
   var
-     i : longint;
+     i : SizeInt;
   begin
      sumofsquares:=0.0;
      for i:=0 to N-1 do
@@ -1295,7 +1295,7 @@ end;
 procedure sumsandsquares(const data : PSingle; Const N : Integer;
   var sum,sumofsquares : float);
   var
-     i : Integer;
+     i : SizeInt;
      temp : float;
   begin
      sumofsquares:=0.0;
@@ -1317,7 +1317,7 @@ procedure sumsandsquares(const data : PSingle; Const N : Integer;
 
  function sumofsquares(const data : PDouble; Const N : Integer) : float;
   var
-     i : longint;
+     i : SizeInt;
   begin
      sumofsquares:=0.0;
      for i:=0 to N-1 do
@@ -1333,7 +1333,7 @@ end;
 procedure sumsandsquares(const data : PDouble; Const N : Integer;
   var sum,sumofsquares : float);
   var
-     i : Integer;
+     i : SizeInt;
      temp : float;
   begin
      sumofsquares:=0.0;
@@ -1355,7 +1355,7 @@ procedure sumsandsquares(const data : PDouble; Const N : Integer;
 
  function sumofsquares(const data : PExtended; Const N : Integer) : float;
   var
-     i : longint;
+     i : SizeInt;
   begin
      sumofsquares:=0.0;
      for i:=0 to N-1 do
@@ -1371,7 +1371,7 @@ end;
 procedure sumsandsquares(const data : PExtended; Const N : Integer;
   var sum,sumofsquares : float);
   var
-     i : Integer;
+     i : SizeInt;
      temp : float;
   begin
      sumofsquares:=0.0;
@@ -1411,7 +1411,7 @@ end;
 {$ifdef FPC_HAS_TYPE_SINGLE}
 procedure MeanAndTotalVariance
   (const data: PSingle; N: LongInt; var mu, variance: float);
-var i: LongInt;
+var i: SizeInt;
 begin
   mu := Mean( data, N );
   variance := 0;
@@ -1511,7 +1511,7 @@ procedure momentskewkurtosis(
   out kurtosis: float
 );
 var
-  i: integer;
+  i: SizeInt;
   value : psingle;
   deviation, deviation2: single;
   reciprocalN: float;
@@ -1562,7 +1562,7 @@ function norm(const data : PSingle; Const N : Integer) : float;
 {$ifdef FPC_HAS_TYPE_DOUBLE}
 procedure MeanAndTotalVariance
   (const data: PDouble; N: LongInt; var mu, variance: float);
-var i: LongInt;
+var i: SizeInt;
 begin
   mu := Mean( data, N );
   variance := 0;
@@ -1666,7 +1666,7 @@ procedure momentskewkurtosis(
   out kurtosis: float
 );
 var
-  i: integer;
+  i: SizeInt;
   value : pdouble;
   deviation, deviation2: double;
   reciprocalN: float;
@@ -1717,7 +1717,7 @@ function norm(const data : PDouble; Const N : Integer) : float;
 {$ifdef FPC_HAS_TYPE_EXTENDED}
 procedure MeanAndTotalVariance
   (const data: PExtended; N: LongInt; var mu, variance: float);
-var i: LongInt;
+var i: SizeInt;
 begin
   mu := Mean( data, N );
   variance := 0;
@@ -1810,7 +1810,7 @@ end;
 
 procedure momentskewkurtosis(
   const data: pExtended;
-  Const N: integer;
+  Const N: Integer;
   out m1: float;
   out m2: 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;
 var
-  I: Integer;
+  I: SizeInt;
 begin
   Result := Data[Low(Data)];
   For I := Succ(Low(Data)) To High(Data) Do
@@ -1879,7 +1879,7 @@ end;
 
 function MaxIntValue(const Data: array of Integer): Integer;
 var
-  I: Integer;
+  I: SizeInt;
 begin
   Result := Data[Low(Data)];
   For I := Succ(Low(Data)) To High(Data) Do
@@ -1893,7 +1893,7 @@ end;
 
 function MinValue(const Data: PInteger; Const N : Integer): Integer;
 var
-  I: Integer;
+  I: SizeInt;
 begin
   Result := Data[0];
   For I := 1 To N-1 do
@@ -1907,7 +1907,7 @@ end;
 
 function maxvalue(const data : PInteger; Const N : Integer) : Integer;
 var
-   i : longint;
+   i : SizeInt;
 begin
    { get an initial value }
    maxvalue:=data[0];
@@ -1924,7 +1924,7 @@ end;
 
 function minvalue(const data : PSingle; Const N : Integer) : Single;
 var
-   i : longint;
+   i : SizeInt;
 begin
    { get an initial value }
    minvalue:=data[0];
@@ -1941,7 +1941,7 @@ end;
 
 function maxvalue(const data : PSingle; Const N : Integer) : Single;
 var
-   i : longint;
+   i : SizeInt;
 begin
    { get an initial value }
    maxvalue:=data[0];
@@ -1959,7 +1959,7 @@ end;
 
 function minvalue(const data : PDouble; Const N : Integer) : Double;
 var
-   i : longint;
+   i : SizeInt;
 begin
    { get an initial value }
    minvalue:=data[0];
@@ -1976,7 +1976,7 @@ end;
 
 function maxvalue(const data : PDouble; Const N : Integer) : Double;
 var
-   i : longint;
+   i : SizeInt;
 begin
    { get an initial value }
    maxvalue:=data[0];
@@ -1994,7 +1994,7 @@ end;
 
 function minvalue(const data : PExtended; Const N : Integer) : Extended;
 var
-   i : longint;
+   i : SizeInt;
 begin
    { get an initial value }
    minvalue:=data[0];
@@ -2011,7 +2011,7 @@ end;
 
 function maxvalue(const data : PExtended; Const N : Integer) : Extended;
 var
-   i : longint;
+   i : SizeInt;
 begin
    { get an initial value }
    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
-{$ifdef cpuarm}
+{$if defined(cpuarm) or defined(cpuavr) or defined(cpui8086) or defined(cpum68k) or defined(cpumips) or defined(cpuz80)}
   {$define slowcpu}
-{$endif cpuarm}
+{$endif}
 
 {$ifdef slowcpu}
    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;
 var
   args,LocalExtraArgs,
-  wpoargs : string;
+  wpoargs,wposuffix : string;
   passnr,
   passes  : longint;
   execres : boolean;
@@ -880,6 +880,7 @@ begin
   if Config.NeedOptions<>'' then
    AppendOptions(Config.NeedOptions,args);
   wpoargs:='';
+  wposuffix:='';
   if (Config.WpoPasses=0) or
      (Config.WpoParas='') then
     passes:=1
@@ -891,6 +892,7 @@ begin
     begin
       if (passes>1) then
         begin
+          wposuffix:='_'+tostr(passnr);
           wpoargs:=' -OW'+config.wpoparas+' -FW'+TestOutputFileName('',PPFile[current],'wp'+tostr(passnr));
           if (passnr>1) then
             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 }
       StartTicks:=GetMicroSTicks;
     {$ifndef macos}
-      execres:=ExecuteRedir(CompilerBin,args+wpoargs,'',CompilerLogFile,'stdout');
+      execres:=ExecuteRedir(CompilerBin,args+wpoargs,'',CompilerLogFile+wposuffix,'stdout');
     {$else macos}
       {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
-        execres:=ExecuteRedir(TestOutputDir + ':ppas','','',CompilerLogFile,'stdout');
+        execres:=ExecuteRedir(TestOutputDir + ':ppas','','',CompilerLogFile+wpo_suffix,'stdout');
     {$endif macos}
       EndTicks:=GetMicroSTicks;
       Verbose(V_Debug,'Exitcode '+ToStr(ExecuteResult));
@@ -913,6 +915,8 @@ begin
           Verbose(V_Normal,'Compilation took '+ToStr(EndTicks-StartTicks)+' us');
         end;
 
+      if passes > 1 then
+        CopyFile(CompilerLogFile+wposuffix,CompilerLogFile,true);
       { Error during execution? }
       if (not execres) and (ExecuteResult=0) then
         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;
 
   WordRec = packed record
+{$ifdef FPC}
+{$ifdef FPC_LITTLE_ENDIAN}
     LoByte,HiByte:Byte
+{$endif}
+{$ifdef FPC_BIG_ENDIAN}
+    HiByte,LoByte:Byte
+{$endif}
+{$endif}
   end;
 
 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}
 {$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}
 {$endif}
 {$ifdef android}

+ 1 - 1
utils/json2pas/fpmake.pp

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

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

@@ -1,13 +1,13 @@
 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
     * 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('unihelper.lpr');
+    T:=P.Targets.AddProgram('gbpparser.lpr');
+    T:=P.Targets.AddProgram('eawparser.lpr');
 
     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
-cldrparser es.xml -d.\data -o.\data
+cldrparser es -d.\data -o.\data
 echo
-cldrparser fr_CA.xml -d.\data -o.\data
+cldrparser fr_CA -d.\data -o.\data
 echo
-cldrparser ja.xml -d.\data -o.\data
+cldrparser ja -d.\data -o.\data
 echo
-cldrparser ko.xml -d.\data -o.\data
+cldrparser ko -d.\data -o.\data
 echo
-cldrparser ru.xml -d.\data -o.\data
+cldrparser ru -d.\data -o.\data
 echo
-cldrparser sv.xml -d.\data -o.\data
+cldrparser sv -d.\data -o.\data
 echo
-cldrparser zh.xml -d.\data -o.\data
+cldrparser zh -d.\data -o.\data
 
 pause

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

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