* synchronize with trunk

git-svn-id: branches/wasm@47877 -

.gitattributes

@@ -12774,6 +12774,7 @@ tests/tbf/tb0269.pp svneol=native#text/pascal
 tests/tbf/tb0270.pp svneol=native#text/pascal
 tests/tbf/tb0271.pp svneol=native#text/pascal
 tests/tbf/tb0272.pp svneol=native#text/plain
+tests/tbf/tb0273.pp svneol=native#text/pascal
 tests/tbf/tb0588.pp svneol=native#text/pascal
 tests/tbf/ub0115.pp svneol=native#text/plain
 tests/tbf/ub0149.pp svneol=native#text/plain
@@ -13472,6 +13473,9 @@ tests/tbs/tb0677.pp svneol=native#text/pascal
 tests/tbs/tb0678.pp svneol=native#text/pascal
 tests/tbs/tb0679.pp svneol=native#text/pascal
 tests/tbs/tb0680.pp svneol=native#text/pascal
+tests/tbs/tb0681.pp svneol=native#text/pascal
+tests/tbs/tb0682.pp svneol=native#text/pascal
+tests/tbs/tb0683.pp svneol=native#text/plain
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
 tests/tbs/ub0119.pp svneol=native#text/plain
@@ -15101,6 +15105,8 @@ tests/test/tgeneric102.pp svneol=native#text/pascal
 tests/test/tgeneric103.pp svneol=native#text/pascal
 tests/test/tgeneric104.pp -text svneol=native#text/pascal
 tests/test/tgeneric105.pp svneol=native#text/pascal
+tests/test/tgeneric106.pp svneol=native#text/pascal
+tests/test/tgeneric107.pp svneol=native#text/pascal
 tests/test/tgeneric11.pp svneol=native#text/plain
 tests/test/tgeneric12.pp svneol=native#text/plain
 tests/test/tgeneric13.pp svneol=native#text/plain
@@ -16145,6 +16151,7 @@ tests/test/units/math/tmask2.pp svneol=native#text/plain
 tests/test/units/math/tminmaxconst.pp svneol=native#text/pascal
 tests/test/units/math/tnaninf.pp svneol=native#text/plain
 tests/test/units/math/tpower.pp svneol=native#text/pascal
+tests/test/units/math/trndcurr.pp svneol=native#text/plain
 tests/test/units/math/troundm.pp svneol=native#text/plain
 tests/test/units/math/tsincos.pp svneol=native#text/pascal
 tests/test/units/math/ttrig1.pp svneol=native#text/plain
@@ -18644,8 +18651,12 @@ tests/webtbs/tw3814.pp svneol=native#text/plain
 tests/webtbs/tw38145a.pp svneol=native#text/pascal
 tests/webtbs/tw38145b.pp svneol=native#text/pascal
 tests/webtbs/tw38151.pp svneol=native#text/pascal
+tests/webtbs/tw38164.pp svneol=native#text/pascal
 tests/webtbs/tw38201.pp svneol=native#text/pascal
 tests/webtbs/tw38202.pp svneol=native#text/pascal
+tests/webtbs/tw38225.pp svneol=native#text/pascal
+tests/webtbs/tw38238.pp svneol=native#text/pascal
+tests/webtbs/tw38249.pp svneol=native#text/pascal
 tests/webtbs/tw3827.pp svneol=native#text/plain
 tests/webtbs/tw3829.pp svneol=native#text/plain
 tests/webtbs/tw3833.pp svneol=native#text/plain
@@ -19314,9 +19325,9 @@ utils/fpdoc/Makefile.fpc.fpcmake svneol=native#text/plain
 utils/fpdoc/README.txt svneol=native#text/plain
 utils/fpdoc/css.inc svneol=native#text/plain
 utils/fpdoc/dglobals.pp svneol=native#text/plain
+utils/fpdoc/dw_chm.pp svneol=native#text/plain
 utils/fpdoc/dw_dxml.pp svneol=native#text/plain
 utils/fpdoc/dw_html.pp svneol=native#text/plain
-utils/fpdoc/dw_htmlchm.inc svneol=native#text/plain
 utils/fpdoc/dw_ipflin.pas svneol=native#text/plain
 utils/fpdoc/dw_latex.pp svneol=native#text/plain
 utils/fpdoc/dw_linrtf.pp svneol=native#text/plain

compiler/aarch64/ncpumat.pas

@@ -82,11 +82,13 @@ implementation
          var
            helper1, helper2: TRegister;
            so: tshifterop;
+           opsize: TCgSize;
          begin
+           opsize:=def_cgsize(resultdef);
            if tordconstnode(right).value=0 then
              internalerror(2020021601)
            else if tordconstnode(right).value=1 then
-             cg.a_load_reg_reg(current_asmdata.CurrAsmList, OS_INT, OS_INT, numerator, resultreg)
+             cg.a_load_reg_reg(current_asmdata.CurrAsmList, opsize, opsize, numerator, resultreg)
            else if (tordconstnode(right).value = int64(-1)) then
              begin
                // note: only in the signed case possible..., may overflow
@@ -100,26 +102,26 @@ implementation
              begin
                if (is_signed(right.resultdef)) then
                  begin
-                    helper2:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
+                    helper2:=cg.getintregister(current_asmdata.CurrAsmList,opsize);
                     if power = 1 then
                       helper1:=numerator
                     else
                       begin
-                        helper1:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
-                        cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SAR,OS_INT,63,numerator,helper1);
+                        helper1:=cg.getintregister(current_asmdata.CurrAsmList,opsize);
+                        cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SAR,opsize,resultdef.size*8-1,numerator,helper1);
                       end;
                     shifterop_reset(so);
                     so.shiftmode:=SM_LSR;
-                    so.shiftimm:=64-power;
+                    so.shiftimm:=resultdef.size*8-power;
                     current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg_shifterop(A_ADD,helper2,numerator,helper1,so));
-                    cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SAR,OS_INT,power,helper2,resultreg);
+                    cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SAR,def_cgsize(resultdef),power,helper2,resultreg);
                   end
                else
-                 cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHR,OS_INT,power,numerator,resultreg)
+                 cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHR,opsize,power,numerator,resultreg)
              end
            else
              { Everything else is handled in the generic code }
-             cg.g_div_const_reg_reg(current_asmdata.CurrAsmList,def_cgsize(resultdef),
+             cg.g_div_const_reg_reg(current_asmdata.CurrAsmList,opsize,
                tordconstnode(right).value.svalue,numerator,resultreg);
          end;
 

compiler/defutil.pas

@@ -229,6 +229,9 @@ interface
     {# Returns true, if def is a currency type }
     function is_currency(def : tdef) : boolean;
 
+    {# Returns true, if def is a comp type (handled by the fpu) }
+    function is_fpucomp(def : tdef) : boolean;
+
     {# Returns true, if def is a single type }
     function is_single(def : tdef) : boolean;
 
@@ -265,7 +268,10 @@ interface
     {# Returns true, if def is a 64 bit integer type }
     function is_64bitint(def : tdef) : boolean;
 
-    {# Returns true, if def is a 64 bit type }
+    {# Returns true, if def is a 64 bit signed integer type }
+    function is_s64bitint(def : tdef) : boolean;
+
+    {# Returns true, if def is a 64 bit ordinal type }
     function is_64bit(def : tdef) : boolean;
 
     { returns true, if def is a longint type }
@@ -408,6 +414,12 @@ implementation
       end;
 
 
+    function is_fpucomp(def: tdef): boolean;
+      begin
+        result:=(def.typ=floatdef) and
+           (tfloatdef(def).floattype=s64comp);
+      end;
+
     { returns true, if def is a single type }
     function is_single(def : tdef) : boolean;
       begin
@@ -1009,6 +1021,7 @@ implementation
          result:=(def.typ=orddef) and (torddef(def).ordtype in [u32bit,s32bit,pasbool32,bool32bit])
       end;
 
+
     { true, if def is a 64 bit int type }
     function is_64bitint(def : tdef) : boolean;
       begin
@@ -1016,6 +1029,12 @@ implementation
       end;
 
 
+    function is_s64bitint(def: tdef): boolean;
+      begin
+        is_s64bitint:=(def.typ=orddef) and (torddef(def).ordtype=s64bit)
+      end;
+
+
     { true, if def is a 64 bit type }
     function is_64bit(def : tdef) : boolean;
       begin

compiler/dirparse.pas

@@ -99,6 +99,12 @@ implementation
            end
           else if tok='RECORDMAX' then
            b.recordalignmax:=l
+
+{          disabled for now as - as Jonas pointed out - this
+           is a matter of abi
+
+           else if tok='MAXCRECORD' then
+           b.maxCrecordalign:=l }
           else { Error }
            UpdateAlignmentStr:=false;
         until false;

compiler/i386/aoptcpu.pas

@@ -238,6 +238,8 @@ unit aoptcpu;
               if InsContainsSegRef(taicpu(p)) then
                 exit;
               case taicpu(p).opcode Of
+                A_ADD:
+                  Result:=OptPass2ADD(p);
                 A_Jcc:
                   Result:=OptPass2Jcc(p);
                 A_Lea:
@@ -334,6 +336,8 @@ unit aoptcpu;
                    end;
                 A_TEST, A_OR:
                   Result:=PostPeepholeOptTestOr(p);
+                A_AND:
+                  Result:=PostPeepholeOptAnd(p);
                 A_MOVSX:
                   Result:=PostPeepholeOptMOVSX(p);
                 else

compiler/i386/cpuinfo.pas

@@ -176,7 +176,9 @@ type
 
    tfpuflags =
       (FPUX86_HAS_AVXUNIT,
-       FPUX86_HAS_AVX512F
+       FPUX86_HAS_AVX512F,
+       FPUX86_HAS_AVX512VL,
+       FPUX86_HAS_AVX512DQ
       );
 
  const
@@ -205,7 +207,7 @@ type
       { fpu_sse42    } [],
       { fpu_avx      } [FPUX86_HAS_AVXUNIT],
       { fpu_avx2     } [FPUX86_HAS_AVXUNIT],
-      { fpu_avx512   } [FPUX86_HAS_AVXUNIT,FPUX86_HAS_AVX512F]
+      { fpu_avx512   } [FPUX86_HAS_AVXUNIT,FPUX86_HAS_AVX512F,FPUX86_HAS_AVX512VL,FPUX86_HAS_AVX512DQ]
    );
 
 Implementation

compiler/i386/i386prop.inc

@@ -1383,10 +1383,10 @@
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
+(Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
+(Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
+(Ch: [Ch_Rop1, Ch_Rop2, Ch_Rop3, Ch_Wop4]),
+(Ch: [Ch_Rop1, Ch_Rop2, Ch_Rop3, Ch_Wop4]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),

compiler/i8086/i8086prop.inc

@@ -1397,10 +1397,10 @@
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
+(Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
+(Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
+(Ch: [Ch_Rop1, Ch_Rop2, Ch_Rop3, Ch_Wop4]),
+(Ch: [Ch_Rop1, Ch_Rop2, Ch_Rop3, Ch_Wop4]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),

compiler/m68k/aoptcpu.pas

@@ -380,7 +380,8 @@ unit aoptcpu;
         (taicpu(next).oper[1]^.ref^.base=NR_A7) and
         (taicpu(next).oper[1]^.ref^.index=NR_NO) and
         (taicpu(next).oper[1]^.ref^.symbol=nil) and
-        (taicpu(next).oper[1]^.ref^.direction=dir_none) then
+        (taicpu(next).oper[1]^.ref^.direction=dir_none) and 
+        not (current_settings.cputype in cpu_coldfire) then
         begin
           DebugMsg('Optimizer: LEA, MOVE(M) to MOVE(M) predecremented',p);
           taicpu(next).oper[1]^.ref^.direction:=dir_dec;
@@ -409,7 +410,8 @@ unit aoptcpu;
         (taicpu(next).oper[0]^.ref^.index=NR_NO) and
         (taicpu(next).oper[0]^.ref^.symbol=nil) and
         (taicpu(next).oper[0]^.ref^.direction=dir_none) and
-        ((taicpu(next).oper[0]^.ref^.offset=(PopCnt(Byte(taicpu(p).oper[1]^.dataregset))+PopCnt(Byte(taicpu(p).oper[1]^.addrregset)))*4)) then
+        ((taicpu(next).oper[0]^.ref^.offset=(PopCnt(Byte(taicpu(p).oper[1]^.dataregset))+PopCnt(Byte(taicpu(p).oper[1]^.addrregset)))*4)) and
+        not (current_settings.cputype in cpu_coldfire) then
         begin
           DebugMsg('Optimizer: MOVE(M), LEA to MOVE(M) postincremented',p);
           taicpu(p).oper[0]^.ref^.direction:=dir_inc;

compiler/m68k/cpuinfo.pas

@@ -165,6 +165,7 @@ type
       CPUM68K_HAS_32BITDIV,     { CPU supports DIVS/DIVU 32/32 -> 32bit                     }
       CPUM68K_HAS_64BITDIV,     { CPU supports DIVS/DIVU 64/32 -> 32bit                     }
       CPUM68K_HAS_REMSREMU,     { CPU supports the REMS/REMU instructions                   }
+      CPUM68K_HAS_LONGLINK,     { CPU supports the LINK instruction with 32bit displacement }
       CPUM68K_HAS_UNALIGNED,    { CPU supports unaligned access                             }
       CPUM68K_HAS_BASEDISP,     { CPU supports addressing with 32bit base displacements     }
       CPUM68K_HAS_INDEXSCALE,   { CPU supports scaling the index register with 2 or 4       }
@@ -187,9 +188,9 @@ const
   cpu_capabilities : array[tcputype] of set of tcpuflags =
     ( { cpu_none     } [],
       { cpu_68000    } [CPUM68K_HAS_DBRA,CPUM68K_HAS_TAS,CPUM68K_HAS_ROLROR,CPUM68K_HAS_MULIMM,CPUM68K_HAS_16BITDIV,CPUM68K_HAS_BYTEWORDMATH],
-      { cpu_68020    } [CPUM68K_HAS_DBRA,CPUM68K_HAS_RTD,CPUM68K_HAS_CAS,CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL,CPUM68K_HAS_ROLROR,CPUM68K_HAS_UNALIGNED,CPUM68K_HAS_BASEDISP,CPUM68K_HAS_MULIMM,CPUM68K_HAS_32BITMUL,CPUM68K_HAS_64BITMUL,CPUM68K_HAS_16BITDIV,CPUM68K_HAS_32BITDIV,CPUM68K_HAS_64BITDIV,CPUM68K_HAS_INDEXSCALE,CPUM68K_HAS_INDEXSCALE8,CPUM68K_HAS_INDEXWORD,CPUM68K_HAS_BYTEWORDMATH,CPUM68K_HAS_BITFIELD],
-      { cpu_68040    } [CPUM68K_HAS_DBRA,CPUM68K_HAS_RTD,CPUM68K_HAS_CAS,CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL,CPUM68K_HAS_ROLROR,CPUM68K_HAS_UNALIGNED,CPUM68K_HAS_BASEDISP,CPUM68K_HAS_MULIMM,CPUM68K_HAS_32BITMUL,CPUM68K_HAS_64BITMUL,CPUM68K_HAS_16BITDIV,CPUM68K_HAS_32BITDIV,CPUM68K_HAS_64BITDIV,CPUM68K_HAS_MOVE16,CPUM68K_HAS_INDEXSCALE,CPUM68K_HAS_INDEXSCALE8,CPUM68K_HAS_INDEXWORD,CPUM68K_HAS_BYTEWORDMATH,CPUM68K_HAS_BITFIELD],
-      { cpu_68060    } [CPUM68K_HAS_DBRA,CPUM68K_HAS_RTD,CPUM68K_HAS_CAS,CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL,CPUM68K_HAS_ROLROR,CPUM68K_HAS_UNALIGNED,CPUM68K_HAS_BASEDISP,CPUM68K_HAS_MULIMM,CPUM68K_HAS_32BITMUL,CPUM68K_HAS_16BITDIV,CPUM68K_HAS_32BITDIV,CPUM68K_HAS_MOVE16,CPUM68K_HAS_INDEXSCALE,CPUM68K_HAS_INDEXSCALE8,CPUM68K_HAS_INDEXWORD,CPUM68K_HAS_BYTEWORDMATH,CPUM68K_HAS_BITFIELD],
+      { cpu_68020    } [CPUM68K_HAS_DBRA,CPUM68K_HAS_RTD,CPUM68K_HAS_CAS,CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL,CPUM68K_HAS_ROLROR,CPUM68K_HAS_UNALIGNED,CPUM68K_HAS_BASEDISP,CPUM68K_HAS_LONGLINK,CPUM68K_HAS_MULIMM,CPUM68K_HAS_32BITMUL,CPUM68K_HAS_64BITMUL,CPUM68K_HAS_16BITDIV,CPUM68K_HAS_32BITDIV,CPUM68K_HAS_64BITDIV,CPUM68K_HAS_INDEXSCALE,CPUM68K_HAS_INDEXSCALE8,CPUM68K_HAS_INDEXWORD,CPUM68K_HAS_BYTEWORDMATH,CPUM68K_HAS_BITFIELD],
+      { cpu_68040    } [CPUM68K_HAS_DBRA,CPUM68K_HAS_RTD,CPUM68K_HAS_CAS,CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL,CPUM68K_HAS_ROLROR,CPUM68K_HAS_UNALIGNED,CPUM68K_HAS_BASEDISP,CPUM68K_HAS_LONGLINK,CPUM68K_HAS_MULIMM,CPUM68K_HAS_32BITMUL,CPUM68K_HAS_64BITMUL,CPUM68K_HAS_16BITDIV,CPUM68K_HAS_32BITDIV,CPUM68K_HAS_64BITDIV,CPUM68K_HAS_MOVE16,CPUM68K_HAS_INDEXSCALE,CPUM68K_HAS_INDEXSCALE8,CPUM68K_HAS_INDEXWORD,CPUM68K_HAS_BYTEWORDMATH,CPUM68K_HAS_BITFIELD],
+      { cpu_68060    } [CPUM68K_HAS_DBRA,CPUM68K_HAS_RTD,CPUM68K_HAS_CAS,CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL,CPUM68K_HAS_ROLROR,CPUM68K_HAS_UNALIGNED,CPUM68K_HAS_BASEDISP,CPUM68K_HAS_LONGLINK,CPUM68K_HAS_MULIMM,CPUM68K_HAS_32BITMUL,CPUM68K_HAS_16BITDIV,CPUM68K_HAS_32BITDIV,CPUM68K_HAS_MOVE16,CPUM68K_HAS_INDEXSCALE,CPUM68K_HAS_INDEXSCALE8,CPUM68K_HAS_INDEXWORD,CPUM68K_HAS_BYTEWORDMATH,CPUM68K_HAS_BITFIELD],
       { cpu_isaa     } [CPUM68K_HAS_UNALIGNED,CPUM68K_HAS_32BITMUL,CPUM68K_HAS_16BITDIV,CPUM68K_HAS_32BITDIV,CPUM68K_HAS_REMSREMU,CPUM68K_HAS_INDEXSCALE],
       { cpu_isaap    } [CPUM68K_HAS_BRAL,CPUM68K_HAS_BYTEREV,CPUM68K_HAS_UNALIGNED,CPUM68K_HAS_32BITMUL,CPUM68K_HAS_16BITDIV,CPUM68K_HAS_32BITDIV,CPUM68K_HAS_REMSREMU,CPUM68K_HAS_INDEXSCALE],
       { cpu_isab     } [CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL,CPUM68K_HAS_MVSMVZ,CPUM68K_HAS_UNALIGNED,CPUM68K_HAS_32BITMUL,CPUM68K_HAS_16BITDIV,CPUM68K_HAS_32BITDIV,CPUM68K_HAS_REMSREMU,CPUM68K_HAS_INDEXSCALE],

compiler/ncnv.pas

@@ -3347,14 +3347,14 @@ implementation
 {$if defined(cpu16bitalu)}
                   if (resultdef.size <= 2) and
                     (is_32bitint(left.resultdef) or is_64bitint(left.resultdef)) and
-                    (left.nodetype in [subn,addn,muln,divn,modn,xorn,andn,orn]) and
+                    (left.nodetype in [subn,addn,muln,divn,modn,xorn,andn,orn,notn,unaryminusn]) and
                     checkremovebiginttypeconvs(left,foundsint,[s8bit,u8bit,s16bit,u16bit],int64(low(smallint)),high(word)) then
                     doremoveinttypeconvs(left,generrordef,not foundsint,s16inttype,u16inttype);
 {$endif defined(cpu16bitalu)}
 {$if defined(cpu8bitalu)}
                  if (resultdef.size<left.resultdef.size) and
                   is_integer(left.resultdef) and
-                  (left.nodetype in [subn,addn,muln,divn,modn,xorn,andn,orn]) and
+                  (left.nodetype in [subn,addn,muln,divn,modn,xorn,andn,orn,notn,unaryminusn]) and
                   checkremovebiginttypeconvs(left,foundsint,[s8bit,u8bit],int64(low(shortint)),high(byte)) then
                     doremoveinttypeconvs(left,generrordef,not foundsint,s8inttype,u8inttype);
 {$endif defined(cpu8bitalu)}

compiler/nflw.pas

@@ -1563,6 +1563,7 @@ implementation
         paratype: tdef;
       begin
         result:=nil;
+        elsestmnt:=nil;
         in_nr:=Default(tinlinenumber);
         { optimize constant expressions }
         if (left.nodetype=ordconstn) then
@@ -1590,9 +1591,24 @@ implementation
           end;
 {$ifndef llvm}
 {$if defined(i386) or defined(x86_64) or defined(xtensa)}
-        { use min/max intrinsic? }
+        { use min/max intrinsic?
+          convert (with <op> being <, >, >=, <=
+          if a <op> b then
+            x:=a
+          else
+            x:=b;
+
+          and
+
+          if a <op> b then
+            x:=a;
+
+          into appropriate min/max intrinsics
+
+          }
         if (cs_opt_level2 in current_settings.optimizerswitches) and
-           (left.nodetype in [gtn,gten,ltn,lten]) and IsSingleStatement(right,thenstmnt) and ((t1=nil) or IsSingleStatement(t1,elsestmnt)) and
+           (left.nodetype in [gtn,gten,ltn,lten]) and IsSingleStatement(right,thenstmnt) and
+           ((t1=nil) or IsSingleStatement(t1,elsestmnt)) and
           (thenstmnt.nodetype=assignn) and ((t1=nil) or (elsestmnt.nodetype=assignn)) and
           not(might_have_sideeffects(left)) and
           ((t1=nil) or tassignmentnode(thenstmnt).left.isequal(tassignmentnode(elsestmnt).left)) and
@@ -1608,8 +1624,36 @@ implementation
 {$if defined(xtensa)}
           (CPUXTENSA_HAS_MINMAX in cpu_capabilities[current_settings.cputype]) and is_32bitint(tassignmentnode(thenstmnt).right.resultdef) and
 {$endif defined(xtensa)}
-          ((tassignmentnode(thenstmnt).right.isequal(taddnode(left).left) and ((t1=nil) or (tassignmentnode(elsestmnt).right.isequal(taddnode(left).right)))) or
-           (tassignmentnode(thenstmnt).right.isequal(taddnode(left).right) and ((t1=nil) or (tassignmentnode(elsestmnt).right.isequal(taddnode(left).left))))
+          (
+          { the right size of the assignment in the then clause must either }
+
+          { equal to the left ... }
+           (tassignmentnode(thenstmnt).right.isequal(taddnode(left).left) and
+
+            { ... and the else clause must be either not exist                 }
+            { and the left side of the assignment in the then clause must be   }
+            {  equal to the right operand of the comparison operator           }
+            (
+              ((t1=nil) and (tassignmentnode(thenstmnt).left.isequal(taddnode(left).right))) or
+
+              { or the else clause exists and the right side of the assignment in the else clause }
+              { must be equal to the right side of the comparison operator                        }
+              (assigned(elsestmnt) and tassignmentnode(elsestmnt).right.isequal(taddnode(left).right)))
+           ) or
+           { ... or right operand of the comparison operator }
+
+            (tassignmentnode(thenstmnt).right.isequal(taddnode(left).right) and
+            { ... and the else clause must be either not exist                 }
+            { and the left side of the assignment in the then clause must be   }
+            {  equal to the left operand of the comparison operator            }
+             (
+              ((t1=nil) and (tassignmentnode(thenstmnt).left.isequal(taddnode(left).left))) or
+
+              { or the else clause exists and the right side of the assignment in the else clause }
+              { must be equal to the left side of the comparison operator                         }
+              (assigned(elsestmnt) and tassignmentnode(elsestmnt).right.isequal(taddnode(left).left))
+             )
+           )
           ) then
           begin
             paratype:=tassignmentnode(thenstmnt).left.resultdef;

compiler/ninl.pas

@@ -2820,7 +2820,10 @@ implementation
 
     function tinlinenode.pass_typecheck:tnode;
 
-      procedure setfloatresultdef;
+      type
+        tfloattypeset = set of tfloattype;
+
+      function removefloatupcasts(var p: tnode; const floattypes: tfloattypeset): tdef;
         var
           hnode: tnode;
         begin
@@ -2830,25 +2833,54 @@ implementation
             which typechecks the arguments, possibly inserting conversion to valreal.
             To handle smaller types without excess precision, we need to remove
             these extra typecasts. }
-          if (left.nodetype=typeconvn) and
-            (ttypeconvnode(left).left.resultdef.typ=floatdef) and
-            (left.flags*[nf_explicit,nf_internal]=[]) and
-            (tfloatdef(ttypeconvnode(left).left.resultdef).floattype in [s32real,s64real,s80real,sc80real,s128real]) then
+          if (p.nodetype=typeconvn) and
+             (ttypeconvnode(p).left.resultdef.typ=floatdef) and
+             (p.flags*[nf_explicit,nf_internal]=[]) and
+             (tfloatdef(ttypeconvnode(p).left.resultdef).floattype in (floattypes*[s32real,s64real,s80real,sc80real,s128real])) then
             begin
-              hnode:=ttypeconvnode(left).left;
-              ttypeconvnode(left).left:=nil;
-              left.free;
-              left:=hnode;
-              resultdef:=left.resultdef;
+              hnode:=ttypeconvnode(p).left;
+              ttypeconvnode(p).left:=nil;
+              p.free;
+              p:=hnode;
+              result:=p.resultdef;
             end
-          else if (left.resultdef.typ=floatdef) and
-            (tfloatdef(left.resultdef).floattype in [s32real,s64real,s80real,sc80real,s128real]) then
-            resultdef:=left.resultdef
+          else if (p.nodetype=typeconvn) and
+             (p.flags*[nf_explicit,nf_internal]=[]) and
+             (ttypeconvnode(p).left.resultdef.typ=floatdef) and
+             (tfloatdef(ttypeconvnode(p).left.resultdef).floattype in (floattypes*[s64currency,s64comp])) then
+            begin
+              hnode:=ttypeconvnode(p).left;
+              ttypeconvnode(p).left:=nil;
+              p.free;
+              p:=hnode;
+              if is_currency(p.resultdef) then
+                begin
+                  if (nf_is_currency in p.flags) and
+                     (p.nodetype=slashn) and
+                     (taddnode(p).right.nodetype=realconstn) and
+                     (trealconstnode(taddnode(p).right).value_real=10000.0) and
+                     not(nf_is_currency in taddnode(p).left.flags) then
+                   begin
+                     hnode:=taddnode(p).left;
+                     taddnode(p).left:=nil;
+                     p.free;
+                     p:=hnode;
+                   end;
+                end;
+              result:=p.resultdef;
+            end
+          { in case the system helper was declared with overloads for different types,
+            keep those }
+          else if (p.resultdef.typ=floatdef) and
+             (tfloatdef(p.resultdef).floattype in (floattypes*[s32real,s64real,s80real,sc80real,s128real])) then
+            result:=p.resultdef
           else
             begin
-              if (left.nodetype <> ordconstn) then
-                inserttypeconv(left,pbestrealtype^);
-              resultdef:=pbestrealtype^;
+              { for variant parameters; the rest has been converted by the
+                call node already }
+              if not(p.nodetype in [ordconstn,realconstn]) then
+                inserttypeconv(P,pbestrealtype^);
+              result:=p.resultdef
             end;
         end;
 
@@ -3595,18 +3627,29 @@ implementation
                   { on i8086, the int64 result is returned in a var param, because
                     it's too big to fit in a register or a pair of registers. In
                     that case we have 2 parameters and left.nodetype is a callparan. }
-                  if left.nodetype = callparan then
-                    temp_pnode := @tcallparanode(left).left
+                  if left.nodetype=callparan then
+                    temp_pnode:=@tcallparanode(left).left
                   else
-                    temp_pnode := @left;
+                    temp_pnode:=@left;
                   set_varstate(temp_pnode^,vs_read,[vsf_must_be_valid]);
-                  { for direct float rounding, no best real type cast should be necessary }
-                  if not((temp_pnode^.resultdef.typ=floatdef) and
-                         (tfloatdef(temp_pnode^.resultdef).floattype in [s32real,s64real,s80real,sc80real,s128real])) and
-                     { converting an int64 to double on platforms without }
-                     { extended can cause precision loss                  }
-                     not(temp_pnode^.nodetype in [ordconstn,realconstn]) then
-                    inserttypeconv(temp_pnode^,pbestrealtype^);
+                  { on platforms where comp and currency are "type int64", this is
+                    handled via inlined system helpers (-> no need for special
+                    handling of s64currency/s64comp for them) }
+                  if inlinenumber=in_trunc_real then
+                    removefloatupcasts(temp_pnode^,[s32real,s64real,s80real,sc80real,s128real,s64currency,s64comp])
+                  else
+                    removefloatupcasts(temp_pnode^,[s32real,s64real,s80real,sc80real,s128real,s64comp]);
+                  if (inlinenumber=in_trunc_real) and
+                     is_currency(temp_pnode^.resultdef) then
+                    begin
+                      result:=cmoddivnode.create(divn,ctypeconvnode.create_internal(temp_pnode^.getcopy,s64inttype),genintconstnode(10000));
+                      exit;
+                    end
+                  else if is_fpucomp(temp_pnode^.resultdef) then
+                    begin
+                      result:=ctypeconvnode.create_internal(temp_pnode^.getcopy,s64inttype);
+                      exit;
+                    end;
                   resultdef:=s64inttype;
                 end;
 
@@ -3633,7 +3676,7 @@ implementation
                   else
                     temp_pnode := @left;
                   set_varstate(temp_pnode^,vs_read,[vsf_must_be_valid]);
-                  setfloatresultdef;
+                  resultdef:=removefloatupcasts(temp_pnode^,[s32real,s64real,s80real,sc80real,s128real]);
                 end;
 
 {$ifdef SUPPORT_MMX}

compiler/nld.pas

@@ -182,6 +182,10 @@ interface
        { Current assignment node }
        aktassignmentnode : tassignmentnode;
 
+       { Create a node tree to load a variable if symbol is assigned, otherwise an error node.
+         Generates an internalerror if called for an absolutevarsym of the "tovar" kind (those
+         are only supported for expansion in the parser) }
+       function gen_load_var(sym: tabstractvarsym): tnode;
 
 implementation
 
@@ -192,10 +196,32 @@ implementation
       defutil,defcmp,
       cpuinfo,
       htypechk,pass_1,procinfo,paramgr,
-      ncon,nflw,ninl,ncnv,nmem,ncal,nutils,
+      nbas,ncon,nflw,ninl,ncnv,nmem,ncal,nutils,
       cgbase
       ;
 
+
+    function gen_load_var(sym: tabstractvarsym): tnode;
+      begin
+        result:=nil;
+        if assigned(sym) then
+          begin
+            if (sym.typ<>absolutevarsym) or
+               (tabsolutevarsym(sym).abstyp<>tovar) then
+              begin
+                result:=cloadnode.create(sym,sym.owner);
+              end
+            else
+              internalerror(2020122601);
+          end
+        else
+          begin
+            result:=cerrornode.create;
+            CGMessage(parser_e_illegal_expression);
+          end;
+      end;
+
+
 {*****************************************************************************
                              TLOADNODE
 *****************************************************************************}

compiler/nmat.pas

@@ -283,19 +283,32 @@ implementation
              (not is_signed(ld) and
               (rd.size >= ld.size))) then
            begin
-             inserttypeconv(left,right.resultdef);
-             ld:=torddef(left.resultdef);
-           end;
-         if (ld.ordtype in [u8bit,u16bit,u32bit,u64bit]) and
+             if rd.size<uinttype.size then
+               begin
+                 inserttypeconv(left,uinttype);
+                 inserttypeconv(right,uinttype);
+               end
+             else
+               inserttypeconv(left,rd);
+             resultdef:=right.resultdef;
+           end
+         else if (ld.ordtype in [u8bit,u16bit,u32bit,u64bit]) and
             ((is_constintnode(right) and
               (tordconstnode(right).value >= 0) and
               (tordconstnode(right).value <= get_max_value(ld))) or
              (not is_signed(rd) and
               (ld.size >= rd.size))) then
-          begin
-            inserttypeconv(right,left.resultdef);
-            rd:=torddef(right.resultdef);
-          end;
+           begin
+             if ld.size<uinttype.size then
+               begin
+                 inserttypeconv(left,uinttype);
+                 inserttypeconv(right,uinttype);
+               end
+             else
+               inserttypeconv(right,ld);
+             resultdef:=left.resultdef;
+           end
+         else
 
          { when there is one currency value, everything is done
            using currency }

compiler/nutils.pas

@@ -78,7 +78,7 @@ interface
     procedure checktreenodetypes(n : tnode;typeset : tnodetypeset);
 
     procedure load_procvar_from_calln(var p1:tnode);
-    function get_local_or_para_sym(const aname: string): tsym;
+    function get_local_or_para_sym(const aname: string): tabstractvarsym;
     function maybe_call_procvar(var p1:tnode;tponly:boolean):boolean;
     function load_high_value_node(vs:tparavarsym):tnode;
     function load_self_node:tnode;
@@ -496,10 +496,12 @@ implementation
       end;
 
 
-    function get_local_or_para_sym(const aname: string): tsym;
+    function get_local_or_para_sym(const aname: string): tabstractvarsym;
       var
-        pd : tprocdef;
+        pd: tprocdef;
+        ressym: tsym;
       begin
+        ressym:=nil;
         result:=nil;
         { is not assigned while parsing a property }
         if not assigned(current_procinfo) then
@@ -509,11 +511,11 @@ implementation
           is run for nested procedures }
         pd:=current_procinfo.procdef;
         repeat
-          result := tsym(pd.localst.Find(aname));
-          if assigned(result) then
+          ressym:=tsym(pd.localst.Find(aname));
+          if assigned(ressym) then
             break;
-          result := tsym(pd.parast.Find(aname));
-          if assigned(result) then
+          ressym:=tsym(pd.parast.Find(aname));
+          if assigned(ressym) then
             break;
           { try the parent of a nested function }
           if assigned(pd.owner.defowner) and
@@ -522,104 +524,60 @@ implementation
           else
             break;
         until false;
+        if assigned(ressym) and
+           not(ressym.typ in [localvarsym,paravarsym]) then
+          internalerror(2020122604);
+        result:=tabstractvarsym(ressym);
       end;
 
 
+
     function load_high_value_node(vs:tparavarsym):tnode;
-      var
-        srsym : tsym;
       begin
-        result:=nil;
-        srsym:=get_high_value_sym(vs);
-        if assigned(srsym) then
-          begin
-            result:=cloadnode.create(srsym,vs.owner);
-            typecheckpass(result);
-          end
-        else
-          CGMessage(parser_e_illegal_expression);
+        result:=gen_load_var(get_high_value_sym(vs));
+        typecheckpass(result);
       end;
 
 
     function load_self_node:tnode;
-      var
-        srsym : tsym;
       begin
-        result:=nil;
-
-        srsym:=get_local_or_para_sym('self');
-        if assigned(srsym) then
-          begin
-            result:=cloadnode.create(srsym,srsym.owner);
-            include(tloadnode(result).loadnodeflags,loadnf_is_self);
-          end
-        else
-          begin
-            result:=cerrornode.create;
-            CGMessage(parser_e_illegal_expression);
-          end;
+        result:=gen_load_var(get_local_or_para_sym('self'));
+        if result.nodetype=loadn then
+          include(tloadnode(result).loadnodeflags,loadnf_is_self)
+        else if result.nodetype<>errorn then
+          internalerror(2020122603);
         typecheckpass(result);
       end;
 
 
     function load_result_node:tnode;
-      var
-        srsym : tsym;
-        pd : tprocdef;
-       begin
-        result:=nil;
-        srsym:=get_local_or_para_sym('result');
-        if not assigned(srsym) then
-          begin
-            pd:=current_procinfo.procdef;
-            if assigned(pd.procsym) then
-              srsym:=get_local_or_para_sym(pd.procsym.name);
-          end;
-        if assigned(srsym) then
-          result:=cloadnode.create(srsym,srsym.owner)
-        else
-          begin
-            result:=cerrornode.create;
-            CGMessage(parser_e_illegal_expression);
-          end;
+      begin
+        result:=gen_load_var(get_local_or_para_sym('result'));
         typecheckpass(result);
       end;
 
 
     function load_self_pointer_node:tnode;
       var
-        srsym : tsym;
+        srsym : tabstractvarsym;
       begin
-        result:=nil;
         srsym:=get_local_or_para_sym('self');
-        if assigned(srsym) then
+        result:=gen_load_var(srsym);
+        if assigned(srsym) and
+           (is_object(tabstractvarsym(srsym).vardef) or is_record(tabstractvarsym(srsym).vardef)) then
           begin
-            result:=cloadnode.create(srsym,srsym.owner);
-            if is_object(tabstractvarsym(srsym).vardef) or is_record(tabstractvarsym(srsym).vardef) then
-              include(tloadnode(result).loadnodeflags,loadnf_load_addr);
-          end
-        else
-          begin
-            result:=cerrornode.create;
-            CGMessage(parser_e_illegal_expression);
+            if result.nodetype=loadn then
+              include(tloadnode(result).loadnodeflags,loadnf_load_addr)
+            else if result.nodetype<>errorn then
+              internalerror(2020122602);
           end;
         typecheckpass(result);
       end;
 
 
     function load_vmt_pointer_node:tnode;
-      var
-        srsym : tsym;
       begin
-        result:=nil;
-        srsym:=get_local_or_para_sym('vmt');
-        if assigned(srsym) then
-          result:=cloadnode.create(srsym,srsym.owner)
-        else
-          begin
-            result:=cerrornode.create;
-            CGMessage(parser_e_illegal_expression);
-          end;
+        result:=gen_load_var(get_local_or_para_sym('vmt'));
         typecheckpass(result);
       end;
 

compiler/optdfa.pas

@@ -714,7 +714,8 @@ unit optdfa;
                    ((vo_is_funcret in sym.varoptions) and
                     (current_procinfo.procdef.parast.symtablelevel=sym.owner.symtablelevel)
                    )
-                  ) and not(vo_is_external in sym.varoptions)
+                  ) and not(vo_is_external in sym.varoptions) and
+                  not sym.inparentfpstruct;
         end;
 
       var

compiler/pdecsub.pas

@@ -1344,7 +1344,7 @@ implementation
             parse_generic:=(df_generic in pd.defoptions);
             if pd.is_generic or pd.is_specialization then
               symtablestack.push(pd.parast);
-            single_type(pd.returndef,[stoAllowSpecialization]);
+            pd.returndef:=result_type([stoAllowSpecialization]);
 
             // Issue #24863, enabled only for the main progra commented out for now because it breaks building of RTL and needs extensive
 // testing and/or RTL patching.
@@ -1555,10 +1555,6 @@ implementation
             include(pd.procoptions,po_variadic);
           end;
 
-        { file types can't be function results }
-        if assigned(pd) and
-           (pd.returndef.typ=filedef) then
-          message(parser_e_illegal_function_result);
         { support procedure proc stdcall export; }
         if not(check_proc_directive(false)) then
           begin

compiler/psub.pas

@@ -369,12 +369,6 @@ implementation
 
         if assigned(current_procinfo.procdef.parentfpstruct) then
          begin
-           { we only do this after the code has been parsed because
-             otherwise for-loop counters moved to the struct cause
-             errors; we still do it nevertheless to prevent false
-             "unused" symbols warnings and to assist debug info
-             generation }
-           redirect_parentfpstruct_local_syms(current_procinfo.procdef);
            { finish the parentfpstruct (add padding, ...) }
            finish_parentfpstruct(current_procinfo.procdef);
          end;
@@ -2171,7 +2165,7 @@ implementation
 
             { translate imag. register to their real counter parts
               this is necessary for debuginfo and verbose assembler output
-              when SSA will be implented, this will be more complicated because we've to
+              when SSA will be implemented, this will be more complicated because we've to
               maintain location lists }
             procdef.parast.SymList.ForEachCall(@translate_registers,templist);
             procdef.localst.SymList.ForEachCall(@translate_registers,templist);
@@ -2278,7 +2272,19 @@ implementation
             { insert line debuginfo }
             if (cs_debuginfo in current_settings.moduleswitches) or
                (cs_use_lineinfo in current_settings.globalswitches) then
+             begin
+               { We only do this after the code generated because
+                 otherwise for-loop counters moved to the struct cause
+                 errors. And doing it before optimisation passes have run
+                 causes problems when they manually look up symbols
+                 like result and self (nutils.load_self_node etc). Still
+                 do it nevertheless to to assist debug info generation
+                 (hide original symbols, add absolutevarsyms that redirect
+                  to their new locations in the parentfpstruct) }
+              if assigned(current_procinfo.procdef.parentfpstruct) then
+                redirect_parentfpstruct_local_syms(current_procinfo.procdef);
               current_debuginfo.insertlineinfo(aktproccode);
+             end;
 
             finish_eh;
 

compiler/ptype.pas

@@ -41,7 +41,9 @@ interface
     procedure resolve_forward_types;
 
     { reads a string, file type or a type identifier }
-    procedure single_type(var def:tdef;options:TSingleTypeOptions);
+    procedure single_type(out def:tdef;options:TSingleTypeOptions);
+    { ... but rejects types that cannot be returned from functions }
+    function result_type(options:TSingleTypeOptions):tdef;
 
     { reads any type declaration, where the resulting type will get name as type identifier }
     procedure read_named_type(var def:tdef;const newsym:tsym;genericdef:tstoreddef;genericlist:tfphashobjectlist;parseprocvardir:boolean;var hadtypetoken:boolean);
@@ -454,7 +456,7 @@ implementation
       end;
 
 
-    procedure single_type(var def:tdef;options:TSingleTypeOptions);
+    procedure single_type(out def:tdef;options:TSingleTypeOptions);
        var
          t2 : tdef;
          isspecialize,
@@ -645,6 +647,14 @@ implementation
       end;
 
 
+    function result_type(options:TSingleTypeOptions):tdef;
+      begin
+        single_type(result,options);
+        { file types cannot be function results }
+        if result.typ=filedef then
+          message(parser_e_illegal_function_result);
+      end;
+
     procedure parse_record_members(recsym:tsym);
 
       function IsAnonOrLocal: Boolean;
@@ -1587,7 +1597,7 @@ implementation
             if is_func then
               begin
                 consume(_COLON);
-                single_type(pd.returndef,[]);
+                pd.returndef:=result_type([stoAllowSpecialization]);
               end;
             if try_to_consume(_OF) then
               begin

compiler/sparcgen/cgsparc.pas

@@ -799,7 +799,7 @@ implementation
                   tmpreg1:=GetIntRegister(list,OS_INT);
                   tmpreg2:=GetIntRegister(list,OS_INT);
                   list.concat(taicpu.op_reg_reg(A_MOV,NR_Y,tmpreg1));
-                  list.concat(taicpu.op_reg_const_reg(A_SRL,dst,31,tmpreg2));
+                  list.concat(taicpu.op_reg_const_reg(A_SRA,dst,31,tmpreg2));
                   list.concat(taicpu.op_reg_reg(A_CMP,tmpreg1,tmpreg2));
                   ovloc.loc:=LOC_FLAGS;
                   ovloc.resflags.Init(NR_ICC,F_NE);

compiler/symbase.pas

@@ -72,6 +72,7 @@ interface
       TSymEntry = class(TFPHashObject)
       private
          FRealName : {$ifdef symansistr}TSymStr{$else}pshortstring{$endif};
+         function GetEscapedRealName: TSymStr;
          function  GetRealname: TSymStr;
          procedure SetRealname(const ANewName: TSymStr);
       public
@@ -80,6 +81,7 @@ interface
          Owner : TSymtable;
          destructor destroy;override;
          property RealName: TSymStr read GetRealName write SetRealName;
+         property EscapedRealName: TSymStr read GetEscapedRealName;
       end;
 
 {************************************************
@@ -208,6 +210,14 @@ implementation
       end;
 
 
+    function TSymEntry.GetEscapedRealName: TSymStr;
+      begin
+        result:=GetRealname;
+        if result=Name then
+          result:='$'+result;
+      end;
+
+
     procedure TSymEntry.SetRealname(const ANewName:TSymStr);
       begin
 {$ifndef symansistr}

compiler/symcreat.pas

@@ -1257,7 +1257,7 @@ implementation
       else
         begin
           symname:=sym.name;
-          symrealname:=sym.realname;
+          symrealname:=sym.EscapedRealName;
         end;
       result:=search_struct_member(trecorddef(nestedvarsdef),symname);
       if not assigned(result) then
@@ -1330,7 +1330,7 @@ implementation
           sl:=tpropaccesslist.create;
           sl.addsym(sl_load,pd.parentfpstruct);
           sl.addsym(sl_subscript,tfieldvarsym(fsym));
-          aliassym:=cabsolutevarsym.create_ref(lsym.name,tfieldvarsym(fsym).vardef,sl);
+          aliassym:=cabsolutevarsym.create_ref(lsym.EscapedRealName,tfieldvarsym(fsym).vardef,sl);
           { hide the original variable (can't delete, because there
             may be other loadnodes that reference it)
             -- only for locals; hiding parameters changes the

compiler/symdef.pas

@@ -1535,36 +1535,42 @@ implementation
         prefix:='';
         if not assigned(st) then
          internalerror(200204212);
-        { sub procedures }
-        while (st.symtabletype in [localsymtable,parasymtable]) do
-         begin
-           if st.defowner.typ<>procdef then
-            internalerror(200204173);
-           { Add the full mangledname of procedure to prevent
-             conflicts with 2 overloads having both a nested procedure
-             with the same name, see tb0314 (PFV) }
-           s:=tprocdef(st.defowner).procsym.name;
-           s:=s+tprocdef(st.defowner).mangledprocparanames(Length(s));
-           if prefix<>'' then
-             prefix:=s+'_'+prefix
-           else
-             prefix:=s;
-           if length(prefix)>100 then
-             begin
-               crc:=0;
-               crc:=UpdateCrc32(crc,prefix[1],length(prefix));
-               prefix:='$CRC'+hexstr(crc,8);
-             end;
-           st:=st.defowner.owner;
-         end;
-        { object/classes symtable, nested type definitions in classes require the while loop }
-        while st.symtabletype in [ObjectSymtable,recordsymtable] do
-         begin
-           if not (st.defowner.typ in [objectdef,recorddef]) then
-            internalerror(200204174);
-           prefix:=tabstractrecorddef(st.defowner).objname^+'_$_'+prefix;
-           st:=st.defowner.owner;
-         end;
+        repeat
+          { sub procedures }
+          while (st.symtabletype in [localsymtable,parasymtable]) do
+           begin
+             if st.defowner.typ<>procdef then
+              internalerror(200204173);
+             { Add the full mangledname of the routine to prevent
+               conflicts with two overloads both having a local entity
+               -- routine (tb0314), class, interface -- with the same name }
+             s:=tprocdef(st.defowner).procsym.name;
+             s:=s+tprocdef(st.defowner).mangledprocparanames(Length(s));
+             if prefix<>'' then
+               prefix:=s+'_'+prefix
+             else
+               prefix:=s;
+             if length(prefix)>100 then
+               begin
+                 crc:=0;
+                 crc:=UpdateCrc32(crc,prefix[1],length(prefix));
+                 prefix:='$CRC'+hexstr(crc,8);
+               end;
+             st:=st.defowner.owner;
+           end;
+          { object/classes symtable, nested type definitions in classes require the while loop }
+          while st.symtabletype in [ObjectSymtable,recordsymtable] do
+           begin
+             if not (st.defowner.typ in [objectdef,recorddef]) then
+              internalerror(200204174);
+             prefix:=tabstractrecorddef(st.defowner).objname^+'_$_'+prefix;
+             st:=st.defowner.owner;
+           end;
+          { local classes & interfaces are possible (because of closures) }
+          if st.symtabletype<>localsymtable then
+            break;
+          prefix:='$'+prefix;
+        until false;
         { symtable must now be static or global }
         if not(st.symtabletype in [staticsymtable,globalsymtable]) then
           internalerror(200204175);
@@ -5811,7 +5817,7 @@ implementation
 {$endif}
         if (typ=procdef) and
            (newtyp=procvardef) and
-           (owner.symtabletype=ObjectSymtable) then
+           (owner.symtabletype in [ObjectSymtable,recordsymtable]) then
           include(tprocvardef(result).procoptions,po_methodpointer);
       end;
 
@@ -6636,7 +6642,7 @@ implementation
       begin
         { don't check assigned(_class), that's also the case for nested
           procedures inside methods }
-        result:=(owner.symtabletype=ObjectSymtable)and not no_self_node;
+        result:=(owner.symtabletype in [recordsymtable,ObjectSymtable]) and not no_self_node;
       end;
 
 

compiler/symsym.pas

@@ -496,7 +496,7 @@ interface
 
     { generate internal static field name based on regular field name }
     function internal_static_field_name(const fieldname: TSymStr): TSymStr;
-    function get_high_value_sym(vs: tparavarsym):tsym; { marking it as inline causes IE 200311075 during loading from ppu file }
+    function get_high_value_sym(vs: tparavarsym):tabstractvarsym; { marking it as inline causes IE 200311075 during loading from ppu file }
 
     procedure check_hints(const srsym: tsym; const symoptions: tsymoptions; const deprecatedmsg : pshortstring);inline;
     procedure check_hints(const srsym: tsym; const symoptions: tsymoptions; const deprecatedmsg : pshortstring;filepos:tfileposinfo);
@@ -534,9 +534,9 @@ implementation
       end;
 
 
-    function get_high_value_sym(vs: tparavarsym):tsym;
+    function get_high_value_sym(vs: tparavarsym):tabstractvarsym;
       begin
-        result := tsym(vs.owner.Find('high'+vs.name));
+        result := tabstractvarsym(vs.owner.Find('high'+vs.name));
       end;
 
 

compiler/symtable.pas

@@ -197,10 +197,10 @@ interface
          procedure generate;
          // helpers
          procedure appenddefoffset(vardef:tdef; fieldoffset: aint; derefclass: boolean);
-         procedure findvariantstarts(variantstarts: tfplist);
+         procedure preprocess(out tempsymlist, variantstarts: tfplist);
          procedure addalignmentpadding(finalsize: aint);
-         procedure buildmapping(variantstarts: tfplist);
-         procedure buildtable(variantstarts: tfplist);
+         procedure buildmapping(tempsymlist, variantstarts: tfplist);
+         procedure buildtable(tempsymlist, variantstarts: tfplist);
        end;
 {$endif llvm}
 
@@ -1425,12 +1425,18 @@ implementation
         changed: boolean;
       begin
         if maybereorder and
-           (cs_opt_reorder_fields in current_settings.optimizerswitches) then
+           (cs_opt_reorder_fields in current_settings.optimizerswitches) and
+           (list.count>1) then
           begin
             { assign dummy field offsets so we can know their order in the
               sorting routine }
             for i:=0 to list.count-1 do
-              tfieldvarsym(list[i]).fieldoffset:=i;
+              begin
+                fieldvs:=tfieldvarsym(list[i]);
+                if sp_static in fieldvs.symoptions then
+                  continue;
+                fieldvs.fieldoffset:=i;
+              end;
             { sort the non-class fields to minimise losses due to alignment }
             list.sort(@field_alignment_compare);
             { now fill up gaps caused by alignment skips with smaller fields
@@ -1526,7 +1532,12 @@ implementation
         end;
         { reset the dummy field offsets }
         for i:=0 to list.count-1 do
-          tfieldvarsym(list[i]).fieldoffset:=-1;
+          begin
+            fieldvs:=tfieldvarsym(list[i]);
+            if sp_static in fieldvs.symoptions then
+              continue;
+            fieldvs.fieldoffset:=-1;
+          end;
         { finally, set the actual field offsets }
         for i:=0 to list.count-1 do
           begin
@@ -2118,31 +2129,42 @@ implementation
 
     procedure tllvmshadowsymtable.addalignmentpadding(finalsize: aint);
       begin
-        case equivst.usefieldalignment of
-          { already correct in this case }
-          bit_alignment:
-            ;
-          else if not(df_llvm_no_struct_packing in tdef(equivst.defowner).defoptions) then
-            begin
-              { add padding fields }
-              while (finalsize>curroffset) do
-                begin
-                  symdeflist.add(tllvmshadowsymtableentry.create(u8inttype,curroffset));
-                  inc(curroffset);
-                end;
-            end;
-        end;
+        if not(df_llvm_no_struct_packing in tdef(equivst.defowner).defoptions) then
+          begin
+            if equivst.usefieldalignment=bit_alignment then
+              curroffset:=align(curroffset,8) div 8;
+            { add padding fields }
+            while (finalsize>curroffset) do
+              begin
+                symdeflist.add(tllvmshadowsymtableentry.create(u8inttype,curroffset));
+                inc(curroffset);
+              end;
+          end;
       end;
 
 
-    procedure tllvmshadowsymtable.findvariantstarts(variantstarts: tfplist);
+    function field_offset_compare(item1, item2: pointer): integer;
       var
-        sym: tfieldvarsym;
-        lastoffset: aint;
+        field1: tfieldvarsym absolute item1;
+        field2: tfieldvarsym absolute item2;
+      begin
+        result:=field1.fieldoffset-field2.fieldoffset;
+      end;
+
+
+    procedure tllvmshadowsymtable.preprocess(out tempsymlist, variantstarts: tfplist);
+      var
+        fieldvs: tfieldvarsym;
+        lastvariantstartoffset, prevfieldoffset: aint;
         newalignment: aint;
         i, j: longint;
+        sorttempsymlist: boolean;
       begin
         i:=0;
+        variantstarts:=nil;
+        tempsymlist:=tfplist.create;
+        sorttempsymlist:=false;
+        prevfieldoffset:=-1;
         while (i<equivst.symlist.count) do
           begin
             if not is_normal_fieldvarsym(tsym(equivst.symlist[i])) then
@@ -2150,38 +2172,42 @@ implementation
                 inc(i);
                 continue;
               end;
-            sym:=tfieldvarsym(equivst.symlist[i]);
+            fieldvs:=tfieldvarsym(equivst.symlist[i]);
+            tempsymlist.Add(fieldvs);
             { a "better" algorithm might be to use the largest }
             { variant in case of (bit)packing, since then      }
             { alignment doesn't matter                         }
-            if (vo_is_first_field in sym.varoptions) then
+            if (vo_is_first_field in fieldvs.varoptions) then
               begin
                 { we assume that all fields are processed in order. }
-                if (variantstarts.count<>0) then
-                  lastoffset:=tfieldvarsym(variantstarts[variantstarts.count-1]).fieldoffset
+                if assigned(variantstarts) then
+                  lastvariantstartoffset:=tfieldvarsym(variantstarts[variantstarts.count-1]).fieldoffset
                 else
-                  lastoffset:=-1;
+                  begin
+                    lastvariantstartoffset:=-1;
+                    variantstarts:=tfplist.create;
+                  end;
 
                 { new variant at same level as last one: use if higher alignment }
-                if (lastoffset=sym.fieldoffset) then
+                if (lastvariantstartoffset=fieldvs.fieldoffset) then
                   begin
-                    if (equivst.fieldalignment<>bit_alignment) then
-                      newalignment:=used_align(sym.vardef.alignment,equivst.recordalignmin,equivst.fieldalignment)
+                    if (equivst.usefieldalignment<>bit_alignment) then
+                      newalignment:=used_align(fieldvs.vardef.alignment,equivst.recordalignmin,equivst.fieldalignment)
                     else
                       newalignment:=1;
                     if (newalignment>tfieldvarsym(variantstarts[variantstarts.count-1]).vardef.alignment) then
-                      variantstarts[variantstarts.count-1]:=sym;
+                      variantstarts[variantstarts.count-1]:=fieldvs;
                   end
                 { variant at deeper level than last one -> add }
-                else if (lastoffset<sym.fieldoffset) then
-                  variantstarts.add(sym)
+                else if (lastvariantstartoffset<fieldvs.fieldoffset) then
+                  variantstarts.add(fieldvs)
                 else
                   begin
                     { a variant at a less deep level, so backtrack }
                     j:=variantstarts.count-2;
                     while (j>=0) do
                       begin
-                        if (tfieldvarsym(variantstarts[j]).fieldoffset=sym.fieldoffset) then
+                        if (tfieldvarsym(variantstarts[j]).fieldoffset=fieldvs.fieldoffset) then
                           break;
                         dec(j);
                       end;
@@ -2189,13 +2215,13 @@ implementation
                       internalerror(2008051003);
                     { new variant has higher alignment? }
                     if (equivst.fieldalignment<>bit_alignment) then
-                      newalignment:=used_align(sym.vardef.alignment,equivst.recordalignmin,equivst.fieldalignment)
+                      newalignment:=used_align(fieldvs.vardef.alignment,equivst.recordalignmin,equivst.fieldalignment)
                     else
                       newalignment:=1;
                     { yes, replace and remove previous nested variants }
                     if (newalignment>tfieldvarsym(variantstarts[j]).vardef.alignment) then
                       begin
-                        variantstarts[j]:=sym;
+                        variantstarts[j]:=fieldvs;
                         variantstarts.count:=j+1;
                       end
                    { no, skip this variant }
@@ -2204,91 +2230,95 @@ implementation
                         inc(i);
                         while (i<equivst.symlist.count) and
                               (not is_normal_fieldvarsym(tsym(equivst.symlist[i])) or
-                               (tfieldvarsym(equivst.symlist[i]).fieldoffset>sym.fieldoffset)) do
-                          inc(i);
+                               (tfieldvarsym(equivst.symlist[i]).fieldoffset>fieldvs.fieldoffset)) do
+                          begin
+                            if is_normal_fieldvarsym(tsym(equivst.symlist[i])) then
+                              tempsymlist.Add(equivst.symlist[i]);
+                            inc(i);
+                          end;
                         continue;
                       end;
                   end;
               end;
+            if not assigned(variantstarts) and
+               (fieldvs.fieldoffset<prevfieldoffset) then
+              sorttempsymlist:=true;
+            prevfieldoffset:=fieldvs.fieldoffset;
             inc(i);
           end;
+        if sorttempsymlist then
+          tempsymlist.Sort(@field_offset_compare);
       end;
 
 
-    procedure tllvmshadowsymtable.buildtable(variantstarts: tfplist);
+    procedure tllvmshadowsymtable.buildtable(tempsymlist, variantstarts: tfplist);
       var
         lastvaroffsetprocessed: aint;
-        i, equivcount, varcount: longint;
+        i, symcount, varcount: longint;
+        fieldvs: tfieldvarsym;
       begin
         { if it's an object/class, the first entry is the parent (if there is one) }
         if (equivst.symtabletype=objectsymtable) and
            assigned(tobjectdef(equivst.defowner).childof) then
           appenddefoffset(tobjectdef(equivst.defowner).childof,0,is_class_or_interface_or_dispinterface(tobjectdef(equivst.defowner).childof));
-        equivcount:=equivst.symlist.count;
+        symcount:=tempsymlist.count;
         varcount:=0;
         i:=0;
         lastvaroffsetprocessed:=-1;
-        while (i<equivcount) do
+        while (i<symcount) do
           begin
-            if not is_normal_fieldvarsym(tsym(equivst.symlist[i])) then
-              begin
-                inc(i);
-                continue;
-              end;
+            fieldvs:=tfieldvarsym(tempsymlist[i]);
             { start of a new variant? }
-            if (vo_is_first_field in tfieldvarsym(equivst.symlist[i]).varoptions) then
+            if (vo_is_first_field in fieldvs.varoptions) then
               begin
                 { if we want to process the same variant offset twice, it means that we  }
                 { got to the end and are trying to process the next variant part -> stop }
-                if (tfieldvarsym(equivst.symlist[i]).fieldoffset<=lastvaroffsetprocessed) then
+                if (fieldvs.fieldoffset<=lastvaroffsetprocessed) then
                   break;
 
                 if (varcount>=variantstarts.count) then
                   internalerror(2008051005);
                 { new variant part -> use the one with the biggest alignment }
-                i:=equivst.symlist.indexof(tobject(variantstarts[varcount]));
-                lastvaroffsetprocessed:=tfieldvarsym(equivst.symlist[i]).fieldoffset;
+                i:=tempsymlist.indexof(tobject(variantstarts[varcount]));
+                lastvaroffsetprocessed:=fieldvs.fieldoffset;
                 inc(varcount);
                 if (i<0) then
                   internalerror(2008051004);
               end;
-            appenddefoffset(tfieldvarsym(equivst.symlist[i]).vardef,tfieldvarsym(equivst.symlist[i]).fieldoffset,false);
+            appenddefoffset(fieldvs.vardef,fieldvs.fieldoffset,false);
             inc(i);
           end;
         addalignmentpadding(equivst.datasize);
       end;
 
 
-    procedure tllvmshadowsymtable.buildmapping(variantstarts: tfplist);
+    procedure tllvmshadowsymtable.buildmapping(tempsymlist, variantstarts: tfplist);
       var
+        fieldvs: tfieldvarsym;
         i, varcount: longint;
         shadowindex: longint;
-        equivcount : longint;
+        symcount : longint;
       begin
         varcount:=0;
         shadowindex:=0;
-        equivcount:=equivst.symlist.count;
+        symcount:=tempsymlist.count;
         i:=0;
-        while (i < equivcount) do
+        while (i<symcount) do
           begin
-            if not is_normal_fieldvarsym(tsym(equivst.symlist[i])) then
-              begin
-                inc(i);
-                continue;
-              end;
+            fieldvs:=tfieldvarsym(tempsymlist[i]);
             { start of a new variant? }
-            if (vo_is_first_field in tfieldvarsym(equivst.symlist[i]).varoptions) then
+            if (vo_is_first_field in fieldvs.varoptions) then
               begin
                 { back up to a less deeply nested variant level? }
-                while (tfieldvarsym(equivst.symlist[i]).fieldoffset<tfieldvarsym(variantstarts[varcount]).fieldoffset) do
+                while fieldvs.fieldoffset<tfieldvarsym(variantstarts[varcount]).fieldoffset do
                   dec(varcount);
                 { it's possible that some variants are more deeply nested than the
                   one we recorded in the shadowsymtable (since we recorded the one
                   with the biggest alignment, not necessarily the biggest one in size
                 }
-                if (tfieldvarsym(equivst.symlist[i]).fieldoffset>tfieldvarsym(variantstarts[varcount]).fieldoffset) then
+                if fieldvs.fieldoffset>tfieldvarsym(variantstarts[varcount]).fieldoffset then
                   varcount:=variantstarts.count-1
-                else if (tfieldvarsym(equivst.symlist[i]).fieldoffset<>tfieldvarsym(variantstarts[varcount]).fieldoffset) then
+                else if fieldvs.fieldoffset<>tfieldvarsym(variantstarts[varcount]).fieldoffset then
                   internalerror(2008051006);
                 { reset the shadowindex to the start of this variant. }
                 { in case the llvmfieldnr is not (yet) set for this   }
@@ -2300,15 +2330,15 @@ implementation
               end;
 
             { find the last shadowfield whose offset <= the current field's offset }
-            while (tllvmshadowsymtableentry(symdeflist[shadowindex]).fieldoffset<tfieldvarsym(equivst.symlist[i]).fieldoffset) and
+            while (tllvmshadowsymtableentry(symdeflist[shadowindex]).fieldoffset<fieldvs.fieldoffset) and
                   (shadowindex<symdeflist.count-1) and
-                  (tllvmshadowsymtableentry(symdeflist[shadowindex+1]).fieldoffset<=tfieldvarsym(equivst.symlist[i]).fieldoffset) do
+                  (tllvmshadowsymtableentry(symdeflist[shadowindex+1]).fieldoffset<=fieldvs.fieldoffset) do
               inc(shadowindex);
             { set the field number and potential offset from that field (in case }
             { of overlapping variants)                                           }
-            tfieldvarsym(equivst.symlist[i]).llvmfieldnr:=shadowindex;
-            tfieldvarsym(equivst.symlist[i]).offsetfromllvmfield:=
-              tfieldvarsym(equivst.symlist[i]).fieldoffset-tllvmshadowsymtableentry(symdeflist[shadowindex]).fieldoffset;
+            fieldvs.llvmfieldnr:=shadowindex;
+            fieldvs.offsetfromllvmfield:=
+              fieldvs.fieldoffset-tllvmshadowsymtableentry(symdeflist[shadowindex]).fieldoffset;
             inc(i);
           end;
       end;
@@ -2316,23 +2346,22 @@ implementation
 
     procedure tllvmshadowsymtable.generate;
       var
-        variantstarts: tfplist;
+        variantstarts, tempsymlist: tfplist;
       begin
-        variantstarts:=tfplist.create;
-
         { first go through the entire record and }
         { store the fieldvarsyms of the variants }
         { with the highest alignment             }
-        findvariantstarts(variantstarts);
+        preprocess(tempsymlist, variantstarts);
 
         { now go through the regular fields and the selected variants, }
-        { and add them to the  llvm shadow record symtable             }
-        buildtable(variantstarts);
+        { and add them to the llvm shadow record symtable             }
+        buildtable(tempsymlist, variantstarts);
 
         { finally map all original fields to the llvm definition }
-        buildmapping(variantstarts);
+        buildmapping(tempsymlist, variantstarts);
 
         variantstarts.free;
+        tempsymlist.free;
       end;
 
 {$endif llvm}

compiler/x86/aoptx86.pas

@@ -146,12 +146,14 @@ unit aoptx86;
         function OptPass2Jcc(var p : tai) : boolean;
         function OptPass2Lea(var p: tai): Boolean;
         function OptPass2SUB(var p: tai): Boolean;
+        function OptPass2ADD(var p : tai): Boolean;
 
         function PostPeepholeOptMov(var p : tai) : Boolean;
 {$ifdef x86_64} { These post-peephole optimisations only affect 64-bit registers. [Kit] }
         function PostPeepholeOptMovzx(var p : tai) : Boolean;
         function PostPeepholeOptXor(var p : tai) : Boolean;
 {$endif}
+        function PostPeepholeOptAnd(var p : tai) : boolean;
         function PostPeepholeOptMOVSX(var p : tai) : boolean;
         function PostPeepholeOptCmp(var p : tai) : Boolean;
         function PostPeepholeOptTestOr(var p : tai) : Boolean;
@@ -3000,6 +3002,23 @@ unit aoptx86;
                       check opsize to avoid overflow when left shifting the 1 }
                     if (taicpu(p).oper[0]^.typ=top_const) and (topsize2memsize[taicpu(hp2).opsize]<=63) then
                       taicpu(p).oper[0]^.val:=taicpu(p).oper[0]^.val and ((qword(1) shl topsize2memsize[taicpu(hp2).opsize])-1);
+
+{$ifdef x86_64}
+                    { Be careful of, for example:
+                        movl %reg1,%reg2
+                        addl %reg3,%reg2
+                        movq %reg2,%reg4
+
+                      This will cause problems if the upper 32-bits of %reg3 or %reg4 are non-zero
+                    }
+                    if (taicpu(hp1).opsize = S_L) and (taicpu(hp2).opsize = S_Q) then
+                      begin
+                        taicpu(hp2).changeopsize(S_L);
+                        setsubreg(taicpu(hp2).oper[0]^.reg, R_SUBD);
+                        setsubreg(taicpu(hp2).oper[1]^.reg, R_SUBD);
+                      end;
+{$endif x86_64}
+
                     taicpu(hp1).changeopsize(taicpu(hp2).opsize);
                     taicpu(p).changeopsize(taicpu(hp2).opsize);
                     if taicpu(p).oper[0]^.typ=top_reg then
@@ -5706,6 +5725,55 @@ unit aoptx86;
             Result := True;
             Exit;
           end
+        else if reg_and_hp1_is_instr and
+          (taicpu(p).oper[0]^.typ = top_reg) and
+          (
+            ((taicpu(hp1).opcode = A_SHR) and (taicpu(p).opcode = A_MOVZX)) or
+            ((taicpu(hp1).opcode = A_SAR) and (taicpu(p).opcode <> A_MOVZX))
+          ) and
+          (taicpu(hp1).oper[0]^.typ = top_const) and
+          SuperRegistersEqual(taicpu(p).oper[0]^.reg, taicpu(p).oper[1]^.reg) and
+          MatchOperand(taicpu(hp1).oper[1]^, taicpu(p).oper[1]^.reg) and
+          { Minimum shift value allowed is the bit size of the smallest register - 1 }
+          (taicpu(hp1).oper[0]^.val <
+            { Multiply by 8 because tcgsize2size returns bytes, not bits }
+            8 * (
+              tcgsize2size[reg_cgsize(taicpu(p).oper[0]^.reg)]
+            )
+          ) then
+          begin
+            { For:
+                movsx   %reg1,%reg1     movzx   %reg1,%reg1   (same register, just different sizes)
+                sar     ##,   %reg1     shr     ##,   %reg1
+
+              Move the shift to before the movx instruction if the shift value
+              is not too large.
+            }
+            asml.Remove(hp1);
+            asml.InsertBefore(hp1, p);
+
+            taicpu(hp1).oper[1]^.reg := taicpu(p).oper[0]^.reg;
+
+            case taicpu(p).opsize of
+              s_BW, S_BL{$ifdef x86_64}, S_BQ{$endif}:
+                taicpu(hp1).opsize := S_B;
+              S_WL{$ifdef x86_64}, S_WQ{$endif}:
+                taicpu(hp1).opsize := S_W;
+              {$ifdef x86_64}
+              S_LQ:
+                taicpu(hp1).opsize := S_L;
+              {$endif}
+              else
+                InternalError(2020112401);
+            end;
+
+            if (taicpu(hp1).opcode = A_SHR) then
+              DebugMsg(SPeepholeOptimization + 'MovzShr2ShrMovz', hp1)
+            else
+              DebugMsg(SPeepholeOptimization + 'MovsSar2SarMovs', hp1);
+
+            Result := True;
+          end
         else if taicpu(p).opcode=A_MOVZX then
           begin
             { removes superfluous And's after movzx's }
@@ -5952,132 +6020,181 @@ unit aoptx86;
 
     function TX86AsmOptimizer.OptPass1AND(var p : tai) : boolean;
       var
-        hp1 : tai;
+        hp1, hp2 : tai;
         MaskLength : Cardinal;
+        MaskedBits : TCgInt;
       begin
         Result:=false;
 
-        if GetNextInstruction(p, hp1) then
+        { There are no optimisations for reference targets }
+        if (taicpu(p).oper[1]^.typ <> top_reg) then
+          Exit;
+
+        while GetNextInstruction(p, hp1) and
+          (hp1.typ = ait_instruction) do
           begin
-            if MatchOpType(taicpu(p),top_const,top_reg) and
-              MatchInstruction(hp1,A_AND,[]) and
-              MatchOpType(taicpu(hp1),top_const,top_reg) and
-              (getsupreg(taicpu(p).oper[1]^.reg) = getsupreg(taicpu(hp1).oper[1]^.reg)) and
-              { the second register must contain the first one, so compare their subreg types }
-              (getsubreg(taicpu(p).oper[1]^.reg)<=getsubreg(taicpu(hp1).oper[1]^.reg)) and
-              (abs(taicpu(p).oper[0]^.val and taicpu(hp1).oper[0]^.val)<$80000000) then
-              { change
-                  and const1, reg
-                  and const2, reg
-                to
-                  and (const1 and const2), reg
-              }
+            if (taicpu(p).oper[0]^.typ = top_const) then
               begin
-                taicpu(hp1).loadConst(0, taicpu(p).oper[0]^.val and taicpu(hp1).oper[0]^.val);
-                DebugMsg(SPeepholeOptimization + 'AndAnd2And done',hp1);
-                RemoveCurrentP(p, hp1);
-                Result:=true;
-                exit;
-              end
-            else if MatchOpType(taicpu(p),top_const,top_reg) and
-              MatchInstruction(hp1,A_MOVZX,[]) and
-              MatchOpType(taicpu(hp1),top_reg,top_reg) and
-              SuperRegistersEqual(taicpu(p).oper[1]^.reg,taicpu(hp1).oper[1]^.reg) and
-              (getsupreg(taicpu(hp1).oper[0]^.reg)=getsupreg(taicpu(hp1).oper[1]^.reg)) and
-               (((taicpu(p).opsize=S_W) and
-                 (taicpu(hp1).opsize=S_BW)) or
-                ((taicpu(p).opsize=S_L) and
-                 (taicpu(hp1).opsize in [S_WL,S_BL{$ifdef x86_64},S_BQ,S_WQ{$endif x86_64}]))
+                if (taicpu(hp1).opcode = A_AND) and
+                  MatchOpType(taicpu(hp1),top_const,top_reg) and
+                  (getsupreg(taicpu(p).oper[1]^.reg) = getsupreg(taicpu(hp1).oper[1]^.reg)) and
+                  { the second register must contain the first one, so compare their subreg types }
+                  (getsubreg(taicpu(p).oper[1]^.reg)<=getsubreg(taicpu(hp1).oper[1]^.reg)) and
+                  (abs(taicpu(p).oper[0]^.val and taicpu(hp1).oper[0]^.val)<$80000000) then
+                  { change
+                      and const1, reg
+                      and const2, reg
+                    to
+                      and (const1 and const2), reg
+                  }
+                  begin
+                    taicpu(hp1).loadConst(0, taicpu(p).oper[0]^.val and taicpu(hp1).oper[0]^.val);
+                    DebugMsg(SPeepholeOptimization + 'AndAnd2And done',hp1);
+                    RemoveCurrentP(p, hp1);
+                    Result:=true;
+                    exit;
+                  end
+                else if (taicpu(hp1).opcode = A_MOVZX) and
+                  MatchOpType(taicpu(hp1),top_reg,top_reg) and
+                  SuperRegistersEqual(taicpu(p).oper[1]^.reg,taicpu(hp1).oper[1]^.reg) and
+                  (getsupreg(taicpu(hp1).oper[0]^.reg)=getsupreg(taicpu(hp1).oper[1]^.reg)) and
+                   (((taicpu(p).opsize=S_W) and
+                     (taicpu(hp1).opsize=S_BW)) or
+                    ((taicpu(p).opsize=S_L) and
+                     (taicpu(hp1).opsize in [S_WL,S_BL{$ifdef x86_64},S_BQ,S_WQ{$endif x86_64}]))
 {$ifdef x86_64}
-                  or
-                 ((taicpu(p).opsize=S_Q) and
-                  (taicpu(hp1).opsize in [S_BQ,S_WQ,S_BL,S_WL]))
+                      or
+                     ((taicpu(p).opsize=S_Q) and
+                      (taicpu(hp1).opsize in [S_BQ,S_WQ,S_BL,S_WL]))
 {$endif x86_64}
-                ) then
-                  begin
-                    if (((taicpu(hp1).opsize) in [S_BW,S_BL{$ifdef x86_64},S_BQ{$endif x86_64}]) and
-                        ((taicpu(p).oper[0]^.val and $ff)=taicpu(p).oper[0]^.val)
-                         ) or
-                       (((taicpu(hp1).opsize) in [S_WL{$ifdef x86_64},S_WQ{$endif x86_64}]) and
-                        ((taicpu(p).oper[0]^.val and $ffff)=taicpu(p).oper[0]^.val))
-                    then
+                    ) then
                       begin
-                        { Unlike MOVSX, MOVZX doesn't actually have a version that zero-extends a
-                          32-bit register to a 64-bit register, or even a version called MOVZXD, so
-                          code that tests for the presence of AND 0xffffffff followed by MOVZX is
-                          wasted, and is indictive of a compiler bug if it were triggered. [Kit]
+                        if (((taicpu(hp1).opsize) in [S_BW,S_BL{$ifdef x86_64},S_BQ{$endif x86_64}]) and
+                            ((taicpu(p).oper[0]^.val and $ff)=taicpu(p).oper[0]^.val)
+                             ) or
+                           (((taicpu(hp1).opsize) in [S_WL{$ifdef x86_64},S_WQ{$endif x86_64}]) and
+                            ((taicpu(p).oper[0]^.val and $ffff)=taicpu(p).oper[0]^.val))
+                        then
+                          begin
+                            { Unlike MOVSX, MOVZX doesn't actually have a version that zero-extends a
+                              32-bit register to a 64-bit register, or even a version called MOVZXD, so
+                              code that tests for the presence of AND 0xffffffff followed by MOVZX is
+                              wasted, and is indictive of a compiler bug if it were triggered. [Kit]
 
-                          NOTE: To zero-extend from 32 bits to 64 bits, simply use the standard MOV.
-                        }
-                        DebugMsg(SPeepholeOptimization + 'AndMovzToAnd done',p);
+                              NOTE: To zero-extend from 32 bits to 64 bits, simply use the standard MOV.
+                            }
+                            DebugMsg(SPeepholeOptimization + 'AndMovzToAnd done',p);
 
-                        RemoveInstruction(hp1);
-                        Exit;
-                      end;
-                  end
-            else if MatchOpType(taicpu(p),top_const,top_reg) and
-              MatchInstruction(hp1,A_SHL,[]) and
-              MatchOpType(taicpu(hp1),top_const,top_reg) and
-              (getsupreg(taicpu(p).oper[1]^.reg)=getsupreg(taicpu(hp1).oper[1]^.reg)) then
-              begin
+                            RemoveInstruction(hp1);
+
+                            { See if there are other optimisations possible }
+                            Continue;
+                          end;
+                      end
+                else if (taicpu(hp1).opcode = A_SHL) and
+                  MatchOpType(taicpu(hp1),top_const,top_reg) and
+                  (getsupreg(taicpu(p).oper[1]^.reg)=getsupreg(taicpu(hp1).oper[1]^.reg)) then
+                  begin
 {$ifopt R+}
 {$define RANGE_WAS_ON}
 {$R-}
 {$endif}
-                { get length of potential and mask }
-                MaskLength:=SizeOf(taicpu(p).oper[0]^.val)*8-BsrQWord(taicpu(p).oper[0]^.val)-1;
+                    { get length of potential and mask }
+                    MaskLength:=SizeOf(taicpu(p).oper[0]^.val)*8-BsrQWord(taicpu(p).oper[0]^.val)-1;
 
-                { really a mask? }
+                    { really a mask? }
 {$ifdef RANGE_WAS_ON}
 {$R+}
 {$endif}
-                if (((QWord(1) shl MaskLength)-1)=taicpu(p).oper[0]^.val) and
-                  { unmasked part shifted out? }
-                  ((MaskLength+taicpu(hp1).oper[0]^.val)>=topsize2memsize[taicpu(hp1).opsize]) then
+                    if (((QWord(1) shl MaskLength)-1)=taicpu(p).oper[0]^.val) and
+                      { unmasked part shifted out? }
+                      ((MaskLength+taicpu(hp1).oper[0]^.val)>=topsize2memsize[taicpu(hp1).opsize]) then
+                      begin
+                        DebugMsg(SPeepholeOptimization + 'AndShlToShl done',p);
+                        RemoveCurrentP(p, hp1);
+                        Result:=true;
+                        exit;
+                      end;
+                  end
+                else if (taicpu(hp1).opcode = A_SHR) and
+                  MatchOpType(taicpu(hp1),top_const,top_reg) and
+                  (taicpu(p).oper[1]^.reg = taicpu(hp1).oper[1]^.reg) and
+                  (taicpu(hp1).oper[0]^.val <= 63) then
                   begin
-                    DebugMsg(SPeepholeOptimization + 'AndShlToShl done',p);
-                    RemoveCurrentP(p, hp1);
-                    Result:=true;
-                    exit;
-                  end;
-              end
-            else if MatchOpType(taicpu(p),top_const,top_reg) and
-              MatchInstruction(hp1,A_MOVSX{$ifdef x86_64},A_MOVSXD{$endif x86_64},[]) and
-              (taicpu(hp1).oper[0]^.typ = top_reg) and
-              MatchOperand(taicpu(p).oper[1]^,taicpu(hp1).oper[1]^) and
-              (getsupreg(taicpu(hp1).oper[0]^.reg)=getsupreg(taicpu(hp1).oper[1]^.reg)) and
-               (((taicpu(p).opsize=S_W) and
-                 (taicpu(hp1).opsize=S_BW)) or
-                ((taicpu(p).opsize=S_L) and
-                 (taicpu(hp1).opsize in [S_WL,S_BL]))
+                    { Does SHR combined with the AND cover all the bits?
+
+                      e.g. for "andb $252,%reg; shrb $2,%reg" - the "and" can be removed }
+
+                    MaskedBits := taicpu(p).oper[0]^.val or ((TCgInt(1) shl taicpu(hp1).oper[0]^.val) - 1);
+
+                    if ((taicpu(p).opsize = S_B) and ((MaskedBits and $FF) = $FF)) or
+                      ((taicpu(p).opsize = S_W) and ((MaskedBits and $FFFF) = $FFFF)) or
+                      ((taicpu(p).opsize = S_L) and ((MaskedBits and $FFFFFFFF) = $FFFFFFFF)) then
+                      begin
+                        DebugMsg(SPeepholeOptimization + 'AndShrToShr done', p);
+                        RemoveCurrentP(p, hp1);
+                        Result := True;
+                        Exit;
+                      end;
+                  end
+                else if ((taicpu(hp1).opcode = A_MOVSX){$ifdef x86_64} or (taicpu(hp1).opcode = A_MOVSXD){$endif x86_64}) and
+                  (taicpu(hp1).oper[0]^.typ = top_reg) and
+                  SuperRegistersEqual(taicpu(hp1).oper[0]^.reg, taicpu(hp1).oper[1]^.reg) then
+                    begin
+                      if SuperRegistersEqual(taicpu(p).oper[1]^.reg, taicpu(hp1).oper[1]^.reg) and
+                        (
+                          (
+                            (taicpu(hp1).opsize in [S_BW,S_BL{$ifdef x86_64},S_BQ{$endif x86_64}]) and
+                            ((taicpu(p).oper[0]^.val and $7F) = taicpu(p).oper[0]^.val)
+                          ) or (
+                            (taicpu(hp1).opsize in [S_WL{$ifdef x86_64},S_WQ{$endif x86_64}]) and
+                            ((taicpu(p).oper[0]^.val and $7FFF) = taicpu(p).oper[0]^.val)
 {$ifdef x86_64}
-                 or
-                 ((taicpu(p).opsize=S_Q) and
-                 (taicpu(hp1).opsize in [S_BQ,S_WQ,S_LQ]))
+                          ) or (
+                            (taicpu(hp1).opsize = S_LQ) and
+                            ((taicpu(p).oper[0]^.val and $7fffffff) = taicpu(p).oper[0]^.val)
 {$endif x86_64}
-                ) then
-                  begin
-                    if (((taicpu(hp1).opsize) in [S_BW,S_BL{$ifdef x86_64},S_BQ{$endif x86_64}]) and
-                        ((taicpu(p).oper[0]^.val and $7f)=taicpu(p).oper[0]^.val)
-                         ) or
-                       (((taicpu(hp1).opsize) in [S_WL{$ifdef x86_64},S_WQ{$endif x86_64}]) and
-                        ((taicpu(p).oper[0]^.val and $7fff)=taicpu(p).oper[0]^.val))
+                          )
+                        ) then
+                        begin
+                          if (taicpu(p).oper[1]^.reg = taicpu(hp1).oper[1]^.reg){$ifdef x86_64} or (taicpu(hp1).opsize = S_LQ){$endif x86_64} then
+                            begin
+                              DebugMsg(SPeepholeOptimization + 'AndMovsxToAnd',p);
+                              RemoveInstruction(hp1);
+                              { See if there are other optimisations possible }
+                              Continue;
+                            end;
+
+                          { The super-registers are the same though.
+
+                            Note that this change by itself doesn't improve
+                            code speed, but it opens up other optimisations. }
 {$ifdef x86_64}
-                       or
-                       (((taicpu(hp1).opsize)=S_LQ) and
-                        ((taicpu(p).oper[0]^.val and $7fffffff)=taicpu(p).oper[0]^.val)
-                       )
+                          { Convert 64-bit register to 32-bit }
+                          case taicpu(hp1).opsize of
+                            S_BQ:
+                              begin
+                                taicpu(hp1).opsize := S_BL;
+                                taicpu(hp1).oper[1]^.reg := newreg(R_INTREGISTER, getsupreg(taicpu(hp1).oper[1]^.reg), R_SUBD);
+                              end;
+                            S_WQ:
+                              begin
+                                taicpu(hp1).opsize := S_WL;
+                                taicpu(hp1).oper[1]^.reg := newreg(R_INTREGISTER, getsupreg(taicpu(hp1).oper[1]^.reg), R_SUBD);
+                              end
+                            else
+                              ;
+                          end;
 {$endif x86_64}
-                       then
-                       begin
-                         DebugMsg(SPeepholeOptimization + 'AndMovsxToAnd',p);
-                         RemoveInstruction(hp1);
-                         Exit;
-                       end;
-                  end
-            else if (taicpu(p).oper[1]^.typ = top_reg) and
-              (hp1.typ = ait_instruction) and
-              (taicpu(hp1).is_jmp) and
+                          DebugMsg(SPeepholeOptimization + 'AndMovsxToAndMovzx', hp1);
+                          taicpu(hp1).opcode := A_MOVZX;
+                          { See if there are other optimisations possible }
+                          Continue;
+                        end;
+                    end;
+              end;
+
+            if (taicpu(hp1).is_jmp) and
               (taicpu(hp1).opcode<>A_JMP) and
               not(RegInUsedRegs(taicpu(p).oper[1]^.reg,UsedRegs)) then
               begin
@@ -6093,10 +6210,12 @@ unit aoptx86;
                 taicpu(p).opcode := A_TEST;
                 Exit;
               end;
+
+            Break;
           end;
 
         { Lone AND tests }
-        if MatchOpType(taicpu(p),top_const,top_reg) then
+        if (taicpu(p).oper[0]^.typ = top_const) then
           begin
             {
               - Convert and $0xFF,reg to and reg,reg if reg is 8-bit
@@ -6116,6 +6235,94 @@ unit aoptx86;
               end;
           end;
 
+        { Backward check to determine necessity of and %reg,%reg }
+        if (taicpu(p).oper[0]^.typ = top_reg) and
+          (taicpu(p).oper[0]^.reg = taicpu(p).oper[1]^.reg) and
+          not RegInUsedRegs(NR_DEFAULTFLAGS, UsedRegs) and
+          GetLastInstruction(p, hp2) and
+          RegModifiedByInstruction(taicpu(p).oper[1]^.reg, hp2) and
+          { Check size of adjacent instruction to determine if the AND is
+            effectively a null operation }
+          (
+            (taicpu(p).opsize = taicpu(hp2).opsize) or
+            { Note: Don't include S_Q }
+            ((taicpu(p).opsize = S_L) and (taicpu(hp2).opsize in [S_BL, S_WL])) or
+            ((taicpu(p).opsize = S_W) and (taicpu(hp2).opsize in [S_BW, S_BL, S_WL, S_L])) or
+            ((taicpu(p).opsize = S_B) and (taicpu(hp2).opsize in [S_BW, S_BL, S_WL, S_W, S_L]))
+          ) then
+          begin
+            DebugMsg(SPeepholeOptimization + 'And2Nop', p);
+            { If GetNextInstruction returned False, hp1 will be nil }
+            RemoveCurrentP(p, hp1);
+            Result := True;
+            Exit;
+          end;
+
+      end;
+
+
+    function TX86AsmOptimizer.OptPass2ADD(var p : tai) : boolean;
+      var
+        hp1: tai;
+
+        { This entire nested function is used in an if-statement below, but we
+          want to avoid all the used reg transfers and GetNextInstruction calls
+          until we really have to check }
+        function MemRegisterNotUsedLater: Boolean; inline;
+          var
+            hp2: tai;
+          begin
+            TransferUsedRegs(TmpUsedRegs);
+            hp2 := p;
+            repeat
+              UpdateUsedRegs(TmpUsedRegs, tai(hp2.Next));
+            until not GetNextInstruction(hp2, hp2) or (hp2 = hp1);
+
+            Result := not RegUsedAfterInstruction(taicpu(p).oper[1]^.reg, hp1, TmpUsedRegs);
+          end;
+
+      begin
+        Result := False;
+
+        { Change:
+            add     %reg2,%reg1
+            mov/s/z #(%reg1),%reg1  (%reg1 superregisters must be the same)
+
+          To:
+            mov/s/z #(%reg1,%reg2),%reg1
+        }
+
+        if (taicpu(p).opsize in [S_L{$ifdef x86_64}, S_Q{$endif}]) and
+          MatchOpType(taicpu(p), top_reg, top_reg) and
+          GetNextInstruction(p, hp1) and
+          MatchInstruction(hp1, [A_MOV, A_MOVZX, A_MOVSX{$ifdef x86_64}, A_MOVSXD{$endif}], []) and
+          MatchOpType(taicpu(hp1), top_ref, top_reg) and
+          (taicpu(hp1).oper[0]^.ref^.scalefactor <= 1) and
+          (
+            (
+              (taicpu(hp1).oper[0]^.ref^.base = taicpu(p).oper[1]^.reg) and
+              (taicpu(hp1).oper[0]^.ref^.index = NR_NO)
+            ) or (
+              (taicpu(hp1).oper[0]^.ref^.index = taicpu(p).oper[1]^.reg) and
+              (taicpu(hp1).oper[0]^.ref^.base = NR_NO)
+            )
+          ) and (
+            Reg1WriteOverwritesReg2Entirely(taicpu(p).oper[1]^.reg, taicpu(hp1).oper[1]^.reg) or
+            (
+              { If the super registers ARE equal, then this MOV/S/Z does a partial write }
+              not SuperRegistersEqual(taicpu(p).oper[1]^.reg, taicpu(hp1).oper[1]^.reg) and
+              MemRegisterNotUsedLater
+            )
+          ) then
+          begin
+            taicpu(hp1).oper[0]^.ref^.base := taicpu(p).oper[1]^.reg;
+            taicpu(hp1).oper[0]^.ref^.index := taicpu(p).oper[0]^.reg;
+
+            DebugMsg(SPeepholeOptimization + 'AddMov2Mov done', p);
+            RemoveCurrentp(p, hp1);
+            Result := True;
+            Exit;
+          end;
       end;
 
 
@@ -6405,6 +6612,41 @@ unit aoptx86;
       end;
 
 
+    function TX86AsmOptimizer.PostPeepholeOptAnd(var p : tai) : boolean;
+      var
+        hp1: tai;
+      begin
+        { Detect:
+            andw   x,  %ax (0 <= x < $8000)
+            ...
+            movzwl %ax,%eax
+
+          Change movzwl %ax,%eax to cwtl (shorter encoding for movswl %ax,%eax)
+        }
+
+        Result := False;
+        if MatchOpType(taicpu(p), top_const, top_reg) and
+          (taicpu(p).oper[1]^.reg = NR_AX) and { This is also enough to determine that opsize = S_W }
+          ((taicpu(p).oper[0]^.val and $7FFF) = taicpu(p).oper[0]^.val) and
+          GetNextInstructionUsingReg(p, hp1, NR_EAX) and
+          MatchInstruction(hp1, A_MOVZX, [S_WL]) and
+          MatchOperand(taicpu(hp1).oper[0]^, NR_AX) and
+          MatchOperand(taicpu(hp1).oper[1]^, NR_EAX) then
+          begin
+            DebugMsg(SPeepholeOptimization + 'Converted movzwl %ax,%eax to cwtl (via AndMovz2AndCwtl)', hp1);
+            taicpu(hp1).opcode := A_CWDE;
+            taicpu(hp1).clearop(0);
+            taicpu(hp1).clearop(1);
+            taicpu(hp1).ops := 0;
+
+            { A change was made, but not with p, so move forward 1 }
+            p := tai(p.Next);
+            Result := True;
+          end;
+
+      end;
+
+
     function TX86AsmOptimizer.PostPeepholeOptMOVSX(var p : tai) : boolean;
       begin
         Result := False;

compiler/x86/cpubase.pas

@@ -960,8 +960,7 @@ implementation
 
   function UseAVX512: boolean;
     begin
-      // Result:=(current_settings.fputype in fpu_avx_instructionsets) {$ifndef i8086}or (CPUX86_HAS_AVXUNIT in cpu_capabilities[current_settings.cputype]){$endif i8086};
-      Result:=false;
+      Result:={$ifdef i8086}false{$else i8086}UseAVX and (FPUX86_HAS_AVX512F in fpu_capabilities[current_settings.fputype]){$endif i8086};
     end;
 
 

compiler/x86/nx86inl.pas

@@ -1309,21 +1309,35 @@ implementation
           begin
             secondpass(left);
             hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,left.resultdef,true);
-            location_reset(location,LOC_MMREGISTER,left.location.size);
+            location_reset(location,LOC_MMREGISTER,def_cgsize(resultdef));
             location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size);
             if UseAVX then
-              case tfloatdef(resultdef).floattype of
+              case tfloatdef(left.resultdef).floattype of
                 s32real:
                   begin
-                    { using left.location.register here as 3rd parameter is crucial to break dependency chains }
-                    current_asmdata.CurrAsmList.concat(taicpu.op_const_reg_reg_reg(A_VROUNDSS,S_NO,3,left.location.register,left.location.register,location.register));
-                    current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_VSUBSS,S_NO,location.register,left.location.register,location.register));
+{$ifndef i8086}
+                    if UseAVX512 and (FPUX86_HAS_AVX512DQ in fpu_capabilities[current_settings.fputype]) then
+                      current_asmdata.CurrAsmList.concat(taicpu.op_const_reg_reg_reg(A_VREDUCESS,S_NO,3,left.location.register,left.location.register,location.register))
+                    else
+{$endif not i8086}
+                      begin
+                        { using left.location.register here as 3rd parameter is crucial to break dependency chains }
+                        current_asmdata.CurrAsmList.concat(taicpu.op_const_reg_reg_reg(A_VROUNDSS,S_NO,3,left.location.register,left.location.register,location.register));
+                        current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_VSUBSS,S_NO,location.register,left.location.register,location.register));
+                      end;
                   end;
                 s64real:
                   begin
-                    { using left.location.register here as 3rd parameter is crucial to break dependency chains }
-                    current_asmdata.CurrAsmList.concat(taicpu.op_const_reg_reg_reg(A_VROUNDSD,S_NO,3,left.location.register,left.location.register,location.register));
-                    current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_VSUBSD,S_NO,location.register,left.location.register,location.register));
+{$ifndef i8086}
+                    if UseAVX512 and (FPUX86_HAS_AVX512DQ in fpu_capabilities[current_settings.fputype]) then
+                      current_asmdata.CurrAsmList.concat(taicpu.op_const_reg_reg_reg(A_VREDUCESD,S_NO,3,left.location.register,left.location.register,location.register))
+                    else
+{$endif not i8086}
+                      begin
+                        { using left.location.register here as 3rd parameter is crucial to break dependency chains }
+                        current_asmdata.CurrAsmList.concat(taicpu.op_const_reg_reg_reg(A_VROUNDSD,S_NO,3,left.location.register,left.location.register,location.register));
+                        current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_VSUBSD,S_NO,location.register,left.location.register,location.register));
+                      end;
                   end;
                 else
                   internalerror(2017052102);
@@ -1332,7 +1346,7 @@ implementation
               begin
                 extrareg:=cg.getmmregister(current_asmdata.CurrAsmList,location.size);
                 cg.a_loadmm_loc_reg(current_asmdata.CurrAsmList,location.size,left.location,location.register,mms_movescalar);
-                case tfloatdef(resultdef).floattype of
+                case tfloatdef(left.resultdef).floattype of
                   s32real:
                     begin
                       current_asmdata.CurrAsmList.concat(taicpu.op_const_reg_reg(A_ROUNDSS,S_NO,3,left.location.register,extrareg));
@@ -1347,6 +1361,8 @@ implementation
                     internalerror(2017052103);
                 end;
               end;
+            if tfloatdef(left.resultdef).floattype<>tfloatdef(resultdef).floattype then
+              hlcg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,location.register,location.register,mms_movescalar);
           end
         else
           internalerror(2017052101);

compiler/x86/nx86mat.pas

@@ -386,8 +386,6 @@ interface
         { put numerator in register }
         cgsize:=def_cgsize(resultdef);
         opsize:=TCGSize2OpSize[cgsize];
-        if not (cgsize in [OS_32,OS_S32,OS_64,OS_S64]) then
-          InternalError(2013102702);
         rega:=newreg(R_INTREGISTER,RS_EAX,cgsize2subreg(R_INTREGISTER,cgsize));
         regd:=newreg(R_INTREGISTER,RS_EDX,cgsize2subreg(R_INTREGISTER,cgsize));
 
@@ -626,7 +624,7 @@ interface
                 cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHR,cgsize,resultdef.size*8-power,hreg2,hreg2);
               end;
             emit_reg_reg(A_ADD,opsize,hreg1,hreg2);
-            emit_const_reg(A_AND,opsize,not((aint(1) shl power)-1),hreg2);
+            cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_AND,cgsize,not((aint(1) shl power)-1),hreg2);
             emit_reg_reg(A_SUB,opsize,hreg2,hreg1);
             location.register:=hreg1;
           end

compiler/x86/rax86att.pas

@@ -649,6 +649,7 @@ Implementation
                  CreateLocalLabel(actasmpattern,hl,false);
                  Consume(AS_ID);
                  AddLabelOperand(hl);
+                 MaybeGetPICModifier(oper);
                end
               else
                { Check for label }
@@ -656,6 +657,7 @@ Implementation
                 begin
                   Consume(AS_ID);
                   AddLabelOperand(hl);
+                  MaybeGetPICModifier(oper);
                 end
               else
                { probably a variable or normal expression }

compiler/x86/x86ins.dat

@@ -8734,7 +8734,7 @@ xmmreg_mz,xmmreg,mem32		          \350\361\371\1\xCB\75\120                 AVX5
 xmmreg_mz,xmmreg,xmmreg_sae               \350\361\371\1\xCB\75\120                 AVX512
 
 [VREDUCEPD]
-(Ch_All)
+(Ch_Rop1, Ch_Rop2, Ch_Wop3)
 xmmreg_mz,xmmrm,imm8                      \350\352\361\372\1\x56\110\26             AVX512,TFV
 xmmreg_mz,bmem64,imm8                     \350\352\361\372\1\x56\110\26             AVX512,TFV
 ymmreg_mz,ymmrm,imm8                      \350\352\361\364\372\1\x56\110\26         AVX512,TFV
@@ -8744,7 +8744,7 @@ zmmreg_mz,bmem64,imm8                     \350\351\352\361\372\1\x56\110\26
 zmmreg_mz,zmmreg_sae,imm8                 \350\351\352\361\372\1\x56\110\26         AVX512
 
 [VREDUCEPS]
-(Ch_All)
+(Ch_Rop1, Ch_Rop2, Ch_Wop3)
 xmmreg_mz,xmmrm,imm8                      \350\361\372\1\x56\110\26                 AVX512,TFV
 xmmreg_mz,bmem32,imm8                     \350\361\372\1\x56\110\26                 AVX512,TFV
 ymmreg_mz,ymmrm,imm8                      \350\361\364\372\1\x56\110\26             AVX512,TFV
@@ -8754,12 +8754,12 @@ zmmreg_mz,bmem32,imm8                     \350\351\361\372\1\x56\110\26
 zmmreg_mz,zmmreg_sae,imm8                 \350\351\361\372\1\x56\110\26             AVX512
 
 [VREDUCESD]
-(Ch_All)
+(Ch_Rop1, Ch_Rop2, Ch_Rop3, Ch_Wop4)
 xmmreg_mz,xmmreg,mem64,imm8               \350\352\361\372\1\x57\75\120\27          AVX512,T1S
 xmmreg_mz,xmmreg,xmmreg_sae,imm8          \350\352\361\372\1\x57\75\120\27          AVX512
 
 [VREDUCESS]
-(Ch_All)
+(Ch_Rop1, Ch_Rop2, Ch_Rop3, Ch_Wop4)
 xmmreg_mz,xmmreg,mem32,imm8               \350\361\372\1\x57\75\120\27              AVX512,T1S
 xmmreg_mz,xmmreg,xmmreg_sae,imm8          \350\361\372\1\x57\75\120\27              AVX512
 

compiler/x86_64/aoptcpu.pas

@@ -173,6 +173,8 @@ uses
                   Result:=OptPass2Lea(p);
                 A_SUB:
                   Result:=OptPass2SUB(p);
+                A_ADD:
+                  Result:=OptPass2ADD(p);
                 else
                   ;
               end;
@@ -192,6 +194,8 @@ uses
               case taicpu(p).opcode of
                 A_MOV:
                   Result:=PostPeepholeOptMov(p);
+                A_AND:
+                  Result:=PostPeepholeOptAnd(p);
                 A_MOVSX:
                   Result:=PostPeepholeOptMOVSX(p);
                 A_MOVZX:

compiler/x86_64/cpuinfo.pas

@@ -182,7 +182,9 @@ type
    tfpuflags =
       (FPUX86_HAS_AVXUNIT,
        FPUX86_HAS_32MMREGS,
-       FPUX86_HAS_AVX512F
+       FPUX86_HAS_AVX512F,
+       FPUX86_HAS_AVX512VL,
+       FPUX86_HAS_AVX512DQ
       );
 
  const
@@ -203,7 +205,7 @@ type
       { fpu_sse42    } [],
       { fpu_avx      } [FPUX86_HAS_AVXUNIT],
       { fpu_avx2     } [FPUX86_HAS_AVXUNIT],
-      { fpu_avx512   } [FPUX86_HAS_AVXUNIT,FPUX86_HAS_32MMREGS,FPUX86_HAS_AVX512F]
+      { fpu_avx512   } [FPUX86_HAS_AVXUNIT,FPUX86_HAS_32MMREGS,FPUX86_HAS_AVX512F,FPUX86_HAS_AVX512VL,FPUX86_HAS_AVX512DQ]
    );
 
 Implementation

compiler/x86_64/x8664pro.inc

@@ -1379,10 +1379,10 @@
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
-(Ch: [Ch_All]),
+(Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
+(Ch: [Ch_Rop1, Ch_Rop2, Ch_Wop3]),
+(Ch: [Ch_Rop1, Ch_Rop2, Ch_Rop3, Ch_Wop4]),
+(Ch: [Ch_Rop1, Ch_Rop2, Ch_Rop3, Ch_Wop4]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),
 (Ch: [Ch_All]),

compiler/xtensa/cgcpu.pas

@@ -688,7 +688,16 @@ implementation
                   if LocalSize<>0 then
                     begin
                       a_reg_alloc(list,NR_STACK_POINTER_REG);
-                      list.concat(taicpu.op_reg_reg_const(A_ADDI,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,-localsize));
+                      { not sure if 32512 is the correct value or if it can be larger }
+                      if Localsize>32512 then
+                        begin
+                          reference_reset(ref,4,[]);
+                          ref.symbol:=create_data_entry(nil,-localsize);
+                          list.concat(taicpu.op_reg_ref(A_L32R,NR_A8,ref));
+                          list.concat(taicpu.op_reg_reg_reg(A_ADD,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,NR_A8));
+                        end
+                      else
+                        list.concat(taicpu.op_reg_reg_const(A_ADDI,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,-localsize));
                     end;
 
                   reference_reset(ref,4,[]);
@@ -703,8 +712,15 @@ implementation
                           ref.base:=NR_A8;
                         end
                       else
-                        { fix me! }
-                        Internalerror(2020031101);
+                        begin
+                          reference_reset(ref,4,[]);
+                          ref.symbol:=create_data_entry(nil,localsize-registerarea);
+                          list.concat(taicpu.op_reg_ref(A_L32R,NR_A8,ref));
+                          list.concat(taicpu.op_reg_reg_reg(A_ADD,NR_A8,NR_A8,NR_STACK_POINTER_REG));
+                          reference_reset(ref,4,[]);
+                          ref.base:=NR_A8;
+                          ref.offset:=registerarea;
+                        end;
                     end;
 
                   if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
@@ -831,8 +847,15 @@ implementation
                               ref.base:=NR_A8;
                             end
                           else
-                            { fix me! }
-                            Internalerror(2020031102);
+                            begin
+                              reference_reset(ref,4,[]);
+                              ref.symbol:=create_data_entry(nil,ref.offset);
+                              list.concat(taicpu.op_reg_ref(A_L32R,NR_A8,ref));
+                              list.concat(taicpu.op_reg_reg_reg(A_ADD,NR_A8,NR_A8,NR_STACK_POINTER_REG));
+                              reference_reset(ref,4,[]);
+                              ref.base:=NR_A8;
+                              ref.offset:=0;
+                            end;
                         end;
 
                       // restore a15 if used
@@ -855,7 +878,16 @@ implementation
                         end;
 
                       // restore stack pointer
-                      list.concat(taicpu.op_reg_reg_const(A_ADDI,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,localsize));
+                      { not sure if 32512 is the correct value or if it can be larger }
+                      if Localsize>32512 then
+                        begin
+                          reference_reset(ref,4,[]);
+                          ref.symbol:=create_data_entry(nil,localsize);
+                          list.concat(taicpu.op_reg_ref(A_L32R,NR_A8,ref));
+                          list.concat(taicpu.op_reg_reg_reg(A_ADD,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,NR_A8));
+                        end
+                      else
+                        list.concat(taicpu.op_reg_reg_const(A_ADDI,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,localsize));
                       a_reg_dealloc(list,NR_STACK_POINTER_REG);
                     end;
                   end;

packages/chm/src/itsftransform.pas

@@ -435,7 +435,15 @@ initialization
 
 finalization
   if Assigned(LocTransforms) then
+  begin
+    while LocTransforms.Count > 0 do
+    begin
+      if Assigned(PITSFTranformItem(LocTransforms.Items[0])^.Instance) then
+          (PITSFTranformItem(LocTransforms.Items[0])^.Instance).Free;
+      LocTransforms.Delete(0);
+    end;
     LocTransforms.Free;
+  end
 
 end.
 

packages/fcl-js/src/jswriter.pp

@@ -611,10 +611,9 @@ begin
               begin
               inc(I,2); // surrogate, two char codepoint
               continue;
-              end
-            else
-              // invalid UTF-16, cannot be encoded as UTF-8 -> encode as hex
-              R:=R+'\u'+TJSString(HexStr(ord(c),4));
+              end;
+            // invalid UTF-16, cannot be encoded as UTF-8 -> encode as hex
+            R:=R+'\u'+TJSString(HexStr(ord(S[i]),4));
             end
           else
             // invalid UTF-16 at end of string, cannot be encoded as UTF-8 -> encode as hex

packages/fcl-passrc/src/pasresolveeval.pas

@@ -564,6 +564,7 @@ type
   TResEvalString = class(TResEvalValue)
   public
     S: RawByteString;
+    OnlyASCII: boolean;
     constructor Create; override;
     constructor CreateValue(const aValue: RawByteString);
     function Clone: TResEvalValue; override;
@@ -692,7 +693,8 @@ type
   private
     FAllowedInts: TResEvalTypedInts;
     {$ifdef FPC_HAS_CPSTRING}
-    FDefaultEncoding: TSystemCodePage;
+    FDefaultSourceEncoding: TSystemCodePage;
+    FDefaultStringEncoding: TSystemCodePage;
     {$endif}
     FOnEvalIdentifier: TPasResEvalIdentHandler;
     FOnEvalParams: TPasResEvalParamsHandler;
@@ -779,6 +781,8 @@ type
     function GetUTF8Str(const s: RawByteString; ErrorEl: TPasElement): String;
     function GetUnicodeStr(const s: RawByteString; ErrorEl: TPasElement): UnicodeString;
     function GetWideChar(const s: RawByteString; out w: WideChar): boolean;
+    function GetExprStringTargetCP(Expr: TPasExpr): TSystemCodePage; virtual; // e.g. var s: String(1234) = 'ä' return 1234
+    function GetExprStringSourceCP(Expr: TPasExpr): TSystemCodePage; virtual; // e.g. {$codepage 123}var s: String = 'ä' return 123
     {$endif}
     property OnLog: TPasResEvalLogHandler read FOnLog write FOnLog;
     property OnEvalIdentifier: TPasResEvalIdentHandler read FOnEvalIdentifier write FOnEvalIdentifier;
@@ -786,7 +790,8 @@ type
     property OnRangeCheckEl: TPasResEvalRangeCheckElHandler read FOnRangeCheckEl write FOnRangeCheckEl;
     property AllowedInts: TResEvalTypedInts read FAllowedInts write FAllowedInts;
     {$ifdef FPC_HAS_CPSTRING}
-    property DefaultStringCodePage: TSystemCodePage read FDefaultEncoding write FDefaultEncoding;
+    property DefaultSourceCodePage: TSystemCodePage read FDefaultSourceEncoding write FDefaultSourceEncoding;
+    property DefaultStringCodePage: TSystemCodePage read FDefaultStringEncoding write FDefaultStringEncoding;
     {$endif}
   end;
   TResExprEvaluatorClass = class of TResExprEvaluator;
@@ -923,6 +928,7 @@ end;
 
 function UnicodeStrToCaption(const u: UnicodeString; MaxLength: integer
   ): Unicodestring;
+// encode a string as a Pascal string literal using '' and #
 var
   InLit: boolean;
   Len: integer;
@@ -4125,15 +4131,22 @@ end;
 
 function TResExprEvaluator.EvalPrimitiveExprString(Expr: TPrimitiveExpr
   ): TResEvalValue;
-{ Extracts the value from a Pascal string literal
-
-  S is a Pascal string literal e.g. 'Line'#10
-    ''  empty string
-    '''' => "'"
-    #decimal
-    #$hex
-    ^l  l is a letter a-z
-}
+ //Extracts the value from a Pascal string literal
+ //
+ // S is a Pascal string literal e.g. 'Line'#10
+ //   ''  empty string
+ //   '''' => "'"
+ //   #decimal
+ //   #$hex
+ //   ^l  l is a letter a-z
+ //
+ // Codepage:
+ //   For example {$codepage utf8}var s: AnsiString(CP_1251) = 'a';
+ //     Source codepage is CP_UTF8, target codepage is CP_1251
+ //
+ //   Source codepage is needed for reading non ASCII string literals 'ä'.
+ //   Target codepage is needed for reading non ASCII # literals.
+ //   Target codepage costs time to compute.
 
   procedure RangeError(id: TMaxPrecInt);
   begin
@@ -4141,24 +4154,36 @@ function TResExprEvaluator.EvalPrimitiveExprString(Expr: TPrimitiveExpr
     RaiseRangeCheck(id,Expr);
   end;
 
-  procedure Add(h: String);
+{$IFDEF FPC_HAS_CPSTRING}
+var
+  TargetCPValid: boolean;
+  TargetCP: word;
+  SourceCPValid: boolean;
+  SourceCP: word;
+
+  procedure FetchSourceCP;
   begin
-    {$ifdef FPC_HAS_CPSTRING}
-    if Result.Kind=revkString then
-      TResEvalString(Result).S:=TResEvalString(Result).S+h
-    else
-      TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+GetUnicodeStr(h,Expr);
-    {$else}
-    TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+h;
-    {$endif}
+    if SourceCPValid then exit;
+    SourceCP:=GetExprStringSourceCP(Expr);
+    if SourceCP=DefaultSystemCodePage then
+      SourceCP:=CP_ACP;
+    SourceCPValid:=true;
   end;
 
-  procedure AddHash(u: longword; ForceUTF16: boolean);
-  {$ifdef FPC_HAS_CPSTRING}
+  procedure FetchTargetCP;
+  begin
+    if TargetCPValid then exit;
+    TargetCP:=GetExprStringTargetCP(Expr);
+    if TargetCP=DefaultSystemCodePage then
+      TargetCP:=CP_ACP;
+    TargetCPValid:=true;
+  end;
+
+  procedure ForceUTF16;
   var
     h: RawByteString;
   begin
-    if ((u>255) or (ForceUTF16)) and (Result.Kind=revkString) then
+    if Result.Kind=revkString then
       begin
       // switch to unicodestring
       h:=TResEvalString(Result).S;
@@ -4166,22 +4191,202 @@ function TResExprEvaluator.EvalPrimitiveExprString(Expr: TPrimitiveExpr
       Result:=nil; // in case of exception in GetUnicodeStr
       Result:=TResEvalUTF16.CreateValue(GetUnicodeStr(h,Expr));
       end;
+  end;
+{$ENDIF}
+
+  procedure AddSrc(h: String);
+  {$ifdef FPC_HAS_CPSTRING}
+  var
+    Value: TResEvalString;
+    OnlyASCII: Boolean;
+    i: Integer;
+  {$ENDIF}
+  begin
+    if h='' then exit;
+    //writeln('AddSrc ',length(h),' ',ord(h[1]),' ',stringcodepage(h),' ',defaultsystemcodepage);
+    {$ifdef FPC_HAS_CPSTRING}
+    OnlyASCII:=true;
+    for i:=1 to length(h) do
+      if ord(h[i])>127 then
+        begin
+        // append non ASCII -> needs codepage
+        OnlyASCII:=false;
+        FetchSourceCP;
+        SetCodePage(rawbytestring(h),SourceCP,false);
+        break;
+        end;
+
+    if Result.Kind=revkString then
+      begin
+      Value:=TResEvalString(Result);
+      if OnlyASCII and Value.OnlyASCII then
+        begin
+        // concatenate ascii strings
+        Value.S:=Value.S+h;
+        exit;
+        end;
+
+      // concatenate non ascii strings
+      FetchTargetCP;
+      case TargetCP of
+      CP_UTF16:
+        begin
+        ForceUTF16;
+        TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+GetUnicodeStr(h,Expr);
+        //writeln('AddSrc len(h)=',length(h),' StringCodePage=',StringCodePage(h),' GetCodePage=',GetCodePage(h),' S=',length(TResEvalUTF16(Result).S));
+        end;
+      CP_UTF16BE:
+        RaiseNotYetImplemented(20201220222608,Expr);
+      else
+        begin
+        if Value.S<>'' then
+        begin
+          if Value.OnlyASCII then
+            SetCodePage(Value.S,TargetCP,false);
+          Value.S:=Value.S+h;
+        end else begin
+          Value.S:=h;
+        end;
+        end;
+      end;
+
+      end
+    else
+      TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+GetUnicodeStr(h,Expr);
+    {$else}
+    TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+h;
+    {$endif}
+  end;
+
+  procedure AddHash(u: longword);
+  {$ifdef FPC_HAS_CPSTRING}
+  begin
     if Result.Kind=revkString then
-      TResEvalString(Result).S:=TResEvalString(Result).S+Chr(u)
+      TResEvalString(Result).s:=TResEvalString(Result).S+Chr(u)
     else
       TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+WideChar(u);
   end;
   {$else}
   begin
     TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+WideChar(u);
-    if ForceUTF16 then ;
   end;
   {$endif}
 
+  function ReadHash(Value: TResEvalValue; const S: string; p, l: integer): integer;
+  var
+    StartP: Integer;
+    u: longword;
+    c: Char;
+    {$ifdef FPC_HAS_CPSTRING}
+    ValueAnsi: TResEvalString;
+    ValueUTF16: TResEvalUTF16;
+    OldCP: TSystemCodePage;
+    {$ENDIF}
+  begin
+    Result:=p;
+    inc(Result);
+    if Result>l then
+      RaiseInternalError(20181016121354); // error in scanner
+    if S[Result]='$' then
+      begin
+      // #$hexnumber
+      inc(Result);
+      StartP:=Result;
+      u:=0;
+      while Result<=l do
+        begin
+        c:=S[Result];
+        case c of
+        '0'..'9': u:=u*16+longword(ord(c)-ord('0'));
+        'a'..'f': u:=u*16+longword(ord(c)-ord('a'))+10;
+        'A'..'F': u:=u*16+longword(ord(c)-ord('A'))+10;
+        else break;
+        end;
+        if u>$10FFFF then
+          RangeError(20170523115712);
+        inc(Result);
+        end;
+      end
+    else
+      begin
+      // #decimalnumber
+      StartP:=Result;
+      u:=0;
+      while Result<=l do
+        begin
+        c:=S[Result];
+        case c of
+        '0'..'9': u:=u*10+longword(ord(c)-ord('0'));
+        else break;
+        end;
+        if u>$ffff then
+          RangeError(20170523123137);
+        inc(Result);
+        end;
+      end;
+    if Result=StartP then
+      RaiseInternalError(20170523123806);
+    {$IFDEF FPC_HAS_CPSTRING}
+    if u<128 then
+      begin
+      // ASCII
+      AddHash(u);
+      exit;
+      end;
+    // non ASCII
+    FetchTargetCP;
+    if (TargetCP=CP_UTF16) or (TargetCP=CP_UTF16BE) or (u>255) then
+      begin
+      ForceUTF16;
+      ValueUTF16:=TResEvalUTF16(Value);
+      if u>$ffff then
+        begin
+        // split into two
+        dec(u,$10000);
+        ValueUTF16.S:=ValueUTF16.S
+                       +WideChar($D800+(u shr 10))+WideChar($DC00+(u and $3ff));
+        end
+      else
+        ValueUTF16.S:=ValueUTF16.S+WideChar(u);
+      if TargetCP=CP_UTF16BE then
+        RaiseNotYetImplemented(20201220212206,Expr);
+      end
+    else
+      begin
+      // byte encoding
+      ValueAnsi:=TResEvalString(Value);
+      if ValueAnsi.S<>'' then
+        begin
+        // append
+        OldCP:=StringCodePage(ValueAnsi.S);
+        if OldCP<>TargetCP then
+          SetCodePage(ValueAnsi.S,TargetCP,false);
+        ValueAnsi.S:=ValueAnsi.S+Chr(u);
+        end
+      else
+        begin
+        // start
+        ValueAnsi.S:=Chr(u);
+        SetCodePage(ValueAnsi.S,TargetCP,false);
+        end;
+      ValueAnsi.OnlyASCII:=false;
+      end;
+    {$ELSE}
+    if u>$ffff then
+      begin
+      // split into two
+      dec(u,$10000);
+      AddHash($D800+(u shr 10));
+      AddHash($DC00+(u and $3ff));
+      end
+    else
+      AddHash(u);
+    {$ENDIF}
+  end;
+
 var
   p, StartP, l: integer;
   c: Char;
-  u: longword;
   S: String;
 begin
   Result:=nil;
@@ -4193,11 +4398,16 @@ begin
   if l=0 then
     RaiseInternalError(20170523113809);
   {$ifdef FPC_HAS_CPSTRING}
+  TargetCPValid:=false;
+  TargetCP:=CP_ACP;
+  SourceCPValid:=false;
+  SourceCP:=CP_ACP;
   Result:=TResEvalString.Create;
   {$else}
   Result:=TResEvalUTF16.Create;
   {$endif}
   p:=1;
+  //writeln('TResExprEvaluator.EvalPrimitiveExprString ',GetObjPath(Expr),' ',Expr.SourceFilename,' ',Expr.SourceLinenumber div 2048,' S=[',S,']');
   while p<=l do
     case S[p] of
     {$ifdef UsePChar}
@@ -4215,12 +4425,12 @@ begin
         '''':
           begin
           if p>StartP then
-            Add(copy(S,StartP,p-StartP));
+            AddSrc(copy(S,StartP,p-StartP));
           inc(p);
           StartP:=p;
           if (p>l) or (S[p]<>'''') then
             break;
-          Add('''');
+          AddSrc('''');
           inc(p);
           StartP:=p;
           end;
@@ -4229,65 +4439,10 @@ begin
         end;
       until false;
       if p>StartP then
-        Add(copy(S,StartP,p-StartP));
+        AddSrc(copy(S,StartP,p-StartP));
       end;
     '#':
-      begin
-      inc(p);
-      if p>l then
-        RaiseInternalError(20181016121354);
-      if S[p]='$' then
-        begin
-        // #$hexnumber
-        inc(p);
-        StartP:=p;
-        u:=0;
-        while p<=l do
-          begin
-          c:=S[p];
-          case c of
-          '0'..'9': u:=u*16+longword(ord(c)-ord('0'));
-          'a'..'f': u:=u*16+longword(ord(c)-ord('a'))+10;
-          'A'..'F': u:=u*16+longword(ord(c)-ord('A'))+10;
-          else break;
-          end;
-          if u>$10FFFF then
-            RangeError(20170523115712);
-          inc(p);
-          end;
-        if p=StartP then
-          RaiseInternalError(20170207164956);
-        if u>$ffff then
-          begin
-          // split into two
-          dec(u,$10000);
-          AddHash($D800+(u shr 10),true);
-          AddHash($DC00+(u and $3ff),true);
-          end
-        else
-          AddHash(u,p-StartP>2);
-        end
-      else
-        begin
-        // #decimalnumber
-        StartP:=p;
-        u:=0;
-        while p<=l do
-          begin
-          c:=S[p];
-          case c of
-          '0'..'9': u:=u*10+longword(ord(c)-ord('0'));
-          else break;
-          end;
-          if u>$ffff then
-            RangeError(20170523123137);
-          inc(p);
-          end;
-        if p=StartP then
-          RaiseInternalError(20170523123806);
-        AddHash(u,false);
-        end;
-      end;
+      p:=ReadHash(Result,S,p,l);
     '^':
       begin
       // ^A is #1
@@ -4296,8 +4451,8 @@ begin
         RaiseInternalError(20181016121520);
       c:=S[p];
       case c of
-      'a'..'z': AddHash(ord(c)-ord('a')+1,false);
-      'A'..'Z': AddHash(ord(c)-ord('A')+1,false);
+      'a'..'z': AddHash(ord(c)-ord('a')+1);
+      'A'..'Z': AddHash(ord(c)-ord('A')+1);
       else RaiseInternalError(20170523123809);
       end;
       inc(p);
@@ -4323,7 +4478,8 @@ begin
   inherited Create;
   FAllowedInts:=ReitDefaults;
   {$ifdef FPC_HAS_CPSTRING}
-  FDefaultEncoding:=CP_ACP;
+  FDefaultSourceEncoding:=system.DefaultSystemCodePage;
+  FDefaultStringEncoding:=CP_ACP;
   {$endif}
 end;
 
@@ -5115,11 +5271,11 @@ end;
 
 function TResExprEvaluator.GetCodePage(const s: RawByteString): TSystemCodePage;
 begin
-  if s='' then exit(DefaultStringCodePage);
+  if s='' then exit(DefaultSourceCodePage);
   Result:=StringCodePage(s);
   if (Result=CP_ACP) or (Result=CP_NONE) then
     begin
-    Result:=DefaultStringCodePage;
+    Result:=DefaultSourceCodePage;
     if (Result=CP_ACP) or (Result=CP_NONE) then
       begin
       Result:=System.DefaultSystemCodePage;
@@ -5181,7 +5337,7 @@ var
 begin
   if s='' then exit('');
   CP:=GetCodePage(s);
-  if CP=CP_UTF8 then
+  if (CP=CP_UTF8) or ((CP=CP_ACP) and (DefaultSystemCodePage=CP_UTF8)) then
     begin
     if ErrorEl<>nil then
       CheckValidUTF8(s,ErrorEl);
@@ -5216,6 +5372,20 @@ begin
     Result:=true;
     end;
 end;
+
+function TResExprEvaluator.GetExprStringTargetCP(Expr: TPasExpr
+  ): TSystemCodePage;
+begin
+  Result:=DefaultStringCodePage;
+  if Expr=nil then ;
+end;
+
+function TResExprEvaluator.GetExprStringSourceCP(Expr: TPasExpr
+  ): TSystemCodePage;
+begin
+  Result:=DefaultSourceCodePage;
+  if Expr=nil then ;
+end;
 {$endif}
 
 procedure TResExprEvaluator.PredBool(Value: TResEvalBool; ErrorEl: TPasElement);
@@ -5564,6 +5734,7 @@ end;
 constructor TResEvalString.Create;
 begin
   inherited Create;
+  OnlyASCII:=true;
   Kind:=revkString;
 end;
 
@@ -5577,6 +5748,7 @@ function TResEvalString.Clone: TResEvalValue;
 begin
   Result:=inherited Clone;
   TResEvalString(Result).S:=S;
+  TResEvalString(Result).OnlyASCII:=OnlyASCII;
 end;
 
 function TResEvalString.AsString: string;

packages/fcl-passrc/src/pasresolver.pp

@@ -1710,7 +1710,8 @@ type
     function CreateClassIntfMap(El: TPasClassType; Index: integer): TPasClassIntfMap;
     procedure CheckConditionExpr(El: TPasExpr; const ResolvedEl: TPasResolverResult); virtual;
     procedure CheckProcSignatureMatch(DeclProc, ImplProc: TPasProcedure;
-      IsOverride: boolean);
+      IsOverride: boolean // override or class intf implementation
+      );
     procedure CheckPointerCycle(El: TPasPointerType);
     procedure CheckGenericTemplateTypes(El: TPasGenericType); virtual;
     procedure ComputeUnaryNot(El: TUnaryExpr; var ResolvedEl: TPasResolverResult;
@@ -6453,6 +6454,10 @@ begin
               RaiseMsg(20180322143202,nNoMatchingImplForIntfMethodXFound,
                 sNoMatchingImplForIntfMethodXFound,
                 [GetProcTypeDescription(IntfProc.ProcType,[prptdUseName,prptdAddPaths,prptdResolveSimpleAlias])],El); // ToDo: jump to interface list
+            // check calling conventions
+            //writeln('TPasResolver.FinishClassType Intf=',GetObjPath(IntfProc),' Found=',GetObjPath(FindData.Found));
+            CheckProcSignatureMatch(IntfProc,TPasProcedure(FindData.Found),true);
+
             Map.Procs[j]:=FindData.Found;
             end;
           Map:=Map.AncestorMap;
@@ -9396,7 +9401,7 @@ var
   DeclName, ImplName: String;
   ImplResult, DeclResult: TPasType;
   ImplTemplType, DeclTemplType: TPasGenericTemplateType;
-  NewImplPTMods: TProcTypeModifiers;
+  NewImplPTMods, DeclPTMods, ImplPTMods: TProcTypeModifiers;
   ptm: TProcTypeModifier;
   NewImplProcMods: TProcedureModifiers;
   pm: TProcedureModifier;
@@ -9409,6 +9414,9 @@ begin
   if DeclArgs.Count<>ImplArgs.Count then
     RaiseNotYetImplemented(20190912110642,ImplProc);
 
+  DeclPTMods:=DeclProc.ProcType.Modifiers;
+  ImplPTMods:=ImplProc.ProcType.Modifiers;
+
   DeclTemplates:=GetProcTemplateTypes(DeclProc);
   ImplTemplates:=GetProcTemplateTypes(ImplProc);
   if DeclTemplates<>nil then
@@ -9465,33 +9473,36 @@ begin
     if CheckElTypeCompatibility(ImplResult,DeclResult,prraSimple)>cGenericExact then
       RaiseIncompatibleType(20170216151734,nResultTypeMismatchExpectedButFound,
         [],DeclResult,ImplResult,ImplProc);
-
-    if ImplProc.IsAsync and not DeclProc.IsAsync then
-      RaiseMsg(20200524111856,nXModifierMismatchY,sXModifierMismatchY,['procedure type','async'],ImplProc);
     end;
 
   // calling convention
   if ImplProc.CallingConvention<>DeclProc.CallingConvention then
     RaiseMsg(20170216151731,nCallingConventionMismatch,sCallingConventionMismatch,[],ImplProc);
 
-  // proc modifiers
-  NewImplProcMods:=ImplProc.Modifiers-DeclProc.Modifiers-[pmAssembler];
-  if not IsOverride then
+  // modifiers
+  if IsOverride then
+    begin
+    // override/class-intf-impl: calling conventions must match
+    NewImplPTMods:=ImplPTMods><DeclPTMods;
+    for ptm in NewImplPTMods do
+      RaiseMsg(20201227213020,nXModifierMismatchY,sXModifierMismatchY,
+        ['procedure type',ProcTypeModifiers[ptm]],ImplProc.ProcType);
+    end
+  else
     begin
     // implementation proc must not add modifiers, except "assembler"
+    NewImplProcMods:=ImplProc.Modifiers-DeclProc.Modifiers-[pmAssembler];
     if NewImplProcMods<>[] then
       for pm in NewImplProcMods do
         RaiseMsg(20200518182445,nDirectiveXNotAllowedHere,sDirectiveXNotAllowedHere,
           [ModifierNames[pm]],ImplProc.ProcType);
+    // implementation proc must not add modifiers
+    NewImplPTMods:=ImplPTMods-DeclPTMods;
+    if NewImplPTMods<>[] then
+      for ptm in NewImplPTMods do
+        RaiseMsg(20200425154821,nDirectiveXNotAllowedHere,sDirectiveXNotAllowedHere,
+          [ProcTypeModifiers[ptm]],ImplProc.ProcType);
     end;
-
-  // proc type modifiers
-  NewImplPTMods:=ImplProc.ProcType.Modifiers-DeclProc.ProcType.Modifiers;
-  // implementation proc must not add modifiers
-  if NewImplPTMods<>[] then
-    for ptm in NewImplPTMods do
-      RaiseMsg(20200425154821,nDirectiveXNotAllowedHere,sDirectiveXNotAllowedHere,
-        [ProcTypeModifiers[ptm]],ImplProc.ProcType);
 end;
 
 procedure TPasResolver.ResolveImplBlock(Block: TPasImplBlock);
@@ -10982,7 +10993,7 @@ begin
     FoundEl:=GetSpecializedEl(NameExpr,FoundEl,TemplParams);
     if FoundEl is TPasProcedure then
       begin
-      // check if params fit the implicit specialized function
+      // check if params fit the explicit specialized function, e.g. Run<Word>()
       CheckCallProcCompatibility(TPasProcedure(FoundEl).ProcType,Params,true);
       end;
     end
@@ -10996,7 +11007,7 @@ begin
       try
         CheckTemplParams(GenTemplates,InferenceParams);
         FoundEl:=GetSpecializedEl(NameExpr,FoundEl,InferenceParams);
-        // check if params fit the implicit specialized function
+        // check if params fit the implicit specialized function, e.g. Run()
         CheckCallProcCompatibility(TPasProcedure(FoundEl).ProcType,Params,true);
       finally
         ReleaseElementList(InferenceParams{$IFDEF CheckPasTreeRefCount},RefIdInferenceParamsExpr{$ENDIF});
@@ -11023,13 +11034,12 @@ begin
       else
         begin
         // typecast to user type
-        CheckTypeCast(TypeEl,Params,true); // emit warnings
+        CheckTypeCast(TypeEl,Params,true); // emit warnings, and errors for specializations
         end;
     end;
 
   // FoundEl compatible element -> create reference
   Ref:=CreateReference(FoundEl,NameExpr,rraRead);
-
   if FindCallData.StartScope.ClassType=ScopeClass_WithExpr then
     Ref.WithExprScope:=TPasWithExprScope(FindCallData.StartScope);
   FindData:=Default(TPRFindData);
@@ -15704,7 +15714,7 @@ begin
       end;
     {$endif}
     revkUnicodeString:
-      if length(TResEvalUTF16(Value).S)=1 then
+      if (length(TResEvalUTF16(Value).S)=1) and (bt in btAllChars) then
         begin
         w:=TResEvalUTF16(Value).S[1];
         {$ifdef FPC_HAS_CPSTRING}
@@ -16652,8 +16662,28 @@ end;
 
 function TPasResolver.CreateSpecializedTypeName(Item: TPRSpecializedItem): string;
 
+  function Get_ProcName(aProc: TPasProcedure): string; forward;
   function GetTypeName(aType: TPasType): string; forward;
 
+  function GetParentName(El: TPasElement): string;
+  begin
+    if El.Parent is TPasType then
+      Result:=GetTypeName(TPasType(El.Parent))
+    else if El is TPasUnresolvedSymbolRef then
+      Result:='System'
+    else if El.Parent is TPasProcedure then
+      Result:=Get_ProcName(TPasProcedure(El.Parent))
+    else
+      Result:=El.GetModule.Name;
+  end;
+
+  function Get_ProcName(aProc: TPasProcedure): string;
+  begin
+    Result:=GetParentName(aProc);
+    if aProc.Name<>'' then
+      Result:=Result+'.'+aProc.Name;
+  end;
+
   function GetSpecParams(Item: TPRSpecializedItem): string;
   var
     i: Integer;
@@ -16692,13 +16722,7 @@ function TPasResolver.CreateSpecializedTypeName(Item: TPRSpecializedItem): strin
       end
     else
       begin
-      if aType.Parent is TPasType then
-        Result:=GetTypeName(TPasType(aType.Parent))
-      else if aType is TPasUnresolvedSymbolRef then
-        Result:='System'
-      else
-        Result:=aType.GetModule.Name;
-      Result:=Result+'.'+aType.Name;
+      Result:=GetParentName(aType)+'.'+aType.Name;
       if (aType.CustomData is TPasGenericScope) and (Pos('<',aType.Name)<1) then
         begin
         ChildItem:=TPasGenericScope(aType.CustomData).SpecializedFromItem;
@@ -26738,7 +26762,7 @@ function TPasResolver.CheckTypeCastRes(const FromResolved,
   end;
 
 var
-  ToTypeEl, ToType, FromType, FromTypeEl: TPasType;
+  ToTypeEl, FromTypeEl: TPasType;
   ToTypeBaseType: TResolverBaseType;
   C: TClass;
   ToProcType, FromProcType: TPasProcedureType;
@@ -26763,9 +26787,12 @@ begin
       begin
       if ToTypeEl.CustomData is TResElDataBaseType then
         begin
-        // base type cast, e.g. double(aninteger)
+        // type cast to base type, e.g. double(aninteger)
         if ToTypeEl=FromResolved.LoTypeEl then
           exit(cExact);
+        if (FromResolved.BaseType=btContext)
+            and (FromResolved.LoTypeEl.ClassType=TPasGenericTemplateType) then
+          exit(cExact); // e.g. double(T) -> will be checked when specialized
         ToTypeBaseType:=(ToTypeEl.CustomData as TResElDataBaseType).BaseType;
         if ToTypeBaseType=FromResolved.BaseType then
           Result:=cExact
@@ -26950,6 +26977,9 @@ begin
       // e.g. T(var)
       TemplType:=TPasGenericTemplateType(ToTypeEl);
       FromTypeEl:=FromResolved.LoTypeEl;
+      if (FromTypeEl<>nil)
+          and (FromTypeEl.ClassType=TPasGenericTemplateType) then
+        exit(cExact); // e.g. T(S)  -> will be checked when specialized
       for i:=0 to length(TemplType.Constraints)-1 do
         begin
         ConEl:=TemplType.Constraints[i];
@@ -26984,9 +27014,9 @@ begin
           if (FromResolved.IdentEl is TPasType) then
             RaiseMsg(20170404162604,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
           // type cast  classof(classof-var)  upwards or downwards
-          ToType:=TPasClassOfType(ToTypeEl).DestType;
-          FromType:=TPasClassOfType(FromResolved.LoTypeEl).DestType;
-          Result:=CheckClassesAreRelated(ToType,FromType);
+          ToTypeEl:=TPasClassOfType(ToTypeEl).DestType;
+          FromTypeEl:=TPasClassOfType(FromResolved.LoTypeEl).DestType;
+          Result:=CheckClassesAreRelated(ToTypeEl,FromTypeEl);
           end;
         end
       else if FromResolved.BaseType=btPointer then
@@ -27171,9 +27201,8 @@ begin
             and (ToTypeEl=ToResolved.IdentEl) then
           begin
           // for example  class-of(Self) in a class function
-          ToType:=TPasClassOfType(ToTypeEl).DestType;
-          FromType:=TPasClassType(FromTypeEl);
-          Result:=CheckClassesAreRelated(ToType,FromType);
+          ToTypeEl:=TPasClassOfType(ToTypeEl).DestType;
+          Result:=CheckClassesAreRelated(ToTypeEl,FromTypeEl);
           end;
         end;
       end;
@@ -27225,6 +27254,11 @@ begin
   {$IFDEF VerbosePasResolver}
   writeln('TPasResolver.CheckTypeCastArray From=',GetTypeDescription(FromType),' ToType=',GetTypeDescription(ToType));
   {$ENDIF}
+  if not RaiseOnError then
+    begin
+    if (ToType.GenericTemplateTypes<>nil) and (ToType.GenericTemplateTypes.Count>0) then
+      exit(cCompatible); // is later checked when specialized
+    end;
   StartFromType:=FromType;
   StartToType:=ToType;
   Result:=cIncompatible;
@@ -27254,10 +27288,11 @@ begin
         break; // ToType has more dimensions
         end;
       // have same dimension -> check ElType
+      Include(FromElTypeRes.Flags,rrfReadable);
+      FromElTypeRes.IdentEl:=nil;
       {$IFDEF VerbosePasResolver}
       writeln('TPasResolver.CheckTypeCastArray check ElType From=',GetResolverResultDbg(FromElTypeRes),' To=',GetResolverResultDbg(ToElTypeRes));
       {$ENDIF}
-      Include(FromElTypeRes.Flags,rrfReadable);
       Result:=CheckTypeCastRes(FromElTypeRes,ToElTypeRes,ErrorEl,false);
       break;
       end

packages/fcl-passrc/src/paswrite.pp

@@ -1659,7 +1659,7 @@ procedure WritePasFile(AElement: TPasElement; const AFilename: string);
 var
   Stream: TFileStream;
 begin
-  Stream := TFileStream.Create(AFilename, fmCreate);
+  Stream := TFileStream.Create(AFilename, fmCreate or fmShareDenyNone);
   try
     WritePasFile(AElement, Stream);
   finally

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -185,6 +185,7 @@ type
     procedure TestGenMethod_OverloadTypeParamCntObjFPC;
     procedure TestGenMethod_OverloadTypeParamCntDelphi;
     procedure TestGenMethod_OverloadArgs;
+    procedure TestGenMethod_TypeCastParam;
   end;
 
 implementation
@@ -2982,6 +2983,33 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGenMethod_TypeCastParam;
+begin
+  StartUnit(false);
+  Add([
+  '{$mode delphi}',
+  'interface',
+  'type',
+  '  TObject = class end;',
+  '  TAnt = class end;',
+  '  TArray<T> = array of T;',
+  '  TBird = class',
+  '    F: TArray<TObject>;',
+  '    procedure Run<S>(a: TArray<S>);',
+  '  end;',
+  'implementation',
+  'procedure TBird.Run<S>(a: TArray<S>);',
+  'begin',
+  '  a:=TArray<S>(a);',
+  '  F:=TArray<TObject>(a);',
+  'end;',
+  'var B: TBird;',
+  'initialization',
+  '  B.Run<TAnt>(nil);',
+  '']);
+  ParseUnit;
+end;
+
 initialization
   RegisterTests([TTestResolveGenerics]);
 

packages/fcl-passrc/tests/tcresolver.pas

@@ -299,7 +299,7 @@ type
     Procedure TestIntegerBoolFail;
     Procedure TestBooleanOperators;
     Procedure TestStringOperators;
-    Procedure TestWideCharOperators;
+    Procedure TestWideCharOperators_DelphiUnicode;
     Procedure TestFloatOperators;
     Procedure TestCAssignments;
     Procedure TestTypeCastBaseTypes;
@@ -2181,6 +2181,8 @@ begin
   Result.OnFindUnit:=@OnPasResolverFindUnit;
   Result.OnLog:=@OnPasResolverLog;
   Result.Hub:=Hub;
+  Result.ExprEvaluator.DefaultStringCodePage:=CP_UTF8;
+  Result.ExprEvaluator.DefaultSourceCodePage:=CP_UTF8;
   FModules.Add(Result);
 end;
 
@@ -4678,9 +4680,9 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.TestWideCharOperators;
+procedure TTestResolver.TestWideCharOperators_DelphiUnicode;
 begin
-  ResolverEngine.ExprEvaluator.DefaultStringCodePage:=CP_UTF8;
+  ResolverEngine.ExprEvaluator.DefaultStringCodePage:=CP_UTF16;
   ResolverEngine.BaseTypeChar:=btWideChar;
   ResolverEngine.BaseTypeString:=btUnicodeString;
   StartProgram(false);
@@ -14307,7 +14309,6 @@ end;
 
 procedure TTestResolver.TestStaticArrayOfChar;
 begin
-  ResolverEngine.ExprEvaluator.DefaultStringCodePage:=CP_UTF8;
   StartProgram(false);
   Add([
   'type',
@@ -14329,7 +14330,6 @@ end;
 
 procedure TTestResolver.TestStaticArrayOfCharDelphi;
 begin
-  ResolverEngine.ExprEvaluator.DefaultStringCodePage:=CP_UTF8;
   StartProgram(false);
   Add([
   '{$mode delphi}',

packages/fcl-res/src/rclex.inc

@@ -141,10 +141,12 @@ begin
                               return(_ID);
                          end;
   25:
-                        ;
+                  return(_NSWPSTR);
   26:
-                        returnc(yytext[1]);
+                        ;
   27:
+                        returnc(yytext[1]);
+  28:
                         return(_ILLEGAL);
   end;
 end(*yyaction*);
@@ -158,14 +160,16 @@ type YYTRec = record
 
 const
 
-yynmarks   = 62;
-yynmatches = 62;
-yyntrans   = 131;
-yynstates  = 94;
+yynmarks   = 88;
+yynmatches = 88;
+yyntrans   = 156;
+yynstates  = 96;
 
 yyk : array [1..yynmarks] of Integer = (
   { 0: }
+  25,
   { 1: }
+  25,
   { 2: }
   { 3: }
   { 4: }
@@ -175,132 +179,153 @@ yyk : array [1..yynmarks] of Integer = (
   { 8: }
   { 9: }
   { 10: }
-  26,
   27,
+  28,
   { 11: }
   8,
-  27,
+  25,
+  28,
   { 12: }
   8,
-  27,
+  25,
+  28,
   { 13: }
   24,
-  27,
+  25,
+  28,
   { 14: }
   12,
-  27,
+  28,
   { 15: }
   24,
-  27,
+  25,
+  28,
   { 16: }
   22,
-  27,
+  28,
   { 17: }
   24,
-  27,
+  25,
+  28,
   { 18: }
   23,
-  27,
+  28,
   { 19: }
   24,
-  27,
+  25,
+  28,
   { 20: }
   25,
+  28,
   { 21: }
   26,
-  27,
   { 22: }
-  25,
   27,
+  28,
   { 23: }
-  27,
+  26,
+  28,
   { 24: }
-  2,
+  28,
   { 25: }
-  3,
+  2,
   { 26: }
-  5,
+  3,
   { 27: }
   5,
   { 28: }
-  7,
+  5,
   { 29: }
-  14,
-  18,
+  7,
   { 30: }
+  14,
   18,
   { 31: }
-  17,
-  { 32: }
   18,
+  { 32: }
+  17,
   { 33: }
-  15,
   18,
   { 34: }
-  1,
+  15,
+  18,
   { 35: }
-  4,
+  1,
   { 36: }
-  8,
+  4,
   { 37: }
   8,
+  25,
   { 38: }
+  8,
+  25,
   { 39: }
+  25,
   { 40: }
-  11,
+  25,
   { 41: }
-  24,
+  25,
   { 42: }
+  11,
   { 43: }
+  24,
+  25,
   { 44: }
   { 45: }
-  24,
   { 46: }
-  24,
   { 47: }
-  6,
+  24,
+  25,
   { 48: }
-  13,
+  24,
+  25,
   { 49: }
-  16,
+  6,
   { 50: }
-  9,
+  13,
   { 51: }
-  10,
+  16,
   { 52: }
+  9,
+  25,
   { 53: }
-  24,
+  10,
+  25,
   { 54: }
-  23,
-  24,
   { 55: }
-  9,
   { 56: }
-  10,
   { 57: }
+  24,
+  25,
   { 58: }
+  23,
+  24,
+  25,
   { 59: }
+  9,
+  25,
   { 60: }
-  24,
+  10,
+  25,
   { 61: }
   { 62: }
-  22,
-  24,
   { 63: }
   { 64: }
+  24,
+  25,
   { 65: }
   { 66: }
   { 67: }
   { 68: }
+  22,
+  24,
+  25,
   { 69: }
   { 70: }
   { 71: }
   { 72: }
-  20,
   { 73: }
-  21,
   { 74: }
-  19
   { 75: }
   { 76: }
   { 77: }
@@ -318,13 +343,20 @@ yyk : array [1..yynmarks] of Integer = (
   { 89: }
   { 90: }
   { 91: }
+  20,
   { 92: }
+  21,
   { 93: }
+  { 94: }
+  { 95: }
+  19
 );
 
 yym : array [1..yynmatches] of Integer = (
 { 0: }
+  25,
 { 1: }
+  25,
 { 2: }
 { 3: }
 { 4: }
@@ -334,132 +366,153 @@ yym : array [1..yynmatches] of Integer = (
 { 8: }
 { 9: }
 { 10: }
-  26,
   27,
+  28,
 { 11: }
   8,
-  27,
+  25,
+  28,
 { 12: }
   8,
-  27,
+  25,
+  28,
 { 13: }
   24,
-  27,
+  25,
+  28,
 { 14: }
   12,
-  27,
+  28,
 { 15: }
   24,
-  27,
+  25,
+  28,
 { 16: }
   22,
-  27,
+  28,
 { 17: }
   24,
-  27,
+  25,
+  28,
 { 18: }
   23,
-  27,
+  28,
 { 19: }
   24,
-  27,
+  25,
+  28,
 { 20: }
   25,
+  28,
 { 21: }
   26,
-  27,
 { 22: }
-  25,
   27,
+  28,
 { 23: }
-  27,
+  26,
+  28,
 { 24: }
-  2,
+  28,
 { 25: }
-  3,
+  2,
 { 26: }
-  5,
+  3,
 { 27: }
   5,
 { 28: }
-  7,
+  5,
 { 29: }
-  14,
-  18,
+  7,
 { 30: }
+  14,
   18,
 { 31: }
-  17,
-{ 32: }
   18,
+{ 32: }
+  17,
 { 33: }
-  15,
   18,
 { 34: }
-  1,
+  15,
+  18,
 { 35: }
-  4,
+  1,
 { 36: }
-  8,
+  4,
 { 37: }
   8,
+  25,
 { 38: }
+  8,
+  25,
 { 39: }
+  25,
 { 40: }
-  11,
+  25,
 { 41: }
-  24,
+  25,
 { 42: }
+  11,
 { 43: }
+  24,
+  25,
 { 44: }
 { 45: }
-  24,
 { 46: }
-  24,
 { 47: }
-  6,
+  24,
+  25,
 { 48: }
-  13,
+  24,
+  25,
 { 49: }
-  16,
+  6,
 { 50: }
-  9,
+  13,
 { 51: }
-  10,
+  16,
 { 52: }
+  9,
+  25,
 { 53: }
-  24,
+  10,
+  25,
 { 54: }
-  23,
-  24,
 { 55: }
-  9,
 { 56: }
-  10,
 { 57: }
+  24,
+  25,
 { 58: }
+  23,
+  24,
+  25,
 { 59: }
+  9,
+  25,
 { 60: }
-  24,
+  10,
+  25,
 { 61: }
 { 62: }
-  22,
-  24,
 { 63: }
 { 64: }
+  24,
+  25,
 { 65: }
 { 66: }
 { 67: }
 { 68: }
+  22,
+  24,
+  25,
 { 69: }
 { 70: }
 { 71: }
 { 72: }
-  20,
 { 73: }
-  21,
 { 74: }
-  19
 { 75: }
 { 76: }
 { 77: }
@@ -477,18 +530,24 @@ yym : array [1..yynmatches] of Integer = (
 { 89: }
 { 90: }
 { 91: }
+  20,
 { 92: }
+  21,
 { 93: }
+{ 94: }
+{ 95: }
+  19
 );
 
 yyt : array [1..yyntrans] of YYTrec = (
 { 0: }
   ( cc: [ #1..#8,#11,#13..#31,'!','#','$','''','*','+',
-            '-','.',':'..'@','['..']','`',#127..#255 ]; s: 23),
-  ( cc: [ #9,#12,' ' ]; s: 22),
-  ( cc: [ #10 ]; s: 20),
+            '-',';'..'@','[',']','`',#127..#255 ]; s: 24),
+  ( cc: [ #9,#12,' ' ]; s: 23),
+  ( cc: [ #10 ]; s: 21),
   ( cc: [ '"' ]; s: 14),
-  ( cc: [ '%','&','(',')',',','^','|','~' ]; s: 21),
+  ( cc: [ '%','&','(',')',',','^','|','~' ]; s: 22),
+  ( cc: [ '.',':','\' ]; s: 20),
   ( cc: [ '/' ]; s: 10),
   ( cc: [ '0' ]; s: 12),
   ( cc: [ '1'..'9' ]; s: 11),
@@ -500,11 +559,12 @@ yyt : array [1..yyntrans] of YYTrec = (
   ( cc: [ '}' ]; s: 18),
 { 1: }
   ( cc: [ #1..#8,#11,#13..#31,'!','#','$','''','*','+',
-            '-','.',':'..'@','['..']','`',#127..#255 ]; s: 23),
-  ( cc: [ #9,#12,' ' ]; s: 22),
-  ( cc: [ #10 ]; s: 20),
+            '-',';'..'@','[',']','`',#127..#255 ]; s: 24),
+  ( cc: [ #9,#12,' ' ]; s: 23),
+  ( cc: [ #10 ]; s: 21),
   ( cc: [ '"' ]; s: 14),
-  ( cc: [ '%','&','(',')',',','^','|','~' ]; s: 21),
+  ( cc: [ '%','&','(',')',',','^','|','~' ]; s: 22),
+  ( cc: [ '.',':','\' ]; s: 20),
   ( cc: [ '/' ]; s: 10),
   ( cc: [ '0' ]; s: 12),
   ( cc: [ '1'..'9' ]; s: 11),
@@ -515,68 +575,76 @@ yyt : array [1..yyntrans] of YYTrec = (
   ( cc: [ '{' ]; s: 16),
   ( cc: [ '}' ]; s: 18),
 { 2: }
-  ( cc: [ #1..#9,#11..#255 ]; s: 25),
-  ( cc: [ #10 ]; s: 24),
+  ( cc: [ #1..#9,#11..#255 ]; s: 26),
+  ( cc: [ #10 ]; s: 25),
 { 3: }
-  ( cc: [ #1..#9,#11..#255 ]; s: 25),
-  ( cc: [ #10 ]; s: 24),
+  ( cc: [ #1..#9,#11..#255 ]; s: 26),
+  ( cc: [ #10 ]; s: 25),
 { 4: }
-  ( cc: [ #0 ]; s: 28),
-  ( cc: [ #1..#9,#11..')','+'..#255 ]; s: 26),
-  ( cc: [ '*' ]; s: 27),
+  ( cc: [ #0 ]; s: 29),
+  ( cc: [ #1..#9,#11..')','+'..#255 ]; s: 27),
+  ( cc: [ '*' ]; s: 28),
 { 5: }
-  ( cc: [ #0 ]; s: 28),
-  ( cc: [ #1..#9,#11..')','+'..#255 ]; s: 26),
-  ( cc: [ '*' ]; s: 27),
+  ( cc: [ #0 ]; s: 29),
+  ( cc: [ #1..#9,#11..')','+'..#255 ]; s: 27),
+  ( cc: [ '*' ]; s: 28),
 { 6: }
-  ( cc: [ #1..#9,#11..'!','#'..'[',']'..#255 ]; s: 32),
-  ( cc: [ #10 ]; s: 31),
-  ( cc: [ '"' ]; s: 29),
-  ( cc: [ '\' ]; s: 30),
+  ( cc: [ #1..#9,#11..'!','#'..'[',']'..#255 ]; s: 33),
+  ( cc: [ #10 ]; s: 32),
+  ( cc: [ '"' ]; s: 30),
+  ( cc: [ '\' ]; s: 31),
 { 7: }
-  ( cc: [ #1..#9,#11..'!','#'..'[',']'..#255 ]; s: 32),
-  ( cc: [ #10 ]; s: 31),
-  ( cc: [ '"' ]; s: 29),
-  ( cc: [ '\' ]; s: 30),
+  ( cc: [ #1..#9,#11..'!','#'..'[',']'..#255 ]; s: 33),
+  ( cc: [ #10 ]; s: 32),
+  ( cc: [ '"' ]; s: 30),
+  ( cc: [ '\' ]; s: 31),
 { 8: }
-  ( cc: [ #1..#9,#11..'!','#'..'[',']'..#255 ]; s: 32),
-  ( cc: [ #10 ]; s: 31),
-  ( cc: [ '"' ]; s: 33),
-  ( cc: [ '\' ]; s: 30),
+  ( cc: [ #1..#9,#11..'!','#'..'[',']'..#255 ]; s: 33),
+  ( cc: [ #10 ]; s: 32),
+  ( cc: [ '"' ]; s: 34),
+  ( cc: [ '\' ]; s: 31),
 { 9: }
-  ( cc: [ #1..#9,#11..'!','#'..'[',']'..#255 ]; s: 32),
-  ( cc: [ #10 ]; s: 31),
-  ( cc: [ '"' ]; s: 33),
-  ( cc: [ '\' ]; s: 30),
+  ( cc: [ #1..#9,#11..'!','#'..'[',']'..#255 ]; s: 33),
+  ( cc: [ #10 ]; s: 32),
+  ( cc: [ '"' ]; s: 34),
+  ( cc: [ '\' ]; s: 31),
 { 10: }
-  ( cc: [ '*' ]; s: 35),
-  ( cc: [ '/' ]; s: 34),
+  ( cc: [ '*' ]; s: 36),
+  ( cc: [ '/' ]; s: 35),
 { 11: }
-  ( cc: [ '0'..'9' ]; s: 36),
-  ( cc: [ 'L' ]; s: 37),
+  ( cc: [ '.',':','A'..'K','M'..'Z','\','_','a'..'z' ]; s: 39),
+  ( cc: [ '0'..'9' ]; s: 37),
+  ( cc: [ 'L' ]; s: 38),
 { 12: }
-  ( cc: [ '0'..'9' ]; s: 36),
-  ( cc: [ 'L' ]; s: 37),
-  ( cc: [ 'o' ]; s: 39),
-  ( cc: [ 'x' ]; s: 38),
+  ( cc: [ '.',':','A'..'K','M'..'Z','\','_','a'..'n',
+            'p'..'w','y','z' ]; s: 39),
+  ( cc: [ '0'..'9' ]; s: 37),
+  ( cc: [ 'L' ]; s: 38),
+  ( cc: [ 'o' ]; s: 41),
+  ( cc: [ 'x' ]; s: 40),
 { 13: }
-  ( cc: [ '"' ]; s: 40),
-  ( cc: [ '0'..'9','A'..'Z','_','a'..'z' ]; s: 41),
+  ( cc: [ '"' ]; s: 42),
+  ( cc: [ '.',':','\' ]; s: 39),
+  ( cc: [ '0'..'9','A'..'Z','_','a'..'z' ]; s: 43),
 { 14: }
-  ( cc: [ 'S' ]; s: 42),
-  ( cc: [ 'T' ]; s: 44),
-  ( cc: [ 'V' ]; s: 43),
+  ( cc: [ 'S' ]; s: 44),
+  ( cc: [ 'T' ]; s: 46),
+  ( cc: [ 'V' ]; s: 45),
 { 15: }
-  ( cc: [ '0'..'9','A'..'D','F'..'Z','_','a'..'z' ]; s: 41),
-  ( cc: [ 'E' ]; s: 45),
+  ( cc: [ '.',':','\' ]; s: 39),
+  ( cc: [ '0'..'9','A'..'D','F'..'Z','_','a'..'z' ]; s: 43),
+  ( cc: [ 'E' ]; s: 47),
 { 16: }
 { 17: }
-  ( cc: [ '0'..'9','A'..'M','O'..'Z','_','a'..'z' ]; s: 41),
-  ( cc: [ 'N' ]; s: 46),
+  ( cc: [ '.',':','\' ]; s: 39),
+  ( cc: [ '0'..'9','A'..'M','O'..'Z','_','a'..'z' ]; s: 43),
+  ( cc: [ 'N' ]; s: 48),
 { 18: }
 { 19: }
-  ( cc: [ '0'..'9','A'..'Z','_','a'..'z' ]; s: 41),
+  ( cc: [ '.',':','\' ]; s: 39),
+  ( cc: [ '0'..'9','A'..'Z','_','a'..'z' ]; s: 43),
 { 20: }
+  ( cc: [ '.','0'..':','A'..'Z','\','_','a'..'z' ]; s: 39),
 { 21: }
 { 22: }
 { 23: }
@@ -584,713 +652,743 @@ yyt : array [1..yyntrans] of YYTrec = (
 { 25: }
 { 26: }
 { 27: }
-  ( cc: [ '/' ]; s: 47),
 { 28: }
+  ( cc: [ '/' ]; s: 49),
 { 29: }
-  ( cc: [ '"' ]; s: 48),
 { 30: }
-  ( cc: [ #10 ]; s: 49),
+  ( cc: [ '"' ]; s: 50),
 { 31: }
+  ( cc: [ #10 ]; s: 51),
 { 32: }
 { 33: }
-  ( cc: [ '"' ]; s: 48),
 { 34: }
+  ( cc: [ '"' ]; s: 50),
 { 35: }
 { 36: }
-  ( cc: [ '0'..'9' ]; s: 36),
-  ( cc: [ 'L' ]; s: 37),
 { 37: }
+  ( cc: [ '.',':','A'..'K','M'..'Z','\','_','a'..'z' ]; s: 39),
+  ( cc: [ '0'..'9' ]; s: 37),
+  ( cc: [ 'L' ]; s: 38),
 { 38: }
-  ( cc: [ '0'..'9','A'..'F','a'..'f' ]; s: 50),
+  ( cc: [ '.','0'..':','A'..'Z','\','_','a'..'z' ]; s: 39),
 { 39: }
-  ( cc: [ '0'..'7' ]; s: 51),
+  ( cc: [ '.','0'..':','A'..'Z','\','_','a'..'z' ]; s: 39),
 { 40: }
+  ( cc: [ '.',':','G'..'Z','\','_','g'..'z' ]; s: 39),
+  ( cc: [ '0'..'9','A'..'F','a'..'f' ]; s: 52),
 { 41: }
-  ( cc: [ '0'..'9','A'..'Z','_','a'..'z' ]; s: 41),
+  ( cc: [ '.','8'..':','A'..'Z','\','_','a'..'z' ]; s: 39),
+  ( cc: [ '0'..'7' ]; s: 53),
 { 42: }
-  ( cc: [ 't' ]; s: 52),
 { 43: }
-  ( cc: [ 'a' ]; s: 77),
+  ( cc: [ '.',':','\' ]; s: 39),
+  ( cc: [ '0'..'9','A'..'Z','_','a'..'z' ]; s: 43),
 { 44: }
-  ( cc: [ 'r' ]; s: 76),
+  ( cc: [ 't' ]; s: 54),
 { 45: }
-  ( cc: [ '0'..'9','A'..'F','H'..'Z','_','a'..'z' ]; s: 41),
-  ( cc: [ 'G' ]; s: 53),
+  ( cc: [ 'a' ]; s: 55),
 { 46: }
-  ( cc: [ '0'..'9','A'..'C','E'..'Z','_','a'..'z' ]; s: 41),
-  ( cc: [ 'D' ]; s: 54),
+  ( cc: [ 'r' ]; s: 56),
 { 47: }
+  ( cc: [ '.',':','\' ]; s: 39),
+  ( cc: [ '0'..'9','A'..'F','H'..'Z','_','a'..'z' ]; s: 43),
+  ( cc: [ 'G' ]; s: 57),
 { 48: }
+  ( cc: [ '.',':','\' ]; s: 39),
+  ( cc: [ '0'..'9','A'..'C','E'..'Z','_','a'..'z' ]; s: 43),
+  ( cc: [ 'D' ]; s: 58),
 { 49: }
 { 50: }
-  ( cc: [ '0'..'9','A'..'F','a'..'f' ]; s: 50),
-  ( cc: [ 'L' ]; s: 55),
 { 51: }
-  ( cc: [ '0'..'7' ]; s: 51),
-  ( cc: [ 'L' ]; s: 56),
 { 52: }
-  ( cc: [ 'r' ]; s: 57),
+  ( cc: [ '.',':','G'..'K','M'..'Z','\','_','g'..'z' ]; s: 39),
+  ( cc: [ '0'..'9','A'..'F','a'..'f' ]; s: 52),
+  ( cc: [ 'L' ]; s: 59),
 { 53: }
-  ( cc: [ '0'..'9','A'..'H','J'..'Z','_','a'..'z' ]; s: 41),
-  ( cc: [ 'I' ]; s: 60),
+  ( cc: [ '.','8'..':','A'..'K','M'..'Z','\','_','a'..'z' ]; s: 39),
+  ( cc: [ '0'..'7' ]; s: 53),
+  ( cc: [ 'L' ]; s: 60),
 { 54: }
-  ( cc: [ '0'..'9','A'..'Z','_','a'..'z' ]; s: 41),
+  ( cc: [ 'r' ]; s: 61),
 { 55: }
+  ( cc: [ 'r' ]; s: 62),
 { 56: }
+  ( cc: [ 'a' ]; s: 63),
 { 57: }
-  ( cc: [ 'i' ]; s: 79),
+  ( cc: [ '.',':','\' ]; s: 39),
+  ( cc: [ '0'..'9','A'..'H','J'..'Z','_','a'..'z' ]; s: 43),
+  ( cc: [ 'I' ]; s: 64),
 { 58: }
-  ( cc: [ 'F' ]; s: 78),
+  ( cc: [ '.',':','\' ]; s: 39),
+  ( cc: [ '0'..'9','A'..'Z','_','a'..'z' ]; s: 43),
 { 59: }
-  ( cc: [ 'n' ]; s: 61),
+  ( cc: [ '.','0'..':','A'..'Z','\','_','a'..'z' ]; s: 39),
 { 60: }
-  ( cc: [ '0'..'9','A'..'M','O'..'Z','_','a'..'z' ]; s: 41),
-  ( cc: [ 'N' ]; s: 62),
+  ( cc: [ '.','0'..':','A'..'Z','\','_','a'..'z' ]; s: 39),
 { 61: }
-  ( cc: [ 's' ]; s: 80),
+  ( cc: [ 'i' ]; s: 65),
 { 62: }
-  ( cc: [ '0'..'9','A'..'Z','_','a'..'z' ]; s: 41),
+  ( cc: [ 'F' ]; s: 66),
 { 63: }
-  ( cc: [ 'g' ]; s: 93),
+  ( cc: [ 'n' ]; s: 67),
 { 64: }
-  ( cc: [ 'l' ]; s: 65),
+  ( cc: [ '.',':','\' ]; s: 39),
+  ( cc: [ '0'..'9','A'..'M','O'..'Z','_','a'..'z' ]; s: 43),
+  ( cc: [ 'N' ]; s: 68),
 { 65: }
-  ( cc: [ 'e' ]; s: 67),
+  ( cc: [ 'n' ]; s: 69),
 { 66: }
-  ( cc: [ 'a' ]; s: 75),
+  ( cc: [ 'i' ]; s: 70),
 { 67: }
-  ( cc: [ 'I' ]; s: 83),
+  ( cc: [ 's' ]; s: 71),
 { 68: }
-  ( cc: [ 'f' ]; s: 70),
+  ( cc: [ '.',':','\' ]; s: 39),
+  ( cc: [ '0'..'9','A'..'Z','_','a'..'z' ]; s: 43),
 { 69: }
-  ( cc: [ 'o' ]; s: 85),
+  ( cc: [ 'g' ]; s: 72),
 { 70: }
-  ( cc: [ 'o' ]; s: 71),
+  ( cc: [ 'l' ]; s: 73),
 { 71: }
-  ( cc: [ '"' ]; s: 72),
+  ( cc: [ 'l' ]; s: 74),
 { 72: }
+  ( cc: [ 'F' ]; s: 75),
 { 73: }
+  ( cc: [ 'e' ]; s: 76),
 { 74: }
+  ( cc: [ 'a' ]; s: 77),
 { 75: }
-  ( cc: [ 't' ]; s: 82),
+  ( cc: [ 'i' ]; s: 78),
 { 76: }
-  ( cc: [ 'a' ]; s: 59),
+  ( cc: [ 'I' ]; s: 79),
 { 77: }
-  ( cc: [ 'r' ]; s: 58),
+  ( cc: [ 't' ]; s: 80),
 { 78: }
-  ( cc: [ 'i' ]; s: 64),
+  ( cc: [ 'l' ]; s: 81),
 { 79: }
-  ( cc: [ 'n' ]; s: 63),
+  ( cc: [ 'n' ]; s: 82),
 { 80: }
-  ( cc: [ 'l' ]; s: 66),
+  ( cc: [ 'i' ]; s: 83),
 { 81: }
-  ( cc: [ '"' ]; s: 73),
+  ( cc: [ 'e' ]; s: 84),
 { 82: }
-  ( cc: [ 'i' ]; s: 69),
+  ( cc: [ 'f' ]; s: 85),
 { 83: }
-  ( cc: [ 'n' ]; s: 68),
+  ( cc: [ 'o' ]; s: 86),
 { 84: }
-  ( cc: [ '"' ]; s: 74),
+  ( cc: [ 'I' ]; s: 87),
 { 85: }
-  ( cc: [ 'n' ]; s: 81),
+  ( cc: [ 'o' ]; s: 88),
 { 86: }
-  ( cc: [ 'o' ]; s: 84),
+  ( cc: [ 'n' ]; s: 89),
 { 87: }
-  ( cc: [ 'f' ]; s: 86),
+  ( cc: [ 'n' ]; s: 90),
 { 88: }
-  ( cc: [ 'n' ]; s: 87),
+  ( cc: [ '"' ]; s: 91),
 { 89: }
-  ( cc: [ 'I' ]; s: 88),
+  ( cc: [ '"' ]; s: 92),
 { 90: }
-  ( cc: [ 'e' ]; s: 89),
+  ( cc: [ 'f' ]; s: 93),
 { 91: }
-  ( cc: [ 'l' ]; s: 90),
 { 92: }
-  ( cc: [ 'i' ]; s: 91),
 { 93: }
-  ( cc: [ 'F' ]; s: 92)
+  ( cc: [ 'o' ]; s: 94),
+{ 94: }
+  ( cc: [ '"' ]; s: 95)
+{ 95: }
 );
 
 yykl : array [0..yynstates-1] of Integer = (
 { 0: } 1,
-{ 1: } 1,
-{ 2: } 1,
-{ 3: } 1,
-{ 4: } 1,
-{ 5: } 1,
-{ 6: } 1,
-{ 7: } 1,
-{ 8: } 1,
-{ 9: } 1,
-{ 10: } 1,
-{ 11: } 3,
-{ 12: } 5,
-{ 13: } 7,
-{ 14: } 9,
-{ 15: } 11,
-{ 16: } 13,
-{ 17: } 15,
-{ 18: } 17,
-{ 19: } 19,
-{ 20: } 21,
-{ 21: } 22,
-{ 22: } 24,
-{ 23: } 26,
-{ 24: } 27,
-{ 25: } 28,
-{ 26: } 29,
-{ 27: } 30,
-{ 28: } 31,
-{ 29: } 32,
-{ 30: } 34,
-{ 31: } 35,
-{ 32: } 36,
-{ 33: } 37,
-{ 34: } 39,
-{ 35: } 40,
-{ 36: } 41,
-{ 37: } 42,
-{ 38: } 43,
-{ 39: } 43,
-{ 40: } 43,
-{ 41: } 44,
-{ 42: } 45,
-{ 43: } 45,
-{ 44: } 45,
-{ 45: } 45,
-{ 46: } 46,
-{ 47: } 47,
-{ 48: } 48,
-{ 49: } 49,
-{ 50: } 50,
-{ 51: } 51,
-{ 52: } 52,
-{ 53: } 52,
-{ 54: } 53,
-{ 55: } 55,
-{ 56: } 56,
-{ 57: } 57,
-{ 58: } 57,
-{ 59: } 57,
-{ 60: } 57,
-{ 61: } 58,
-{ 62: } 58,
-{ 63: } 60,
-{ 64: } 60,
-{ 65: } 60,
-{ 66: } 60,
-{ 67: } 60,
-{ 68: } 60,
-{ 69: } 60,
-{ 70: } 60,
-{ 71: } 60,
-{ 72: } 60,
-{ 73: } 61,
-{ 74: } 62,
-{ 75: } 63,
-{ 76: } 63,
-{ 77: } 63,
-{ 78: } 63,
-{ 79: } 63,
-{ 80: } 63,
-{ 81: } 63,
-{ 82: } 63,
-{ 83: } 63,
-{ 84: } 63,
-{ 85: } 63,
-{ 86: } 63,
-{ 87: } 63,
-{ 88: } 63,
-{ 89: } 63,
-{ 90: } 63,
-{ 91: } 63,
-{ 92: } 63,
-{ 93: } 63
+{ 1: } 2,
+{ 2: } 3,
+{ 3: } 3,
+{ 4: } 3,
+{ 5: } 3,
+{ 6: } 3,
+{ 7: } 3,
+{ 8: } 3,
+{ 9: } 3,
+{ 10: } 3,
+{ 11: } 5,
+{ 12: } 8,
+{ 13: } 11,
+{ 14: } 14,
+{ 15: } 16,
+{ 16: } 19,
+{ 17: } 21,
+{ 18: } 24,
+{ 19: } 26,
+{ 20: } 29,
+{ 21: } 31,
+{ 22: } 32,
+{ 23: } 34,
+{ 24: } 36,
+{ 25: } 37,
+{ 26: } 38,
+{ 27: } 39,
+{ 28: } 40,
+{ 29: } 41,
+{ 30: } 42,
+{ 31: } 44,
+{ 32: } 45,
+{ 33: } 46,
+{ 34: } 47,
+{ 35: } 49,
+{ 36: } 50,
+{ 37: } 51,
+{ 38: } 53,
+{ 39: } 55,
+{ 40: } 56,
+{ 41: } 57,
+{ 42: } 58,
+{ 43: } 59,
+{ 44: } 61,
+{ 45: } 61,
+{ 46: } 61,
+{ 47: } 61,
+{ 48: } 63,
+{ 49: } 65,
+{ 50: } 66,
+{ 51: } 67,
+{ 52: } 68,
+{ 53: } 70,
+{ 54: } 72,
+{ 55: } 72,
+{ 56: } 72,
+{ 57: } 72,
+{ 58: } 74,
+{ 59: } 77,
+{ 60: } 79,
+{ 61: } 81,
+{ 62: } 81,
+{ 63: } 81,
+{ 64: } 81,
+{ 65: } 83,
+{ 66: } 83,
+{ 67: } 83,
+{ 68: } 83,
+{ 69: } 86,
+{ 70: } 86,
+{ 71: } 86,
+{ 72: } 86,
+{ 73: } 86,
+{ 74: } 86,
+{ 75: } 86,
+{ 76: } 86,
+{ 77: } 86,
+{ 78: } 86,
+{ 79: } 86,
+{ 80: } 86,
+{ 81: } 86,
+{ 82: } 86,
+{ 83: } 86,
+{ 84: } 86,
+{ 85: } 86,
+{ 86: } 86,
+{ 87: } 86,
+{ 88: } 86,
+{ 89: } 86,
+{ 90: } 86,
+{ 91: } 86,
+{ 92: } 87,
+{ 93: } 88,
+{ 94: } 88,
+{ 95: } 88
 );
 
 yykh : array [0..yynstates-1] of Integer = (
-{ 0: } 0,
-{ 1: } 0,
-{ 2: } 0,
-{ 3: } 0,
-{ 4: } 0,
-{ 5: } 0,
-{ 6: } 0,
-{ 7: } 0,
-{ 8: } 0,
-{ 9: } 0,
-{ 10: } 2,
-{ 11: } 4,
-{ 12: } 6,
-{ 13: } 8,
-{ 14: } 10,
-{ 15: } 12,
-{ 16: } 14,
-{ 17: } 16,
-{ 18: } 18,
-{ 19: } 20,
-{ 20: } 21,
-{ 21: } 23,
-{ 22: } 25,
-{ 23: } 26,
-{ 24: } 27,
-{ 25: } 28,
-{ 26: } 29,
-{ 27: } 30,
-{ 28: } 31,
-{ 29: } 33,
-{ 30: } 34,
-{ 31: } 35,
-{ 32: } 36,
-{ 33: } 38,
-{ 34: } 39,
-{ 35: } 40,
-{ 36: } 41,
-{ 37: } 42,
-{ 38: } 42,
-{ 39: } 42,
-{ 40: } 43,
-{ 41: } 44,
-{ 42: } 44,
-{ 43: } 44,
-{ 44: } 44,
-{ 45: } 45,
-{ 46: } 46,
-{ 47: } 47,
-{ 48: } 48,
-{ 49: } 49,
-{ 50: } 50,
-{ 51: } 51,
-{ 52: } 51,
-{ 53: } 52,
-{ 54: } 54,
-{ 55: } 55,
-{ 56: } 56,
-{ 57: } 56,
-{ 58: } 56,
-{ 59: } 56,
-{ 60: } 57,
-{ 61: } 57,
-{ 62: } 59,
-{ 63: } 59,
-{ 64: } 59,
-{ 65: } 59,
-{ 66: } 59,
-{ 67: } 59,
-{ 68: } 59,
-{ 69: } 59,
-{ 70: } 59,
-{ 71: } 59,
-{ 72: } 60,
-{ 73: } 61,
-{ 74: } 62,
-{ 75: } 62,
-{ 76: } 62,
-{ 77: } 62,
-{ 78: } 62,
-{ 79: } 62,
-{ 80: } 62,
-{ 81: } 62,
-{ 82: } 62,
-{ 83: } 62,
-{ 84: } 62,
-{ 85: } 62,
-{ 86: } 62,
-{ 87: } 62,
-{ 88: } 62,
-{ 89: } 62,
-{ 90: } 62,
-{ 91: } 62,
-{ 92: } 62,
-{ 93: } 62
+{ 0: } 1,
+{ 1: } 2,
+{ 2: } 2,
+{ 3: } 2,
+{ 4: } 2,
+{ 5: } 2,
+{ 6: } 2,
+{ 7: } 2,
+{ 8: } 2,
+{ 9: } 2,
+{ 10: } 4,
+{ 11: } 7,
+{ 12: } 10,
+{ 13: } 13,
+{ 14: } 15,
+{ 15: } 18,
+{ 16: } 20,
+{ 17: } 23,
+{ 18: } 25,
+{ 19: } 28,
+{ 20: } 30,
+{ 21: } 31,
+{ 22: } 33,
+{ 23: } 35,
+{ 24: } 36,
+{ 25: } 37,
+{ 26: } 38,
+{ 27: } 39,
+{ 28: } 40,
+{ 29: } 41,
+{ 30: } 43,
+{ 31: } 44,
+{ 32: } 45,
+{ 33: } 46,
+{ 34: } 48,
+{ 35: } 49,
+{ 36: } 50,
+{ 37: } 52,
+{ 38: } 54,
+{ 39: } 55,
+{ 40: } 56,
+{ 41: } 57,
+{ 42: } 58,
+{ 43: } 60,
+{ 44: } 60,
+{ 45: } 60,
+{ 46: } 60,
+{ 47: } 62,
+{ 48: } 64,
+{ 49: } 65,
+{ 50: } 66,
+{ 51: } 67,
+{ 52: } 69,
+{ 53: } 71,
+{ 54: } 71,
+{ 55: } 71,
+{ 56: } 71,
+{ 57: } 73,
+{ 58: } 76,
+{ 59: } 78,
+{ 60: } 80,
+{ 61: } 80,
+{ 62: } 80,
+{ 63: } 80,
+{ 64: } 82,
+{ 65: } 82,
+{ 66: } 82,
+{ 67: } 82,
+{ 68: } 85,
+{ 69: } 85,
+{ 70: } 85,
+{ 71: } 85,
+{ 72: } 85,
+{ 73: } 85,
+{ 74: } 85,
+{ 75: } 85,
+{ 76: } 85,
+{ 77: } 85,
+{ 78: } 85,
+{ 79: } 85,
+{ 80: } 85,
+{ 81: } 85,
+{ 82: } 85,
+{ 83: } 85,
+{ 84: } 85,
+{ 85: } 85,
+{ 86: } 85,
+{ 87: } 85,
+{ 88: } 85,
+{ 89: } 85,
+{ 90: } 85,
+{ 91: } 86,
+{ 92: } 87,
+{ 93: } 87,
+{ 94: } 87,
+{ 95: } 88
 );
 
 yyml : array [0..yynstates-1] of Integer = (
 { 0: } 1,
-{ 1: } 1,
-{ 2: } 1,
-{ 3: } 1,
-{ 4: } 1,
-{ 5: } 1,
-{ 6: } 1,
-{ 7: } 1,
-{ 8: } 1,
-{ 9: } 1,
-{ 10: } 1,
-{ 11: } 3,
-{ 12: } 5,
-{ 13: } 7,
-{ 14: } 9,
-{ 15: } 11,
-{ 16: } 13,
-{ 17: } 15,
-{ 18: } 17,
-{ 19: } 19,
-{ 20: } 21,
-{ 21: } 22,
-{ 22: } 24,
-{ 23: } 26,
-{ 24: } 27,
-{ 25: } 28,
-{ 26: } 29,
-{ 27: } 30,
-{ 28: } 31,
-{ 29: } 32,
-{ 30: } 34,
-{ 31: } 35,
-{ 32: } 36,
-{ 33: } 37,
-{ 34: } 39,
-{ 35: } 40,
-{ 36: } 41,
-{ 37: } 42,
-{ 38: } 43,
-{ 39: } 43,
-{ 40: } 43,
-{ 41: } 44,
-{ 42: } 45,
-{ 43: } 45,
-{ 44: } 45,
-{ 45: } 45,
-{ 46: } 46,
-{ 47: } 47,
-{ 48: } 48,
-{ 49: } 49,
-{ 50: } 50,
-{ 51: } 51,
-{ 52: } 52,
-{ 53: } 52,
-{ 54: } 53,
-{ 55: } 55,
-{ 56: } 56,
-{ 57: } 57,
-{ 58: } 57,
-{ 59: } 57,
-{ 60: } 57,
-{ 61: } 58,
-{ 62: } 58,
-{ 63: } 60,
-{ 64: } 60,
-{ 65: } 60,
-{ 66: } 60,
-{ 67: } 60,
-{ 68: } 60,
-{ 69: } 60,
-{ 70: } 60,
-{ 71: } 60,
-{ 72: } 60,
-{ 73: } 61,
-{ 74: } 62,
-{ 75: } 63,
-{ 76: } 63,
-{ 77: } 63,
-{ 78: } 63,
-{ 79: } 63,
-{ 80: } 63,
-{ 81: } 63,
-{ 82: } 63,
-{ 83: } 63,
-{ 84: } 63,
-{ 85: } 63,
-{ 86: } 63,
-{ 87: } 63,
-{ 88: } 63,
-{ 89: } 63,
-{ 90: } 63,
-{ 91: } 63,
-{ 92: } 63,
-{ 93: } 63
+{ 1: } 2,
+{ 2: } 3,
+{ 3: } 3,
+{ 4: } 3,
+{ 5: } 3,
+{ 6: } 3,
+{ 7: } 3,
+{ 8: } 3,
+{ 9: } 3,
+{ 10: } 3,
+{ 11: } 5,
+{ 12: } 8,
+{ 13: } 11,
+{ 14: } 14,
+{ 15: } 16,
+{ 16: } 19,
+{ 17: } 21,
+{ 18: } 24,
+{ 19: } 26,
+{ 20: } 29,
+{ 21: } 31,
+{ 22: } 32,
+{ 23: } 34,
+{ 24: } 36,
+{ 25: } 37,
+{ 26: } 38,
+{ 27: } 39,
+{ 28: } 40,
+{ 29: } 41,
+{ 30: } 42,
+{ 31: } 44,
+{ 32: } 45,
+{ 33: } 46,
+{ 34: } 47,
+{ 35: } 49,
+{ 36: } 50,
+{ 37: } 51,
+{ 38: } 53,
+{ 39: } 55,
+{ 40: } 56,
+{ 41: } 57,
+{ 42: } 58,
+{ 43: } 59,
+{ 44: } 61,
+{ 45: } 61,
+{ 46: } 61,
+{ 47: } 61,
+{ 48: } 63,
+{ 49: } 65,
+{ 50: } 66,
+{ 51: } 67,
+{ 52: } 68,
+{ 53: } 70,
+{ 54: } 72,
+{ 55: } 72,
+{ 56: } 72,
+{ 57: } 72,
+{ 58: } 74,
+{ 59: } 77,
+{ 60: } 79,
+{ 61: } 81,
+{ 62: } 81,
+{ 63: } 81,
+{ 64: } 81,
+{ 65: } 83,
+{ 66: } 83,
+{ 67: } 83,
+{ 68: } 83,
+{ 69: } 86,
+{ 70: } 86,
+{ 71: } 86,
+{ 72: } 86,
+{ 73: } 86,
+{ 74: } 86,
+{ 75: } 86,
+{ 76: } 86,
+{ 77: } 86,
+{ 78: } 86,
+{ 79: } 86,
+{ 80: } 86,
+{ 81: } 86,
+{ 82: } 86,
+{ 83: } 86,
+{ 84: } 86,
+{ 85: } 86,
+{ 86: } 86,
+{ 87: } 86,
+{ 88: } 86,
+{ 89: } 86,
+{ 90: } 86,
+{ 91: } 86,
+{ 92: } 87,
+{ 93: } 88,
+{ 94: } 88,
+{ 95: } 88
 );
 
 yymh : array [0..yynstates-1] of Integer = (
-{ 0: } 0,
-{ 1: } 0,
-{ 2: } 0,
-{ 3: } 0,
-{ 4: } 0,
-{ 5: } 0,
-{ 6: } 0,
-{ 7: } 0,
-{ 8: } 0,
-{ 9: } 0,
-{ 10: } 2,
-{ 11: } 4,
-{ 12: } 6,
-{ 13: } 8,
-{ 14: } 10,
-{ 15: } 12,
-{ 16: } 14,
-{ 17: } 16,
-{ 18: } 18,
-{ 19: } 20,
-{ 20: } 21,
-{ 21: } 23,
-{ 22: } 25,
-{ 23: } 26,
-{ 24: } 27,
-{ 25: } 28,
-{ 26: } 29,
-{ 27: } 30,
-{ 28: } 31,
-{ 29: } 33,
-{ 30: } 34,
-{ 31: } 35,
-{ 32: } 36,
-{ 33: } 38,
-{ 34: } 39,
-{ 35: } 40,
-{ 36: } 41,
-{ 37: } 42,
-{ 38: } 42,
-{ 39: } 42,
-{ 40: } 43,
-{ 41: } 44,
-{ 42: } 44,
-{ 43: } 44,
-{ 44: } 44,
-{ 45: } 45,
-{ 46: } 46,
-{ 47: } 47,
-{ 48: } 48,
-{ 49: } 49,
-{ 50: } 50,
-{ 51: } 51,
-{ 52: } 51,
-{ 53: } 52,
-{ 54: } 54,
-{ 55: } 55,
-{ 56: } 56,
-{ 57: } 56,
-{ 58: } 56,
-{ 59: } 56,
-{ 60: } 57,
-{ 61: } 57,
-{ 62: } 59,
-{ 63: } 59,
-{ 64: } 59,
-{ 65: } 59,
-{ 66: } 59,
-{ 67: } 59,
-{ 68: } 59,
-{ 69: } 59,
-{ 70: } 59,
-{ 71: } 59,
-{ 72: } 60,
-{ 73: } 61,
-{ 74: } 62,
-{ 75: } 62,
-{ 76: } 62,
-{ 77: } 62,
-{ 78: } 62,
-{ 79: } 62,
-{ 80: } 62,
-{ 81: } 62,
-{ 82: } 62,
-{ 83: } 62,
-{ 84: } 62,
-{ 85: } 62,
-{ 86: } 62,
-{ 87: } 62,
-{ 88: } 62,
-{ 89: } 62,
-{ 90: } 62,
-{ 91: } 62,
-{ 92: } 62,
-{ 93: } 62
+{ 0: } 1,
+{ 1: } 2,
+{ 2: } 2,
+{ 3: } 2,
+{ 4: } 2,
+{ 5: } 2,
+{ 6: } 2,
+{ 7: } 2,
+{ 8: } 2,
+{ 9: } 2,
+{ 10: } 4,
+{ 11: } 7,
+{ 12: } 10,
+{ 13: } 13,
+{ 14: } 15,
+{ 15: } 18,
+{ 16: } 20,
+{ 17: } 23,
+{ 18: } 25,
+{ 19: } 28,
+{ 20: } 30,
+{ 21: } 31,
+{ 22: } 33,
+{ 23: } 35,
+{ 24: } 36,
+{ 25: } 37,
+{ 26: } 38,
+{ 27: } 39,
+{ 28: } 40,
+{ 29: } 41,
+{ 30: } 43,
+{ 31: } 44,
+{ 32: } 45,
+{ 33: } 46,
+{ 34: } 48,
+{ 35: } 49,
+{ 36: } 50,
+{ 37: } 52,
+{ 38: } 54,
+{ 39: } 55,
+{ 40: } 56,
+{ 41: } 57,
+{ 42: } 58,
+{ 43: } 60,
+{ 44: } 60,
+{ 45: } 60,
+{ 46: } 60,
+{ 47: } 62,
+{ 48: } 64,
+{ 49: } 65,
+{ 50: } 66,
+{ 51: } 67,
+{ 52: } 69,
+{ 53: } 71,
+{ 54: } 71,
+{ 55: } 71,
+{ 56: } 71,
+{ 57: } 73,
+{ 58: } 76,
+{ 59: } 78,
+{ 60: } 80,
+{ 61: } 80,
+{ 62: } 80,
+{ 63: } 80,
+{ 64: } 82,
+{ 65: } 82,
+{ 66: } 82,
+{ 67: } 82,
+{ 68: } 85,
+{ 69: } 85,
+{ 70: } 85,
+{ 71: } 85,
+{ 72: } 85,
+{ 73: } 85,
+{ 74: } 85,
+{ 75: } 85,
+{ 76: } 85,
+{ 77: } 85,
+{ 78: } 85,
+{ 79: } 85,
+{ 80: } 85,
+{ 81: } 85,
+{ 82: } 85,
+{ 83: } 85,
+{ 84: } 85,
+{ 85: } 85,
+{ 86: } 85,
+{ 87: } 85,
+{ 88: } 85,
+{ 89: } 85,
+{ 90: } 85,
+{ 91: } 86,
+{ 92: } 87,
+{ 93: } 87,
+{ 94: } 87,
+{ 95: } 88
 );
 
 yytl : array [0..yynstates-1] of Integer = (
 { 0: } 1,
-{ 1: } 15,
-{ 2: } 29,
-{ 3: } 31,
-{ 4: } 33,
-{ 5: } 36,
-{ 6: } 39,
-{ 7: } 43,
-{ 8: } 47,
-{ 9: } 51,
-{ 10: } 55,
-{ 11: } 57,
-{ 12: } 59,
-{ 13: } 63,
-{ 14: } 65,
-{ 15: } 68,
-{ 16: } 70,
-{ 17: } 70,
-{ 18: } 72,
-{ 19: } 72,
-{ 20: } 73,
-{ 21: } 73,
-{ 22: } 73,
-{ 23: } 73,
-{ 24: } 73,
-{ 25: } 73,
-{ 26: } 73,
-{ 27: } 73,
-{ 28: } 74,
-{ 29: } 74,
-{ 30: } 75,
-{ 31: } 76,
-{ 32: } 76,
-{ 33: } 76,
-{ 34: } 77,
-{ 35: } 77,
-{ 36: } 77,
-{ 37: } 79,
-{ 38: } 79,
-{ 39: } 80,
-{ 40: } 81,
-{ 41: } 81,
-{ 42: } 82,
-{ 43: } 83,
-{ 44: } 84,
-{ 45: } 85,
-{ 46: } 87,
-{ 47: } 89,
-{ 48: } 89,
-{ 49: } 89,
-{ 50: } 89,
-{ 51: } 91,
-{ 52: } 93,
-{ 53: } 94,
-{ 54: } 96,
-{ 55: } 97,
-{ 56: } 97,
-{ 57: } 97,
-{ 58: } 98,
-{ 59: } 99,
-{ 60: } 100,
-{ 61: } 102,
-{ 62: } 103,
-{ 63: } 104,
-{ 64: } 105,
-{ 65: } 106,
-{ 66: } 107,
-{ 67: } 108,
-{ 68: } 109,
-{ 69: } 110,
-{ 70: } 111,
-{ 71: } 112,
-{ 72: } 113,
-{ 73: } 113,
-{ 74: } 113,
-{ 75: } 113,
-{ 76: } 114,
-{ 77: } 115,
-{ 78: } 116,
-{ 79: } 117,
-{ 80: } 118,
-{ 81: } 119,
-{ 82: } 120,
-{ 83: } 121,
-{ 84: } 122,
-{ 85: } 123,
-{ 86: } 124,
-{ 87: } 125,
-{ 88: } 126,
-{ 89: } 127,
-{ 90: } 128,
-{ 91: } 129,
-{ 92: } 130,
-{ 93: } 131
-);
-
-yyth : array [0..yynstates-1] of Integer = (
-{ 0: } 14,
-{ 1: } 28,
-{ 2: } 30,
-{ 3: } 32,
+{ 1: } 16,
+{ 2: } 31,
+{ 3: } 33,
 { 4: } 35,
 { 5: } 38,
-{ 6: } 42,
-{ 7: } 46,
-{ 8: } 50,
-{ 9: } 54,
-{ 10: } 56,
-{ 11: } 58,
+{ 6: } 41,
+{ 7: } 45,
+{ 8: } 49,
+{ 9: } 53,
+{ 10: } 57,
+{ 11: } 59,
 { 12: } 62,
-{ 13: } 64,
-{ 14: } 67,
-{ 15: } 69,
-{ 16: } 69,
-{ 17: } 71,
-{ 18: } 71,
-{ 19: } 72,
-{ 20: } 72,
-{ 21: } 72,
-{ 22: } 72,
-{ 23: } 72,
-{ 24: } 72,
-{ 25: } 72,
-{ 26: } 72,
-{ 27: } 73,
-{ 28: } 73,
-{ 29: } 74,
-{ 30: } 75,
-{ 31: } 75,
-{ 32: } 75,
-{ 33: } 76,
-{ 34: } 76,
-{ 35: } 76,
-{ 36: } 78,
-{ 37: } 78,
-{ 38: } 79,
-{ 39: } 80,
-{ 40: } 80,
-{ 41: } 81,
-{ 42: } 82,
-{ 43: } 83,
-{ 44: } 84,
-{ 45: } 86,
-{ 46: } 88,
-{ 47: } 88,
-{ 48: } 88,
-{ 49: } 88,
-{ 50: } 90,
-{ 51: } 92,
-{ 52: } 93,
-{ 53: } 95,
-{ 54: } 96,
-{ 55: } 96,
-{ 56: } 96,
-{ 57: } 97,
-{ 58: } 98,
-{ 59: } 99,
-{ 60: } 101,
-{ 61: } 102,
-{ 62: } 103,
-{ 63: } 104,
-{ 64: } 105,
-{ 65: } 106,
-{ 66: } 107,
-{ 67: } 108,
-{ 68: } 109,
-{ 69: } 110,
-{ 70: } 111,
-{ 71: } 112,
-{ 72: } 112,
-{ 73: } 112,
-{ 74: } 112,
-{ 75: } 113,
-{ 76: } 114,
-{ 77: } 115,
-{ 78: } 116,
-{ 79: } 117,
-{ 80: } 118,
-{ 81: } 119,
-{ 82: } 120,
-{ 83: } 121,
-{ 84: } 122,
-{ 85: } 123,
-{ 86: } 124,
-{ 87: } 125,
-{ 88: } 126,
-{ 89: } 127,
-{ 90: } 128,
-{ 91: } 129,
-{ 92: } 130,
-{ 93: } 131
+{ 13: } 67,
+{ 14: } 70,
+{ 15: } 73,
+{ 16: } 76,
+{ 17: } 76,
+{ 18: } 79,
+{ 19: } 79,
+{ 20: } 81,
+{ 21: } 82,
+{ 22: } 82,
+{ 23: } 82,
+{ 24: } 82,
+{ 25: } 82,
+{ 26: } 82,
+{ 27: } 82,
+{ 28: } 82,
+{ 29: } 83,
+{ 30: } 83,
+{ 31: } 84,
+{ 32: } 85,
+{ 33: } 85,
+{ 34: } 85,
+{ 35: } 86,
+{ 36: } 86,
+{ 37: } 86,
+{ 38: } 89,
+{ 39: } 90,
+{ 40: } 91,
+{ 41: } 93,
+{ 42: } 95,
+{ 43: } 95,
+{ 44: } 97,
+{ 45: } 98,
+{ 46: } 99,
+{ 47: } 100,
+{ 48: } 103,
+{ 49: } 106,
+{ 50: } 106,
+{ 51: } 106,
+{ 52: } 106,
+{ 53: } 109,
+{ 54: } 112,
+{ 55: } 113,
+{ 56: } 114,
+{ 57: } 115,
+{ 58: } 118,
+{ 59: } 120,
+{ 60: } 121,
+{ 61: } 122,
+{ 62: } 123,
+{ 63: } 124,
+{ 64: } 125,
+{ 65: } 128,
+{ 66: } 129,
+{ 67: } 130,
+{ 68: } 131,
+{ 69: } 133,
+{ 70: } 134,
+{ 71: } 135,
+{ 72: } 136,
+{ 73: } 137,
+{ 74: } 138,
+{ 75: } 139,
+{ 76: } 140,
+{ 77: } 141,
+{ 78: } 142,
+{ 79: } 143,
+{ 80: } 144,
+{ 81: } 145,
+{ 82: } 146,
+{ 83: } 147,
+{ 84: } 148,
+{ 85: } 149,
+{ 86: } 150,
+{ 87: } 151,
+{ 88: } 152,
+{ 89: } 153,
+{ 90: } 154,
+{ 91: } 155,
+{ 92: } 155,
+{ 93: } 155,
+{ 94: } 156,
+{ 95: } 157
+);
+
+yyth : array [0..yynstates-1] of Integer = (
+{ 0: } 15,
+{ 1: } 30,
+{ 2: } 32,
+{ 3: } 34,
+{ 4: } 37,
+{ 5: } 40,
+{ 6: } 44,
+{ 7: } 48,
+{ 8: } 52,
+{ 9: } 56,
+{ 10: } 58,
+{ 11: } 61,
+{ 12: } 66,
+{ 13: } 69,
+{ 14: } 72,
+{ 15: } 75,
+{ 16: } 75,
+{ 17: } 78,
+{ 18: } 78,
+{ 19: } 80,
+{ 20: } 81,
+{ 21: } 81,
+{ 22: } 81,
+{ 23: } 81,
+{ 24: } 81,
+{ 25: } 81,
+{ 26: } 81,
+{ 27: } 81,
+{ 28: } 82,
+{ 29: } 82,
+{ 30: } 83,
+{ 31: } 84,
+{ 32: } 84,
+{ 33: } 84,
+{ 34: } 85,
+{ 35: } 85,
+{ 36: } 85,
+{ 37: } 88,
+{ 38: } 89,
+{ 39: } 90,
+{ 40: } 92,
+{ 41: } 94,
+{ 42: } 94,
+{ 43: } 96,
+{ 44: } 97,
+{ 45: } 98,
+{ 46: } 99,
+{ 47: } 102,
+{ 48: } 105,
+{ 49: } 105,
+{ 50: } 105,
+{ 51: } 105,
+{ 52: } 108,
+{ 53: } 111,
+{ 54: } 112,
+{ 55: } 113,
+{ 56: } 114,
+{ 57: } 117,
+{ 58: } 119,
+{ 59: } 120,
+{ 60: } 121,
+{ 61: } 122,
+{ 62: } 123,
+{ 63: } 124,
+{ 64: } 127,
+{ 65: } 128,
+{ 66: } 129,
+{ 67: } 130,
+{ 68: } 132,
+{ 69: } 133,
+{ 70: } 134,
+{ 71: } 135,
+{ 72: } 136,
+{ 73: } 137,
+{ 74: } 138,
+{ 75: } 139,
+{ 76: } 140,
+{ 77: } 141,
+{ 78: } 142,
+{ 79: } 143,
+{ 80: } 144,
+{ 81: } 145,
+{ 82: } 146,
+{ 83: } 147,
+{ 84: } 148,
+{ 85: } 149,
+{ 86: } 150,
+{ 87: } 151,
+{ 88: } 152,
+{ 89: } 153,
+{ 90: } 154,
+{ 91: } 154,
+{ 92: } 154,
+{ 93: } 155,
+{ 94: } 156,
+{ 95: } 156
 );
 
 

packages/fcl-res/src/rclex.l

@@ -63,6 +63,7 @@ O [0-7]
 D [0-9]
 H [0-9a-fA-F]
 IDENT [a-zA-Z_]([a-zA-Z0-9_])*
+NSWPSTR ([a-zA-Z0-9_\:\.\\])*
 
 %%
 
@@ -108,6 +109,7 @@ END|}                   return(_END);
                             else
                               return(_ID);
                          end;
+{NSWPSTR}         return(_NSWPSTR);
 [ \t\n\f]               ;
 [,()|^&+-*/%~]          returnc(yytext[1]);
 .                       return(_ILLEGAL);

packages/fcl-res/src/rcparser.y

@@ -12,7 +12,7 @@ unit rcparser;
 %token _ILLEGAL
 %token _NUMBER _QUOTEDSTR _QUOTEDSTRL
 %token _STR_StringFileInfo _STR_VarFileInfo _STR_Translation
-%token _BEGIN _END _ID
+%token _BEGIN _END _ID _NSWPSTR
 %token _LANGUAGE _CHARACTERISTICS _VERSION _MOVEABLE _FIXED _PURE _IMPURE _PRELOAD _LOADONCALL _DISCARDABLE
 %token _BITMAP _CURSOR _ICON _STRINGTABLE _VERSIONINFO
 %token _ANICURSOR _ANIICON _DLGINCLUDE _DLGINIT _HTML _MANIFEST _MESSAGETABLE _PLUGPLAY _RCDATA _VXD
@@ -20,7 +20,7 @@ unit rcparser;
 %token _ACCELERATORS _DIALOG _DIALOGEX _MENU _MENUEX
 
 %type <rcnumtype> numpos numexpr numeral
-%type <rcstrtype> ident_string long_string
+%type <rcstrtype> ident_string long_string non_whitespace_string long_stringfn
 %type <TResourceDesc> resid rcdataid
 %type <TMemoryStream> raw_data raw_item
 %type <TFileStream> filename_string
@@ -188,8 +188,21 @@ ident_string
     | long_string
     ;
 
+non_whitespace_string
+    : _NSWPSTR                                     { string_new($$, yytext, opt_code_page); }
+    ;
+
 filename_string
-    : long_string                                  { $$:= TFileStream.Create($1.v^, fmOpenRead or fmShareDenyWrite); }
+    : long_stringfn                                { $$:= TFileStream.Create($1.v^, fmOpenRead or fmShareDenyWrite); }
+    | non_whitespace_string                        { $$:= TFileStream.Create($1.v^, fmOpenRead or fmShareDenyWrite); }
+    ;
+
+long_stringfn
+    : _QUOTEDSTR                                   { string_new_uni($$, @strbuf[0], strbuflen, opt_code_page, false); }
+    | _QUOTEDSTRL                                  { string_new_uni($$, @strbuf[0], strbuflen, CP_UTF16, false); }
+    | _STR_StringFileInfo                          { string_new($$, yytext, opt_code_page); }
+    | _STR_VarFileInfo                             { string_new($$, yytext, opt_code_page); }
+    | _STR_Translation                             { string_new($$, yytext, opt_code_page); }
     ;
 
 long_string

packages/hash/src/sha1.pp

@@ -15,10 +15,10 @@
 
 // Normally, if an optimized version is available for OS/CPU, that will be used
 // Define to use existing unoptimized implementation
-{ the assembler implementation does not work on darwin }
-{$ifdef darwin}
+{ the i386 assembler implementation does not work on platforms with a fixed stack }
+{$if DEFINED(CPU386) and (defined(darwin) or defined(linux))}
 {$DEFINE SHA1PASCAL}
-{$endif darwin}
+{$endif}
 
 unit sha1;
 {$mode objfpc}{$h+}

packages/pastojs/src/fppas2js.pp

@@ -6198,7 +6198,8 @@ begin
   cInterfaceToString:=cTypeConversion+1;
 
   {$IFDEF FPC_HAS_CPSTRING}
-  ExprEvaluator.DefaultStringCodePage:=CP_UTF8;
+  ExprEvaluator.DefaultSourceCodePage:=CP_UTF8;
+  ExprEvaluator.DefaultStringCodePage:=CP_UTF16;
   {$ENDIF}
   FExternalNames:=TPasResHashList.Create;
   StoreSrcColumns:=true;
@@ -6517,6 +6518,7 @@ function TPas2JSResolver.ExtractPasStringLiteral(El: TPasElement;
     #decimal
     #$hex
     ^l  l is a letter a-z
+    Note that invalid UTF-8 sequences are checked by the scanner
 }
 var
   p, StartP, i, l: integer;
@@ -6544,7 +6546,7 @@ begin
         '''':
           begin
           if p>StartP then
-            Result:=Result+StrToJSString(copy(S,StartP,p-StartP));
+            Result:=Result+StrToJSString(copy(S,StartP,p-StartP)); // todo error on invalid UTF-8 sequence
           inc(p);
           StartP:=p;
           if (p>l) or (S[p]<>'''') then
@@ -6558,10 +6560,11 @@ begin
         end;
       until false;
       if p>StartP then
-        Result:=Result+StrToJSString(copy(S,StartP,p-StartP));
+        Result:=Result+StrToJSString(copy(S,StartP,p-StartP)); // todo error on invalid UTF-8 sequence
       end;
     '#':
       begin
+      // word sequence
       inc(p);
       if p>l then
         RaiseInternalError(20170207155121);
@@ -6586,7 +6589,6 @@ begin
           end;
         if p=StartP then
           RaiseInternalError(20170207164956);
-        Result:=Result+CodePointToJSString(i);
         end
       else
         begin
@@ -6606,8 +6608,8 @@ begin
           end;
         if p=StartP then
           RaiseInternalError(20170207171148);
-        Result:=Result+CodePointToJSString(i);
         end;
+      Result:=Result+CodePointToJSString(i);
       end;
     '^':
       begin

packages/pastojs/src/pas2jsfilecache.pp

@@ -1697,6 +1697,7 @@ var
   {$IFDEF FPC}
   i: Integer;
   l: TMaxPrecInt;
+  FS: TFileStream;
   {$ENDIF}
 begin
   if Assigned(OnWriteFile) then
@@ -1726,7 +1727,12 @@ begin
     end;
     {$ELSE}
     try
-      ms.SaveToFile(Filename);
+      FS:=TFileStream.Create (FileName,fmCreate or fmShareDenyNone);
+      Try
+        ms.SaveToStream(FS);
+      finally
+        FS.free;
+      end;
     except
       on E: Exception do begin
         i:=GetLastOSError;

packages/pastojs/tests/tcmodules.pas

@@ -282,6 +282,7 @@ type
     Procedure TestChar_Compare;
     Procedure TestChar_BuiltInProcs;
     Procedure TestStringConst;
+    Procedure TestStringConst_InvalidUTF16;
     Procedure TestStringConstSurrogate;
     Procedure TestString_Length;
     Procedure TestString_Compare;
@@ -889,6 +890,7 @@ type
     Procedure TestAsync_ProcTypeAsyncModMismatchFail;
     Procedure TestAsync_Inherited;
     Procedure TestAsync_ClassInterface;
+    Procedure TestAsync_ClassInterface_AsyncMissmatchFail;
   end;
 
 function LinesToStr(Args: array of const): string;
@@ -983,6 +985,28 @@ var
     end;
   end;
 
+  function HasSpecialChar(s: string): boolean;
+  var
+    i: Integer;
+  begin
+    for i:=1 to length(s) do
+      if s[i] in [#0..#31,#127..#255] then
+        exit(true);
+    Result:=false;
+  end;
+
+  function HashSpecialChars(s: string): string;
+  var
+    i: Integer;
+  begin
+    Result:='';
+    for i:=1 to length(s) do
+      if s[i] in [#0..#31,#127..#255] then
+        Result:=Result+'#'+hexstr(ord(s[i]),2)
+      else
+        Result:=Result+s[i];
+  end;
+
   procedure DiffFound;
   var
     ActLineStartP, ActLineEndP, p, StartPos: PChar;
@@ -1011,8 +1035,12 @@ var
         ActLineEndP:=FindLineEnd(ActualP);
         ActLine:=copy(Actual,ActLineStartP-PChar(Actual)+1,ActLineEndP-ActLineStartP);
         writeln('- ',ActLine);
+        if HasSpecialChar(ActLine) then
+          writeln('- ',HashSpecialChars(ActLine));
         // write expected line
         writeln('+ ',ExpLine);
+        if HasSpecialChar(ExpLine) then
+          writeln('- ',HashSpecialChars(ExpLine));
         // write empty line with pointer ^
         for i:=1 to 2+ExpectedP-StartPos do write(' ');
         writeln('^');
@@ -7467,6 +7495,7 @@ begin
   '  c:=#$DFFF;', // invalid UTF-16
   '  c:=#$FFFF;', // last UCS-2
   '  c:=high(c);', // last UCS-2
+  '  c:=#269;',
   '']);
   ConvertProgram;
   CheckSource('TestCharConst',
@@ -7497,6 +7526,7 @@ begin
     '$mod.c="\uDFFF";',
     '$mod.c="\uFFFF";',
     '$mod.c="\uFFFF";',
+    '$mod.c = "č";',
     '']));
 end;
 
@@ -7607,9 +7637,16 @@ begin
   '  s:=''"''''"'';',
   '  s:=#$20AC;', // euro
   '  s:=#$10437;', // outside BMP
+  '  s:=''abc''#$20AC;', // ascii,#
+  '  s:=''ä''#$20AC;', // non ascii,#
+  '  s:=#$20AC''abc'';', // #, ascii
+  '  s:=#$20AC''ä'';', // #, non ascii
   '  s:=default(string);',
   '  s:=concat(s);',
-  '  s:=concat(s,''a'',s)',
+  '  s:=concat(s,''a'',s);',
+  '  s:=#250#269;',
+  //'  s:=#$2F804;',
+  // ToDo: \uD87E\uDC04 -> \u{2F804}
   '']);
   ConvertProgram;
   CheckSource('TestStringConst',
@@ -7631,9 +7668,47 @@ begin
     '$mod.s=''"\''"'';',
     '$mod.s="€";',
     '$mod.s="'#$F0#$90#$90#$B7'";',
+    '$mod.s = "abc€";',
+    '$mod.s = "ä€";',
+    '$mod.s = "€abc";',
+    '$mod.s = "ۊ";',
     '$mod.s="";',
     '$mod.s = $mod.s;',
     '$mod.s = $mod.s.concat("a", $mod.s);',
+    '$mod.s = "úč";',
+    '']));
+end;
+
+procedure TTestModule.TestStringConst_InvalidUTF16;
+begin
+  StartProgram(false);
+  Add([
+  'const',
+  '  a: char = #$D87E;',
+  '  b: string = #$D87E;',
+  '  c: string = #$D87E#43;',
+  'begin',
+  '  c:=''abc''#$D87E;',
+  '  c:=#0#1#2;',
+  '  c:=#127;',
+  '  c:=#128;',
+  '  c:=#255;',
+  '  c:=#256;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestStringConst',
+    LinesToStr([
+    'this.a = "\uD87E";',
+    'this.b = "\uD87E";',
+    'this.c = "\uD87E+";',
+    '']),
+    LinesToStr([
+    '$mod.c = "abc\uD87E";',
+    '$mod.c = "\x00\x01\x02";',
+    '$mod.c = "'#127'";',
+    '$mod.c = "'#$c2#$80'";',
+    '$mod.c = "'#$c3#$BF'";',
+    '$mod.c = "'#$c4#$80'";',
     '']));
 end;
 
@@ -32868,8 +32943,18 @@ begin
   '    function _AddRef: longint;',
   '    function _Release: longint;',
   '  end;',
+  'function Say(i: IUnknown): IUnknown; async;',
+  'begin',
+  'end;',
   'function Run: IUnknown; async;',
   'begin',
+  '  Result:=await(Run);',
+  '  Result:=await(Run());',
+  '  Result:=await(Run) as IUnknown;',
+  '  Result:=await(Say(nil));',
+  '  Result:=await(Say(await(Run())));',
+  '  Result:=await(Say(await(Run()) as IUnknown));',
+  '  Result:=await(Say(await(Run()) as IUnknown)) as IUnknown;',
   'end;',
   'procedure Fly;',
   'var p: TJSPromise;',
@@ -32885,8 +32970,25 @@ begin
   CheckSource('TestAsync_ClassInterface',
     LinesToStr([ // statements
     'rtl.createInterface(this, "IUnknown", "{D7ADB0E1-758A-322B-BDDF-21CD521DDFA9}", ["_AddRef", "_Release"], null);',
+    'this.Say = async function (i) {',
+    '  var Result = null;',
+    '  return Result;',
+    '};',
     'this.Run = async function () {',
     '  var Result = null;',
+    '  var $ok = false;',
+    '  try {',
+    '    Result = rtl.setIntfL(Result, await $mod.Run());',
+    '    Result = rtl.setIntfL(Result, await $mod.Run());',
+    '    Result = rtl.setIntfL(Result, rtl.intfAsIntfT(await $mod.Run(), $mod.IUnknown));',
+    '    Result = rtl.setIntfL(Result, await $mod.Say(null));',
+    '    Result = rtl.setIntfL(Result, await $mod.Say(await $mod.Run()));',
+    '    Result = rtl.setIntfL(Result, await $mod.Say(rtl.intfAsIntfT(await $mod.Run(), $mod.IUnknown)));',
+    '    Result = rtl.setIntfL(Result, rtl.intfAsIntfT(await $mod.Say(rtl.intfAsIntfT(await $mod.Run(), $mod.IUnknown)), $mod.IUnknown));',
+    '    $ok = true;',
+    '  } finally {',
+    '    if (!$ok) rtl._Release(Result);',
+    '  };',
     '  return Result;',
     '};',
     'this.Fly = function () {',
@@ -32902,6 +33004,29 @@ begin
   CheckResolverUnexpectedHints();
 end;
 
+procedure TTestModule.TestAsync_ClassInterface_AsyncMissmatchFail;
+begin
+  StartProgram(true,[supTInterfacedObject]);
+  Add([
+  '{$mode objfpc}',
+  '{$modeswitch externalclass}',
+  'type',
+  '  TJSPromise = class external name ''Promise''',
+  '  end;',
+  '  IBird = interface',
+  '    procedure Run;',
+  '  end;',
+  '  TBird = class(TInterfacedObject,IBird)',
+  '    procedure Run; async;',
+  '  end;',
+  'procedure TBird.Run;',
+  'begin',
+  'end;',
+  'begin',
+  '  ']);
+  SetExpectedPasResolverError('procedure type modifier "async" mismatch',nXModifierMismatchY);
+  ConvertProgram;
+end;
 
 Initialization
   RegisterTests([TTestModule]);

rtl/darwin/aarch64/sighnd.inc

@@ -32,8 +32,6 @@ begin
           Else
             Res:=207; {coprocessor error}
         end;
-        { clear "exception happened" flags }
-        SigContext^.uc_mcontext^.__fs.__fpsr:=SigContext^.uc_mcontext^.__fs.__fpsr and not(fpu_exception_mask shr fpu_exception_mask_to_status_mask_shift);
       end;
     SIGBUS:
         res:=214;
@@ -45,6 +43,8 @@ begin
     SIGQUIT:
         res:=233;
   end;
+  { right now, macOS generates SIGILL signals for fpu exceptions, so always clear the fpu exceptions }
+  SigContext^.uc_mcontext^.__fs.__fpsr:=SigContext^.uc_mcontext^.__fs.__fpsr and not(fpu_exception_mask shr fpu_exception_mask_to_status_mask_shift);
   {$ifdef FPC_USE_SIGPROCMASK}
    reenable_signal(sig);
   {$endif }

rtl/freertos/xtensa/esp8266.pp

@@ -81,7 +81,11 @@ unit esp8266;
       begin
         ReadChar := true;
         ACh := #0;
-        uart_rx_one_char(@ACh);  // check failure?
+        repeat
+          uart_rx_one_char(@ACh);  // check failure?
+          if ACh = #0 then
+            vTaskDelay(1);
+        until ACh <> #0;
       end;
 
 begin

rtl/i386/cpu.pp

@@ -14,6 +14,7 @@
 
  **********************************************************************}
 {$mode objfpc}
+{$goto on}
 unit cpu;
 
   interface
@@ -41,6 +42,7 @@ unit cpu;
     function MOVBESupport: boolean;inline;
     function F16CSupport: boolean;inline;
     function RDRANDSupport: boolean;inline;
+    function RTMSupport: boolean;inline;
 
     var
       is_sse3_cpu : boolean = false;
@@ -60,14 +62,33 @@ unit cpu;
       _SSE42Support,
       _MOVBESupport,
       _F16CSupport,
-      _RDRANDSupport: boolean;
+      _RDRANDSupport,
+      _RTMSupport: boolean;
 
+{$ASMMODE ATT}
 
     function InterlockedCompareExchange128(var Target: Int128Rec; NewValue: Int128Rec; Comperand: Int128Rec): Int128Rec;
       begin
-        RunError(217);
+{$ifndef FPC_PIC}      
+        if _RTMSupport then
+          begin
+            asm
+            .Lretry:
+              xbegin .Lretry
+            end;
+            Result:=Target;
+            if (Result.Lo=Comperand.Lo) and (Result.Hi=Comperand.Hi) then
+              Target:=NewValue;
+            asm
+              xend
+            end;
+          end
+        else
+{$endif FPC_PIC}        
+          RunError(217);
       end;
 
+{$ASMMODE INTEL}
 
     function cpuid_support : boolean;assembler;
       {
@@ -163,14 +184,16 @@ unit cpu;
                  popl %ebx
               end;
               _AVX2Support:=_AVXSupport and ((_ebx and $20)<>0);
+              _RTMSupport:=((_ebx and $800)<>0);
            end;
       end;
 
 
     function InterlockedCompareExchange128Support : boolean;
       begin
-        { 32 Bit CPUs have no 128 Bit interlocked exchange support }
-        result:=false;
+        { 32 Bit CPUs have no 128 Bit interlocked exchange support,
+          but it can simulated using RTM }
+        result:=_RTMSupport;
       end;
 
 
@@ -234,6 +257,12 @@ unit cpu;
       end;
 
 
+    function RTMSupport: boolean;inline;
+      begin
+        result:=_RTMSupport;
+      end;
+
+
 begin
   SetupSupport;
 end.

rtl/inc/currh.inc

@@ -14,16 +14,16 @@
 
 
 {$ifdef FPC_CURRENCY_IS_INT64}
-    function trunc(c : currency) : int64;
+    function trunc(c : currency) : int64; {$ifdef systeminline} inline; {$endif}
 {$ifndef FPUNONE}
     function round(c : currency) : int64;
 {$endif FPUNONE}
 {$ifndef cpujvm}
-    function trunc(c : comp) : int64;
-    function round(c : comp) : int64;
+    function trunc(c : comp) : int64; {$ifdef systeminline} inline; {$endif}
+    function round(c : comp) : int64; {$ifdef systeminline} inline; {$endif}
 {$else not cpujvm}
-    function trunc_comp(c: comp) : int64;
-    function round_comp(c : comp) : int64;
+    function trunc_comp(c: comp) : int64; {$ifdef systeminline} inline; {$endif}
+    function round_comp(c : comp) : int64; {$ifdef systeminline} inline; {$endif}
 {$endif not cpujvm}
 {$endif FPC_CURRENCY_IS_INT64}
 

rtl/inc/gencurr.inc

@@ -14,16 +14,16 @@
 
 {$ifdef FPC_CURRENCY_IS_INT64}
 
-    function trunc(c : currency) : int64;
+    function trunc(c : currency) : int64; {$ifdef systeminline} inline; {$endif}
       begin
         { the type conversion includes dividing by 10000 }
         result := int64(c)
       end;
 
 {$ifndef cpujvm}
-    function trunc(c : comp) : int64;
+    function trunc(c : comp) : int64; {$ifdef systeminline} inline; {$endif}
 {$else not cpujvm}
-    function trunc_comp(c : comp) : int64;
+    function trunc_comp(c : comp) : int64; {$ifdef systeminline} inline; {$endif}
 {$endif cpujvm}
       begin
         result := c
@@ -34,27 +34,43 @@
       var
         rem, absrem: currency;
       begin
-        { (int64(tmyrec(c))(+/-)5000) div 10000 can overflow }
         result := int64(c);
         rem := c - currency(result);
-        absrem := rem;
-        if absrem < 0 then
-          absrem := -absrem;
-        if (absrem > 0.5) or
-           ((absrem = 0.5) and
-            (rem > 0)) then
-          if (rem > 0) then
-            inc(result)
-          else
-            dec(result);
+        case softfloat_rounding_mode of
+          rmNearest:
+            begin
+              absrem := abs(rem);
+              if (absrem > 0.5) or
+                 ((absrem = 0.5) and
+                  odd(result)) then
+                if (rem > 0) then
+                  inc(result)
+                else
+                  dec(result)
+            end;
+          rmDown:
+            begin
+              if rem < 0 then
+                dec(result);
+            end;
+          rmUp:
+            begin
+              if rem > 0 then
+                inc(result);
+            end;
+          rmTruncate:
+            begin
+              // result is already ok
+            end;
+        end;
       end;
 {$endif FPUNONE}
 
 
 {$ifndef cpujvm}
-    function round(c : comp) : int64;
+    function round(c : comp) : int64; {$ifdef systeminline} inline; {$endif}
 {$else not cpujvm}
-    function round_comp(c : comp) : int64;
+    function round_comp(c : comp) : int64; {$ifdef systeminline} inline; {$endif}
 {$endif cpujvm}
       begin
         result := c

rtl/inc/genmath.inc

@@ -1443,9 +1443,15 @@ end;
       if (hx < $00100000) then              { x < 2**-1022  }
       begin
         if (((hx and $7fffffff) or longint(lx))=0) then
-          exit(-two54/zero);                { log(+-0)=-inf }
+          begin
+            float_raise(float_flag_divbyzero);
+            exit(-two54/zero);                { log(+-0)=-inf }
+          end;
         if (hx<0) then
-          exit((d-d)/zero);                 { log(-#) = NaN }
+          begin
+            float_raise(float_flag_invalid);
+            exit((d-d)/zero);                 { log(-#) = NaN }
+          end;
         dec(k, 54); d := d * two54;         { subnormal number, scale up x }
         hx := float64high(d);
       end;

rtl/objpas/sysutils/dati.inc

@@ -352,7 +352,7 @@ end;
 
 Const
   DateTimeToStrFormat : Array[Boolean] of string = ('c','f');
-  
+
 function DateTimeToStr(DateTime: TDateTime; ForceTimeIfZero : Boolean = False): string;
 begin
   DateTimeToString(Result, DateTimeToStrFormat[ForceTimeIfZero], DateTime)
@@ -1089,8 +1089,8 @@ var
         end ;
         '/': StoreStr(@FormatSettings.DateSeparator, 1);
         ':': StoreStr(@FormatSettings.TimeSeparator, 1);
-	'[': if (fdoInterval in Options) then isInterval := true else StoreStr(FormatCurrent, 1);
-	']': if (fdoInterval in Options) then isInterval := false else StoreStr(FormatCurrent, 1);
+        '[': if (fdoInterval in Options) then isInterval := true else StoreStr(FormatCurrent, 1);
+        ']': if (fdoInterval in Options) then isInterval := false else StoreStr(FormatCurrent, 1);
         ' ', 'C', 'D', 'H', 'M', 'N', 'S', 'T', 'Y', 'Z', 'F' {$IFDEF MSWindows}, 'G', 'E'{$ENDIF MSWindows} :
         begin
           while (P < FormatEnd) and (UpCase(P^) = Token) do
@@ -1105,9 +1105,9 @@ var
                 StoreInt(Year mod 100, 2);
             end;
             'M': begin
-	      if isInterval and ((prevlasttoken = 'H') or TimeFlag) then
-	        StoreInt(Minute + (Hour + trunc(abs(DateTime))*24)*60, 0)
-	      else
+              if isInterval and ((prevlasttoken = 'H') or TimeFlag) then
+                StoreInt(Minute + (Hour + trunc(abs(DateTime))*24)*60, 0)
+              else
               if (lastformattoken = 'H') or TimeFlag then
               begin
                 if Count = 1 then
@@ -1137,11 +1137,11 @@ var
                 StoreFormat(FormatSettings.LongDateFormat, Nesting+1, False);
               end ;
             end ;
-            'H': 
-	      if isInterval then
-	        StoreInt(Hour + trunc(abs(DateTime))*24, 0)
-	      else
-	      if Clock12 then
+            'H':
+              if isInterval then
+                StoreInt(Hour + trunc(abs(DateTime))*24, 0)
+              else
+              if Clock12 then
               begin
                 tmp := hour mod 12;
                 if tmp=0 then tmp:=12;
@@ -1152,32 +1152,32 @@ var
               end
               else begin
                 if Count = 1 then
-		  StoreInt(Hour, 0)
+                  StoreInt(Hour, 0)
                 else
                   StoreInt(Hour, 2);
               end;
             'N': if isInterval then
-	           StoreInt(Minute + (Hour + trunc(abs(DateTime))*24)*60, 0)
-		 else
-		 if Count = 1 then
+                   StoreInt(Minute + (Hour + trunc(abs(DateTime))*24)*60, 0)
+                 else
+                 if Count = 1 then
                    StoreInt(Minute, 0)
                  else
                    StoreInt(Minute, 2);
             'S': if isInterval then
-	           StoreInt(Second + (Minute + (Hour + trunc(abs(DateTime))*24)*60)*60, 0)
-	         else 
-	         if Count = 1 then
+                   StoreInt(Second + (Minute + (Hour + trunc(abs(DateTime))*24)*60)*60, 0)
+                 else
+                 if Count = 1 then
                    StoreInt(Second, 0)
                  else
                    StoreInt(Second, 2);
             'Z': if Count = 1 then
                    StoreInt(MilliSecond, 0)
                  else
-		   StoreInt(MilliSecond, 3);
+                   StoreInt(MilliSecond, 3);
             'T': if Count = 1 then
-		   StoreFormat(FormatSettings.ShortTimeFormat, Nesting+1, True)
+                   StoreFormat(FormatSettings.ShortTimeFormat, Nesting+1, True)
                  else
-	           StoreFormat(FormatSettings.LongTimeFormat, Nesting+1, True);
+                   StoreFormat(FormatSettings.LongTimeFormat, Nesting+1, True);
             'C': begin
                    StoreFormat(FormatSettings.ShortDateFormat, Nesting+1, False);
                    if (Hour<>0) or (Minute<>0) or (Second<>0) then
@@ -1203,7 +1203,7 @@ var
                      Count := P - FormatCurrent;
                      StoreString(ConvertEraYearString(Count,Year,Month,Day));
                    end;
-		 prevlasttoken := lastformattoken;  
+                 prevlasttoken := lastformattoken;  
                  lastformattoken:=token;
                end;
              'G':
@@ -1217,12 +1217,12 @@ var
                      Count := P - FormatCurrent;
                      StoreString(ConvertEraString(Count,Year,Month,Day));
                    end;
-		 prevlasttoken := lastformattoken;
+                 prevlasttoken := lastformattoken;
                  lastformattoken:=token;
                end;
 {$endif win32 or win64}
           end;
-	  prevlasttoken := lastformattoken;
+          prevlasttoken := lastformattoken;
           lastformattoken := token;
         end;
         else

rtl/win/sysutils.pp

@@ -917,6 +917,12 @@ begin
 end;
 
 
+type
+  TGetTimeZoneInformationForYear = function(wYear: USHORT; lpDynamicTimeZoneInformation: PDynamicTimeZoneInformation;
+    var lpTimeZoneInformation: TTimeZoneInformation): BOOL;stdcall;
+var
+  GetTimeZoneInformationForYear:TGetTimeZoneInformationForYear=nil;
+
 function GetLocalTimeOffset(const DateTime: TDateTime; const InputIsUTC: Boolean; out Offset: Integer): Boolean;
 var
   Year: Integer;
@@ -961,10 +967,11 @@ var
   DSTStart, DSTEnd: TDateTime;
 
 begin
+  if not Assigned(GetTimeZoneInformationForYear) then
+    Exit(False);
   Year := YearOf(DateTime);
   TZInfo := Default(TTimeZoneInformation);
-  // GetTimeZoneInformationForYear is supported only on Vista and newer
-  if not ((Win32MajorVersion>=6) and GetTimeZoneInformationForYear(Year, nil, TZInfo)) then
+  if not GetTimeZoneInformationForYear(Year, nil, TZInfo) then
     Exit(False);
 
   if (TZInfo.StandardDate.Month>0) and (TZInfo.DaylightDate.Month>0) then
@@ -1590,6 +1597,9 @@ begin
      FindExInfoDefaults := FindExInfoStandard; // also searches SFNs. XP only.
   if (Win32MajorVersion>=6) and (Win32MinorVersion>=1) then 
     FindFirstAdditionalFlags := FIND_FIRST_EX_LARGE_FETCH; // win7 and 2008R2+
+  // GetTimeZoneInformationForYear is supported only on Vista and newer
+  if (kernel32dll<>0) and (Win32MajorVersion>=6) then
+    GetTimeZoneInformationForYear:=TGetTimeZoneInformationForYear(GetProcAddress(kernel32dll,'GetTimeZoneInformationForYear'));
 end;
 
 Function GetAppConfigDir(Global : Boolean) : String;

rtl/win/wininc/redef.inc

@@ -623,8 +623,8 @@ function GetThreadPriorityBoost(hThread: THandle; var DisablePriorityBoost: Bool
 function GetThreadSelectorEntry(hThread: THandle; dwSelector: DWORD; var lpSelectorEntry: TLDTEntry): BOOL; external 'kernel32' name 'GetThreadSelectorEntry';
 function GetThreadTimes(hThread: THandle; var lpCreationTime, lpExitTime, lpKernelTime, lpUserTime: TFileTime): BOOL; external 'kernel32' name 'GetThreadTimes';
 function GetTimeZoneInformation(var lpTimeZoneInformation: TTimeZoneInformation): DWORD; external 'kernel32' name 'GetTimeZoneInformation';
-function GetTimeZoneInformationForYear(wYear: USHORT; lpDynamicTimeZoneInformation: PDynamicTimeZoneInformation;
-  var lpTimeZoneInformation: TTimeZoneInformation): BOOL; external 'kernel32' name 'GetTimeZoneInformationForYear';
+//function GetTimeZoneInformationForYear(wYear: USHORT; lpDynamicTimeZoneInformation: PDynamicTimeZoneInformation;
+//  var lpTimeZoneInformation: TTimeZoneInformation): BOOL; external 'kernel32' name 'GetTimeZoneInformationForYear';
 //function GetTitleBarInfo(hwnd: HWND; var pti: TTitleBarInfo): BOOL;external 'user32' name 'GetTitleBarInfo';
 function GetTokenInformation(TokenHandle: THandle; TokenInformationClass: TTokenInformationClass; TokenInformation: Pointer; TokenInformationLength: DWORD; var ReturnLength: DWORD): BOOL; external 'advapi32' name 'GetTokenInformation';
 function GetUpdateRect(hWnd: HWND; var lpRect: TRect; bErase: BOOL): BOOL; external 'user32' name 'GetUpdateRect';

rtl/x86_64/cpu.pp

@@ -39,6 +39,7 @@ unit cpu;
     function MOVBESupport: boolean;inline;
     function F16CSupport: boolean;inline;
     function RDRANDSupport: boolean;inline;
+    function RTMSupport: boolean;inline;
 
     var
       is_sse3_cpu : boolean = false;
@@ -60,7 +61,8 @@ unit cpu;
       _SSE42Support,
       _MOVBESupport,
       _F16CSupport,
-      _RDRANDSupport: boolean;
+      _RDRANDSupport,
+      _RTMSupport: boolean;
 
     function InterlockedCompareExchange128(var Target: Int128Rec; NewValue: Int128Rec; Comperand: Int128Rec): Int128Rec; assembler;
      {
@@ -179,6 +181,7 @@ unit cpu;
            movl %ebx,_ebx
         end ['rax','rbx','rcx','rdx'];
         _AVX2Support:=_AVXSupport and ((_ebx and $20)<>0);
+        _RTMSupport:=((_ebx and $800)<>0);
       end;
 
 
@@ -247,6 +250,11 @@ unit cpu;
       end;
 
 
+    function RTMSupport: boolean;inline;
+      begin
+        result:=_RTMSupport;
+      end;
+
 begin
   SetupSupport;
 end.

tests/tbf/tb0273.pp

@@ -0,0 +1,8 @@
+{ %FAIL }
+
+// EXPECTED: 'Error: Illegal function result type'
+// ACTUAL: gets compiled
+type M = function : file;
+
+begin
+end.

tests/tbs/tb0681.pp

@@ -0,0 +1,23 @@
+program tb0681;
+
+{$Mode Delphi}
+
+type R = record
+    var X: Integer;
+    function Foo: Integer;
+end;
+
+function R.Foo: Integer;
+begin
+    result := X
+end;
+
+var    F: function : Integer of object;
+    Z: R = (X:42);
+begin
+    // EXPECTED: gets compiled
+    // ACTUAL: 'Error: Incompatible types'
+    F := Z.Foo;
+    if F() <> 42 then
+      Halt(1);
+end.

tests/tbs/tb0682.pp

@@ -0,0 +1,17 @@
+{ %target=linux,openbsd,netbsd,freebsd }
+{ %cpu=i386 }
+{ %norun }
+{$goto on }
+label
+  l;
+
+begin
+  asm
+    movl l@GOT(%eax),%eax 
+    l:
+  end;
+  asm
+    movl .Ll@GOT(%eax),%eax 
+    .Ll:
+  end;
+end.

tests/tbs/tb0683.pp

@@ -0,0 +1,22 @@
+{$ifndef SKIP_CURRENCY_TEST}
+var
+  c: currency;
+  co: comp;
+  i: int64;
+begin
+  c:=10.25;
+  co:=12;
+  i:=trunc(c);
+  if i<>10 then
+    halt(1);
+  i:=trunc(co);
+  if i<>12 then
+    halt(2);
+  i:=round(co);
+  if i<>12 then
+   halt(3);
+end.
+{$else}
+begin
+end.
+{$endif}

tests/test/tcas128.pp

@@ -1,4 +1,4 @@
-{ %cpu=x86_64 }
+{ %cpu=x86_64,i386 }
 
 {$codealign varmin=16}
 
@@ -9,24 +9,34 @@ var
   i1,i2,i3,i4 : int128rec;
 
 begin
-  writeln('Start');
-  i1.lo:=11;
-  i1.hi:=12;
-  i2.lo:=21;
-  i2.hi:=22;
-  i3:=i1;
-  i4.lo:=0;
-  i4.hi:=0;
-  i4:=InterlockedCompareExchange128(i1,i2,i3);
-  {
-  writeln(i4.lo);
-  writeln(i4.hi);
-  writeln(i1.lo);
-  writeln(i1.hi);
-  writeln(i2.lo);
-  writeln(i2.hi);
-  }
-  if (i4.lo<>11) or (i4.hi<>12) or (i1.lo<>i2.lo) or (i1.hi<>i2.hi) then
-    halt(1);
-  writeln('ok');
+{$ifdef cpui386}
+  writeln('RTM Support: ',RTMSupport);
+  if RTMSupport then
+    begin
+{$endif cpui386}
+      writeln('Start');
+      i1.lo:=11;
+      i1.hi:=12;
+      i2.lo:=21;
+      i2.hi:=22;
+      i3:=i1;
+      i4.lo:=0;
+      i4.hi:=0;
+      i4:=InterlockedCompareExchange128(i1,i2,i3);
+      {
+      writeln(i4.lo);
+      writeln(i4.hi);
+      writeln(i1.lo);
+      writeln(i1.hi);
+      writeln(i2.lo);
+      writeln(i2.hi);
+      }
+      if (i4.lo<>11) or (i4.hi<>12) or (i1.lo<>i2.lo) or (i1.hi<>i2.hi) then
+        halt(1);
+      writeln('ok');
+{$ifdef cpui386}
+    end
+  else
+    writeln('No InterlockedCompareExchange128 support available');
+{$endif cpui386}
 end.

tests/test/texception4.pp

@@ -123,6 +123,30 @@ begin
        end;
    end;
    test_exception('ln(-1)');
+   try
+   exception_called:=false;
+   i := 0;
+   e := ln(i);
+   except
+     on e : exception do
+       begin
+         Writeln('exception called ',e.message);
+         exception_called:=true;
+       end;
+   end;
+   test_exception('ln(0)');
+   try
+   exception_called:=false;
+   i := -1;
+   e := sqrt(i);
+   except
+     on e : exception do
+       begin
+         Writeln('exception called ',e.message);
+         exception_called:=true;
+       end;
+   end;
+   test_exception('sqrt(-1)');
    if program_has_errors then
      Halt(1);
 end.

tests/test/tgeneric106.pp

@@ -0,0 +1,23 @@
+program tgeneric106;
+
+{$Mode Delphi}
+
+type G<T> = class
+    var X: T;
+    // EXPECTED: gets compiled
+    // ACTUAL: 'Error: Generics without specialization cannot be used as a type for a variable'
+    class var F: function(const X: T) : G<T> of object;
+    function Foo(const X: T): G<T>;
+end;
+
+function G<T>.Foo(const X: T): G<T>;
+begin
+    result := G<T>.Create;
+    result.X := X
+end;
+
+begin
+    G<Integer>.F := G<Integer>.Create.Foo;
+    if G<Integer>.F(42).X <> 42 then
+      halt(1);
+end.

tests/test/tgeneric107.pp

@@ -0,0 +1,23 @@
+program tgeneric107;
+
+{$Mode ObjFpc}
+
+type generic G<T> = class
+    var X: T;
+    // EXPECTED: gets compiled
+    // ACTUAL: 'Error: Generics without specialization cannot be used as a type for a variable'
+    class var F: function(const X: T) : specialize G<T> of object;
+    function Foo(const aX: T): specialize G<T>;
+end;
+
+function G.Foo(const aX: T): specialize G<T>;
+begin
+    result := specialize G<T>.Create;
+    result.X := aX
+end;
+
+begin
+    specialize G<Integer>.F := @specialize G<Integer>.Create.Foo;
+    if specialize G<Integer>.F(42).X <> 42 then
+      halt(1);
+end.

tests/test/tminmax.pp

@@ -45,7 +45,7 @@ procedure TestSingle;
   function Min3(a, b: Single): Single; inline;
     begin
       Result := b;
-      if a < b then
+      if a < Result then
         Result := a;
     end;
 
@@ -53,7 +53,7 @@ procedure TestSingle;
   function Max3(a, b: Single): Single; inline;
     begin
       Result := b;
-      if a > b then
+      if a > Result then
         Result := a;
     end;
 
@@ -61,7 +61,7 @@ procedure TestSingle;
   function Min4(a, b: Single): Single; inline;
     begin
       Result := b;
-      if a <= b then
+      if a <= Result then
         Result := a;
     end;
 
@@ -69,7 +69,7 @@ procedure TestSingle;
   function Max4(a, b: Single): Single; inline;
     begin
       Result := b;
-      if a >= b then
+      if a >= Result then
         Result := a;
     end;
 

tests/test/tprec8.pp

@@ -40,19 +40,19 @@ begin
     halt(1);
   r.g := 5;
   if (r.g <> 5) then
-    halt(1);
+    halt(2);
   r.h := 65535;
   if (r.h <> 65535) then
-    halt(1);
+    halt(3);
   r.k := true;
   if not (r.k) then
-    halt(1);
+    halt(4);
   r.j := false;
   if r.j then
-    halt(1);
+    halt(5);
   if b <> 0 then
-    halt(1);
+    halt(6);
   if sizeof(tr) <> 13 then
-    halt(2);
+    halt(7);
 end.
 

tests/test/units/linux/tstatx.pp

@@ -3,11 +3,52 @@ uses
   ctypes,baseunix,linux;
   
 var
+  un : utsname;
   mystatx : statx;
   res : cint;
   f : text;
-  
+  st,major,minor : string;
+  i,p,e : longint;
+  err : word;
+  major_release, minor_release : longint;
 begin
+  fpuname(un);
+  st:=un.release;
+  for i:=1 to UTSNAME_LENGTH do
+    if st[i]='.' then
+      begin
+        p:=i;
+        major:=system.copy(st,1,p-1);
+        system.val(major,major_release,err);
+        if err<>0 then
+          begin 
+            writeln('Unable to parse first part of linux version ',st,'(',major,') correctly');
+            halt(2);
+          end;
+        break;
+      end;
+  
+  for i:=p+1 to UTSNAME_LENGTH do
+    if st[i]='.' then
+      begin
+        e:=i;
+        minor:=system.copy(st,p+1,e-p-1);
+        system.val(minor,minor_release,err);
+        if err<>0 then
+          begin 
+            writeln('Unable to second part of parse linux version ',st,'i(',minor,') correctly');
+            halt(2);
+          end;
+        break;
+      end;
+  if (major_release<4) or (minor_release<11) then
+    begin
+      writeln('This version of Linux: ',st,' does not have fstatx syscall');
+      halt(0);
+    end
+  else
+    writeln('This linux version ',st,' should support statx syscall');
+     
   assign(f,'test.txt');
   rewrite(f);
   write(f,'ccccc');

tests/test/units/math/trndcurr.pp

@@ -0,0 +1,78 @@
+uses
+  Math;
+
+{$ifndef SKIP_CURRENCY_TEST}
+procedure testround(const c, expected: currency; error: longint);
+begin
+  if round(c)<>expected then
+    begin
+      writeln('round(',c,') = ',round(c),' instead of ', expected);
+      halt(error);
+    end;
+end;
+
+{$endif}
+
+
+begin
+{$ifndef SKIP_CURRENCY_TEST}
+  writeln('Rounding mode: rmNearest (even)');
+  testround(0.5,0.0,1);
+  testround(1.5,2.0,2);
+  testround(-0.5,0.0,3);
+  testround(-1.5,-2.0,4);
+  testround(0.6,1.0,101);
+  testround(1.6,2.0,102);
+  testround(-0.6,-1.0,103);
+  testround(-1.6,-2.0,104);
+  testround(0.4,0.0,151);
+  testround(1.4,1.0,152);
+  testround(-0.4,-0.0,153);
+  testround(-1.4,-1.0,154);
+
+  writeln('Rounding mode: rmUp');
+  SetRoundMode(rmUp);
+  testround(0.5,1.0,5);
+  testround(1.5,2.0,6);
+  testround(-0.5,0.0,7);
+  testround(-1.5,-1.0,8);
+  testround(0.6,1.0,105);
+  testround(1.6,2.0,106);
+  testround(-0.6,0.0,107);
+  testround(-1.6,-1.0,108);
+  testround(0.4,1.0,155);
+  testround(1.4,2.0,156);
+  testround(-0.4,0.0,157);
+  testround(-1.4,-1.0,158);
+
+  writeln('Rounding mode: rmDown');
+  SetRoundMode(rmDown);
+  testround(0.5,0.0,9);
+  testround(1.5,1.0,10);
+  testround(-0.5,-1.0,11);
+  testround(-1.5,-2.0,12);
+  testround(0.6,0.0,109);
+  testround(1.6,1.0,110);
+  testround(-0.6,-1.0,111);
+  testround(-1.6,-2.0,112);
+  testround(0.4,0.0,159);
+  testround(1.4,1.0,160);
+  testround(-0.4,-1.0,161);
+  testround(-1.4,-2.0,162);
+
+  writeln('Rounding mode: rmTruncate');
+  SetRoundMode(rmTruncate);
+  testround(0.5,0.0,13);
+  testround(1.5,1.0,14);
+  testround(-0.5,0.0,15);
+  testround(-1.5,-1.0,16);
+  testround(0.6,0.0,113);
+  testround(1.6,1.0,114);
+  testround(-0.6,0.0,115);
+  testround(-1.6,-1.0,116);
+  testround(0.4,0.0,163);
+  testround(1.4,1.0,164);
+  testround(-0.4,0.0,165);
+  testround(-1.4,-1.0,166);
+{$endif}
+end.

tests/webtbs/tw38164.pp

@@ -0,0 +1,13 @@
+program int64modint64bug;
+{$mode delphi}
+const
+   a = int64($100000000);
+ var
+   b: int64 = 123;
+   c: int64;
+begin
+  c := b mod a;
+  if c <> 0 then
+  begin
+  end;
+end.

tests/webtbs/tw38225.pp

@@ -0,0 +1,37 @@
+{$inline on}
+{$mode objfpc}
+uses
+  classes;
+
+operator - (const A: TPoint): TPoint; inline;
+begin
+  Result.X := - A.X;
+  Result.Y := - A.Y;
+end;
+
+operator div(const A: TPoint; ADivisor: Integer): TPoint; inline;
+begin
+  Result.X := A.X div ADivisor;
+  Result.Y := A.Y div ADivisor;
+end;
+
+
+procedure p;
+  var
+    i1,i2 : longint;
+    q1,q2 : int64;
+    d2 : dword;
+    p1,p2 : TPoint;
+
+  begin
+    p2:=-p2 div 2;
+    try
+      p2:=-p2 div 2;
+    except
+      p2:=-p2 div 2;
+    end;
+  end;
+
+begin
+end.
+

tests/webtbs/tw38238.pp

@@ -0,0 +1,56 @@
+program tw38238;
+
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+type
+  TCallback = procedure(AValue: longint) of object;
+
+  TRec = record
+    Clb: TCallback;
+    procedure AddCallback(ACallback: TCallback);
+    procedure TriggerCallback(AValue: longint);
+  end;
+
+  TRec2 = record
+    Value: longint;
+    Rec: TRec;
+    procedure CLB(AValue: longint);
+    procedure InitStuff;
+  end;
+
+procedure TRec.AddCallback(ACallback: TCallback);
+begin
+  Clb:=ACallback;
+end;
+
+procedure TRec.TriggerCallback(AValue: longint);
+begin
+  if assigned(Clb) then
+    Clb(AValue);
+end;
+
+procedure TRec2.CLB(AValue: longint);
+begin
+  Value:=AValue;
+end;
+
+procedure TRec2.InitStuff;
+begin
+  Rec.AddCallback(@CLB);
+end;
+
+var
+  Rec1, Rec2: TRec2;
+begin
+  Rec1.InitStuff;
+  Rec2.InitStuff;
+
+  Rec1.Rec.TriggerCallback(1234);
+  Rec2.Rec.TriggerCallback($0943);
+
+  if Rec1.Value<>1234 then
+    Halt(1);
+  if Rec2.Value<>$0943 then
+    Halt(2);
+end.

tests/webtbs/tw38249.pp

@@ -0,0 +1,9 @@
+var
+  A: Double = 0.0001;
+  B: Double = 0;
+begin
+  if B >= 0 then
+    A := B;
+  if A<>0 then
+    halt(1);
+end.

utils/fpdoc/dw_htmlchm.inc → utils/fpdoc/dw_chm.pp

@@ -1,5 +1,10 @@
-{%mainunit dw_html}
-{$IFDEF chmInterface}
+unit dw_chm;
+
+interface
+
+uses Classes, DOM, DOM_HTML,
+    dGlobals, PasTree, dwriter, dw_html, ChmWriter, chmtypes;
+
 type
 
   { TFpDocChmWriter }
@@ -42,7 +47,10 @@ type
     Class Function FileNameExtension : String; override;
     Class procedure SplitImport(var AFilename, ALinkPrefix: String); override;
   end;
-{$ELSE} // implementation
+
+implementation
+
+uses SysUtils, HTMWrite, chmsitemap;
 
 { TFpDocChmWriter }
 
@@ -470,7 +478,7 @@ var
   i: Integer;
   PageDoc: TXMLDocument;
   FileStream: TMemoryStream;
-  FileName: String;
+  IFileName,FileName: String;
   FilePath: String;
 begin
   FileName := Engine.Output;
@@ -520,16 +528,16 @@ begin
 
   //write any found images to CHM stream
   FileStream := TMemoryStream.Create;
-  for i := 0 to FImageFileList.Count - 1 do
+  for iFilename in ImageFileList do
   begin
-{$ifdef imagetest}    DoLog('  adding image: '+FImageFileList[i]); {$endif}
-    if FileExists(FImageFileList[i]) then
+{$ifdef imagetest}    DoLog('  adding image: '+iFileName); {$endif}
+    if FileExists(iFileName) then
     begin
 {$ifdef imagetest}    DoLog(' - found'); {$endif}
-      FileName := ExtractFileName(FImageFileList[i]);
-      FilePath := '/'+FixHTMLpath(ExtractFilePath(FImageFileList[i]));
+      FileName := ExtractFileName(iFileName);
+      FilePath := '/'+FixHTMLpath(ExtractFilePath(iFileName));
 
-      FileStream.LoadFromFile(FImageFileList[i]);
+      FileStream.LoadFromFile(iFileName);
       FChm.AddStreamToArchive(FileName, FilePath, FileStream, True);
       FileStream.Size := 0;
     end
@@ -629,4 +637,8 @@ begin
     end;
 end;
 
-{$ENDIF}
+initialization
+  RegisterWriter(TCHMHTMLWriter,'chm','Compressed HTML file output using fpdoc.css stylesheet.');
+finalization
+  UnRegisterWriter('chm');
+end.

utils/fpdoc/dw_html.pp

@@ -19,7 +19,7 @@ unit dw_html;
 {$WARN 5024 off : Parameter "$1" not used}
 interface
 
-uses Classes, DOM, DOM_HTML, dGlobals, PasTree, dWriter, ChmWriter, chmtypes;
+uses Classes, DOM, DOM_HTML, dGlobals, PasTree, dWriter;
 
 const
   // Subpage indices for modules
@@ -273,16 +273,15 @@ type
     Property IndexColCount : Integer Read FIndexColCount write FIndexColCount;
     Property BaseImageURL : String Read FBaseImageURL Write FBaseImageURL;
     Property UseMenuBrackets : Boolean Read FUseMenuBrackets write FUseMenuBrackets;
+    Property ImageFileList : TStrings Read FImageFileList;
   end;
 
-  {$DEFINE chmInterface}
-  {$I dw_htmlchm.inc}
-  {$UNDEF chmInterface}
+
+Function FixHTMLpath(S : String) : STring;
 
 implementation
 
-uses SysUtils, XMLRead, HTMWrite, sh_pas, fpdocclasstree,
-  chmsitemap;
+uses SysUtils, XMLRead, HTMWrite, sh_pas, fpdocclasstree;
 
 {$i css.inc}
 {$i plusimage.inc}
@@ -294,7 +293,6 @@ begin
   Result:=StringReplace(S,'\','/',[rfReplaceAll]);
 end;
 
-{$I dw_htmlchm.inc}
 
 procedure TFileAllocator.AllocFilename(AElement: TPasElement;
   ASubindex: Integer);
@@ -3955,9 +3953,8 @@ end;
 initialization
   // Do not localize.
   RegisterWriter(THTMLWriter,'html','HTML output using fpdoc.css stylesheet.');
-  RegisterWriter(TCHMHTMLWriter,'chm','Compressed HTML file output using fpdoc.css stylesheet.');
 
 finalization
   UnRegisterWriter('html');
-  UnRegisterWriter('chm');
+
 end.

utils/fpdoc/fpdoc.pp

@@ -31,6 +31,8 @@ uses
   dw_XML,    // XML writer
   dw_dxml,   // Delphi XML doc.
   dw_HTML,   // HTML writer
+  dw_chm,    // CHM Writer
+  // dw_markdown, // Markdown writer
   dw_ipflin, // IPF writer (new linear output)
   dw_man,    // Man page writer
   dw_linrtf, // linear RTF writer