* synchronized with trunk

git-svn-id: branches/unicodekvm@49342 -

.gitattributes

@@ -8843,12 +8843,15 @@ packages/pxlib/src/pxlib.pp svneol=native#text/plain
 packages/qlunits/Makefile svneol=native#text/plain
 packages/qlunits/Makefile.fpc svneol=native#text/plain
 packages/qlunits/README.txt svneol=native#text/plain
+packages/qlunits/examples/mtinf.pas svneol=native#text/plain
 packages/qlunits/examples/qlcube.pas svneol=native#text/plain
 packages/qlunits/fpmake.pp svneol=native#text/plain
 packages/qlunits/src/qdos.pas svneol=native#text/plain
+packages/qlunits/src/qdosfuncs.inc svneol=native#text/plain
 packages/qlunits/src/qlfloat.pas svneol=native#text/plain
 packages/qlunits/src/qlutil.pas svneol=native#text/plain
 packages/qlunits/src/sms.pas svneol=native#text/plain
+packages/qlunits/src/smsfuncs.inc svneol=native#text/plain
 packages/regexpr/Makefile svneol=native#text/plain
 packages/regexpr/Makefile.fpc svneol=native#text/plain
 packages/regexpr/Makefile.fpc.fpcmake svneol=native#text/plain
@@ -12551,6 +12554,11 @@ tests/bench/bansi1.inc svneol=native#text/plain
 tests/bench/bansi1.pp svneol=native#text/plain
 tests/bench/bansi1mt.pp svneol=native#text/plain
 tests/bench/bcase.pp svneol=native#text/pascal
+tests/bench/bdiv.pp svneol=native#text/pascal
+tests/bench/bdiv_s32.inc svneol=native#text/plain
+tests/bench/bdiv_s64.inc svneol=native#text/plain
+tests/bench/bdiv_u32.inc svneol=native#text/plain
+tests/bench/bdiv_u64.inc svneol=native#text/plain
 tests/bench/blists1.inc svneol=native#text/plain
 tests/bench/blists1.pp svneol=native#text/plain
 tests/bench/bmd5.pp svneol=native#text/plain
@@ -14169,6 +14177,7 @@ tests/test/cg/tmoddiv2.pp svneol=native#text/plain
 tests/test/cg/tmoddiv3.pp svneol=native#text/pascal
 tests/test/cg/tmoddiv4.pp svneol=native#text/pascal
 tests/test/cg/tmoddiv5.pp svneol=native#text/pascal
+tests/test/cg/tmoddiv6.pp svneol=native#text/pascal
 tests/test/cg/tmul3264.pp svneol=native#text/plain
 tests/test/cg/tneg.pp svneol=native#text/plain
 tests/test/cg/tnegnotassign1.pp svneol=native#text/plain
@@ -16428,6 +16437,7 @@ tests/test/units/system/tstring.pp svneol=native#text/plain
 tests/test/units/system/ttrig.pas svneol=native#text/plain
 tests/test/units/system/ttrig.pp svneol=native#text/plain
 tests/test/units/system/ttrunc.pp svneol=native#text/plain
+tests/test/units/system/ttxtflsh.pp svneol=native#text/plain
 tests/test/units/system/tval.inc svneol=native#text/plain
 tests/test/units/system/tval.pp svneol=native#text/plain
 tests/test/units/system/tval1.pp svneol=native#text/plain
@@ -18902,6 +18912,8 @@ tests/webtbs/tw38718.pp svneol=native#text/pascal
 tests/webtbs/tw38733.pp svneol=native#text/pascal
 tests/webtbs/tw38766.pp svneol=native#text/plain
 tests/webtbs/tw38802.pp svneol=native#text/pascal
+tests/webtbs/tw38832.pp svneol=native#text/pascal
+tests/webtbs/tw38833.pp svneol=native#text/plain
 tests/webtbs/tw3893.pp svneol=native#text/plain
 tests/webtbs/tw3898.pp svneol=native#text/plain
 tests/webtbs/tw3899.pp svneol=native#text/plain

compiler/Makefile

@@ -587,7 +587,7 @@ ifeq ($(findstring $(PPC_TARGET),x86_64 aarch64 arm),)
 $(error The $(PPC_TARGET) architecture is not (yet) supported by the FPC/LLVM code generator)
 endif
 ifeq ($(findstring $(OS_TARGET),darwin iphonesim linux),)
-$(error The $(PPC_TARGET) target OS is not (yet) supported by the FPC/LLVM code generator)
+$(error The $(OS_TARGET) target OS is not (yet) supported by the FPC/LLVM code generator)
 endif
 override LOCALOPT+=-dllvm -Fullvm
 endif

compiler/Makefile.fpc

@@ -332,7 +332,7 @@ $(error The $(PPC_TARGET) architecture is not (yet) supported by the FPC/LLVM co
 endif
 
 ifeq ($(findstring $(OS_TARGET),darwin iphonesim linux),)
-$(error The $(PPC_TARGET) target OS is not (yet) supported by the FPC/LLVM code generator)
+$(error The $(OS_TARGET) target OS is not (yet) supported by the FPC/LLVM code generator)
 endif
 
 override LOCALOPT+=-dllvm -Fullvm

compiler/aarch64/aasmcpu.pas

@@ -1061,7 +1061,8 @@ implementation
                  { check for pre/post indexed in spilling_get_operation_type_ref }
                  result:=operand_read;
              end;
-           A_MOVK:
+           A_MOVK,
+           A_BFI:
              begin
                if opnr=0 then
                  result:=operand_readwrite
@@ -1074,7 +1075,6 @@ implementation
            A_ADRP,
            A_AND,
            A_ASR,
-           A_BFI,
            A_BFXIL,
            A_CLZ,
            A_CSEL,

compiler/aarch64/agcpugas.pas

@@ -837,7 +837,7 @@ unit agcpugas;
        as_aarch64_clang_gas_info : tasminfo =
           (
             id     : as_clang_gas;
-            idtxt  : 'CLANG';
+            idtxt  : 'AS-CLANG';
             asmbin : 'clang';
             asmcmd : '-x assembler -c -target $TRIPLET -o $OBJ $MARCHOPT $EXTRAOPT -x assembler $ASM';
             supported_targets : [system_aarch64_win64];

compiler/aarch64/aoptcpu.pas

@@ -44,6 +44,10 @@ Interface
         function RegLoadedWithNewValue(reg: tregister; hp: tai): boolean;override;
         function InstructionLoadsFromReg(const reg: TRegister; const hp: tai): boolean;override;
         function LookForPostindexedPattern(var p : tai) : boolean;
+      public
+        { With these routines, there's optimisation code that's general for all ARM platforms }
+        function OptPass1LDR(var p: tai): Boolean; override;
+        function OptPass1STR(var p: tai): Boolean; override;
       private
         function RemoveSuperfluousFMov(const p: tai; movp: tai; const optimizer: string): boolean;
         function OptPass1Shift(var p: tai): boolean;
@@ -199,9 +203,9 @@ Implementation
         not(RegModifiedBetween(taicpu(hp1).oper[2]^.reg,p,hp1)) then
         begin
           if taicpu(p).opcode = A_LDR then
-            DebugMsg('Peephole LdrAdd/Sub2Ldr Postindex done', p)
+            DebugMsg(SPeepholeOptimization + 'LdrAdd/Sub2Ldr Postindex done', p)
           else
-            DebugMsg('Peephole StrAdd/Sub2Str Postindex done', p);
+            DebugMsg(SPeepholeOptimization + 'StrAdd/Sub2Str Postindex done', p);
 
           taicpu(p).oper[1]^.ref^.addressmode:=AM_POSTINDEXED;
           if taicpu(hp1).opcode=A_ADD then
@@ -244,7 +248,7 @@ Implementation
           dealloc:=FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(movp.Next));
           if assigned(dealloc) then
             begin
-              DebugMsg('Peephole '+optimizer+' removed superfluous vmov', movp);
+              DebugMsg(SPeepholeOptimization + optimizer+' removed superfluous vmov', movp);
               result:=true;
 
               { taicpu(p).oper[0]^.reg is not used anymore, try to find its allocation
@@ -291,6 +295,24 @@ Implementation
     end;
 
 
+  function TCpuAsmOptimizer.OptPass1LDR(var p: tai): Boolean;
+    begin
+      Result := False;
+      if inherited OptPass1LDR(p) or
+        LookForPostindexedPattern(p) then
+        Exit(True);
+    end;
+
+
+  function TCpuAsmOptimizer.OptPass1STR(var p: tai): Boolean;
+    begin
+      Result := False;
+      if inherited OptPass1STR(p) or
+        LookForPostindexedPattern(p) then
+        Exit(True);
+    end;
+
+
   function TCpuAsmOptimizer.OptPass1Shift(var p : tai): boolean;
     var
       hp1,hp2: tai;
@@ -395,7 +417,7 @@ Implementation
                 RemoveInstruction(hp1);
                 RemoveCurrentp(p);
 
-                DebugMsg('Peephole FoldShiftProcess done', hp2);
+                DebugMsg(SPeepholeOptimization + 'FoldShiftProcess done', hp2);
                 Result:=true;
                 break;
               end;
@@ -488,7 +510,7 @@ Implementation
           hp3.free;
           hp4.free;
           p:=hp2;
-          DebugMsg('Peephole Bl2B done', p);
+          DebugMsg(SPeepholeOptimization + 'Bl2B done', p);
           Result:=true;
         end;
     end;
@@ -503,7 +525,7 @@ Implementation
        (taicpu(p).oppostfix=PF_None) then
        begin
          RemoveCurrentP(p);
-         DebugMsg('Peephole Mov2None done', p);
+         DebugMsg(SPeepholeOptimization + 'Mov2None done', p);
          Result:=true;
        end
 
@@ -669,9 +691,9 @@ Implementation
                                 }
                                 taicpu(p).opcode := TargetOpcode;
                                 if TargetOpcode = A_STP then
-                                  DebugMsg('Peephole Optimization: StrStr2Stp', p)
+                                  DebugMsg(SPeepholeOptimization + 'StrStr2Stp', p)
                                 else
-                                  DebugMsg('Peephole Optimization: LdrLdr2Ldp', p);
+                                  DebugMsg(SPeepholeOptimization + 'LdrLdr2Ldp', p);
                                 taicpu(p).ops := 3;
                                 taicpu(p).loadref(2, taicpu(p).oper[1]^.ref^);
                                 taicpu(p).loadreg(1, taicpu(hp1).oper[0]^.reg);
@@ -695,9 +717,9 @@ Implementation
                                 }
                                 taicpu(p).opcode := TargetOpcode;
                                 if TargetOpcode = A_STP then
-                                  DebugMsg('Peephole Optimization: StrStr2Stp (reverse)', p)
+                                  DebugMsg(SPeepholeOptimization + 'StrStr2Stp (reverse)', p)
                                 else
-                                  DebugMsg('Peephole Optimization: LdrLdr2Ldp (reverse)', p);
+                                  DebugMsg(SPeepholeOptimization + 'LdrLdr2Ldp (reverse)', p);
                                 taicpu(p).ops := 3;
                                 taicpu(p).loadref(2, taicpu(hp1).oper[1]^.ref^);
                                 taicpu(p).loadreg(1, taicpu(p).oper[0]^.reg);
@@ -752,7 +774,7 @@ Implementation
           p.free;
           hp1.free;
           p:=hp2;
-          DebugMsg('Peephole CMPB.E/NE2CBNZ/CBZ done', p);
+          DebugMsg(SPeepholeOptimization + 'CMPB.E/NE2CBNZ/CBZ done', p);
           Result:=true;
         end;
     end;
@@ -764,9 +786,10 @@ Implementation
       if p.typ=ait_instruction then
         begin
           case taicpu(p).opcode of
-            A_LDR,
+            A_LDR:
+              Result:=OptPass1LDR(p);
             A_STR:
-              Result:=LookForPostindexedPattern(p);
+              Result:=OptPass1STR(p);
             A_MOV:
               Result:=OptPass1Mov(p);
             A_STP:

compiler/aarch64/cgcpu.pas

@@ -583,13 +583,15 @@ implementation
         opc: tasmop;
         shift: byte;
         so: tshifterop;
-        reginited,doinverted: boolean;
+        reginited,doinverted,extendedsize: boolean;
         manipulated_a: tcgint;
         leftover_a: word;
       begin
 {$ifdef extdebug}
         list.concat(tai_comment.Create(strpnew('Generating constant ' + tostr(a) + ' / $' + hexstr(a, 16))));
 {$endif extdebug}
+        extendedsize := (size in [OS_64,OS_S64]);
+
         case a of
           { Small positive number }
           $0..$FFFF:
@@ -613,19 +615,50 @@ implementation
             end;
           else
             begin
+              if not extendedsize then
+                { Mostly so programmers don't get confused when they view the disassembly and
+                  'a' is sign-extended to 64-bit, say, but also avoids potential problems with
+                  third-party assemblers if the number is out of bounds for a given size }
+                a := Cardinal(a);
 
-              if size in [OS_64,OS_S64] then
+              { Check to see if a is a valid shifter constant that can be encoded in ORR as is }
+              if is_shifter_const(a,size) then
+                begin
+                  { Use synthetic "MOV" instruction instead of "ORR reg,wzr,#a" (an alias),
+                    since AArch64 conventions prefer this, and it's clearer in the
+                    disassembly }
+                  list.concat(taicpu.op_reg_const(A_MOV,reg,a));
+                  Exit;
+                end;
+
+              { If the value of a fits into 32 bits, it's fastest to use movz/movk regardless }
+              if extendedsize and ((a shr 32) <> 0) then
                 begin
-                  { Check to see if a is a valid shifter constant that can be encoded in ORR as is }
-                  if is_shifter_const(a,size) then
+                  { This determines whether this write can be performed with an ORR followed by MOVK
+                    by copying the 3nd word to the 1st word for the ORR constant, then overwriting
+                    the 1st word.  The alternative would require 4 instructions.  This sequence is
+                    common when division reciprocals are calculated (e.g. 3 produces AAAAAAAAAAAAAAAB). }
+                  leftover_a := word(a and $FFFF);
+                  manipulated_a := (a and $FFFFFFFFFFFF0000) or ((a shr 32) and $FFFF);
+                  { if manipulated_a = a, don't check, because is_shifter_const was already
+                    called for a and it returned False.  Reduces processing time. [Kit] }
+                  if (manipulated_a <> a) and is_shifter_const(manipulated_a, OS_64) then
                     begin
-                      list.concat(taicpu.op_reg_reg_const(A_ORR,reg,makeregsize(NR_XZR,size),a));
+                      { Encode value as:
+                          orr  reg,xzr,manipulated_a
+                          movk reg,#(leftover_a)
+
+                        Use "orr" instead of "mov" here for the assembly dump so it better
+                        implies that something special is happening with the number arrangement.
+                      }
+                      list.concat(taicpu.op_reg_reg_const(A_ORR, reg, NR_XZR, manipulated_a));
+                      list.concat(taicpu.op_reg_const(A_MOVK, reg, leftover_a));
                       Exit;
                     end;
 
                   { This determines whether this write can be performed with an ORR followed by MOVK
                     by copying the 2nd word to the 4th word for the ORR constant, then overwriting
-                    the 4th word (unless the word is.  The alternative would require 3 instructions }
+                    the 4th word.  The alternative would require 3 instructions }
                   leftover_a := word(a shr 48);
                   manipulated_a := (a and $0000FFFFFFFFFFFF);
 
@@ -642,13 +675,16 @@ implementation
                   manipulated_a := manipulated_a or (((a shr 16) and $FFFF) shl 48);
                   { if manipulated_a = a, don't check, because is_shifter_const was already
                     called for a and it returned False.  Reduces processing time. [Kit] }
-                  if (manipulated_a <> a) and is_shifter_const(manipulated_a, size) then
+                  if (manipulated_a <> a) and is_shifter_const(manipulated_a, OS_64) then
                     begin
                       { Encode value as:
                           orr  reg,xzr,manipulated_a
                           movk reg,#(leftover_a),lsl #48
+
+                        Use "orr" instead of "mov" here for the assembly dump so it better
+                        implies that something special is happening with the number arrangement.
                       }
-                      list.concat(taicpu.op_reg_reg_const(A_ORR, reg, makeregsize(NR_XZR, size), manipulated_a));
+                      list.concat(taicpu.op_reg_reg_const(A_ORR, reg, NR_XZR, manipulated_a));
                       shifterop_reset(so);
                       so.shiftmode := SM_LSL;
                       so.shiftimm := 48;
@@ -679,10 +715,7 @@ implementation
                   end;
                 end
               else
-                begin
-                  a:=cardinal(a);
-                  doinverted:=False;
-                end;
+                doinverted:=False;
             end;
         end;
 

compiler/aarch64/ncpumat.pas

@@ -71,20 +71,35 @@ implementation
       var
          op         : tasmop;
          tmpreg,
+         zeroreg,
          numerator,
          divider,
+         largernumreg,
+         largerresreg,
          resultreg  : tregister;
-         hl : tasmlabel;
+         hl         : tasmlabel;
          overflowloc: tlocation;
-         power: longint;
+         power      : longint;
+         opsize     : tcgsize;
+
+         dividend   : Int64;
+         high_bit,
+         reciprocal : QWord;
+         { Just to save on stack space and the like }
+         reciprocal_signed : Int64 absolute reciprocal;
+
+         expandword,
+         magic_add  : Boolean;
+         shift      : byte;
+
+         shifterop  : tshifterop;
+         hp         : taicpu;
 
        procedure genOrdConstNodeDiv;
          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
@@ -98,7 +113,7 @@ implementation
                current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_NEG,
                  resultreg,numerator),toppostfix(ord(cs_check_overflow in current_settings.localswitches)*ord(PF_S))));
              end
-           else if ispowerof2(tordconstnode(right).value,power) then
+           else if isabspowerof2(tordconstnode(right).value,power) then
              begin
                if (is_signed(right.resultdef)) then
                  begin
@@ -115,98 +130,318 @@ implementation
                     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,def_cgsize(resultdef),power,helper2,resultreg);
+
+                    if (tordconstnode(right).value < 0) then
+                      { Invert the result }
+                      current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_NEG,resultreg,resultreg));
                   end
-               else
-                 cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHR,opsize,power,numerator,resultreg)
+                else
+                  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,opsize,
-               tordconstnode(right).value.svalue,numerator,resultreg);
+             { Generic division }
+             begin
+               if is_signed(left.resultdef) then
+                 op:=A_SDIV
+               else
+                 op:=A_UDIV;
+
+               { If we didn't acquire the original divisor earlier, grab it now }
+               if divider = NR_NO then
+                 begin
+                   divider:=cg.getintregister(current_asmdata.CurrAsmList,opsize);
+                   cg.a_load_const_reg(current_asmdata.CurrAsmList,opsize,tordconstnode(right).value.svalue,divider);
+                 end;
+
+               current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op,resultreg,numerator,divider));
+             end;
          end;
 
-      begin
-       secondpass(left);
-       secondpass(right);
-       { avoid warning }
-       divider:=NR_NO;
-
-       { set result location }
-       location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
-       location.register:=cg.getintregister(current_asmdata.CurrAsmList,def_cgsize(resultdef));
-       resultreg:=location.register;
-
-       { put numerator in register }
-       hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
-       numerator:=left.location.register;
-
-       if (right.nodetype=ordconstn) and
-          ((tordconstnode(right).value=1) or
-           (tordconstnode(right).value=int64(-1)) or
-           (tordconstnode(right).value=0) or
-           ispowerof2(tordconstnode(right).value,power)) then
+       procedure genOverflowCheck;
          begin
-           genOrdConstNodeDiv;
-           if nodetype=modn then
+           { in case of overflow checking, also check for low(int64) div (-1)
+             (no hardware support for this either) }
+           if (cs_check_overflow in current_settings.localswitches) and
+              is_signed(left.resultdef) and
+              ((right.nodetype<>ordconstn) or
+               (tordconstnode(right).value=-1)) then
              begin
-               divider:=cg.getintregister(current_asmdata.CurrAsmList,def_cgsize(resultdef));
-               cg.a_load_const_reg(current_asmdata.CurrAsmList,def_cgsize(resultdef),int64(tordconstnode(right).value),divider);
+               { num=ffff... and div=8000... <=>
+                 num xor not(div xor 8000...) = 0
+                 (and we have the "eon" operation, which performs "xor not(...)" }
+               tmpreg:=hlcg.getintregister(current_asmdata.CurrAsmList,left.resultdef);
+               hlcg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_XOR,left.resultdef,low(int64),numerator,tmpreg);
+               current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_EON,
+                 tmpreg,numerator,tmpreg));
+               current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_CMP,tmpreg,0));
+               { now the zero/equal flag is set in case we divided low(int64) by
+                 (-1) }
+               location_reset(overflowloc,LOC_FLAGS,OS_NO);
+               overflowloc.resflags:=F_EQ;
+               cg.g_overflowcheck_loc(current_asmdata.CurrAsmList,location,resultdef,overflowloc);
              end;
-         end
-       else
-         begin
-           { load divider in a register }
-           hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,right.resultdef,true);
-           divider:=right.location.register;
-
-           { start division }
-           if is_signed(left.resultdef) then
-             op:=A_SDIV
-           else
-             op:=A_UDIV;
-           current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op,location.register,numerator,divider));
          end;
 
-       { no divide-by-zero detection available in hardware, emulate (if it's a
-         constant, this will have been detected earlier already) }
-       if (right.nodetype<>ordconstn) then
-         begin
-           current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_CMP,
-             right.location.register,0));
+      begin
+        secondpass(left);
+        secondpass(right);
+        { avoid warning }
+        divider := NR_NO;
+        largernumreg := NR_NO;
+        expandword := False;
 
-           current_asmdata.getjumplabel(hl);
-           current_asmdata.CurrAsmList.concat(taicpu.op_cond_sym(A_B,C_NE,hl));
-           cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DIVBYZERO',false);
-           cg.a_label(current_asmdata.CurrAsmList,hl);
-         end;
+        opsize := def_cgsize(resultdef);
 
-       { in case of overflow checking, also check for low(int64) div (-1)
-         (no hardware support for this either) }
-       if (cs_check_overflow in current_settings.localswitches) and
-          is_signed(left.resultdef) and
-          ((right.nodetype<>ordconstn) or
-           (tordconstnode(right).value=-1)) then
-         begin
-           { num=ffff... and div=8000... <=>
-             num xor not(div xor 8000...) = 0
-             (and we have the "eon" operation, which performs "xor not(...)" }
-           tmpreg:=hlcg.getintregister(current_asmdata.CurrAsmList,left.resultdef);
-           hlcg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_XOR,left.resultdef,low(int64),left.location.register,tmpreg);
-           current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_EON,
-             tmpreg,left.location.register,tmpreg));
-           current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_CMP,tmpreg,0));
-           { now the zero/equal flag is set in case we divided low(int64) by
-             (-1) }
-           location_reset(overflowloc,LOC_FLAGS,OS_NO);
-           overflowloc.resflags:=F_EQ;
-           cg.g_overflowcheck_loc(current_asmdata.CurrAsmList,location,resultdef,overflowloc);
-         end;
+        { set result location }
+        location_reset(location,LOC_REGISTER,opsize);
+        location.register:=cg.getintregister(current_asmdata.CurrAsmList,opsize);
+        resultreg:=location.register;
 
-       { in case of modulo, multiply result again by the divider and subtract
-         from the numerator }
-       if nodetype=modn then
-         current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg_reg(A_MSUB,resultreg,
-           resultreg,divider,numerator));
+        { put numerator in register }
+        hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
+        numerator:=left.location.register;
+
+        if (right.nodetype=ordconstn) then
+          begin
+            { If optimising for size, just use regular division operations }
+            if (cs_opt_size in current_settings.optimizerswitches) or
+              ((tordconstnode(right).value=1) or
+              (tordconstnode(right).value=int64(-1)) or
+              isabspowerof2(tordconstnode(right).value,power)) then
+              begin
+
+                { Store divisor for later (and executed at the same time as the multiplication) }
+                if (nodetype=modn) then
+                  begin
+                    if (tordconstnode(right).value = 1) or (tordconstnode(right).value = int64(-1)) then
+                      begin
+                        { Just evaluates to zero }
+                        current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_MOVZ,resultreg, 0));
+                        Exit;
+                      end
+                    { "not cs_opt_size" saves from checking the value of the divisor again
+                      (if cs_opt_size is not set, then the divisor is a power of 2) }
+                    else if not (cs_opt_size in current_settings.optimizerswitches) then
+                      begin
+                        divider:=cg.getintregister(current_asmdata.CurrAsmList,opsize);
+                        cg.a_load_const_reg(current_asmdata.CurrAsmList,opsize,tordconstnode(right).value.svalue,divider);
+                      end
+                  end;
+
+                genOrdConstNodeDiv;
+                genOverflowCheck;
+
+                { in case of modulo, multiply result again by the divider and subtract
+                  from the numerator }
+                if (nodetype=modn) then
+                  begin
+                    if ispowerof2(tordconstnode(right).value,power) then
+                      begin
+                        shifterop.shiftmode := SM_LSL;
+                        shifterop.shiftimm := power;
+
+                        current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg_shifterop(A_SUB,resultreg,numerator,resultreg,shifterop));
+                      end
+                    else
+                      current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg_reg(A_MSUB,resultreg,
+                        resultreg,divider,numerator));
+                  end;
+
+                Exit;
+              end
+            else
+              begin
+                if is_signed(left.resultdef) then
+                  begin
+                    if (nodetype=modn) then { Signed mod doesn't work properly }
+                      begin
+                        divider:=cg.getintregister(current_asmdata.CurrAsmList,opsize);
+                        cg.a_load_const_reg(current_asmdata.CurrAsmList,opsize,tordconstnode(right).value.svalue,divider);
+                        genOrdConstNodeDiv;
+                      end
+                    else
+                      begin
+                        { Read signed value to avoid Internal Error 200706094 }
+                        dividend := tordconstnode(right).value.svalue;
+
+                        calc_divconst_magic_signed(resultdef.size * 8, dividend, reciprocal_signed, shift);
+                        cg.a_load_const_reg(current_asmdata.CurrAsmList, opsize, reciprocal_signed, resultreg);
+
+                        { SMULH is only available for the full 64-bit registers }
+                        if opsize in [OS_64, OS_S64] then
+                          begin
+                            current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SMULH,resultreg,resultreg,numerator));
+                            largerresreg := resultreg;
+                          end
+                        else
+                          begin
+                            largerresreg := newreg(getregtype(resultreg), getsupreg(resultreg), R_SUBWHOLE);
+                            largernumreg := newreg(getregtype(numerator), getsupreg(numerator), R_SUBWHOLE);
+                            current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_MUL,largerresreg,largerresreg,largernumreg));
+                            expandword := True; { Merge the shift operation with something below }
+                          end;
+
+                        { Store divisor for later (and executed at the same time as the multiplication) }
+                        if nodetype=modn then
+                          begin
+                            divider:=cg.getintregister(current_asmdata.CurrAsmList,opsize);
+                            cg.a_load_const_reg(current_asmdata.CurrAsmList,opsize,dividend,divider);
+                          end;
+
+                        { add or subtract dividend }
+                        if (dividend > 0) and (reciprocal_signed < 0) then
+                          begin
+                            if expandword then
+                              begin
+                                shifterop.shiftmode := SM_ASR;
+                                shifterop.shiftimm := 32;
+                                expandword := False;
+                                current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg_shifterop(A_ADD,largerresreg,largernumreg,largerresreg,shifterop));
+                              end
+                            else
+                              current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_ADD,resultreg,resultreg,numerator));
+                          end
+                        else if (dividend < 0) and (reciprocal_signed > 0) then
+                          begin
+                            if expandword then
+                              begin
+                                { We can't append LSR to the SUB below because it's on the wrong operand }
+                                expandword := False;
+                                current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_ASR,largerresreg,largerresreg,32));
+                              end;
+
+                            current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUB,resultreg,resultreg,numerator));
+                          end
+                        else if expandword then
+                          Inc(shift,32);
+
+                        { shift if necessary }
+                        if (shift <> 0) then
+                          begin
+                            if expandword then
+                              current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_ASR,largerresreg,largerresreg,shift))
+                            else
+                              current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_ASR,resultreg,resultreg,shift));
+                          end;
+
+                        { extract and add the sign bit }
+                        shifterop.shiftmode := SM_LSR;
+                        shifterop.shiftimm := left.resultdef.size*8 - 1;
+
+                        if (dividend < 0) then
+                          current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg_shifterop(A_ADD,resultreg,resultreg,resultreg,shifterop))
+                        else
+                          current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg_shifterop(A_ADD,resultreg,resultreg,numerator,shifterop));
+                      end;
+                  end
+                else
+                  begin
+                    calc_divconst_magic_unsigned(resultdef.size * 8, tordconstnode(right).value, reciprocal, magic_add, shift);
+                    { Add explicit typecast to tcgint type, to avoid range or overflow check }
+                    cg.a_load_const_reg(current_asmdata.CurrAsmList, opsize, tcgint(reciprocal), resultreg);
+                    { UMULH is only available for the full 64-bit registers }
+                    if opsize in [OS_64, OS_S64] then
+                      begin
+                        current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_UMULH,resultreg,resultreg,numerator));
+                        largerresreg := resultreg;
+                      end
+                    else
+                      begin
+                        largerresreg := newreg(getregtype(resultreg), getsupreg(resultreg), R_SUBWHOLE);
+                        largernumreg := newreg(getregtype(numerator), getsupreg(numerator), R_SUBWHOLE);
+                        current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_MUL,largerresreg,largerresreg,largernumreg));
+                        expandword := True; { Try to merge the shift operation with something below }
+                      end;
+
+                    { Store divisor for later (and executed at the same time as the multiplication) }
+                    if (nodetype=modn) then
+                      begin
+                        divider:=cg.getintregister(current_asmdata.CurrAsmList,opsize);
+                        cg.a_load_const_reg(current_asmdata.CurrAsmList,opsize,tordconstnode(right).value.svalue,divider);
+                      end;
+
+                    if magic_add then
+                      begin
+                        { We can't append LSR to the ADD below because it would require extending the registers
+                          and interfere with the carry bit }
+                        if expandword then
+                          current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_LSR,largerresreg,largerresreg,32));
+
+                        { Add the reciprocal to the high-order word, tracking the carry bit, shift, then
+                          insert the carry bit via CSEL and ORR }
+
+                        if opsize in [OS_64,OS_S64] then
+                          zeroreg := NR_XZR
+                        else
+                          zeroreg := NR_WZR;
+
+                        high_bit := QWord(1) shl ((resultdef.size * 8) - shift);
+
+                        tmpreg := cg.getintregister(current_asmdata.CurrAsmList, opsize);
+                        cg.a_load_const_reg(current_asmdata.CurrAsmList, opsize, high_bit, tmpreg);
+
+                        { Generate ADDS instruction }
+                        hp := taicpu.op_reg_reg_reg(A_ADD,resultreg,resultreg,numerator);
+                        hp.oppostfix := PF_S;
+                        current_asmdata.CurrAsmList.concat(hp);
+
+                        current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg_cond(A_CSEL,tmpreg,tmpreg,zeroreg, C_CS));
+
+                        shifterop.shiftmode := SM_LSR;
+                        shifterop.shiftimm := shift;
+
+                        current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg_shifterop(A_ORR,resultreg,tmpreg,resultreg,shifterop));
+                      end
+                    else if expandword then
+                      { Include the right-shift by 32 to get the high-order DWord }
+                      current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_LSR,largerresreg,largerresreg,shift + 32))
+                    else
+                      current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_LSR,resultreg,resultreg,shift));
+                  end;
+
+              end;
+
+          end
+        { no divide-by-zero detection available in hardware, emulate (if it's a
+          constant, this will have been detected earlier already) }
+        else
+          begin
+            { load divider in a register }
+            hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,right.resultdef,true);
+            divider:=right.location.register;
+
+            { ARM-64 developer guides recommend checking for division by zero conditions
+              AFTER the division, since the check and the division can be done in tandem }
+            if is_signed(left.resultdef) then
+              op:=A_SDIV
+            else
+              op:=A_UDIV;
+
+            current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op,resultreg,numerator,divider));
+
+            current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_CMP,divider,0));
+            current_asmdata.getjumplabel(hl);
+            current_asmdata.CurrAsmList.concat(taicpu.op_cond_sym(A_B,C_NE,hl));
+            cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DIVBYZERO',false);
+            cg.a_label(current_asmdata.CurrAsmList,hl);
+          end;
+
+        genOverflowCheck;
+
+        { in case of modulo, multiply result again by the divider and subtract
+          from the numerator }
+        if (nodetype=modn) then
+          begin
+            { If we didn't acquire the original divisor earlier, grab it now }
+            if divider = NR_NO then
+              begin
+                divider:=cg.getintregister(current_asmdata.CurrAsmList,opsize);
+                cg.a_load_const_reg(current_asmdata.CurrAsmList,opsize,tordconstnode(right).value.svalue,divider);
+              end;
+
+            current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg_reg(A_MSUB,resultreg,
+              resultreg,divider,numerator));
+          end;
     end;
 
 

compiler/aggas.pas

@@ -513,7 +513,8 @@ implementation
          system_i386_OS2,
          system_i386_EMX: ;
          system_m68k_atari, { atari tos/mint GNU AS also doesn't seem to like .section (KB) }
-         system_m68k_amiga: { amiga has old GNU AS (2.14), which blews up from .section (KB) }
+         system_m68k_amiga, { amiga has old GNU AS (2.14), which blews up from .section (KB) }
+         system_m68k_sinclairql: { same story, only ancient GNU tools available (KB) }
            begin
              { ... but vasm is GAS compatible on amiga/atari, and supports named sections }
              if create_smartlink_sections then

compiler/arm/aoptcpu.pas

@@ -59,7 +59,11 @@ Type
     function InstructionLoadsFromReg(const reg : TRegister; const hp : tai) : boolean; override;
 
     function RegLoadedWithNewValue(reg : tregister; hp : tai) : boolean; override;
-    function OptPass1And(var p: tai): Boolean; override; { There's optimisation code that's general for all ARM platforms }
+
+     { With these routines, there's optimisation code that's general for all ARM platforms }
+    function OptPass1And(var p: tai): Boolean; override;
+    function OptPass1LDR(var p: tai): Boolean; override;
+    function OptPass1STR(var p: tai): Boolean; override;
   protected
     function LookForPreindexedPattern(p: taicpu): boolean;
     function LookForPostindexedPattern(p: taicpu): boolean;
@@ -69,9 +73,7 @@ Type
     function OptPass1DataCheckMov(var p: tai): Boolean;
     function OptPass1ADDSUB(var p: tai): Boolean;
     function OptPass1CMP(var p: tai): Boolean;
-    function OptPass1LDR(var p: tai): Boolean;
     function OptPass1STM(var p: tai): Boolean;
-    function OptPass1STR(var p: tai): Boolean;
     function OptPass1MOV(var p: tai): Boolean;
     function OptPass1MUL(var p: tai): Boolean;
     function OptPass1MVN(var p: tai): Boolean;
@@ -834,7 +836,9 @@ Implementation
     var
       hp1: tai;
     begin
-      Result := False;
+      Result := inherited OptPass1LDR(p);
+      if Result then
+        Exit;
 
       { change
         ldr reg1,ref
@@ -1022,7 +1026,9 @@ Implementation
     var
       hp1: tai;
     begin
-      Result := False;
+      Result := inherited OptPass1STR(p);
+      if Result then
+        Exit;
 
       { Common conditions }
       if (taicpu(p).oper[1]^.typ = top_ref) and

compiler/armgen/aoptarm.pas

@@ -26,7 +26,7 @@ Unit aoptarm;
 {$i fpcdefs.inc}
 
 { $define DEBUG_PREREGSCHEDULER}
-{ $define DEBUG_AOPTCPU}
+{$define DEBUG_AOPTCPU}
 
 Interface
 
@@ -41,12 +41,15 @@ Type
 
     function RemoveSuperfluousMove(const p: tai; movp: tai; const optimizer: string): boolean;
     function RedundantMovProcess(var p: tai; var hp1: tai): boolean;
-    function GetNextInstructionUsingReg(Current: tai; out Next: tai; reg: TRegister): Boolean;
+    function GetNextInstructionUsingReg(Current: tai; out Next: tai; const reg: TRegister): Boolean;
 
     function OptPass1UXTB(var p: tai): Boolean;
     function OptPass1UXTH(var p: tai): Boolean;
     function OptPass1SXTB(var p: tai): Boolean;
     function OptPass1SXTH(var p: tai): Boolean;
+
+    function OptPass1LDR(var p: tai): Boolean; virtual;
+    function OptPass1STR(var p: tai): Boolean; virtual;
     function OptPass1And(var p: tai): Boolean; virtual;
   End;
 
@@ -69,15 +72,23 @@ Implementation
     systems,
     cpuinfo,
     cgobj,procinfo,
-    aasmbase,aasmdata;
+    aasmbase,aasmdata,itcpugas;
 
 
 {$ifdef DEBUG_AOPTCPU}
+  const
+    SPeepholeOptimization: shortstring = 'Peephole Optimization: ';
+
   procedure TARMAsmOptimizer.DebugMsg(const s: string;p : tai);
     begin
       asml.insertbefore(tai_comment.Create(strpnew(s)), p);
     end;
 {$else DEBUG_AOPTCPU}
+  { Empty strings help the optimizer to remove string concatenations that won't
+    ever appear to the user on release builds. [Kit] }
+  const
+    SPeepholeOptimization = '';
+
   procedure TARMAsmOptimizer.DebugMsg(const s: string;p : tai);inline;
     begin
     end;
@@ -179,7 +190,7 @@ Implementation
 
 
   function TARMAsmOptimizer.GetNextInstructionUsingReg(Current: tai;
-    Out Next: tai; reg: TRegister): Boolean;
+    Out Next: tai; const reg: TRegister): Boolean;
     var
       gniResult: Boolean;
     begin
@@ -395,7 +406,14 @@ Implementation
                   UpdateUsedRegs(TmpUsedRegs, tai(current_hp.Next));
                   LDRChange := False;
 
-                  if (taicpu(next_hp).opcode in [A_LDR,A_STR]) and (taicpu(next_hp).ops = 2) then
+                  if (taicpu(next_hp).opcode in [A_LDR,A_STR]) and (taicpu(next_hp).ops = 2)
+{$ifdef AARCH64}
+                    { If r0 is the zero register, then this sequence of instructions will cause
+                      an access violation, but that's better than an assembler error caused by
+                      changing r0 to xzr inside the reference (Where it's illegal). [Kit] }
+                    and (getsupreg(taicpu(p).oper[1]^.reg) <> RS_XZR)
+{$endif AARCH64}
+                    then
                     begin
 
                       { Change the registers from r1 to r0 }
@@ -1018,6 +1036,209 @@ Implementation
     end;
 
 
+  function TARMAsmOptimizer.OptPass1LDR(var p : tai) : Boolean;
+    var
+      hp1: tai;
+      Reference: TReference;
+      NewOp: TAsmOp;
+    begin
+      Result := False;
+      if (taicpu(p).ops <> 2) or (taicpu(p).condition <> C_None) then
+        Exit;
+
+      Reference := taicpu(p).oper[1]^.ref^;
+      if (Reference.addressmode = AM_OFFSET) and
+        not RegInRef(taicpu(p).oper[0]^.reg, Reference) and
+        { Delay calling GetNextInstruction for as long as possible }
+        GetNextInstruction(p, hp1) and
+        (hp1.typ = ait_instruction) and
+        (taicpu(hp1).condition = C_None) and
+        (taicpu(hp1).oppostfix = taicpu(p).oppostfix) then
+        begin
+          if (taicpu(hp1).opcode = A_STR) and
+            RefsEqual(taicpu(hp1).oper[1]^.ref^, Reference) and
+            (getregtype(taicpu(p).oper[0]^.reg) = getregtype(taicpu(hp1).oper[0]^.reg)) then
+            begin
+              { With:
+                  ldr reg1,[ref]
+                  str reg2,[ref]
+
+                If reg1 = reg2, Remove str
+              }
+              if taicpu(p).oper[0]^.reg = taicpu(hp1).oper[0]^.reg then
+                begin
+                  DebugMsg(SPeepholeOptimization + 'Removed redundant store instruction (load/store -> load/nop)', hp1);
+                  RemoveInstruction(hp1);
+                  Result := True;
+                  Exit;
+                end;
+            end
+          else if (taicpu(hp1).opcode = A_LDR) and
+            RefsEqual(taicpu(hp1).oper[1]^.ref^, Reference) then
+            begin
+              { With:
+                  ldr reg1,[ref]
+                  ldr reg2,[ref]
+
+                If reg1 = reg2, delete the second ldr
+                If reg1 <> reg2, changing the 2nd ldr to a mov might introduce
+                  a dependency, but it will likely open up new optimisations, so
+                  do it for now and handle any new dependencies later.
+              }
+              if taicpu(p).oper[0]^.reg = taicpu(hp1).oper[0]^.reg then
+                begin
+                  DebugMsg(SPeepholeOptimization + 'Removed duplicate load instruction (load/load -> load/nop)', hp1);
+                  RemoveInstruction(hp1);
+                  Result := True;
+                  Exit;
+                end
+              else if
+                (getregtype(taicpu(p).oper[0]^.reg) = R_INTREGISTER) and
+                (getregtype(taicpu(hp1).oper[0]^.reg) = R_INTREGISTER) and
+                (getsubreg(taicpu(p).oper[0]^.reg) = getsubreg(taicpu(hp1).oper[0]^.reg)) then
+                begin
+                  DebugMsg(SPeepholeOptimization + 'Changed second ldr' + oppostfix2str[taicpu(hp1).oppostfix] + ' to mov (load/load -> load/move)', hp1);
+                  taicpu(hp1).opcode := A_MOV;
+                  taicpu(hp1).oppostfix := PF_None;
+                  taicpu(hp1).loadreg(1, taicpu(p).oper[0]^.reg);
+                  AllocRegBetween(taicpu(p).oper[0]^.reg, p, hp1, UsedRegs);
+                  Result := True;
+                  Exit;
+                end;
+            end;
+        end;
+    end;
+
+
+    function TARMAsmOptimizer.OptPass1STR(var p : tai) : Boolean;
+      var
+        hp1: tai;
+        Reference: TReference;
+        SizeMismatch: Boolean;
+        SrcReg: TRegister;
+        NewOp: TAsmOp;
+      begin
+        Result := False;
+        if (taicpu(p).ops <> 2) or (taicpu(p).condition <> C_None) then
+          Exit;
+
+        Reference := taicpu(p).oper[1]^.ref^;
+        if (Reference.addressmode = AM_OFFSET) and
+          not RegInRef(taicpu(p).oper[0]^.reg, Reference) and
+          { Delay calling GetNextInstruction for as long as possible }
+          GetNextInstruction(p, hp1) and
+          (hp1.typ = ait_instruction) and
+          (taicpu(hp1).condition = C_None) and
+          (taicpu(hp1).oppostfix = taicpu(p).oppostfix) then
+
+        if GetNextInstruction(p, hp1) and
+          (hp1.typ = ait_instruction) and
+          (taicpu(hp1).condition = C_None) then
+          begin
+            { Saves constant dereferencing and makes it easier to change the size if necessary }
+            SrcReg := taicpu(p).oper[0]^.reg;
+
+            if (taicpu(hp1).opcode = A_LDR) and
+              RefsEqual(taicpu(hp1).oper[1]^.ref^, Reference) and
+              (
+                (taicpu(hp1).oppostfix = taicpu(p).oppostfix) or
+                ((taicpu(p).oppostfix = PF_B) and (taicpu(hp1).oppostfix = PF_SB)) or
+                ((taicpu(p).oppostfix = PF_H) and (taicpu(hp1).oppostfix = PF_SH))
+{$ifdef AARCH64}
+                or ((taicpu(p).oppostfix = PF_W) and (taicpu(hp1).oppostfix = PF_SW))
+{$endif AARCH64}
+              ) then
+              begin
+                { With:
+                    str reg1,[ref]
+                    ldr reg2,[ref]
+
+                  If reg1 = reg2, Remove ldr.
+                  If reg1 <> reg2, replace ldr with "mov reg2,reg1"
+                }
+
+                if (SrcReg = taicpu(hp1).oper[0]^.reg) and
+                  { e.g. the ldrb in strb/ldrb is not a null operation as it clears the upper 24 bits }
+                  (taicpu(p).oppostfix=PF_None) then
+                  begin
+                    DebugMsg(SPeepholeOptimization + 'Removed redundant load instruction (store/load -> store/nop)', hp1);
+                    RemoveInstruction(hp1);
+                    Result := True;
+                    Exit;
+                  end
+                else if (getregtype(taicpu(p).oper[0]^.reg) = R_INTREGISTER) and
+                  (getregtype(taicpu(hp1).oper[0]^.reg) = R_INTREGISTER) and
+                  (getsubreg(taicpu(p).oper[0]^.reg) = getsubreg(taicpu(hp1).oper[0]^.reg)) then
+                  begin
+                    NewOp:=A_NONE;
+                    if taicpu(hp1).oppostfix=PF_None then
+                      NewOp:=A_MOV
+                    else 
+{$ifndef AARCH64}
+                      if (current_settings.cputype >= cpu_armv6) then
+{$endif not AARCH64}
+                      case taicpu(hp1).oppostfix of
+                        PF_B:
+                          NewOp := A_UXTB;
+                        PF_SB:
+                          NewOp := A_SXTB;
+                        PF_H:
+                          NewOp := A_UXTH;
+                        PF_SH:
+                          NewOp := A_SXTH;
+{$ifdef AARCH64}
+                        PF_SW:
+                          NewOp := A_SXTW;
+                        PF_W:
+                          NewOp := A_MOV;
+{$endif AARCH64}
+                      else
+                        InternalError(2021043001);
+                      end;
+                    if (NewOp<>A_None) then
+                      begin
+                        DebugMsg(SPeepholeOptimization + 'Changed ldr' + oppostfix2str[taicpu(hp1).oppostfix] + ' to ' + gas_op2str[NewOp] + ' (store/load -> store/move)', hp1);
+
+                        taicpu(hp1).oppostfix := PF_None;
+                        taicpu(hp1).opcode := NewOp;
+                        taicpu(hp1).loadreg(1, taicpu(p).oper[0]^.reg);
+                        AllocRegBetween(taicpu(p).oper[0]^.reg, p, hp1, UsedRegs);
+                        Result := True;
+                        Exit;
+                      end;
+                end
+              end
+            else if (taicpu(hp1).opcode = A_STR) and
+              RefsEqual(taicpu(hp1).oper[1]^.ref^, Reference) then
+              begin
+                { With:
+                    str reg1,[ref]
+                    str reg2,[ref]
+
+                  If reg1 <> reg2, delete the first str
+                  IF reg1 = reg2, delete the second str
+                }
+                if SrcReg = taicpu(hp1).oper[0]^.reg then
+                  begin
+                    DebugMsg(SPeepholeOptimization + 'Removed duplicate store instruction (store/store -> store/nop)', hp1);
+                    RemoveInstruction(hp1);
+                    Result := True;
+                    Exit;
+                  end
+                else if
+                  { Registers same byte size? }
+                  (tcgsize2size[reg_cgsize(taicpu(p).oper[0]^.reg)] = tcgsize2size[reg_cgsize(taicpu(hp1).oper[0]^.reg)]) then
+                  begin
+                    DebugMsg(SPeepholeOptimization + 'Removed dominated store instruction (store/store -> nop/store)', p);
+                    RemoveCurrentP(p, hp1);
+                    Result := True;
+                    Exit;
+                  end;
+              end;
+          end;
+      end;
+
+
   function TARMAsmOptimizer.OptPass1And(var p : tai) : Boolean;
     var
       hp1, hp2: tai;

compiler/globals.pas

@@ -416,7 +416,7 @@ interface
 {$if defined(m68k)}
        { Sinclair QL specific }
        sinclairql_metadata_format: string[4] = 'QHDR';
-       sinclairql_vlink_experimental: boolean = false; { temporary }
+       sinclairql_vlink_experimental: boolean = true; { temporary }
 {$endif defined(m68k)}
 
        { default name of the C-style "main" procedure of the library/program }

compiler/m68k/cpupara.pas

@@ -83,7 +83,7 @@ unit cpupara;
       begin
         { d0 and d1 are considered volatile }
         Result:=VOLATILE_INTREGISTERS;
-        if (target_info.system in [system_m68k_palmos]) or
+        if (target_info.system in [system_m68k_palmos,system_m68k_macosclassic]) or
            ((target_info.system in [system_m68k_atari]) and (calloption in [pocall_syscall])) then
           include(result,RS_D2);
       end;

compiler/msg/errore.msg

@@ -3908,10 +3908,23 @@ F*0*_Only options valid for the default or selected platform are listed.
 6*2Amot_Standard Motorola assembler
 6*2Avasm_Use vasm to assemble
 A*2Aas_Assemble using GNU AS
+A*2Aas-darwin_Assemble using GNU AS for Darwin targets
+A*2Aclang_Assemble using clang
+A*2Aelf_Assemble using internal ELF writer
+a*2Aas_Assemble using GNU AS
+a*2Aclang_Assemble using clang for darwin/ios targets
+a*2Aas-clang_Assemble using clang for other targets 
 P*2Aas_Assemble using GNU AS
 S*2Aas_Assemble using GNU AS
+s*2Aas_Assemble using GNU AS
+v*2Aas_Assemble using GNU AS
+W*2Abinaryen_Assemble using GNU AS for wasm32 (wasm-as)
+W*2Allvm-mc_Assemble using llvm-mc
+W*2Awabt_Assemble using wasa
+x*2Aas_Assemble using GNU AS
 Z*2Asdcc-sdasz80_Assemble using SDCC-SDASZ80
 Z*2Az80asm_Assemble using z80asm
+Z*2Avasm_Assemble using Vasm
 # Used only internally by IDE
 **1b_Generate browser info
 **2bl_Generate local symbol info
@@ -4183,6 +4196,7 @@ A*2Twince_Windows CE
 # aarch64 targets
 a*2Tandroid_Android
 a*2Tdarwin_Darwin/Mac OS X
+a*2Tfreebsd_FreeBSD
 a*2Tios_iOS
 a*2Tlinux_Linux
 a*2Twin64_Windows 64

compiler/msgidx.inc

@@ -1139,7 +1139,7 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 87287;
+  MsgTxtSize = 87808;
 
   MsgIdxMax : array[1..20] of longint=(
     28,107,361,131,99,63,146,36,223,68,

compiler/msgtxt.inc

@@ -1,8 +1,8 @@
 const msgtxt_codepage=20127;
 {$ifdef Delphi}
-const msgtxt : array[0..000363] of string[240]=(
+const msgtxt : array[0..000365] of string[240]=(
 {$else Delphi}
-const msgtxt : array[0..000363,1..240] of char=(
+const msgtxt : array[0..000365,1..240] of char=(
 {$endif Delphi}
   '01000_T_Compiler: $1'#000+
   '01001_D_Compiler OS: $1'#000+
@@ -1507,272 +1507,286 @@ const msgtxt : array[0..000363,1..240] of char=(
   '6*2Amot_Standard Motorola assembler'#010+
   '6*2Avasm_Use vasm to assemble'#010+
   'A*2Aas_Assemble using GNU AS'#010+
+  'A*2Aas-darwin_Assemble using GNU AS for Darwin targets'#010+
+  'A*2Aclang_As','semble using clang'#010+
+  'A*2Aelf_Assemble using internal ELF writer'#010+
+  'a*2Aas_Assemble using GNU AS'#010+
+  'a*2Aclang_Assemble using clang for darwin/ios targets'#010+
+  'a*2Aas-clang_Assemble using clang for other targets '#010+
   'P*2Aas_Assemble using GNU AS'#010+
-  'S*2Aas_Assemble using GNU AS'#010+
-  'Z*2Asdcc-','sdasz80_Assemble using SDCC-SDASZ80'#010+
+  'S*2Aas_Assemb','le using GNU AS'#010+
+  's*2Aas_Assemble using GNU AS'#010+
+  'v*2Aas_Assemble using GNU AS'#010+
+  'W*2Abinaryen_Assemble using GNU AS for wasm32 (wasm-as)'#010+
+  'W*2Allvm-mc_Assemble using llvm-mc'#010+
+  'W*2Awabt_Assemble using wasa'#010+
+  'x*2Aas_Assemble using GNU AS'#010+
+  'Z*2Asdcc-sdasz80_','Assemble using SDCC-SDASZ80'#010+
   'Z*2Az80asm_Assemble using z80asm'#010+
+  'Z*2Avasm_Assemble using Vasm'#010+
   '**1b_Generate browser info'#010+
   '**2bl_Generate local symbol info'#010+
   '**1B_Build all modules'#010+
   '**1C<x>_Code generation options:'#010+
-  '**2C3_Turn on ieee error checking for constants'#010+
-  '**2Ca<x','>_Select ABI; see fpc -i or fpc -ia for possible values'#010+
+  '**2C3_Turn on ieee error checking ','for constants'#010+
+  '**2Ca<x>_Select ABI; see fpc -i or fpc -ia for possible values'#010+
   '**2Cb_Generate code for a big-endian variant of the target architectur'+
   'e'#010+
   '**2Cc<x>_Set default calling convention to <x>'#010+
-  '**2CD_Create also dynamic library (not supported)'#010+
-  '**2Ce_Compilati','on with emulated floating point opcodes'#010+
+  '**2CD_Create also dynamic library (not suppo','rted)'#010+
+  '**2Ce_Compilation with emulated floating point opcodes'#010+
   '**2CE_Generate FPU code which can raise exceptions'#010+
   '**2Cf<x>_Select fpu instruction set to use; see fpc -i or fpc -if for '+
   'possible values'#010+
-  '**2CF<x>_Minimal floating point constant precision (default, 32',', 64)'+
+  '**2CF<x>_Minimal floating point constant p','recision (default, 32, 64)'+
   #010+
   '**2Cg_Generate PIC code'#010+
   '**2Ch<n>[,m]_<n> bytes min heap size (between 1023 and 67107840) and o'+
   'ptionally [m] max heap size'#010+
   '**2Ci_IO-checking'#010+
   'A*2CI<x>_Select instruction set on ARM: ARM or THUMB'#010+
-  'L*2Cl<x>_LLVM code generation options'#010+
-  'L*3','Clflto_Enable Link-time optimisation (needed both when compiling '+
-  'units and programs/libraries)'#010+
+  'L*2Cl<x>_LLVM code g','eneration options'#010+
+  'L*3Clflto_Enable Link-time optimisation (needed both when compiling un'+
+  'its and programs/libraries)'#010+
   'L*3Clfltonosystem_Disable LTO for the system unit (needed with at leas'+
   't Xcode 10.2 and earlier due to linker bugs)'#010+
-  'L*3Clv<x>_LLVM target version:',' Xcode-10.1, 7.0, 8.0, .., 10.0'#010+
+  'L*3Clv<x>','_LLVM target version: Xcode-10.1, 7.0, 8.0, .., 10.0'#010+
   '**2Cn_Omit linking stage'#010+
   'P*2CN_Generate nil-pointer checks (AIX-only)'#010+
   '**2Co_Check overflow of integer operations'#010+
   '**2CO_Check for possible overflow of integer operations'#010+
-  '**2Cp<x>_Select instruction set; see fp','c -i or fpc -ic for possible '+
+  '**2Cp<x>_Select in','struction set; see fpc -i or fpc -ic for possible '+
   'values'#010+
   '**2CP<x>=<y>_ packing settings'#010+
   '**3CPPACKSET=<y>_ <y> set allocation: 0, 1 or DEFAULT or NORMAL, 2, 4 '+
   'and 8'#010+
   '**3CPPACKENUM=<y>_ <y> enum packing: 0, 1, 2 and 4 or DEFAULT or NORMA'+
   'L'#010+
-  '**3CPPACKRECORD=<y>_ <y> ','record packing: 0 or DEFAULT or NORMAL, 1, '+
+  '**3C','PPACKRECORD=<y>_ <y> record packing: 0 or DEFAULT or NORMAL, 1, '+
   '2, 4, 8, 16 and 32'#010+
   '**2Cr_Range checking'#010+
   '**2CR_Verify object method call validity'#010+
   '**2Cs<n>_Set stack checking size to <n>'#010+
   '**2Ct_Stack checking (for testing only, see manual)'#010+
-  '8*2CT<x>_Target-specific',' code generation options'#010+
+  '8*2','CT<x>_Target-specific code generation options'#010+
   '3*2CT<x>_Target-specific code generation options'#010+
   '4*2CT<x>_Target-specific code generation options'#010+
   'p*2CT<x>_Target-specific code generation options'#010+
-  'P*2CT<x>_Target-specific code generation options'#010+
-  'J*2CT<x>_Target-spe','cific code generation options'#010+
+  'P*2CT<x>_Target-specific code generation option','s'#010+
+  'J*2CT<x>_Target-specific code generation options'#010+
   'A*2CT<x>_Target-specific code generation options'#010+
   'p*3CTsmalltoc_ Generate smaller TOCs at the expense of execution speed'+
   ' (AIX)'#010+
-  'P*3CTsmalltoc_ Generate smaller TOCs at the expense of execution speed'+
-  ' (AIX)'#010+
-  'J*3CTau','togetterprefix=X_  Automatically create getters for propertie'+
-  's with prefix X (empty string disables)'#010+
+  'P*3CTsmalltoc_ Generate smaller TOCs at the expense of executio','n spe'+
+  'ed (AIX)'#010+
+  'J*3CTautogetterprefix=X_  Automatically create getters for properties '+
+  'with prefix X (empty string disables)'#010+
   'J*3CTautosetterprefix=X_  Automatically create setters for properties '+
   'with prefix X (empty string disables)'#010+
-  '8*3CTcld_                 Emit ','a CLD instruction before using the x8'+
+  '8*3CTcld_ ','                Emit a CLD instruction before using the x8'+
   '6 string instructions'#010+
   '3*3CTcld_                 Emit a CLD instruction before using the x86 '+
   'string instructions'#010+
-  '4*3CTcld_                 Emit a CLD instruction before using the x86 '+
+  '4*3CTcld_                 Emit a CLD instruction before using the x86 ',
   'string instructions'#010+
-  '8','*3CTfarprocspushoddbp_       Increment BP before pushing it in the '+
-  'prologue of far functions'#010+
+  '8*3CTfarprocspushoddbp_       Increment BP before pushing it in the pr'+
+  'ologue of far functions'#010+
   'J*3CTcompactintarrayinit_ Generate smaller (but potentially slower) co'+
   'de for initializing integer array constants'#010+
-  'J*3CTenumfieldinit_       Initial','ize enumeration fields in construct'+
+  'J*3CTenumfie','ldinit_       Initialize enumeration fields in construct'+
   'ors to enumtype(0), after calling inherited constructors'#010+
   'J*3CTinitlocals_          Initialize local variables that trigger a JV'+
-  'M bytecode verification error if used uninitialized (slows down code)'#010+
-  'J*3CTlow','ercaseprocstart_  Lowercase the first character of procedure'+
-  '/function/method names'#010+
+  'M bytecode verification error if used uninitialized (slow','s down code'+
+  ')'#010+
+  'J*3CTlowercaseprocstart_  Lowercase the first character of procedure/f'+
+  'unction/method names'#010+
   'A*3CTthumbinterworking_ Generate Thumb interworking-safe code if possi'+
   'ble'#010+
   'J*2Cv_Var/out parameter copy-out checking'#010+
-  'A*2CV<x>_Set section threadvar model to <','x>'#010+
+  'A*2CV<x>_Set section',' threadvar model to <x>'#010+
   '**2CX_Create also smartlinked library'#010+
   '**1d<x>_Defines the symbol <x>'#010+
   '**1D_Generate a DEF file'#010+
   '**2DD<x>_Set the date string returned by %DATE% to x, it is not checke'+
   'd for being a valid date string'#010+
-  '**2Dd<x>_Set description to <x>'#010+
-  '**2DT<x>_','Set the time string returned by %TIME% to x, it is not chec'+
-  'ked for being a valid time string'#010+
+  '**2Dd<x>_Set descrip','tion to <x>'#010+
+  '**2DT<x>_Set the time string returned by %TIME% to x, it is not checke'+
+  'd for being a valid time string'#010+
   '**2Dv<x>_Set DLL version to <x>'#010+
   '*O2Dw_PM application'#010+
   '**1e<x>_Set path to executable'#010+
   '**1E_Same as -Cn'#010+
   '**1fPIC_Same as -Cg'#010+
-  '**1F<x>_Set file names and',' paths:'#010+
+  '**1F<','x>_Set file names and paths:'#010+
   '**2Fa<x>[,y]_(for a program) load units <x> and [y] before uses is par'+
   'sed'#010+
   '**2Fc<x>_Set input codepage to <x>'#010+
   '**2FC<x>_Set RC compiler binary name to <x>'#010+
   '**2Fd_Disable the compiler'#039's internal directory cache'#010+
-  '**2FD<x>_Set the director','y where to search for compiler utilities'#010+
+  '**2F','D<x>_Set the directory where to search for compiler utilities'#010+
   '**2Fe<x>_Redirect error output to <x>'#010+
   '**2FE<x>_Set exe/unit output path to <x>'#010+
   '**2Ff<x>_Add <x> to framework path (Darwin only), or set IDF path to <'+
   'x> (Xtensa-FreeRTOS)'#010+
-  '**2FF_Use fpcres as RC to RES',' compiler instead of windres or gorc'#010+
+  '**2FF_Us','e fpcres as RC to RES compiler instead of windres or gorc'#010+
   '**2Fi<x>_Add <x> to include path'#010+
   '**2Fl<x>_Add <x> to library path'#010+
   '**2FL<x>_Use <x> as dynamic linker'#010+
   '**2Fm<x>_Load unicode conversion table from <x>.txt in the compiler di'+
   'r'#010+
-  '**2FM<x>_Set the directory whe','re to search for unicode binary files'#010+
+  '**2FM<x>_','Set the directory where to search for unicode binary files'#010+
   '**2FN<x>_Add <x> to list of default unit scopes (namespaces)'#010+
   '**2Fo<x>_Add <x> to object path'#010+
   '**2Fr<x>_Load error message file <x>'#010+
   '**2FR<x>_Set resource (.res) linker to <x>'#010+
-  '**2Fu<x>_Add <x> to unit path',#010+
+  '**2Fu<x>','_Add <x> to unit path'#010+
   '**2FU<x>_Set unit output path to <x>, overrides -FE'#010+
   '**2FW<x>_Store generated whole-program optimization feedback in <x>'#010+
   '**2Fw<x>_Load previously stored whole-program optimization feedback fr'+
   'om <x>'#010+
-  '*g1g_Generate debug information (default f','ormat for target)'#010+
+  '*g1g_Generate debug i','nformation (default format for target)'#010+
   '*g2gc_Generate checks for pointers (experimental, only available on so'+
   'me targets, might generate false positive)'#010+
   '*g2gh_Use heaptrace unit (for memory leak/corruption debugging)'#010+
-  '*g2gl_Use line info unit (show more info with',' backtraces)'#010+
+  '*g2gl_Use line info unit',' (show more info with backtraces)'#010+
   '*g2gm_Generate Microsoft CodeView debug information (experimental)'#010+
   '*g2go<x>_Set debug information options'#010+
   '*g3godwarfsets_ Enable DWARF '#039'set'#039' type debug information (bre'+
   'aks gdb < 6.5)'#010+
-  '*g3gostabsabsincludes_ Store absolute/full i','nclude file paths in Sta'+
+  '*g3gostabsabsincludes_ ','Store absolute/full include file paths in Sta'+
   'bs'#010+
   '*g3godwarfmethodclassprefix_ Prefix method names in DWARF with class n'+
   'ame'#010+
   '*g3godwarfcpp_ Simulate C++ debug information in DWARF'#010+
-  '*g3godwarfomflinnum_ Generate line number information in OMF LINNUM re'+
-  'cords in MS LI','NK format in addition to the DWARF debug information ('+
+  '*g3godwarfomflinnum_ Generate line number information in OMF LI','NNUM '+
+  'records in MS LINK format in addition to the DWARF debug information ('+
   'Open Watcom Debugger/Linker compatibility)'#010+
   '*g2gp_Preserve case in stabs symbol names'#010+
   '*g2gs_Generate Stabs debug information'#010+
-  '*g2gt_Trash local variables (to detect uninitialized uses; mul','tiple '+
+  '*g2gt_Trash local variables (to detect un','initialized uses; multiple '+
   #039't'#039' changes the trashing value)'#010+
   '*g2gv_Generates programs traceable with Valgrind'#010+
   '*g2gw_Generate DWARFv2 debug information (same as -gw2)'#010+
   '*g2gw2_Generate DWARFv2 debug information'#010+
-  '*g2gw3_Generate DWARFv3 debug information'#010+
-  '*g2gw4_Genera','te DWARFv4 debug information (experimental)'#010+
+  '*g2gw3_Generate DWARFv3 debug info','rmation'#010+
+  '*g2gw4_Generate DWARFv4 debug information (experimental)'#010+
   '**1i_Information'#010+
   '**2iD_Return compiler date'#010+
   '**2iSO_Return compiler OS'#010+
   '**2iSP_Return compiler host processor'#010+
   '**2iTO_Return target OS'#010+
   '**2iTP_Return target processor'#010+
-  '**2iV_Return short compiler versi','on'#010+
+  '**2iV_Return',' short compiler version'#010+
   '**2iW_Return full compiler version'#010+
   '**2ia_Return list of supported ABI targets'#010+
   '**2ib_Return the used code generation backend type'#010+
   '**2ic_Return list of supported CPU instruction sets'#010+
-  '**2if_Return list of supported FPU instruction sets'#010+
-  '**2i','i_Return list of supported inline assembler modes'#010+
+  '**2if_Return list of supported FPU ','instruction sets'#010+
+  '**2ii_Return list of supported inline assembler modes'#010+
   '**2im_Return list of supported modeswitches'#010+
   '**2io_Return list of supported optimizations'#010+
   '**2ir_Return list of recognized compiler and RTL features'#010+
-  '**2it_Return list of supported targets'#010+
-  '**2i','u_Return list of supported microcontroller types'#010+
+  '**2it_Return list of s','upported targets'#010+
+  '**2iu_Return list of supported microcontroller types'#010+
   '**2iw_Return list of supported whole program optimizations'#010+
   '**1I<x>_Add <x> to include path'#010+
   '**1k<x>_Pass <x> to the linker'#010+
   '**1l_Write logo'#010+
-  '**1M<x>_Set language mode to <x> / enable modeswitch ','<x> (see option'+
+  '**1M<x>_Set language mode to <x>',' / enable modeswitch <x> (see option'+
   ' -im)'#010+
   '**2Mfpc_Free Pascal dialect (default)'#010+
   '**2Mobjfpc_FPC mode with Object Pascal support'#010+
   '**2Mdelphi_Delphi 7 compatibility mode'#010+
   '**2Mtp_TP/BP 7.0 compatibility mode'#010+
-  '**2Mmacpas_Macintosh Pascal dialects compatibility mode'#010+
-  '**2','Miso_ISO 7185 mode'#010+
+  '**2Mmacpas_Macintosh Pascal dialects c','ompatibility mode'#010+
+  '**2Miso_ISO 7185 mode'#010+
   '**2Mextendedpascal_ISO 10206 mode'#010+
   '**2Mdelphiunicode_Delphi 2009 and later compatibility mode'#010+
   '**2*_Each mode (as listed above) enables its default set of modeswitch'+
   'es.'#010+
-  '**2*_Other modeswitches are disabled and need to be en','abled one by a'+
+  '**2*_Other modeswitches are disab','led and need to be enabled one by a'+
   'nother.'#010+
   '**1M<x>-_Disable modeswitch <x> (see option -im)'#010+
   '**1n_Do not read the default config files'#010+
   '**1o<x>_Change the name of the executable produced to <x>'#010+
   '**1O<x>_Optimizations:'#010+
-  '**2O-_Disable optimizations'#010+
-  '**2O1_Level 1 opti','mizations (quick and debugger friendly)'#010+
+  '**2O-_Disable optimizatio','ns'#010+
+  '**2O1_Level 1 optimizations (quick and debugger friendly)'#010+
   '**2O2_Level 2 optimizations (-O1 + quick optimizations)'#010+
   '**2O3_Level 3 optimizations (-O2 + slow optimizations)'#010+
-  '**2O4_Level 4 optimizations (-O3 + optimizations which might have unex'+
-  'pected side effects',')'#010+
+  '**2O4_Level 4 optimizations (-O3 + optimizations which might have un','e'+
+  'xpected side effects)'#010+
   '**2Oa<x>=<y>_Set alignment'#010+
   '**2Oo[NO]<x>_Enable or disable optimizations; see fpc -i or fpc -io fo'+
   'r possible values'#010+
   '**2Op<x>_Set target cpu for optimizing; see fpc -i or fpc -ic for poss'+
   'ible values'#010+
-  '**2OW<x>_Generate whole-program optimizat','ion feedback for optimizati'+
+  '**2OW<x>_Generate wh','ole-program optimization feedback for optimizati'+
   'on <x>; see fpc -i or fpc -iw for possible values'#010+
   '**2Ow<x>_Perform whole-program optimization <x>; see fpc -i or fpc -iw'+
   ' for possible values'#010+
   '**2Os_Optimize for size rather than speed'#010+
-  '**1pg_Generate profile code fo','r gprof (defines FPC_PROFILE)'#010+
+  '**1pg_Gen','erate profile code for gprof (defines FPC_PROFILE)'#010+
   'F*1P<x>_Target CPU / compiler related options:'#010+
   'F*2PB_Show default compiler binary'#010+
   'F*2PP_Show default target cpu'#010+
   'F*2P<x>_Set target CPU (aarch64,arm,avr,i386,i8086,jvm,m68k,mips,mipse'+
-  'l,powerpc,powerpc64,sparc,x8','6_64)'#010+
+  'l,power','pc,powerpc64,sparc,x86_64)'#010+
   '**1R<x>_Assembler reading style:'#010+
   '**2Rdefault_Use default assembler for target'#010+
   '3*2Ratt_Read AT&T style assembler'#010+
   '3*2Rintel_Read Intel style assembler'#010+
   '4*2Ratt_Read AT&T style assembler'#010+
-  '4*2Rintel_Read Intel style assembler'#010+
-  '8*2Ratt_Read A','T&T style assembler'#010+
+  '4*2Rintel_Read Intel style ass','embler'#010+
+  '8*2Ratt_Read AT&T style assembler'#010+
   '8*2Rintel_Read Intel style assembler'#010+
   '6*2RMOT_Read Motorola style assembler'#010+
   '**1S<x>_Syntax options:'#010+
   '**2S2_Same as -Mobjfpc'#010+
   '**2Sc_Support operators like C (*=,+=,/= and -=)'#010+
   '**2Sa_Turn on assertions'#010+
-  '**2Sd_Same as -Mdelphi'#010+
-  '*','*2Se<x>_Error options. <x> is a combination of the following:'#010+
+  '**2','Sd_Same as -Mdelphi'#010+
+  '**2Se<x>_Error options. <x> is a combination of the following:'#010+
   '**3*_<n> : Compiler halts after the <n> errors (default is 1)'#010+
   '**3*_w : Compiler also halts after warnings'#010+
   '**3*_n : Compiler also halts after notes'#010+
-  '**3*_h : Compiler also halts af','ter hints'#010+
+  '**3*_h : C','ompiler also halts after hints'#010+
   '**2Sf_Enable certain features in compiler and RTL; see fpc -i or fpc -'+
   'ir for possible values)'#010+
   '**2Sg_Enable LABEL and GOTO (default in -Mtp and -Mdelphi)'#010+
-  '**2Sh_Use reference counted strings (ansistring by default) instead of'+
-  ' shorts','trings'#010+
+  '**2Sh_Use reference counted strings (ansistring by defau','lt) instead '+
+  'of shortstrings'#010+
   '**2Si_Turn on inlining of procedures/functions declared as "inline"'#010+
   '**2Sj_Allows typed constants to be writeable (default in all modes)'#010+
   '**2Sk_Load fpcylix unit'#010+
   '**2SI<x>_Set interface style to <x>'#010+
-  '**3SIcom_COM compatible interface (de','fault)'#010+
+  '**3SIcom_COM com','patible interface (default)'#010+
   '**3SIcorba_CORBA compatible interface'#010+
   '**2sT_Generate script only to link on target'#010+
   '**2Sm_Support macros like C (global)'#010+
   '**2So_Same as -Mtp'#010+
   '**2Sr_Transparent file names in ISO mode'#010+
-  '**2Ss_Constructor name must be init (destructor must ','be done)'#010+
+  '**2Ss_Constructor name must be i','nit (destructor must be done)'#010+
   '**2Sv_Support vector processing (use CPU vector extensions if availabl'+
   'e)'#010+
   '**2Sx_Enable exception keywords (default in Delphi/ObjFPC modes)'#010+
   '**2Sy_@<pointer> returns a typed pointer, same as $T+'#010+
-  '**1s_Do not call assembler and linker'#010+
-  '*','*2sh_Generate script to link on host'#010+
+  '**1s_Do not call a','ssembler and linker'#010+
+  '**2sh_Generate script to link on host'#010+
   '**2st_Generate script to assemble and link on target'#010+
   '**2sr_Skip register allocation phase (use with -alr)'#010+
   '**1T<x>_Target operating system:'#010+
   '3*2Tandroid_Android'#010+
   '3*2Taros_AROS'#010+
-  '3*2Tbeos_BeOS'#010+
-  '3*2Tdarwin_Darwi','n/Mac OS X'#010+
+  '3*2Tbeos_','BeOS'#010+
+  '3*2Tdarwin_Darwin/Mac OS X'#010+
   '3*2Tembedded_Embedded'#010+
   '3*2Temx_OS/2 via EMX (including EMX/RSX extender)'#010+
   '3*2Tfreebsd_FreeBSD'#010+
   '3*2Tgo32v2_Version 2 of DJ Delorie DOS extender'#010+
   '3*2Thaiku_Haiku'#010+
-  '3*2Tiphonesim_iPhoneSimulator from iOS SDK 3.2+ (older versions: -Tdar'+
-  'win',')'#010+
+  '3*2Tiphonesim_iPhoneSimulator from iOS SDK 3.2+ (old','er versions: -Td'+
+  'arwin)'#010+
   '3*2Tlinux_Linux'#010+
   '3*2Tnativent_Native NT API (experimental)'#010+
   '3*2Tnetbsd_NetBSD'#010+
@@ -1780,8 +1794,8 @@ const msgtxt : array[0..000363,1..240] of char=(
   '3*2Tnetwlibc_Novell Netware Module (libc)'#010+
   '3*2Topenbsd_OpenBSD'#010+
   '3*2Tos2_OS/2 / eComStation'#010+
-  '3*2Tsymbian_Symbian OS'#010+
-  '3*2Tsolar','is_Solaris'#010+
+  '3*2Tsymbian','_Symbian OS'#010+
+  '3*2Tsolaris_Solaris'#010+
   '3*2Twatcom_Watcom compatible DOS extender'#010+
   '3*2Twdosx_WDOSX DOS extender'#010+
   '3*2Twin32_Windows 32 Bit'#010+
@@ -1790,8 +1804,8 @@ const msgtxt : array[0..000363,1..240] of char=(
   '4*2Taros_AROS'#010+
   '4*2Tdarwin_Darwin/Mac OS X'#010+
   '4*2Tdragonfly_DragonFly BSD'#010+
-  '4*2Tembedded_Embedded'#010+
-  '4','*2Tfreebsd_FreeBSD'#010+
+  '4*','2Tembedded_Embedded'#010+
+  '4*2Tfreebsd_FreeBSD'#010+
   '4*2Thaiku_Haiku'#010+
   '4*2Tiphonesim_iPhoneSimulator'#010+
   '4*2Tlinux_Linux'#010+
@@ -1800,8 +1814,8 @@ const msgtxt : array[0..000363,1..240] of char=(
   '4*2Tsolaris_Solaris'#010+
   '4*2Twin64_Win64 (64 bit Windows systems)'#010+
   '6*2Tamiga_Commodore Amiga'#010+
-  '6*2Tatari_Atari ST/STe/TT'#010+
-  '6*2Tembe','dded_Embedded'#010+
+  '6*2Tatari_Ata','ri ST/STe/TT'#010+
+  '6*2Tembedded_Embedded'#010+
   '6*2Tlinux_Linux'#010+
   '6*2Tnetbsd_NetBSD'#010+
   '6*2Tmacosclassic_Classic Mac OS'#010+
@@ -1810,8 +1824,8 @@ const msgtxt : array[0..000363,1..240] of char=(
   '8*2Tembedded_Embedded'#010+
   '8*2Tmsdos_MS-DOS (and compatible)'#010+
   '8*2Twin16_Windows 16 Bit'#010+
-  'A*2Tandroid_Android'#010+
-  'A*2Taros_AROS'#010,
+  'A*2Tandroid_A','ndroid'#010+
+  'A*2Taros_AROS'#010+
   'A*2Tembedded_Embedded'#010+
   'A*2Tfreertos_FreeRTOS'#010+
   'A*2Tgba_Game Boy Advance'#010+
@@ -1823,7 +1837,8 @@ const msgtxt : array[0..000363,1..240] of char=(
   'A*2Tsymbian_Symbian'#010+
   'A*2Twince_Windows CE'#010+
   'a*2Tandroid_Android'#010+
-  'a*2Tdarwin_Darwin/Mac OS X',#010+
+  'a*2Td','arwin_Darwin/Mac OS X'#010+
+  'a*2Tfreebsd_FreeBSD'#010+
   'a*2Tios_iOS'#010+
   'a*2Tlinux_Linux'#010+
   'a*2Twin64_Windows 64'#010+
@@ -1835,9 +1850,9 @@ const msgtxt : array[0..000363,1..240] of char=(
   'M*2Tembedded_Embedded'#010+
   'M*2Tlinux_Linux'#010+
   'P*2Taix_AIX'#010+
-  'P*2Tamiga_AmigaOS'#010+
+  'P*2Tami','ga_AmigaOS'#010+
   'P*2Tdarwin_Darwin/Mac OS X'#010+
-  'P*2','Tembedded_Embedded'#010+
+  'P*2Tembedded_Embedded'#010+
   'P*2Tlinux_Linux'#010+
   'P*2Tmacosclassic_Classic Mac OS'#010+
   'P*2Tmorphos_MorphOS'#010+
@@ -1847,9 +1862,9 @@ const msgtxt : array[0..000363,1..240] of char=(
   'p*2Tdarwin_Darwin/Mac OS X'#010+
   'p*2Tembedded_Embedded'#010+
   'p*2Tlinux_Linux'#010+
-  'R*2Tlinux_Linux'#010+
+  'R*2Tl','inux_Linux'#010+
   'R*2Tembedded_Embedded'#010+
-  'r*2Tlinu','x_Linux'#010+
+  'r*2Tlinux_Linux'#010+
   'r*2Tembedded_Embedded'#010+
   'S*2Tlinux_Linux'#010+
   'S*2Tsolaris_Solaris'#010+
@@ -1859,162 +1874,161 @@ const msgtxt : array[0..000363,1..240] of char=(
   'x*2Tfreertos_FreeRTOS'#010+
   'x*2Tlinux_Linux'#010+
   'Z*2Tembedded_Embedded'#010+
-  'Z*2Tzxspectrum_ZX Spectrum'#010+
+  'Z*2Tzxspectru','m_ZX Spectrum'#010+
   'Z*2Tmsxdos_MSX-DOS'#010+
-  'W*2Tembe','dded_Embedded'#010+
+  'W*2Tembedded_Embedded'#010+
   'W*2Twasi_The WebAssembly System Interface (WASI)'#010+
   '**1u<x>_Undefines the symbol <x>'#010+
   '**1U_Unit options:'#010+
   '**2Un_Do not check where the unit name matches the file name'#010+
-  '**2Ur_Generate release unit files (never automatically recompile','d)'#010+
+  '**2Ur_Generate release ','unit files (never automatically recompiled)'#010+
   '**2Us_Compile a system unit'#010+
   '**1v<x>_Be verbose. <x> is a combination of the following letters:'#010+
   '**2*_e : Show errors (default)       0 : Show nothing (except errors)'#010+
-  '**2*_w : Show warnings               u : Show unit info'#010+
-  '**2*_n : Show no','tes                  t : Show tried/used files'#010+
+  '**2*_w : Show warnings         ','      u : Show unit info'#010+
+  '**2*_n : Show notes                  t : Show tried/used files'#010+
   '**2*_h : Show hints                  c : Show conditionals'#010+
   '**2*_i : Show general info           d : Show debug info'#010+
-  '**2*_l : Show linenumbers            r : Rhide/GCC compatibility mode'#010+
-  '**2*_s ',': Show time stamps            q : Show message numbers'#010+
+  '**2*_l : Show linenumbers           ',' r : Rhide/GCC compatibility mod'+
+  'e'#010+
+  '**2*_s : Show time stamps            q : Show message numbers'#010+
   '**2*_a : Show everything             x : Show info about invoked tools'+
   #010+
   '**2*_b : Write file names messages   p : Write tree.log with parse tre'+
   'e'#010+
-  '**2*_    with full path              v : W','rite fpcdebug.txt with'#010+
+  '*','*2*_    with full path              v : Write fpcdebug.txt with'#010+
   '**2*_z : Write output to stderr          lots of debugging info'#010+
   '**2*_m<x>,<y> : Do not show messages numbered <x> and <y>'#010+
-  'F*1V<x>_Append '#039'-<x>'#039' to the used compiler binary name (e.g. f'+
-  'or version)'#010+
-  '**1W<x>_Target-specif','ic options (targets)'#010+
+  'F*1V<x>_Append '#039'-<x>'#039' to the used compiler binary name',' (e.g.'+
+  ' for version)'#010+
+  '**1W<x>_Target-specific options (targets)'#010+
   '3*2WA_Specify native type application (Windows)'#010+
   '4*2WA_Specify native type application (Windows)'#010+
   'A*2WA_Specify native type application (Windows)'#010+
-  '3*2Wb_Create a bundle instead of a library (Darwin)'#010+
-  'P*2Wb_Create a bundle i','nstead of a library (Darwin)'#010+
+  '3*2Wb_Create a bundle instead of a',' library (Darwin)'#010+
+  'P*2Wb_Create a bundle instead of a library (Darwin)'#010+
   'p*2Wb_Create a bundle instead of a library (Darwin)'#010+
   'a*2Wb_Create a bundle instead of a library (Darwin)'#010+
   'A*2Wb_Create a bundle instead of a library (Darwin)'#010+
-  '4*2Wb_Create a bundle instead of a library (Darwin)'#010+
-  '3*2','WB_Create a relocatable image (Windows, Symbian)'#010+
+  '4*2Wb_Create a',' bundle instead of a library (Darwin)'#010+
+  '3*2WB_Create a relocatable image (Windows, Symbian)'#010+
   '3*2WB<x>_Set image base to <x> (Windows, Symbian)'#010+
   '4*2WB_Create a relocatable image (Windows)'#010+
   '4*2WB<x>_Set image base to <x> (Windows)'#010+
-  'A*2WB_Create a relocatable image (Windows, Symbian)'#010+
-  'A*2WB','<x>_Set image base to <x> (Windows, Symbian)'#010+
+  'A*2WB_Create a r','elocatable image (Windows, Symbian)'#010+
+  'A*2WB<x>_Set image base to <x> (Windows, Symbian)'#010+
   'Z*2WB<x>_Set image base to <x> (ZX Spectrum)'#010+
   '3*2WC_Specify console type application (EMX, OS/2, Windows)'#010+
-  '4*2WC_Specify console type application (Windows)'#010+
-  'A*2WC_Specify console type application (W','indows)'#010+
+  '4*2WC_Specify console type application (Windows)'#010,
+  'A*2WC_Specify console type application (Windows)'#010+
   'P*2WC_Specify console type application (Classic Mac OS)'#010+
   '3*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+
   '4*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+
-  'A*2WD_Use DEFFILE to export functions of DLL or EXE ','(Windows)'#010+
+  'A*2WD_Use D','EFFILE to export functions of DLL or EXE (Windows)'#010+
   '3*2We_Use external resources (Darwin)'#010+
   '4*2We_Use external resources (Darwin)'#010+
   'a*2We_Use external resources (Darwin)'#010+
   'A*2We_Use external resources (Darwin)'#010+
-  'P*2We_Use external resources (Darwin)'#010+
+  'P*2We_Use external resources (Darwin)',#010+
   'p*2We_Use external resources (Darwin)'#010+
-  '3*','2WF_Specify full-screen type application (EMX, OS/2)'#010+
+  '3*2WF_Specify full-screen type application (EMX, OS/2)'#010+
   '3*2WG_Specify graphic type application (EMX, OS/2, Windows)'#010+
   '4*2WG_Specify graphic type application (Windows)'#010+
-  'A*2WG_Specify graphic type application (Windows)'#010+
-  'P*2WG_Specify graphic type ap','plication (Classic Mac OS)'#010+
+  'A*2WG_Specify graphic type applicatio','n (Windows)'#010+
+  'P*2WG_Specify graphic type application (Classic Mac OS)'#010+
   '3*2Wi_Use internal resources (Darwin)'#010+
   '4*2Wi_Use internal resources (Darwin)'#010+
   'a*2Wi_Use internal resources (Darwin)'#010+
   'A*2Wi_Use internal resources (Darwin)'#010+
-  'P*2Wi_Use internal resources (Darwin)'#010+
-  'p*2Wi_Use internal reso','urces (Darwin)'#010+
+  'P*2Wi_Use internal r','esources (Darwin)'#010+
+  'p*2Wi_Use internal resources (Darwin)'#010+
   '3*2WI_Turn on/off the usage of import sections (Windows)'#010+
   '4*2WI_Turn on/off the usage of import sections (Windows)'#010+
   'A*2WI_Turn on/off the usage of import sections (Windows)'#010+
-  '8*2Wh_Use huge code for units (ignored for models with',' CODE in a uni'+
+  '8*2Wh_Use hug','e code for units (ignored for models with CODE in a uni'+
   'que segment)'#010+
   '8*2Wm<x>_Set memory model'#010+
   '8*3WmTiny_Tiny memory model'#010+
   '8*3WmSmall_Small memory model (default)'#010+
   '8*3WmMedium_Medium memory model'#010+
   '8*3WmCompact_Compact memory model'#010+
-  '8*3WmLarge_Large memory model'#010+
-  '8*3WmHuge_Huge memory m','odel'#010+
+  '8*3WmLarge_L','arge memory model'#010+
+  '8*3WmHuge_Huge memory model'#010+
   '3*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
   'n)'#010+
   '4*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
   'n)'#010+
-  'p*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
-  'n)'#010+
-  'P*2WM<x>_Minimum',' Mac OS X deployment version: 10.4, 10.5.1, ... (Dar'+
+  'p*2WM<x>_Minimum Mac OS X deployment version: 10','.4, 10.5.1, ... (Dar'+
   'win)'#010+
+  'P*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
+  'n)'#010+
   '3*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
   '4*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
-  'A*2WN_Do not generate relocation code, need','ed for debugging (Windows'+
+  'A*','2WN_Do not generate relocation code, needed for debugging (Windows'+
   ')'#010+
   'A*2Wp<x>_Specify the controller type; see fpc -i or fpc -iu for possib'+
   'le values'#010+
   'm*2Wp<x>_Specify the controller type; see fpc -i or fpc -iu for possib'+
   'le values'#010+
-  'R*2Wp<x>_Specify the controller type; see fpc -i or f','pc -iu for poss'+
+  'R*2Wp<x>_Spe','cify the controller type; see fpc -i or fpc -iu for poss'+
   'ible values'#010+
   'V*2Wp<x>_Specify the controller type; see fpc -i or fpc -iu for possib'+
   'le values'#010+
   'x*2Wp<x>_Specify the controller type; see fpc -i or fpc -iu for possib'+
   'le values'#010+
-  '3*2WP<x>_Minimum iOS deployment version: 3.0, 5.0.1, ','... (iphonesim)'+
+  '3*2WP<x>_Min','imum iOS deployment version: 3.0, 5.0.1, ... (iphonesim)'+
   #010+
   '4*2WP<x>_Minimum iOS deployment version: 8.0, 8.0.2, ... (iphonesim)'#010+
   'a*2WP<x>_Minimum iOS deployment version: 7.0, 7.1.2, ... (Darwin)'#010+
-  'A*2WP<x>_Minimum iOS deployment version: 3.0, 5.0.1, ... (Darwin)'#010+
-  '3*2WR_Generate relocati','on code (Windows)'#010+
+  'A*2WP<x>_Minimum iOS deployment version: 3.0, 5.','0.1, ... (Darwin)'#010+
+  '3*2WR_Generate relocation code (Windows)'#010+
   '4*2WR_Generate relocation code (Windows)'#010+
   'A*2WR_Generate relocation code (Windows)'#010+
   '8*2Wt<x>_Set the target executable format'#010+
   '8*3Wtexe_Create a DOS .EXE file (default)'#010+
-  '8*3Wtcom_Create a DOS .COM file (requires tiny memory mo','del)'#010+
+  '8*3Wtcom_Create',' a DOS .COM file (requires tiny memory model)'#010+
   'P*2WT_Specify MPW tool type application (Classic Mac OS)'#010+
   '6*2WQ<x>_Set executable metadata format (Sinclair QL)'#010+
   '6*3WQqhdr_Set metadata to QDOS File Header style (default)'#010+
-  '6*3WQxtcc_Set metadata to XTcc style'#010+
-  '**2WX_Enable executable stac','k (Linux)'#010+
+  '6*3WQxtcc_Set metadata t','o XTcc style'#010+
+  '**2WX_Enable executable stack (Linux)'#010+
   '**1X_Executable options:'#010+
   '**2X9_Generate linkerscript for GNU Binutils ld older than version 2.1'+
   '9.1 (Linux)'#010+
   '**2Xa_Generate code which allows to use more than 2 GB static data on '+
-  '64 Bit targets (Linux)'#010+
-  '**2Xc_Pass --shared/-dynamic t','o the linker (BeOS, Darwin, FreeBSD, L'+
-  'inux)'#010+
+  '64 Bit targe','ts (Linux)'#010+
+  '**2Xc_Pass --shared/-dynamic to the linker (BeOS, Darwin, FreeBSD, Lin'+
+  'ux)'#010+
   '**2Xd_Do not search default library path (sometimes required for cross'+
   '-compiling when not using -XR)'#010+
   '**2Xe_Use external linker'#010+
-  '**2Xf_Substitute pthread library name for linking (BSD)'#010+
-  '**2Xg_Create ','debuginfo in a separate file and add a debuglink sectio'+
-  'n to executable'#010+
+  '**2Xf_Substitute pthread lib','rary name for linking (BSD)'#010+
+  '**2Xg_Create debuginfo in a separate file and add a debuglink section '+
+  'to executable'#010+
   '**2XD_Try to link units dynamically      (defines FPC_LINK_DYNAMIC)'#010+
   '**2Xi_Use internal linker'#010+
-  'L*2XlS<x>_LLVM utilties suffix (e.g. -7 in case clang is called clang-'+
-  '7)'#010+
-  '**','2XLA_Define library substitutions for linking'#010+
+  'L*2XlS<x>_LLVM utilties suffix (e.','g. -7 in case clang is called clan'+
+  'g-7)'#010+
+  '**2XLA_Define library substitutions for linking'#010+
   '**2XLO_Define order of library linking'#010+
   '**2XLD_Exclude default order of standard libraries'#010+
   '**2Xm_Generate link map'#010+
-  '**2XM<x>_Set the name of the '#039'main'#039' program routine (default i'+
-  's '#039'main'#039')'#010+
-  '**2Xn_Us','e target system native linker instead of GNU ld (Solaris, AI'+
-  'X)'#010+
+  '**2XM<x>_Set the name of the '#039'main'#039' pro','gram routine (default'+
+  ' is '#039'main'#039')'#010+
+  '**2Xn_Use target system native linker instead of GNU ld (Solaris, AIX)'+
+  #010+
   'F*2Xp<x>_First search for the compiler binary in the directory <x>'#010+
   '**2XP<x>_Prepend the binutils names with the prefix <x>'#010+
-  '**2Xr<x>_Set the linker'#039's rlink-path to <x> (needed fo','r cross co'+
+  '**2Xr<x>_Set ','the linker'#039's rlink-path to <x> (needed for cross co'+
   'mpile, see the ld manual for more information) (BeOS, Linux)'#010+
   '**2XR<x>_Prepend <x> to all linker search paths (BeOS, Darwin, FreeBSD'+
   ', Linux, Mac OS, Solaris)'#010+
-  '**2Xs_Strip all symbols from executable'#010+
-  '**2XS_Try to link units staticall','y (default, defines FPC_LINK_STATIC'+
-  ')'#010+
+  '**2Xs_Strip all symbols from exe','cutable'#010+
+  '**2XS_Try to link units statically (default, defines FPC_LINK_STATIC)'#010+
   '**2Xt_Link with static libraries (-static is passed to linker)'#010+
   '**2Xu_Generate executable in UF2 format  (embedded targets only)'#010+
-  '**2Xv_Generate table for Virtual Entry calls'#010+
-  '**2XV_Use VLink as external li','nker       (default on Amiga, MorphOS)'+
-  #010+
+  '**2Xv_Generate table for Virtual E','ntry calls'#010+
+  '**2XV_Use VLink as external linker       (default on Amiga, MorphOS)'#010+
   '**2XX_Try to smartlink units             (defines FPC_LINK_SMART)'#010+
   '**1*_'#010+
   '**1?_Show this help'#010+

compiler/nflw.pas

@@ -111,6 +111,7 @@ interface
           loopiteration : tnode;
           loopvar_notid:cardinal;
           constructor create(l,r,_t1,_t2 : tnode;back : boolean);virtual;reintroduce;
+          destructor destroy;override;
           function pass_typecheck:tnode;override;
           function pass_1 : tnode;override;
           function makewhileloop : tnode;
@@ -1774,6 +1775,13 @@ implementation
          include(loopflags,lnf_testatbegin);
       end;
 
+    destructor tfornode.destroy;
+      begin
+         if assigned(loopiteration) then
+           loopiteration.destroy;
+         inherited destroy;
+      end;
+
     function tfornode.simplify(forinline : boolean) : tnode;
       begin
         result:=nil;
@@ -2734,10 +2742,10 @@ implementation
          begin
            result:=right;
            right:=nil;
-         end;
+         end
        { if the finally block contains no code, we can kill
          it and just return the try part }
-       if has_no_code(right) and not(assigned(third)) and not(implicitframe) then
+       else if has_no_code(right) and not(assigned(third)) and not(implicitframe) then
          begin
            result:=left;
            left:=nil;

compiler/options.pas

@@ -2764,7 +2764,7 @@ begin
                     'L':
                       begin
                         if (target_info.system in [system_m68k_sinclairql]) then
-                          sinclairql_vlink_experimental:=true
+                          sinclairql_vlink_experimental:=false
                         else
                           IllegalPara(opt);
                       end;

compiler/paramgr.pas

@@ -801,6 +801,12 @@ implementation
       var
         reg : tregisterrec;
       begin
+        { Explicitly zero the whole record, to avoid
+          trouble as this record is used as is in a
+          hash calculation, which might give unreliable
+          results if the record as gaps between fields
+          due to field alignment. PM 2021-05-06 }
+        fillchar(result,sizeof(trttiparaloc),#0);
         if paraloc^.Loc=LOC_REFERENCE then
           begin
             reg:=tregisterrec(paraloc^.reference.index);

compiler/rgobj.pas

@@ -2846,8 +2846,10 @@ unit rgobj;
                     set weigth of the newly allocated register higher than the old one,
                     so it will selected for spilling with a lower priority than
                     the original one, this prevents an endless spilling loop if orgreg
-                    is short living, see e.g. tw25164.pp }
-                  add_reg_instruction(instr,loadreg,reginfo[orgreg].weight+1);
+                    is short living, see e.g. tw25164.pp
+
+                    the min trick is needed to avoid an overflow in case weight=high(weight which might happen }
+                  add_reg_instruction(instr,loadreg,min(high(reginfo[orgreg].weight)-1,reginfo[orgreg].weight)+1);
                   ungetregisterinline(list,loadreg);
                 end;
             end;
@@ -2878,8 +2880,10 @@ unit rgobj;
                     set weigth of the newly allocated register higher than the old one,
                     so it will selected for spilling with a lower priority than
                     the original one, this prevents an endless spilling loop if orgreg
-                    is short living, see e.g. tw25164.pp }
-                  add_reg_instruction(instr,storereg,reginfo[orgreg].weight+1);
+                    is short living, see e.g. tw25164.pp
+
+                    the min trick is needed to avoid an overflow in case weight=high(weight which might happen }
+                  add_reg_instruction(instr,storereg,min(high(reginfo[orgreg].weight)-1,reginfo[orgreg].weight)+1);
                 end;
             end;
 

compiler/symsym.pas

@@ -1861,7 +1861,7 @@ implementation
                   (varregable <> vr_none)) or
                  (not refpara and
                   not(varregable in [vr_none,vr_addr])))
-{$if not defined(powerpc) and not defined(powerpc64)}
+{$if not defined(powerpc) and not defined(powerpc64) and not defined(aarch64)}
                 and ((vardef.typ <> recorddef) or
                      (varregable = vr_addr) or
                      tabstractrecordsymtable(tabstractrecorddef(vardef).symtable).has_single_field(tempdef) or

compiler/systems/t_sinclairql.pas

@@ -266,6 +266,7 @@ begin
   GCSectionsStr:='';
   DynLinkStr:='';
   FlagsStr:='';
+  QLFlagsStr:='';
   MapStr:='';
 
   if (cs_link_map in current_settings.globalswitches) then

compiler/utils/msgused.pl

@@ -4,8 +4,8 @@
 
 unlink("./msgidx.inc");
 unlink("./msgtxt.inc");
-@compiler_src = (glob("./*.inc"),
-                 glob("./*.pas"));
+@compiler_src = (glob("./*.inc"),glob("./*/*.inc"),
+                 glob("./*.pas"),glob("./*/*.pas"));
 
 open(MESSAGE_FILE, "< ./msg/errore.msg") or
   die "Couldn't open <./msg/errore.msg> for reading: $!\n";

packages/fcl-image/src/fpwritepnm.pp

@@ -15,8 +15,8 @@
 {*****************************************************************************}
 {Support for writing PNM (Portable aNyMap) formats added :
     * PBM (P1,P4) : Portable BitMap format : 1 bit per pixel
-    * PGM (P2,P5) : Portable GrayMap format : 8 bits per pixel
-    * PPM (P5,P6) : Portable PixelMap foramt : 24 bits per pixel}
+    * PGM (P2,P5) : Portable GrayMap format : 8 bits per pixel for P2 (ASCII), 8 or 16 bit for P5 (binary)
+    * PPM (P3,P6) : Portable PixelMap format : 24 bits per pixel for P3 (ASCII), 24 or 48 bit for P6 (binary)}
 {$mode objfpc}{$h+}
 unit FPWritePNM;
 
@@ -38,7 +38,7 @@ type
   protected
     procedure InternalWrite(Stream:TStream;Img:TFPCustomImage);override;
   public
-    Property FullWidth: Boolean Read FFullWidth Write SetFullWidth;
+    Property FullWidth: Boolean Read FFullWidth Write SetFullWidth; {if true write 16 bits per colour for P5, P6 formats}
     function GuessColorDepthOfImage(Img: TFPCustomImage): TPNMColorDepth;
     function GetColorDepthOfExtension(AExtension: string): TPNMColorDepth;
     function GetFileExtension(AColorDepth: TPNMColorDepth): string;
@@ -233,18 +233,18 @@ var useBitMapType: integer;
                 4:if(Red<=$2F00)or(Green<=$2F00)or(Blue<=$2F00)
                   then
                     aLine[Coulumn shr 3]:=aLine[Coulumn shr 3] or ($80 shr (Coulumn and $07));
-                5: if FullWidth then
-                     dLine[Coulumn]:=Word(Round(Red*0.299+Green*0.587+Blue*0.114))
-                   else
+                5: if FullWidth then {16 bit per colour}
+                     dLine[Coulumn]:=NToBe(Word(Round(Red*0.299+Green*0.587+Blue*0.114))) {write in big-endian format}
+                   else {8 bit per colour}
                      aLine[Coulumn]:=Hi(Word(Round(Red*0.299+Green*0.587+Blue*0.114)));
                 6:if FullWidth then
-                  begin
-                    dLine[3*Coulumn]:=NToBE(Red);
+                  begin {16 bit per colour}
+                    dLine[3*Coulumn]:=NToBE(Red); {write in big-endian format}
                     dLine[3*Coulumn+1]:=NToBE(Green);
                     dLine[3*Coulumn+2]:=NToBE(Blue);
                   end
                   else
-                  begin
+                  begin {8 bit per colour}
                     aLine[3*Coulumn]:=Hi(Red);
                     aLine[3*Coulumn+1]:=Hi(Green);
                     aLine[3*Coulumn+2]:=Hi(Blue);

packages/graph/src/ptcgraph/ptcgraph.pp

@@ -18,6 +18,7 @@ unit ptcgraph;
 
 {//$define logging}
 {$define FPC_GRAPH_SUPPORTS_TRUECOLOR}
+{$modeswitch DEFAULTPARAMETERS+}
 
 {******************************************************************************}
                                     interface
@@ -139,7 +140,7 @@ var
   WindowTitle: AnsiString;
   PTCWrapperObject: TPTCWrapperThread;
 
-function InstallUserMode(Width, Height: SmallInt; Colors: LongInt; HardwarePages: SmallInt; XAspect, YAspect: Word): smallint;
+function InstallUserMode(Width, Height: SmallInt; Colors: LongInt; HardwarePages: SmallInt = 1; XAspect: Word = 10000; YAspect: Word = 10000): smallint;
 
 {******************************************************************************}
                                  implementation

packages/pastojs/src/pas2jscompiler.pp

@@ -1,4 +1,4 @@
-{ Author: Mattias Gaertner  2019  [email protected]
+{ Author: Mattias Gaertner  2021  [email protected]
 
 Abstract:
   TPas2jsCompiler is the wheel boss of the pas2js compiler.
@@ -4828,7 +4828,7 @@ begin
   if FHasShownLogo then exit;
   FHasShownLogo:=true;
   WriteVersionLine;
-  Log.LogPlain('Copyright (c) 2019 Free Pascal team.');
+  Log.LogPlain('Copyright (c) 2021 Free Pascal team.');
   if coShowInfos in Options then
     WriteEncoding;
 end;

packages/qlunits/examples/mtinf.pas

@@ -0,0 +1,53 @@
+{
+    Copyright (c) 2021 Karoly Balogh
+
+    System info/System variables access on a Sinclair QL
+    Example program for Free Pascal's Sinclair QL support
+
+    This example program is in the Public Domain under the terms of
+    Unlicense: http://unlicense.org/
+
+ **********************************************************************}
+
+program mtinf;
+
+uses
+  qdos;
+
+type
+  Tver = array[0..3] of char;
+
+var
+  job_id: longint;
+  ver_ascii: longint;
+  system_vars: pbyte;
+
+function get_id_str(const id: dword): string;
+const
+  QDOS = $D2540000;
+  SMS = $53324154; { S2AT }
+  SMSQ = $534D5351; { SMSQ }
+  ARGOS_THOR = $DC010000;
+begin
+  case id of
+    QDOS: get_id_str:='QDOS';
+    SMS: get_id_str:='SMS';
+    SMSQ: get_id_str:='SMSQ';
+    ARGOS_THOR: get_id_str:='Thor (ARGOS)';
+  else
+    get_id_str:='unknown ($'+hexstr(id,8)+')';
+  end;
+end;
+
+begin
+  job_id:=mt_inf(@system_vars,@ver_ascii);
+
+  writeln('Job ID:',lo(job_id),' Tag:',hi(job_id));
+  writeln('Identification: ',get_id_str(pdword(@system_vars[SV_IDENT])^));
+  writeln('Version: ',Tver(ver_ascii));
+
+  writeln('System vars are at: $',hexstr(system_vars));
+  writeln('Processor type: 680',hexstr(system_vars[SV_PTYP],2));
+  writeln('Monitor mode: ',system_vars[SV_TVMOD]);
+  writeln('Random number: ',pword(@system_vars[SV_RAND])^);
+end.

packages/qlunits/fpmake.pp

@@ -25,6 +25,7 @@ begin
 {$endif ALLPACKAGES}
     P.Version:='3.3.1';
     P.SourcePath.Add('src');
+    P.IncludePath.Add('src');
 
     P.OSes:=[sinclairql];
 
@@ -35,6 +36,7 @@ begin
 
     P.ExamplePath.Add('examples');
     T:=P.Targets.AddExampleProgram('qlcube.pas');
+    T:=P.Targets.AddExampleProgram('mtinf.pas');
 
 {$ifndef ALLPACKAGES}
     Run;

packages/qlunits/src/qdos.pas

@@ -54,6 +54,68 @@ const
   Q_OPEN_OVER = 3;  { Not available on microdrives. }
   Q_OPEN_DIR = 4;
 
+{ sysvars offsets }
+const
+   SV_IDENT = $00;
+   SV_CHEAP = $04;
+   SV_CHPFR = $08;
+   SV_FREE = $0c;
+   SV_BASIC = $10;
+   SV_TRNSP = $14;
+   SV_TRNFR = $18;
+   SV_RESPR = $1c;
+   SV_RAMT = $20;
+   SV_RAND = $2e;
+   SV_POLLM = $30;
+   SV_TVMOD = $32;
+   SV_SCRST = $33;
+   SV_MCSTA = $34;
+   SV_PCINT = $35;
+   SV_NETNR = $37;
+   SV_I2LST = $38;
+   SV_PLIST = $3c;
+   SV_SHLST = $40;
+   SV_DRLST = $44;
+   SV_DDLST = $48;
+   SV_KEYQ = $4c;
+   SV_TRAPV = $50;
+   SV_BTPNT = $54;
+   SV_BTBAS = $58;
+   SV_BTTOP = $5c;
+   SV_JBTAG = $60;
+   SV_JBMAX = $62;
+   SV_JBPNT = $64;
+   SV_JBBAS = $68;
+   SV_JBTOP = $6c;
+   SV_CHTAG = $70;
+   SV_CHMAX = $72;
+   SV_CHPNT = $74;
+   SV_CHBAS = $78;
+   SV_CHTOP = $7c;
+   SV_CAPS = $88;
+   SV_ARBUF = $8a;
+   SV_ARDEL = $8c;
+   SV_ARFRQ = $8e;
+   SV_ARCNT = $90;
+   SV_CQCH = $92;
+   SV_SOUND = $96;
+   SV_SER1C = $98;
+   SV_SER2C = $9c;
+   SV_TMODE = $a0;
+   SV_PTYP = $a1;
+   SV_CSUB = $a2;
+   SV_TIMO = $a6;
+   SV_TIMOV = $a8;
+   SV_FSTAT = $aa;
+   SV_MDRUN = $ee;
+   SV_MDCNT = $ef;
+   SV_MDDID = $f0;
+   SV_MDSTA = $f8;
+   SV_FSDEF = $100;
+   SV_FSLST = $140;
+   SV_TOP = $180;
+
+
 type
   Tqlfloat = array[0..5] of byte;
   Pqlfloat = ^Tqlfloat;
@@ -81,43 +143,13 @@ type
   PWindowDef = ^TWindowDef;
 
 
-{ the functions declared as external here are implemented in the system unit. They're included
-  here via externals, do avoid double implementation of assembler wrappers (KB) }
-
-procedure mt_frjob(jobID: Tjobid; exitCode: longint); external name '_mt_frjob';
-function mt_inf(sys_vars: ppchar; ver_ascii: plongint): Tjobid; external name '_mt_inf';
-
-procedure mt_dmode(s_mode: pword; d_type: pword); external name '_mt_dmode';
-
-function mt_alchp(size: dword; sizegot: pdword; jobid: Tjobid): pointer; external name '_mt_alchp';
-procedure mt_rechp(area: pointer); external name '_mt_rechp';
-
-function io_open_qlstr(name_qlstr: pointer; mode: longint): Tchanid; external name '_io_open_qlstr';
-function io_open(name: pchar; mode: longint): Tchanid; external name '_io_open';
-function io_close(chan: Tchanid): longint; external name '_io_close';
-function io_delet(name: pchar): longint; external name '_io_delet';
-
-function io_fbyte(chan: Tchanid; timeout: Ttimeout): longint; external name '_io_fbyte';
-function io_fline(chan: Tchanid; timeout: Ttimeout; buf: pointer; len: word): longint; external name '_io_fline';
-function io_fstrg(chan: Tchanid; timeout: Ttimeout; buf: pointer; len: word): longint; external name '_io_fstrg';
-function io_sbyte(chan: Tchanid; timeout: Ttimeout; c: char): longint; external name '_io_sbyte';
-function io_sstrg(chan: Tchanid; timeout: Ttimeout; buf: pointer; len: word): longint; external name '_io_sstrg';
-
-function fs_posab(chan: Tchanid; var new_pos: longint): longint; external name '_fs_posab';
-function fs_posre(chan: Tchanid; var new_pos: longint): longint; external name '_fs_posre';
-function fs_headr(chan: Tchanid; buf: pointer; buf_size: word): longint; external name '_fs_headr';
-function fs_rename_qlstr(chan: Tchanid; new_name_as_qlstr: pointer): longint; external name '_fs_rename_qlstr';
-function fs_rename(chan: Tchanid; new_name: pchar): longint; external name '_fs_rename';
-function fs_truncate(chan: Tchanid): longint; external name '_fs_truncate';
-function fs_mkdir(chan: Tchanid): longint; external name '_iof_mkdr'; { SMS }
-
-function sd_wdef(chan: Tchanid; timeout: Ttimeout; border_colour: byte; border_width: word; window: PQLRect): longint; external name '_sd_wdef'; 
-function sd_clear(chan: Tchanid; timeout: Ttimeout): longint; external name '_sd_clear';
+{ the functions declared in qdosfuncs.inc are implemented in the system unit. They're included
+  here via externals, do avoid double implementation of assembler wrappers. for this reason,
+  qdosfuncs.inc in packages/qlunits must be kept identical to the one in rtl/sinclairql (KB). }
 
-function ut_con(params: PWindowDef): Tchanid; external name '_ut_con';
-function ut_scr(params: PWindowDef): Tchanid; external name '_ut_scr';
+{$i qdosfuncs.inc}
 
-function mt_rclck: longint; external name '_mt_rclck';
+{ other functions, not used/implemented by the RTL }
 
 procedure sd_point(chan: Tchanid; timeout: Ttimeout; x: Pqlfloat; y: Pqlfloat);
 procedure sd_point(chan: Tchanid; timeout: Ttimeout; x: double; y: double);

packages/qlunits/src/qdosfuncs.inc

@@ -0,0 +1,50 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2020-2021 by Karoly Balogh
+
+    Headers to QDOS OS functions used by the Sinclair QL RTL
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+procedure mt_frjob(jobID: Tjobid; exitCode: longint); external name '_mt_frjob';
+function mt_inf(sys_vars: ppchar; ver_ascii: plongint): Tjobid; external name '_mt_inf';
+
+procedure mt_dmode(s_mode: pword; d_type: pword); external name '_mt_dmode';
+
+function mt_alchp(size: dword; sizegot: pdword; jobid: Tjobid): pointer; external name '_mt_alchp';
+procedure mt_rechp(area: pointer); external name '_mt_rechp';
+
+function io_open_qlstr(name_qlstr: pointer; mode: longint): Tchanid; external name '_io_open_qlstr';
+function io_open(name: pchar; mode: longint): Tchanid; external name '_io_open';
+function io_close(chan: Tchanid): longint; external name '_io_close';
+function io_delet(name: pchar): longint; external name '_io_delet';
+
+function io_fbyte(chan: Tchanid; timeout: Ttimeout): longint; external name '_io_fbyte';
+function io_fline(chan: Tchanid; timeout: Ttimeout; buf: pointer; len: word): longint; external name '_io_fline';
+function io_fstrg(chan: Tchanid; timeout: Ttimeout; buf: pointer; len: word): longint; external name '_io_fstrg';
+function io_sbyte(chan: Tchanid; timeout: Ttimeout; c: char): longint; external name '_io_sbyte';
+function io_sstrg(chan: Tchanid; timeout: Ttimeout; buf: pointer; len: word): longint; external name '_io_sstrg';
+
+function fs_posab(chan: Tchanid; var new_pos: longint): longint; external name '_fs_posab';
+function fs_posre(chan: Tchanid; var new_pos: longint): longint; external name '_fs_posre';
+function fs_headr(chan: Tchanid; buf: pointer; buf_size: word): longint; external name '_fs_headr';
+function fs_rename_qlstr(chan: Tchanid; new_name_as_qlstr: pointer): longint; external name '_fs_rename_qlstr';
+function fs_rename(chan: Tchanid; new_name: pchar): longint; external name '_fs_rename';
+function fs_truncate(chan: Tchanid): longint; external name '_fs_truncate';
+function fs_mkdir(chan: Tchanid): longint; external name '_iof_mkdr'; { SMS }
+
+function sd_wdef(chan: Tchanid; timeout: Ttimeout; border_colour: byte; border_width: word; window: PQLRect): longint; external name '_sd_wdef'; 
+function sd_clear(chan: Tchanid; timeout: Ttimeout): longint; external name '_sd_clear';
+
+function ut_con(params: PWindowDef): Tchanid; external name '_ut_con';
+function ut_scr(params: PWindowDef): Tchanid; external name '_ut_scr';
+
+function mt_rclck: longint; external name '_mt_rclck';

packages/qlunits/src/sms.pas

@@ -22,7 +22,12 @@ uses
   qdos;
 
 
-function iof_mkdr(chan: Tchanid): longint; external name '_iof_mkdr';
+{ the functions declared in smsfuncs.inc are implemented in the system unit. They're included
+  here via externals, do avoid double implementation of assembler wrappers. for this reason,
+  smsfuncs.inc in packages/qlunits must be kept identical to the one in rtl/sinclairql (KB). }
+
+{$i smsfuncs.inc}
+
 
 implementation
 

packages/qlunits/src/smsfuncs.inc

@@ -0,0 +1,16 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2021 by Karoly Balogh
+
+    Headers to SMS only OS functions used by the Sinclair QL RTL
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+function iof_mkdr(chan: Tchanid): longint; external name '_iof_mkdr';

packages/rtl-extra/fpmake.pp

@@ -21,9 +21,9 @@ Const
 
   PrinterOSes   = [go32v2,msdos,os2,win32,win64]+unixlikes-[beos,haiku,morphos];
   SerialOSes    = [android,linux,netbsd,openbsd,win32,win64];
-  UComplexOSes  = [atari,embedded,emx,gba,go32v2,msdos,nativent,nds,netware,netwlibc,os2,symbian,watcom,wii,wince,win32,win64,freertos]+UnixLikes+AllAmigaLikeOSes;
-  MatrixOSes    = [atari,embedded,emx,gba,go32v2,msdos,nativent,nds,netware,netwlibc,os2,symbian,watcom,wii,win32,win64,wince,freertos]+UnixLikes+AllAmigaLikeOSes;
-  ObjectsOSes   = [atari,embedded,emx,gba,go32v2,macosclassic,msdos,nds,netware,netwlibc,os2,symbian,watcom,wii,win16,win32,win64,wince,freertos]+UnixLikes+AllAmigaLikeOSes;
+  UComplexOSes  = [atari,embedded,emx,gba,go32v2,msdos,nativent,nds,netware,netwlibc,os2,sinclairql,symbian,watcom,wii,wince,win32,win64,freertos]+UnixLikes+AllAmigaLikeOSes;
+  MatrixOSes    = [atari,embedded,emx,gba,go32v2,msdos,nativent,nds,netware,netwlibc,os2,sinclairql,symbian,watcom,wii,win32,win64,wince,freertos]+UnixLikes+AllAmigaLikeOSes;
+  ObjectsOSes   = [atari,embedded,emx,gba,go32v2,macosclassic,msdos,nds,netware,netwlibc,os2,sinclairql,symbian,watcom,wii,win16,win32,win64,wince,freertos]+UnixLikes+AllAmigaLikeOSes;
   WinsockOSes   = [win32,win64,wince,os2,emx,netware,netwlibc];
   WinSock2OSes  = [win32,win64,wince];
   SocketsOSes   = UnixLikes+AllAmigaLikeOSes+[netware,netwlibc,os2,emx,wince,win32,win64];

packages/rtl-objpas/fpmake.pp

@@ -15,22 +15,22 @@ Const
 //  AllUnixOSes  = [Linux,FreeBSD,NetBSD,OpenBSD,Darwin,QNX,BeOS,Solaris,Haiku,iphonesim,ios,aix,Android];
 //    unixlikes-[beos];
 //
-  StrUtilsOSes  = [atari,emx,gba,go32v2,msdos,nds,netware,wince,nativent,os2,netwlibc,symbian,watcom,wii,win32,win64,freertos]+UnixLikes+AllAmigaLikeOSes;
-  VarUtilsOSes  = [atari,emx,gba,go32v2,msdos,nds,netware,wince,nativent,os2,netwlibc,symbian,watcom,wii,win32,win64,freertos]+UnixLikes+AllAmigaLikeOSes;
-  ConvUtilsOSes = [nativent,netware,netwlibc,win32,win64,wince]+AllAmigaLikeOSes+UnixLikes-[BeOS];
+  StrUtilsOSes  = [atari,emx,gba,go32v2,msdos,nds,netware,wince,nativent,os2,netwlibc,sinclairql,symbian,watcom,wii,win32,win64,freertos]+UnixLikes+AllAmigaLikeOSes;
+  VarUtilsOSes  = [atari,emx,gba,go32v2,msdos,nds,netware,wince,nativent,os2,netwlibc,sinclairql,symbian,watcom,wii,win32,win64,freertos]+UnixLikes+AllAmigaLikeOSes;
+  ConvUtilsOSes = [nativent,netware,netwlibc,sinclairql,win32,win64,wince]+AllAmigaLikeOSes+UnixLikes-[BeOS];
   ConvUtilOSes  = [atari,Go32v2,msdos,os2,emx,freertos,watcom];
-  DateUtilsOSes = [gba,nativent,nds,netware,netwlibc,symbian,wii,win32,win64,wince,freertos]+UnixLikes+AllAmigaLikeOSes;
+  DateUtilsOSes = [gba,nativent,nds,netware,netwlibc,sinclairql,symbian,wii,win32,win64,wince,freertos]+UnixLikes+AllAmigaLikeOSes;
   DateUtilOSes  = [atari,Go32v2,msdos,os2,emx,freertos,watcom];
   StdConvsOSes  = [NativeNT,Win32,win64,os2,msdos,go32v2,freertos]+UnixLikes-[BeOS];
-  FmtBCDOSes    = [atari,emx,gba,go32v2,msdos,nativent,nds,netware,netwlibc,os2,symbian,watcom,wii,win32,win64,wince,freertos]+UnixLikes+AllAmigaLikeOSes;
-  VariantsOSes  = [atari,emx,gba,go32v2,msdos,nativent,nds,netware,netwlibc,os2,symbian,watcom,wii,win32,win64,wince,freertos]+UnixLikes+AllAmigaLikeOSes;
-  RttiOSes      = [atari,emx,gba,go32v2,msdos,nativent,nds,netware,netwlibc,os2,watcom,wii,win32,win64,wince,freertos]+UnixLikes+AllAmigaLikeOSes;
-  UItypesOSes   = [atari,emx,gba,go32v2,msdos,nativent,nds,netware,netwlibc,os2,watcom,wii,win32,win64,wince,freertos]+UnixLikes+AllAmigaLikeOSes-ConvUtilOSes;
+  FmtBCDOSes    = [atari,emx,gba,go32v2,msdos,nativent,nds,netware,netwlibc,os2,sinclairql,symbian,watcom,wii,win32,win64,wince,freertos]+UnixLikes+AllAmigaLikeOSes;
+  VariantsOSes  = [atari,emx,gba,go32v2,msdos,nativent,nds,netware,netwlibc,os2,sinclairql,symbian,watcom,wii,win32,win64,wince,freertos]+UnixLikes+AllAmigaLikeOSes;
+  RttiOSes      = [atari,emx,gba,go32v2,msdos,nativent,nds,netware,netwlibc,os2,sinclairql,watcom,wii,win32,win64,wince,freertos]+UnixLikes+AllAmigaLikeOSes;
+  UItypesOSes   = [atari,emx,gba,go32v2,msdos,nativent,nds,netware,netwlibc,os2,sinclairql,watcom,wii,win32,win64,wince,freertos]+UnixLikes+AllAmigaLikeOSes-ConvUtilOSes;
   AllTargetsObjPas = DateUtilsOses +DateUtilOSes+
                   VarutilsOses + ConvutilsOSes + ConvutilOSes + StdConvsOSes+
                   FmtBCDOSes + StrUtilsOSes + UITypesOSes;
 
-  CommonSrcOSes = [atari,emx,gba,go32v2,msdos,nds,netware,wince,nativent,os2,netwlibc,symbian,watcom,wii,freertos]+UnixLikes+AllAmigaLikeOSes;
+  CommonSrcOSes = [atari,emx,gba,go32v2,msdos,nds,netware,wince,nativent,os2,netwlibc,sinclairql,symbian,watcom,wii,freertos]+UnixLikes+AllAmigaLikeOSes;
 
 Var
   P : TPackage;

packages/rtl-objpas/src/inc/rtti.pp

@@ -113,9 +113,11 @@ type
   public
     class function Empty: TValue; static;
     class procedure Make(ABuffer: pointer; ATypeInfo: PTypeInfo; out result: TValue); static;
+    class procedure Make(AValue: NativeInt; ATypeInfo: PTypeInfo; out Result: TValue); static; inline;
     { Note: a TValue based on an open array is only valid until the routine having the open array parameter is left! }
     class procedure MakeOpenArray(AArray: Pointer; ALength: SizeInt; ATypeInfo: PTypeInfo; out Result: TValue); static;
 {$ifndef NoGenericMethods}
+    generic class procedure Make<T>(const AValue: T; out Result: TValue); static; inline;
     generic class function From<T>(constref aValue: T): TValue; static; inline;
     { Note: a TValue based on an open array is only valid until the routine having the open array parameter is left! }
     generic class function FromOpenArray<T>(constref aValue: array of T): TValue; static; inline;
@@ -1722,6 +1724,11 @@ begin
   end;
 end;
 
+class procedure TValue.Make(AValue: NativeInt; ATypeInfo: PTypeInfo; out Result: TValue);
+begin
+  TValue.Make(@AValue, ATypeInfo, Result);
+end;
+
 class procedure TValue.MakeOpenArray(AArray: Pointer; ALength: SizeInt; ATypeInfo: PTypeInfo; out Result: TValue);
 var
   el: TValue;
@@ -1749,6 +1756,11 @@ begin
 end;
 
 {$ifndef NoGenericMethods}
+generic class procedure TValue.Make<T>(const AValue: T; out Result: TValue);
+begin
+  TValue.Make(@AValue, PTypeInfo(System.TypeInfo(T)), Result);
+end;
+
 generic class function TValue.From<T>(constref aValue: T): TValue;
 begin
   TValue.Make(@aValue, PTypeInfo(System.TypeInfo(T)), Result);

packages/rtl-objpas/tests/tests.rtti.pas

@@ -78,6 +78,16 @@ type
     procedure TestMakeAnsiChar;
     procedure TestMakeWideChar;
 
+    procedure TestMakeNativeInt;
+
+    procedure TestMakeGenericNil;
+    procedure TestMakeGenericLongInt;
+    procedure TestMakeGenericString;
+    procedure TestMakeGenericObject;
+    procedure TestMakeGenericDouble;
+    procedure TestMakeGenericAnsiChar;
+    procedure TestMakeGenericWideChar;
+
     procedure TestFromOrdinal;
 
     procedure TestDataSize;
@@ -104,6 +114,10 @@ type
     procedure MakeFromOrdinalSet;
     procedure MakeFromOrdinalString;
     procedure MakeFromOrdinalNil;
+
+{$ifndef fpc}
+    procedure Ignore(const aMsg: String);
+{$endif}
   end;
 
 implementation
@@ -302,6 +316,13 @@ begin
   CheckTrue(IsTestCaseClassFound, 'RTTI information does not contain class of testcase.');
 end;*)
 
+{$ifndef fpc}
+procedure TTestCase1.Ignore(const aMsg: string);
+begin
+  { empty }
+end;
+{$endif}
+
 procedure TTestCase1.TestGetValueStringCastError;
 var
   ATestClass : TTestValueClass;
@@ -552,7 +573,7 @@ var
 begin
   fs := 3.14;
 
-  TValue.Make(@fs, TypeInfo(fs), v);
+  TValue.Make(@fs, TypeInfo(Single), v);
   CheckEquals(v.IsClass, False);
   CheckEquals(v.IsObject, False);
   CheckEquals(v.IsOrdinal, False);
@@ -586,7 +607,7 @@ var
 begin
   fd := 3.14;
 
-  TValue.Make(@fd, TypeInfo(fd), v);
+  TValue.Make(@fd, TypeInfo(Double), v);
   CheckEquals(v.IsClass, False);
   CheckEquals(v.IsObject, False);
   CheckEquals(v.IsOrdinal, False);
@@ -620,7 +641,7 @@ var
 begin
   fe := 3.14;
 
-  TValue.Make(@fe, TypeInfo(fe), v);
+  TValue.Make(@fe, TypeInfo(Extended), v);
   CheckEquals(v.IsClass, False);
   CheckEquals(v.IsObject, False);
   CheckEquals(v.IsOrdinal, False);
@@ -654,7 +675,7 @@ var
 begin
   fcu := 3.14;
 
-  TValue.Make(@fcu, TypeInfo(fcu), v);
+  TValue.Make(@fcu, TypeInfo(Currency), v);
   CheckEquals(v.IsClass, False);
   CheckEquals(v.IsObject, False);
   CheckEquals(v.IsOrdinal, False);
@@ -689,7 +710,7 @@ var
 begin
   fco := 314;
 
-  TValue.Make(@fco, TypeInfo(fco), v);
+  TValue.Make(@fco, TypeInfo(Comp), v);
 
   if v.Kind <> tkFloat then
     Exit;
@@ -726,11 +747,13 @@ var
 begin
   e := te1;
 
-  TValue.Make(@e, TypeInfo(e), v);
+  TValue.Make(@e, TypeInfo(TTestEnum), v);
   Check(not v.IsClass);
   Check(not v.IsArray);
   Check(not v.IsEmpty);
+{$ifdef fpc}
   Check(not v.IsOpenArray);
+{$endif}
   Check(not v.IsObject);
   Check(v.IsOrdinal);
 
@@ -745,11 +768,13 @@ var
 begin
   c := #20;
 
-  TValue.Make(@c, TypeInfo(c), v);
+  TValue.Make(@c, TypeInfo(AnsiChar), v);
   Check(not v.IsClass);
   Check(not v.IsArray);
   Check(not v.IsEmpty);
+{$ifdef fpc}
   Check(not v.IsOpenArray);
+{$endif}
   Check(not v.IsObject);
   Check(v.IsOrdinal);
 
@@ -765,11 +790,195 @@ var
 begin
   c := #$1234;
 
-  TValue.Make(@c, TypeInfo(c), v);
+  TValue.Make(@c, TypeInfo(WideChar), v);
   Check(not v.IsClass);
   Check(not v.IsArray);
   Check(not v.IsEmpty);
+{$ifdef fpc}
   Check(not v.IsOpenArray);
+{$endif}
+  Check(not v.IsObject);
+  Check(v.IsOrdinal);
+
+  Check(v.GetReferenceToRawData <> @c);
+  Check(WideChar(v.AsOrdinal) = #$1234);
+  Check(v.AsWideChar = #$1234);
+end;
+
+procedure TTestCase1.TestMakeNativeInt;
+var
+  fni: NativeInt;
+  s: AnsiString;
+  v: TValue;
+  o: TObject;
+begin
+  fni := 2021;
+
+  TValue.Make(fni, TypeInfo(LongInt), v);
+  CheckEquals(v.IsClass, False);
+  CheckEquals(v.IsObject, False);
+  CheckEquals(v.IsOrdinal, True);
+  Check(NativeInt(v.GetReferenceToRawData) <> fni);
+  CheckEquals(v.AsOrdinal, 2021);
+
+  s := 'Hello World';
+  TValue.Make(NativeInt(s), TypeInfo(AnsiString), v);
+  CheckEquals(v.IsClass, False);
+  CheckEquals(v.IsObject, False);
+  CheckEquals(v.IsOrdinal, False);
+  CheckEquals(v.AsString, s);
+
+  o := TObject.Create;
+  TValue.Make(NativeInt(o), TypeInfo(TObject), v);
+  CheckEquals(v.IsClass, False);
+  CheckEquals(v.IsObject, True);
+  CheckEquals(v.IsOrdinal, False);
+  Check(PPointer(v.GetReferenceToRawData)^ = Pointer(o));
+  Check(v.AsObject = o);
+  o.Free;
+end;
+
+procedure TTestCase1.TestMakeGenericNil;
+var
+  value: TValue;
+begin
+  TValue.{$ifdef fpc}specialize{$endif} Make<TObject>(Nil, value);
+  CheckTrue(value.IsEmpty);
+  CheckTrue(value.IsObject);
+  CheckTrue(value.IsClass);
+  CheckTrue(value.IsOrdinal);
+  CheckFalse(value.IsArray);
+  CheckTrue(value.AsObject=Nil);
+  CheckTrue(value.AsClass=Nil);
+  CheckTrue(value.AsInterface=Nil);
+  CheckEquals(0, value.AsOrdinal);
+
+  TValue.{$ifdef fpc}specialize{$endif} Make<TClass>(Nil, value);
+  CheckTrue(value.IsEmpty);
+  CheckTrue(value.IsClass);
+  CheckTrue(value.IsOrdinal);
+  CheckFalse(value.IsArray);
+  CheckTrue(value.AsObject=Nil);
+  CheckTrue(value.AsClass=Nil);
+  CheckTrue(value.AsInterface=Nil);
+  CheckEquals(0, value.AsOrdinal);
+end;
+
+procedure TTestCase1.TestMakeGenericLongInt;
+var
+  value: TValue;
+begin
+  TValue.{$ifdef fpc}specialize{$endif} Make<LongInt>(0, value);
+  CheckTrue(value.IsOrdinal);
+  CheckFalse(value.IsEmpty);
+  CheckFalse(value.IsClass);
+  CheckFalse(value.IsObject);
+  CheckFalse(value.IsArray);
+  CheckEquals(0, value.AsOrdinal);
+  CheckEquals(0, value.AsInteger);
+  CheckEquals(0, value.AsInt64);
+  CheckEquals(0, value.AsUInt64);
+end;
+
+procedure TTestCase1.TestMakeGenericString;
+var
+  value: TValue;
+begin
+  TValue.{$ifdef fpc}specialize{$endif} Make<String>('test', value);
+  CheckFalse(value.IsEmpty);
+  CheckFalse(value.IsObject);
+  CheckFalse(value.IsClass);
+  CheckFalse(value.IsArray);
+  CheckEquals('test', value.AsString);
+end;
+
+procedure TTestCase1.TestMakeGenericObject;
+var
+  value: TValue;
+  TestClass: TTestValueClass;
+begin
+  TestClass := TTestValueClass.Create;
+  TestClass.AInteger := 54329;
+  TValue.{$ifdef fpc}specialize{$endif} Make<TTestValueClass>(TestClass, value);
+  CheckEquals(value.IsClass, False);
+  CheckEquals(value.IsObject, True);
+  Check(value.AsObject=TestClass);
+  Check(PPointer(value.GetReferenceToRawData)^ = Pointer(TestClass));
+  CheckEquals(TTestValueClass(value.AsObject).AInteger, 54329);
+  TestClass.Free;
+end;
+
+procedure TTestCase1.TestMakeGenericDouble;
+var
+  fd: Double;
+  v: TValue;
+  hadexcept: Boolean;
+begin
+  fd := 3.14;
+
+  TValue.{$ifdef fpc}specialize{$endif} Make<Double>(fd, v);
+  CheckEquals(v.IsClass, False);
+  CheckEquals(v.IsObject, False);
+  CheckEquals(v.IsOrdinal, False);
+  Check(v.AsExtended=fd);
+  Check(v.GetReferenceToRawData <> @fd);
+
+  try
+    hadexcept := False;
+    v.AsInt64;
+  except
+    hadexcept := True;
+  end;
+
+  CheckTrue(hadexcept, 'No signed type conversion exception');
+
+  try
+    hadexcept := False;
+    v.AsUInt64;
+  except
+    hadexcept := True;
+  end;
+
+  CheckTrue(hadexcept, 'No unsigned type conversion exception');
+end;
+
+
+procedure TTestCase1.TestMakeGenericAnsiChar;
+var
+  c: AnsiChar;
+  v: TValue;
+begin
+  c := #20;
+
+  TValue.{$ifdef fpc}specialize{$endif} Make<AnsiChar>(c, v);
+  Check(not v.IsClass);
+  Check(not v.IsArray);
+  Check(not v.IsEmpty);
+{$ifdef fpc}
+  Check(not v.IsOpenArray);
+{$endif}
+  Check(not v.IsObject);
+  Check(v.IsOrdinal);
+
+  Check(v.GetReferenceToRawData <> @c);
+  Check(AnsiChar(v.AsOrdinal) = #20);
+  Check(v.AsAnsiChar = #20);
+end;
+
+procedure TTestCase1.TestMakeGenericWideChar;
+var
+  c: WideChar;
+  v: TValue;
+begin
+  c := #$1234;
+
+  TValue.{$ifdef fpc}specialize{$endif} Make<WideChar>(c, v);
+  Check(not v.IsClass);
+  Check(not v.IsArray);
+  Check(not v.IsEmpty);
+{$ifdef fpc}
+  Check(not v.IsOpenArray);
+{$endif}
   Check(not v.IsObject);
   Check(v.IsOrdinal);
 
@@ -880,9 +1089,13 @@ begin
   end;
 end;
 
-procedure TTestCase1.TestIsType;
 type
   TMyLongInt = type LongInt;
+
+procedure TTestCase1.TestIsType;
+{ Delphi does not provide type information for local types :/ }
+{type
+  TMyLongInt = type LongInt;}
 var
   v: TValue;
   l: LongInt;
@@ -890,21 +1103,21 @@ var
 begin
   l := 42;
   ml := 42;
-  TValue.Make(@l, TypeInfo(l), v);
-  Check(v.IsType(TypeInfo(l)));
-  Check(not v.IsType(TypeInfo(ml)));
+  TValue.Make(@l, TypeInfo(LongInt), v);
+  Check(v.IsType(TypeInfo(LongInt)));
+  Check(not v.IsType(TypeInfo(TMyLongInt)));
   Check(not v.IsType(TypeInfo(String)));
-  Check(v.specialize IsType<LongInt>);
-  Check(not v.specialize IsType<TMyLongInt>);
-  Check(not v.specialize IsType<String>);
+  Check(v.{$ifdef fpc}specialize{$endif} IsType<LongInt>);
+  Check(not v.{$ifdef fpc}specialize{$endif} IsType<TMyLongInt>);
+  Check(not v.{$ifdef fpc}specialize{$endif} IsType<String>);
 
-  TValue.Make(@ml, TypeInfo(ml), v);
-  Check(v.IsType(TypeInfo(ml)));
-  Check(not v.IsType(TypeInfo(l)));
+  TValue.Make(@ml, TypeInfo(TMyLongInt), v);
+  Check(v.IsType(TypeInfo(TMyLongInt)));
+  Check(not v.IsType(TypeInfo(LongInt)));
   Check(not v.IsType(TypeInfo(String)));
-  Check(v.specialize IsType<TMyLongInt>);
-  Check(not v.specialize IsType<LongInt>);
-  Check(not v.specialize IsType<String>);
+  Check(v.{$ifdef fpc}specialize{$endif} IsType<TMyLongInt>);
+  Check(not v.{$ifdef fpc}specialize{$endif} IsType<LongInt>);
+  Check(not v.{$ifdef fpc}specialize{$endif} IsType<String>);
 end;
 
 procedure TTestCase1.TestPropGetValueBoolean;
@@ -1467,7 +1680,7 @@ begin
     try
       ARttiType := c.GetType(ATestClass.ClassInfo);
       AProperty := ARttiType.GetProperty('AObject');
-      TypeInfo := GetPropInfo(ATestClass, 'AObject')^.PropType;
+      TypeInfo := GetPropInfo(ATestClass, 'AObject')^.PropType{$ifndef fpc}^{$endif};
 
       O := TPersistent.Create;
       TValue.Make(@O, TypeInfo, AValue);
@@ -1503,16 +1716,19 @@ begin
     try
       ARttiType := c.GetType(ATestClass.ClassInfo);
       AProperty := ARttiType.GetProperty('AUnknown');
-      TypeInfo := GetPropInfo(ATestClass, 'AUnknown')^.PropType;
+      TypeInfo := GetPropInfo(ATestClass, 'AUnknown')^.PropType{$ifndef fpc}^{$endif};
 
       i := TInterfacedObject.Create;
       TValue.Make(@i, TypeInfo, AValue);
       AProperty.SetValue(ATestClass, AValue);
       Check(ATestClass.AUnknown = i);
 
+    {$ifdef fpc}
+      { Delphi does not provide an implicit assignment overload for IUnknown }
       i := TInterfacedObject.Create;
       AProperty.SetValue(ATestClass, i);
       Check(ATestClass.AUnknown = i);
+    {$endif}
     finally
       AtestClass.Free;
     end;
@@ -1542,7 +1758,7 @@ begin
       ARttiType := c.GetType(ATestClass.ClassInfo);
 
       AProperty := ARttiType.GetProperty('ASingle');
-      TypeInfo := GetPropInfo(ATestClass, 'ASingle')^.PropType;
+      TypeInfo := GetPropInfo(ATestClass, 'ASingle')^.PropType{$ifndef fpc}^{$endif};
 
       S := 1.1;
       TValue.Make(@S, TypeInfo, AValue);
@@ -1554,7 +1770,7 @@ begin
       CheckEquals(S, ATestClass.ASingle, 0.001);
 
       AProperty := ARttiType.GetProperty('ADouble');
-      TypeInfo := GetPropInfo(ATestClass, 'ADouble')^.PropType;
+      TypeInfo := GetPropInfo(ATestClass, 'ADouble')^.PropType{$ifndef fpc}^{$endif};
 
       D := 2.1;
       TValue.Make(@D, TypeInfo, AValue);
@@ -1566,7 +1782,7 @@ begin
       CheckEquals(D, ATestClass.ADouble, 0.001);
 
       AProperty := ARttiType.GetProperty('AExtended');
-      TypeInfo := GetPropInfo(ATestClass, 'AExtended')^.PropType;
+      TypeInfo := GetPropInfo(ATestClass, 'AExtended')^.PropType{$ifndef fpc}^{$endif};
 
       E := 3.1;
       TValue.Make(@E, TypeInfo, AValue);
@@ -1578,7 +1794,7 @@ begin
       CheckEquals(E, ATestClass.AExtended, 0.001);
 
       AProperty := ARttiType.GetProperty('ACurrency');
-      TypeInfo := GetPropInfo(ATestClass, 'ACurrency')^.PropType;
+      TypeInfo := GetPropInfo(ATestClass, 'ACurrency')^.PropType{$ifndef fpc}^{$endif};
 
       Cur := 40;
       TValue.Make(@Cur, TypeInfo, AValue);
@@ -1590,7 +1806,7 @@ begin
       CheckEquals(Cur, ATestClass.ACurrency, 0.001);
 
       AProperty := ARttiType.GetProperty('AComp');
-      TypeInfo := GetPropInfo(ATestClass, 'AComp')^.PropType;
+      TypeInfo := GetPropInfo(ATestClass, 'AComp')^.PropType{$ifndef fpc}^{$endif};
 
       Cmp := 50;
       TValue.Make(@Cmp, TypeInfo, AValue);
@@ -1625,7 +1841,7 @@ begin
     try
       ARttiType := c.GetType(ATestClass.ClassInfo);
       AProperty := ARttiType.GetProperty('AArray');
-      TypeInfo := GetPropInfo(ATestClass, 'AArray')^.PropType;
+      TypeInfo := GetPropInfo(ATestClass, 'AArray')^.PropType{$ifndef fpc}^{$endif};
 
       A := [1, 2, 3, 4, 5];
       TValue.Make(@A, TypeInfo, AValue);

packages/rtl-objpas/tests/tests.rtti.util.pas

@@ -1,6 +1,8 @@
 unit Tests.Rtti.Util;
 
+{$ifdef fpc}
 {$mode objfpc}{$H+}
+{$endif}
 
 interface
 
@@ -10,14 +12,22 @@ uses
 {$ifndef fpc}
 type
   CodePointer = Pointer;
+  PCodePointer = ^CodePointer;
+  SizeInt = NativeInt;
+  QWord = UInt64;
 
   TValueHelper = record helper for TValue
+    class procedure Make<T>(const aValue: T; var aResult: TValue); overload; static;
     function AsUnicodeString: UnicodeString;
     function AsAnsiString: AnsiString;
     function AsChar: Char; inline;
     function AsAnsiChar: AnsiChar;
     function AsWideChar: WideChar;
   end;
+
+  TTypeDataHelper = record helper for TTypeData
+    function SetSize: SizeInt; inline;
+  end;
 {$endif}
 
 const
@@ -42,7 +52,9 @@ function GetDoubleValue(aValue: Double): TValue;
 function GetExtendedValue(aValue: Extended): TValue;
 function GetCompValue(aValue: Comp): TValue;
 function GetCurrencyValue(aValue: Currency): TValue;
+{$ifdef fpc}
 function GetArray(const aArg: array of SizeInt): TValue;
+{$endif}
 
 implementation
 
@@ -50,6 +62,11 @@ uses
   SysUtils, Math;
 
 {$ifndef fpc}
+class procedure TValueHelper.Make<T>(const aValue: T; var aResult: TValue);
+begin
+  TValue.Make(@aValue, PTypeInfo(System.TypeInfo(T)), aResult);
+end;
+
 function TValueHelper.AsUnicodeString: UnicodeString;
 begin
   Result := UnicodeString(AsString);
@@ -60,24 +77,29 @@ begin
   Result := AnsiString(AsString);
 end;
 
-function TValue.AsWideChar: WideChar;
+function TValueHelper.AsWideChar: WideChar;
 begin
   if Kind <> tkWideChar then
     raise EInvalidCast.Create('Invalid cast');
   Result := WideChar(Word(AsOrdinal));
 end;
 
-function TValue.AsAnsiChar: AnsiChar;
+function TValueHelper.AsAnsiChar: AnsiChar;
 begin
   if Kind <> tkChar then
     raise EInvalidCast.Create('Invalid cast');
   Result := AnsiChar(Byte(AsOrdinal));
 end;
 
-function TValue.AsChar: Char;
+function TValueHelper.AsChar: Char;
 begin
   Result := AsWideChar;
 end;
+
+function TTypeDataHelper.SetSize: NativeInt;
+begin
+  Result := SetTypeOrSize;
+end;
 {$endif}
 
 function CopyValue({$ifdef fpc}constref{$else}const [ref]{$endif} aValue: TValue): TValue;
@@ -105,7 +127,7 @@ var
 begin
 {$ifdef debug}
   Writeln('Empty: ', aValue1.IsEmpty, ' ', aValue2.IsEmpty);
-  Writeln('Kind: ', aValue1.Kind, ' ', aValue2.Kind);
+  Writeln('Kind: ', TypeKindToStr(aValue1.Kind), ' ', TypeKindToStr(aValue2.Kind));
   Writeln('Array: ', aValue1.IsArray, ' ', aValue2.IsArray);
 {$endif}
   if aValue1.IsEmpty and aValue2.IsEmpty then
@@ -120,7 +142,7 @@ begin
       for i := 0 to aValue1.GetArrayLength - 1 do
         if not EqualValues(aValue1.GetArrayElement(i), aValue2.GetArrayElement(i)) then begin
 {$ifdef debug}
-          Writeln('Element ', i, ' differs: ', HexStr(aValue1.GetArrayElement(i).AsOrdinal, 4), ' ', HexStr(aValue2.GetArrayElement(i).AsOrdinal, 4));
+          Writeln('Element ', i, ' differs: ', IntToHex(aValue1.GetArrayElement(i).AsOrdinal, 4), ' ', IntToHex(aValue2.GetArrayElement(i).AsOrdinal, 4));
 {$endif}
           Result := False;
           Break;
@@ -131,8 +153,10 @@ begin
     td1 := aValue1.TypeData;
     td2 := aValue2.TypeData;
     case aValue1.Kind of
+    {$ifdef fpc}
       tkBool:
         Result := aValue1.AsBoolean xor not aValue2.AsBoolean;
+    {$endif}
       tkSet:
         if td1^.SetSize = td2^.SetSize then
           if td1^.SetSize < SizeOf(SizeInt) then
@@ -144,12 +168,16 @@ begin
       tkEnumeration,
       tkChar,
       tkWChar,
+    {$ifdef fpc}
       tkUChar,
+    {$endif}
       tkInt64,
       tkInteger:
         Result := aValue1.AsOrdinal = aValue2.AsOrdinal;
+    {$ifdef fpc}
       tkQWord:
         Result := aValue1.AsUInt64 = aValue2.AsUInt64;
+    {$endif}
       tkFloat:
         if td1^.FloatType <> td2^.FloatType then
           Result := False
@@ -167,9 +195,17 @@ begin
               Result := aValue1.AsCurrency = aValue2.AsCurrency;
           end;
         end;
+    {$ifdef fpc}
       tkSString,
+    {$else}
+      tkShortString,
+    {$endif}
       tkUString,
+    {$ifdef fpc}
       tkAString,
+    {$else}
+      tkAnsiString,
+    {$endif}
       tkWString:
         Result := aValue1.AsString = aValue2.AsString;
       tkDynArray,
@@ -186,13 +222,21 @@ begin
       tkClass,
       tkClassRef,
       tkInterface,
+    {$ifdef fpc}
       tkInterfaceRaw,
+    {$endif}
       tkPointer:
         Result := PPointer(aValue1.GetReferenceToRawData)^ = PPointer(aValue2.GetReferenceToRawData)^;
+    {$ifdef fpc}
       tkProcVar:
+    {$else}
+      tkProcedure:
+    {$endif}
         Result := PCodePointer(aValue1.GetReferenceToRawData)^ = PCodePointer(aValue2.GetReferenceToRawData)^;
       tkRecord,
+    {$ifdef fpc}
       tkObject,
+    {$endif}
       tkMethod,
       tkVariant: begin
         if aValue1.DataSize = aValue2.DataSize then

rtl/aarch64/math.inc

@@ -51,7 +51,7 @@
     {$endif FPC_SYSTEM_HAS_SQRT}
 
 
-{$ifndef VER3_2}
+{$if not defined(VER3_2) and not defined(CPULLVM)}
     {$ifndef FPC_SYSTEM_HAS_FRAC}
     {$define FPC_SYSTEM_HAS_FRAC}
     function fpc_frac_real(d : ValReal) : ValReal;compilerproc;
@@ -61,7 +61,7 @@
         result:=0;
       end;
     {$endif FPC_SYSTEM_HAS_FRAC}
-{$endif VER3_2}
+{$endif not VER3_2 and not CPULLVM }
 
 
     {$ifndef FPC_SYSTEM_HAS_INT}

rtl/darwin/pthread.inc

@@ -84,3 +84,24 @@ function pthread_mutexattr_destroy(_para1:Ppthread_mutexattr_t):cint;cdecl;exter
 function pthread_mutexattr_gettype(_para1:Ppthread_mutexattr_t; _para2:Pcint):cint;cdecl;external 'c' name 'pthread_mutexattr_gettype';
 function pthread_mutexattr_settype(_para1:Ppthread_mutexattr_t; _para2:cint):cint;cdecl;external 'c' name 'pthread_mutexattr_settype';
 function pthread_cond_timedwait(__cond:ppthread_cond_t; __mutex:ppthread_mutex_t; __abstime:ptimespec):cint; cdecl;external 'c' name 'pthread_cond_timedwait';
+
+var
+  // available in macOS 10.6 / iOS 3.2 and higher
+  pthread_setname_np: function(name: PAnsiChar):cint;cdecl;
+
+var
+  PthreadDLL: Pointer;
+
+function LoadPthreads: Boolean;
+begin
+  PThreadDLL:=DlOpen('libSystem.dylib',RTLD_LAZY);
+  Result:=PThreadDLL<>Nil;
+  if not Result then
+    exit;
+  Pointer(pthread_setname_np):=dlsym(PthreadDLL,'pthread_setname_np');
+end;
+
+function UnLoadPthreads: Boolean;
+begin
+  Result:=dlclose(PThreadDLL)=0;
+end;

rtl/inc/genmath.inc

@@ -1435,6 +1435,12 @@ end;
       hfsq,f,s,z,R,w,t1,t2,dk: double;
       k,hx,i,j: longint;
       lx: longword;
+{$push}
+{ if we have to check manually fpu exceptions, then force the exit statements here to
+  throw one }
+{$CHECKFPUEXCEPTIONS+}
+{ turn off fastmath as it converts (d-d)/zero into 0 and thus not raising an exception }
+{$OPTIMIZATION NOFASTMATH}
     begin
       hx := float64high(d);
       lx := float64low(d);
@@ -1443,20 +1449,15 @@ end;
       if (hx < $00100000) then              { x < 2**-1022  }
       begin
         if (((hx and $7fffffff) or longint(lx))=0) then
-          begin
-            float_raise(float_flag_divbyzero);
-            exit(-two54/zero);                { log(+-0)=-inf }
-          end;
+          exit(-two54/zero);                { log(+-0)=-inf }
         if (hx<0) then
-          begin
-            float_raise(float_flag_invalid);
-            exit((d-d)/zero);                 { log(-#) = NaN }
-          end;
+          exit((d-d)/zero);                 { log(-#) = NaN }
         dec(k, 54); d := d * two54;         { subnormal number, scale up x }
         hx := float64high(d);
       end;
       if (hx >= $7ff00000) then
         exit(d+d);
+{$pop}
       inc(k, (hx shr 20)-1023);
       hx := hx and $000fffff;
       i := (hx + $95f64) and $100000;

rtl/inc/systemh.inc

@@ -1447,6 +1447,27 @@ procedure SetTextCodePage(var T: Text; CodePage: TSystemCodePage);
 {$ifdef FPC_HAS_FEATURE_UNICODESTRINGS}
 Function GetFullName(var T:Text) : UnicodeString;
 {$endif FPC_HAS_FEATURE_UNICODESTRINGS}
+procedure SetTextAutoFlush (var T: Text; AutoFlush: boolean);
+(* By default, output to text files is buffered in case of "regular" files,  *)
+(* i.e. files on regular block devices, and not buffered in case of various  *)
+(* other devices like console or sockets. Calling this procedure right after *)
+(* opening the file (i.e. after Rewrite or Append) allows changing the       *)
+(* default behaviour either to always perform flush after every Write or     *)
+(* WriteLn in case of AutoFlush = true, i.e. disable output buffering for    *)
+(* the given particular open text file even in case of regular files on      *)
+(* block devices, or to enforce output buffering even in case of text files  *)
+(* used for output to other devices like console or sockets in case of       *)
+(* AutoFlush = false. Note that reopening the file resets the behaviour to   *)
+(* the default. Runtime error 103 is triggered if the text file is not open, *)
+(* runtime error 105 if the text file is open strictly for input. The call   *)
+(* is ignored if InOutRes is not 0 before the call.                          *)
+function GetTextAutoFlush (var T: Text): boolean;
+(* Check whether output buffering is enabled for the currently open file, or *)
+(* not - either due to default behaviour for the associated device, or due   *)
+(* a previous call of SetTextAutoFlush. Runtime error 103 is triggered if    *)
+(* the text file is not open, runtime error 105 if the text file is open     *)
+(* strictly for input. The call is ignored if InOutRes is not 0 before the   *)
+(* call.                                                                     *)
 {$endif FPC_HAS_FEATURE_TEXTIO}
 
 {****************************************************************************

rtl/inc/text.inc

@@ -614,6 +614,42 @@ begin
 end;
 
 
+procedure SetTextAutoFlush (var T: Text; AutoFlush: boolean);[IOCheck];
+Begin
+  If InOutRes<>0 then
+   exit;
+  if TextRec(T).mode<>fmOutput then
+   begin
+     if TextRec(T).mode=fmInput then
+      InOutRes:=105
+     else
+      InOutRes:=103;
+     exit;
+   end;
+  if AutoFlush then
+   TextRec(T).FlushFunc := TextRec(T).InOutFunc
+  else
+   TextRec(T).FlushFunc := nil;
+End;
+
+
+function GetTextAutoFlush (var T: Text): boolean;[IOCheck];
+Begin
+  GetTextAutoFlush := false;
+  If InOutRes<>0 then
+   exit;
+  if TextRec(t).mode<>fmOutput then
+   begin
+     if TextRec(t).mode=fmInput then
+      InOutRes:=105
+     else
+      InOutRes:=103;
+     exit;
+   end;
+  GetTextAutoFlush := Assigned (TextRec(T).FlushFunc);
+End;
+
+
 Function fpc_get_input:PText;compilerproc;
 begin
   fpc_get_input:=@Input;

rtl/objpas/sysutils/dati.inc

@@ -1141,7 +1141,7 @@ var
             end ;
             'H':
               if isInterval then
-                StoreInt(Hour + trunc(abs(DateTime))*24, 0)
+                StoreInt(Hour + trunc(abs(DateTime))*24, Count)
               else
               if Clock12 then
               begin
@@ -1159,14 +1159,14 @@ var
                   StoreInt(Hour, 2);
               end;
             'N': if isInterval then
-                   StoreInt(Minute + (Hour + trunc(abs(DateTime))*24)*60, 0)
+                   StoreInt(Minute + (Hour + trunc(abs(DateTime))*24)*60, Count)
                  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)
+                   StoreInt(Second + (Minute + (Hour + trunc(abs(DateTime))*24)*60)*60, Count)
                  else
                  if Count = 1 then
                    StoreInt(Second, 0)

rtl/sinclairql/Makefile

@@ -3622,7 +3622,7 @@ include $(INC)/makefile.inc
 SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
 include $(PROCINC)/makefile.cpu
 SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
-SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS) qdos.inc qdosfuncs.inc sms.inc
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS) qdos.inc qdosh.inc qdosfuncs.inc sms.inc
 $(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp $(SYSDEPS)
 	$(COMPILER) $(FPC_SYSTEM_OPT) -Us -Sg @rtl.cfg $(SYSTEMUNIT).pp $(REDIR)
 uuchar$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(INC)/uuchar.pp

rtl/sinclairql/Makefile.fpc

@@ -71,7 +71,7 @@ include $(PROCINC)/makefile.cpu
 SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
 
 # Put system unit dependencies together.
-SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS) qdos.inc qdosfuncs.inc sms.inc
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS) qdos.inc qdosh.inc qdosfuncs.inc sms.inc
 
 
 #

rtl/sinclairql/qdosfuncs.inc

@@ -1,6 +1,6 @@
 {
     This file is part of the Free Pascal run time library.
-    Copyright (c) 2020 by Karoly Balogh
+    Copyright (c) 2020-2021 by Karoly Balogh
 
     Headers to QDOS OS functions used by the Sinclair QL RTL
 
@@ -13,7 +13,6 @@
 
  **********************************************************************}
 
-{$i qdosh.inc}
 
 procedure mt_frjob(jobID: Tjobid; exitCode: longint); external name '_mt_frjob';
 function mt_inf(sys_vars: ppchar; ver_ascii: plongint): Tjobid; external name '_mt_inf';

rtl/sinclairql/si_prc.pp

@@ -19,6 +19,7 @@ interface
 
 implementation
 
+{$i qdosh.inc}
 {$i qdosfuncs.inc}
 
 var
@@ -79,7 +80,7 @@ asm
     move.l (a1)+,d7
     beq @noreloc
 
-{.$DEFINE PACKEDRELOCS}
+{$DEFINE PACKEDRELOCS}
 {$IFNDEF PACKEDRELOCS}
 @relocloop:
     { we read the offsets and relocate them }

rtl/sinclairql/sysutils.pp

@@ -53,6 +53,7 @@ uses
 { Include platform independent implementation part }
 {$i sysutils.inc}
 
+{$i qdosh.inc}
 {$i qdosfuncs.inc}
 {$i smsfuncs.inc}
 
@@ -65,9 +66,17 @@ uses
 (****** non portable routines ******)
 
 function FileOpen(const FileName: rawbytestring; Mode: Integer): THandle;
+var
+  QLMode: Integer;
 begin
   FileOpen:=-1;
-  if FileOpen < -1 then
+  case Mode of
+    fmOpenRead: QLMode := Q_OPEN_IN;
+    fmOpenWrite: QLMode :=  Q_OPEN_OVER;
+    fmOpenReadWrite: QLMode := Q_OPEN;
+  end;
+  FileOpen := io_open(pchar(Filename), QLMode);
+  if FileOpen < 0 then
     FileOpen:=-1;
 end;
 
@@ -99,8 +108,9 @@ end;
 
 function FileCreate(const FileName: RawByteString) : THandle;
 begin
-  FileCreate:=-1;
-  if FileCreate < -1 then
+  DeleteFile(FileName);
+  FileCreate := io_open(pchar(FileName), Q_OPEN_NEW);
+  if FileCreate < 0 then
     FileCreate:=-1;
 end;
 
@@ -119,12 +129,12 @@ end;
 
 function FileRead(Handle: THandle; out Buffer; Count: LongInt): LongInt;
 begin
-  FileRead:=-1;
   if (Count<=0) then
     exit;
 
-  FileRead:=-1;
-  if FileRead < -1 then
+  { io_fstrg handles EOF }
+  FileRead := io_fstrg(Handle, -1, @Buffer, Count);
+  if FileRead < 0 then
     FileRead:=-1;
 end;
 
@@ -134,9 +144,8 @@ begin
   FileWrite:=-1;
   if (Count<=0) then 
     exit;
-
-  FileWrite:=-1;
-  if FileWrite < -1 then
+  FileWrite:= io_sstrg(Handle, -1, @Buffer, Count);
+  if FileWrite < 0 then
     FileWrite:=-1;
 end;
 
@@ -144,42 +153,88 @@ end;
 function FileSeek(Handle: THandle; FOffset, Origin: LongInt) : LongInt;
 var
   dosResult: longint;
-begin
-  FileSeek:=-1;
+  seekEOF: longint;
+begin
+  FileSeek := -1;
+
+  case Origin of
+    fsFromBeginning: dosResult := fs_posab(Handle, FOffset);
+    fsFromCurrent: dosResult := fs_posre(Handle, FOffset);
+    fsFromEnd: 
+      begin
+        seekEOF := $7FFFFFBF;
+        dosResult := fs_posab(Handle, seekEOF);
+        fOffset := -FOffset;
+        dosResult := fs_posre(Handle, FOffset);
+      end;  
+  end;
 
-  dosResult:=-1;
-  if dosResult < 0 then
-    exit;
+  { We might need to handle Errors in dosResult, but
+    EOF is permitted as a non-error in QDOS/SMSQ. }
+  if dosResult = ERR_EF then
+    dosResult := 0;
 
-  FileSeek:=dosResult;
+  if dosResult <> 0 then
+    begin
+      FileSeek := -1;
+      exit;
+    end;
+
+  { However, BEWARE! FS_POSAB/FS_POSRE use FOFFSET as a VAR parameter.
+    the new file position is returned in FOFFSET. }
+
+  { Did we change FOffset? }
+  FileSeek := FOffset;
 end;
 
 function FileSeek(Handle: THandle; FOffset: Int64; Origin: Longint): Int64;
+var
+  longOffset: longint;
 begin
-  FileSeek:=FileSeek(Handle,LongInt(FOffset),Origin);
+  longOffset := longint(FOffset);
+  FileSeek:=FileSeek(Handle, longOffset, Origin);
+  flush(output);
 end;
 
 
 procedure FileClose(Handle: THandle);
 begin
+  io_close(Handle);
 end;
 
 
 function FileTruncate(Handle: THandle; Size: Int64): Boolean;
 begin
-  FileTruncate:=False;
+  FileTruncate := False;
+  if FileSeek(Handle, LongInt(Size), fsFromBeginning) = -1 then
+    exit;
+  if fs_truncate(Handle) = 0 then
+    FileTruncate := True;
 end;
 
-
 function DeleteFile(const FileName: RawByteString) : Boolean;
 begin
   DeleteFile:=false;
+  if io_delet(pchar(Filename)) < 0 then
+    exit;
+  DeleteFile := True;
 end;
 
 
 function RenameFile(const OldName, NewName: RawByteString): Boolean;
+var
+  Handle: THandle;
+  QLerr: longint;
 begin
   RenameFile:=false;
+  Handle := FileOpen(OldName, fmOpenReadWrite);
+  if Handle = -1 then
+    exit;
+
+  QLerr := fs_rename(Handle, pchar(NewName));
+  FileClose(Handle);
+  if QLerr >= 0 then
+    RenameFile := true; 
 end;
 
 

rtl/unix/cthreads.pp

@@ -60,6 +60,10 @@ interface
  {$endif darwin}
 {$endif}
 
+{$if defined(Darwin) or defined(iphonesim)}
+  {$define dynpthreads}
+{$endif darwin}
+
 {$define basicevents_with_pthread_cond}
 
 Procedure SetCThreadManager;
@@ -544,6 +548,15 @@ Type  PINTRTLEvent = ^TINTRTLEvent;
           pthread_setname_np(pthread_t(threadHandle), @CuttedName[1]);
         end;
       end;
+{$elseif defined(Darwin) or defined(iphonesim)}
+  {$ifdef dynpthreads}
+      if Assigned(pthread_setname_np) then
+  {$endif dynpthreads}
+      begin
+        // only allowed to set from within the thread
+        if threadHandle=TThreadID(-1) then
+          pthread_setname_np(@ThreadName[1]);
+      end;
 {$else}
        {$Warning SetThreadDebugName needs to be implemented}
 {$endif}
@@ -559,6 +572,13 @@ Type  PINTRTLEvent = ^TINTRTLEvent;
       begin
         CSetThreadDebugNameA(threadHandle, AnsiString(ThreadName));
       end;
+{$elseif defined(Darwin) or defined(iphonesim)}
+  {$ifdef dynpthreads}
+      if Assigned(pthread_setname_np) then
+  {$endif dynpthreads}
+      begin
+        CSetThreadDebugNameA(threadHandle, AnsiString(ThreadName));
+      end;
 {$else}
        {$Warning SetThreadDebugName needs to be implemented}
 {$endif}

tests/Makefile

@@ -2421,7 +2421,7 @@ endif
 TEST_OUTPUTDIR=output/$(TEST_TARGETSUFFIX)
 C_SUBDIR=$(TEST_OS_TARGET)/$(TEST_CPU_TARGET)
 ifneq ($(DATE),__missing_command_DATE)
-TEST_DATETIME:=$(shell $(DATE) +%Y%m%d%H%M)
+TEST_DATETIME:=$(shell $(DATE) -u +%Y%m%d%H%M)
 else
 TEST_DATETIME="No-date"
 endif

tests/Makefile.fpc

@@ -111,7 +111,7 @@ C_SUBDIR=$(TEST_OS_TARGET)/$(TEST_CPU_TARGET)
 
 # Date and time the testsuite was run
 ifneq ($(DATE),__missing_command_DATE)
-TEST_DATETIME:=$(shell $(DATE) +%Y%m%d%H%M)
+TEST_DATETIME:=$(shell $(DATE) -u +%Y%m%d%H%M)
 else
 # Use a spaceless string, as it will be used for file names
 TEST_DATETIME="No-date"

tests/bench/bdiv.pp

@@ -0,0 +1,469 @@
+{ %OPT=-O2 }
+program bdiv;
+
+{$mode objfpc}{$H+}
+
+uses
+  SysUtils;
+
+{ Utility functions }
+function GetRealTime(const st: TSystemTime): Real;
+  begin
+    Result := st.Hour*3600.0 + st.Minute*60.0 + st.Second + st.MilliSecond/1000.0;
+  end;
+
+{$push}
+{$warn 5057 off}
+function GetRealTime : Real;
+  var
+    st:TSystemTime;
+  begin
+    GetLocalTime(st);
+    result:=GetRealTime(st);
+  end;
+{$pop}
+
+const
+  ITERATIONS = 524288;
+  INTERNAL_LOOPS = 64;
+
+{ TTestAncestor }
+type
+  TTestAncestor = class
+    private
+      FStartTime: Real;
+      FEndTime: Real;
+      FAvgTime: Real;
+      procedure SetStartTime;
+      procedure SetEndTime;
+    protected
+      procedure DoTestIteration(Iteration: Integer); virtual; abstract;
+    public
+      constructor Create; virtual;
+      destructor Destroy; override;
+      procedure Run;
+      function TestTitle: shortstring; virtual; abstract;
+      function WriteResults: Boolean; virtual; abstract;
+      property RunTime: Real read FAvgTime;
+  end;
+
+  TTestClass = class of TTestAncestor;
+
+  TUInt32DivTest = class(TTestAncestor)
+    protected
+      FInputArray: array[$00..$FF] of Cardinal;
+      FResultArray: array[$00..$FF] of Cardinal;
+      function GetDivisor: Cardinal; virtual; abstract;
+      function DoVariableDiv(Numerator: Cardinal): Cardinal; inline;
+    public
+      function WriteResults: Boolean; override;
+  end;
+
+  TUInt32ModTest = class(TUInt32DivTest)
+    protected
+      function DoVariableMod(Numerator: Cardinal): Cardinal; inline;
+    public
+      function WriteResults: Boolean; override;
+  end;
+
+  TSInt32DivTest = class(TTestAncestor)
+    protected
+      FInputArray: array[$00..$FF] of Integer;
+      FResultArray: array[$00..$FF] of Integer;
+      function GetDivisor: Integer; virtual; abstract;
+      function DoVariableDiv(Numerator: Integer): Integer; inline;
+    public
+      function WriteResults: Boolean; override;
+  end;
+
+  TSInt32ModTest = class(TSInt32DivTest)
+    protected
+      function DoVariableMod(Numerator: Integer): Integer; inline;
+    public
+      function WriteResults: Boolean; override;
+  end;
+
+  TUInt64DivTest = class(TTestAncestor)
+    protected
+      FInputArray: array[$00..$FF] of QWord;
+      FResultArray: array[$00..$FF] of QWord;
+      function GetDivisor: QWord; virtual; abstract;
+      function DoVariableDiv(Numerator: QWord): QWord; inline;
+    public
+      function WriteResults: Boolean; override;
+  end;
+
+  TUInt64ModTest = class(TUInt64DivTest)
+    protected
+      function DoVariableMod(Numerator: QWord): QWord; inline;
+    public
+      function WriteResults: Boolean; override;
+  end;
+
+  TSInt64DivTest = class(TTestAncestor)
+    protected
+      FInputArray: array[$00..$FF] of Int64;
+      FResultArray: array[$00..$FF] of Int64;
+      function GetDivisor: Int64; virtual; abstract;
+      function DoVariableDiv(Numerator: Int64): Int64; inline;
+    public
+      function WriteResults: Boolean; override;
+  end;
+
+  TSInt64ModTest = class(TSInt64DivTest)
+    protected
+      function DoVariableMod(Numerator: Int64): Int64; inline;
+    public
+      function WriteResults: Boolean; override;
+  end;
+
+{$I bdiv_u32.inc}
+{$I bdiv_u64.inc}
+{$I bdiv_s32.inc}
+{$I bdiv_s64.inc}
+
+{ TTestAncestor }
+
+constructor TTestAncestor.Create;
+  begin
+    FStartTime := 0;
+    FEndTime := 0;
+    FAvgTime := 0;
+  end;
+
+destructor TTestAncestor.Destroy;
+  begin
+    inherited Destroy;
+  end;
+
+procedure TTestAncestor.SetStartTime;
+  begin
+    FStartTime := GetRealTime();
+  end;
+
+procedure TTestAncestor.SetEndTime;
+  begin
+    FEndTime := GetRealTime();
+    if FEndTime < FStartTime then { Happens if the test runs past midnight }
+      FEndTime := FEndTime + 86400.0;
+  end;
+
+procedure TTestAncestor.Run;
+  var
+    X: Integer;
+  begin
+    SetStartTime;
+    for X := 0 to ITERATIONS - 1 do
+      DoTestIteration(X);
+
+    SetEndTime;
+
+    FAvgTime := FEndTime - FStartTime;
+  end;
+
+{ TUInt32DivTest }
+
+function TUInt32DivTest.DoVariableDiv(Numerator: Cardinal): Cardinal;
+  begin
+    Result := Numerator div GetDivisor;
+  end;
+
+function TUInt32DivTest.WriteResults: Boolean;
+  var
+    X: Integer;
+    Expected: Cardinal;
+  begin
+    Result := True;
+    for X := 0 to 255 do
+      begin
+        Expected := DoVariableDiv(FInputArray[X]);
+        if FResultArray[X] <> Expected then
+          begin
+            WriteLn('FAIL - ', FInputArray[X], ' div ', GetDivisor, '; expected ', Expected, ' got ', FResultArray[X]);
+            Result := False;
+            Exit;
+          end;
+      end;
+  end;
+
+{ TUInt32ModTest }
+
+function TUInt32ModTest.DoVariableMod(Numerator: Cardinal): Cardinal;
+  begin
+    Result := Numerator mod GetDivisor;
+  end;
+
+function TUInt32ModTest.WriteResults: Boolean;
+  var
+    X: Integer;
+    Expected: Cardinal;
+  begin
+    Result := True;
+    for X := 0 to 255 do
+      begin
+        Expected := DoVariableMod(FInputArray[X]);
+        if FResultArray[X] <> Expected then
+          begin
+            WriteLn('FAIL - ', FInputArray[X], ' mod ', GetDivisor, '; expected ', Expected, ' got ', FResultArray[X]);
+            Result := False;
+            Exit;
+          end;
+      end;
+  end;
+
+{ TSInt32DivTest }
+
+function TSInt32DivTest.DoVariableDiv(Numerator: Integer): Integer;
+  begin
+    Result := Numerator div GetDivisor;
+  end;
+
+function TSInt32DivTest.WriteResults: Boolean;
+  var
+    X: Integer;
+    Expected: Integer;
+  begin
+    Result := True;
+    for X := 0 to 255 do
+      begin
+        Expected := DoVariableDiv(FInputArray[X]);
+        if FResultArray[X] <> Expected then
+          begin
+            WriteLn('FAIL - ', FInputArray[X], ' div ', GetDivisor, '; expected ', Expected, ' got ', FResultArray[X]);
+            Result := False;
+            Exit;
+          end;
+      end;
+  end;
+
+{ TSInt32ModTest }
+
+function TSInt32ModTest.DoVariableMod(Numerator: Integer): Integer;
+  begin
+    Result := Numerator mod GetDivisor;
+  end;
+
+function TSInt32ModTest.WriteResults: Boolean;
+  var
+    X: Integer;
+    Expected: Integer;
+  begin
+    Result := True;
+    for X := 0 to 255 do
+      begin
+        Expected := DoVariableMod(FInputArray[X]);
+        if FResultArray[X] <> Expected then
+          begin
+            WriteLn('FAIL - ', FInputArray[X], ' mod ', GetDivisor, '; expected ', Expected, ' got ', FResultArray[X]);
+            Result := False;
+            Exit;
+          end;
+      end;
+  end;
+
+{ TUInt64DivTest }
+
+function TUInt64DivTest.DoVariableDiv(Numerator: QWord): QWord;
+  begin
+    Result := Numerator div GetDivisor;
+  end;
+
+function TUInt64DivTest.WriteResults: Boolean;
+  var
+    X: Integer;
+    Expected: QWord;
+  begin
+    Result := True;
+    for X := 0 to 255 do
+      begin
+        Expected := DoVariableDiv(FInputArray[X]);
+        if FResultArray[X] <> Expected then
+          begin
+            WriteLn('FAIL - ', FInputArray[X], ' div ', GetDivisor, '; expected ', Expected, ' got ', FResultArray[X]);
+            Result := False;
+            Exit;
+          end;
+      end;
+  end;
+
+{ TUInt64ModTest }
+
+function TUInt64ModTest.DoVariableMod(Numerator: QWord): QWord;
+  begin
+    Result := Numerator mod GetDivisor;
+  end;
+
+function TUInt64ModTest.WriteResults: Boolean;
+  var
+    X: Integer;
+    Expected: QWord;
+  begin
+    Result := True;
+    for X := 0 to 255 do
+      begin
+        Expected := DoVariableMod(FInputArray[X]);
+        if FResultArray[X] <> Expected then
+          begin
+            WriteLn('FAIL - ', FInputArray[X], ' mod ', GetDivisor, '; expected ', Expected, ' got ', FResultArray[X]);
+            Result := False;
+            Exit;
+          end;
+      end;
+  end;
+
+{ TSInt64DivTest }
+
+function TSInt64DivTest.DoVariableDiv(Numerator: Int64): Int64;
+  begin
+    Result := Numerator div GetDivisor;
+  end;
+
+function TSInt64DivTest.WriteResults: Boolean;
+  var
+    X: Integer;
+    Expected: Int64;
+  begin
+    Result := True;
+    for X := 0 to 255 do
+      begin
+        Expected := DoVariableDiv(FInputArray[X]);
+        if FResultArray[X] <> Expected then
+          begin
+            WriteLn('FAIL - ', FInputArray[X], ' div ', GetDivisor, '; expected ', Expected, ' got ', FResultArray[X]);
+            Result := False;
+            Exit;
+          end;
+      end;
+  end;
+
+{ TSInt64ModTest }
+
+function TSInt64ModTest.DoVariableMod(Numerator: Int64): Int64;
+  begin
+    Result := Numerator mod GetDivisor;
+  end;
+
+function TSInt64ModTest.WriteResults: Boolean;
+  var
+    X: Integer;
+    Expected: Int64;
+  begin
+    Result := True;
+    for X := 0 to 255 do
+      begin
+        Expected := DoVariableMod(FInputArray[X]);
+        if FResultArray[X] <> Expected then
+          begin
+            WriteLn('FAIL - ', FInputArray[X], ' mod ', GetDivisor, '; expected ', Expected, ' got ', FResultArray[X]);
+            Result := False;
+            Exit;
+          end;
+      end;
+  end;
+
+{ Main function }
+const
+  TestClasses: array[0..53] of TTestClass = (
+    TUInt32Bit1Test,
+    TUInt32Bit1ModTest,
+    TUInt32Bit2Test,
+    TUInt32Bit2ModTest,
+    TUInt32Bit3Test,
+    TUInt32Bit3ModTest,
+    TUInt32Bit10Test,
+    TUInt32Bit10ModTest,
+    TUInt32Bit100Test,
+    TUInt32Bit100ModTest,
+    TUInt32Bit1000Test,
+    TUInt32Bit1000ModTest,
+    TUInt32Bit60000Test,
+    TUInt32Bit60000ModTest,
+    TUInt32Bit146097Test,
+    TUInt32Bit146097ModTest,
+    TUInt32Bit3600000Test,
+    TUInt32Bit3600000ModTest,
+    TUInt64Bit1Test,
+    TUInt64Bit1ModTest,
+    TUInt64Bit2Test,
+    TUInt64Bit2ModTest,
+    TUInt64Bit3Test,
+    TUInt64Bit3ModTest,
+    TUInt64Bit5Test,
+    TUInt64Bit5ModTest,
+    TUInt64Bit10Test,
+    TUInt64Bit10ModTest,
+    TUInt64Bit100Test,
+    TUInt64Bit100ModTest,
+    TUInt64Bit1000000000Test,
+    TUInt64Bit1000000000ModTest,
+    TSInt32Bit1Test,
+    TSInt32Bit1ModTest,
+    TSInt32Bit100Test,
+    TSInt32Bit100ModTest,
+    TSInt64Bit1Test,
+    TSInt64Bit1ModTest,
+    TSInt64Bit10Test,
+    TSInt64Bit10ModTest,
+    TSInt64Bit18Test,
+    TSInt64Bit18ModTest,
+    TSInt64Bit24Test,
+    TSInt64Bit24ModTest,
+    TSInt64Bit100Test,
+    TSInt64Bit100ModTest,
+    TSInt64Bit153Test,
+    TSInt64Bit153ModTest,
+    TSInt64Bit1461Test,
+    TSInt64Bit1461ModTest,
+    TSInt64Bit10000Test,
+    TSInt64Bit10000ModTest,
+    TSInt64Bit86400000Test,
+    TSInt64Bit86400000ModTest
+  );
+
+var
+  CurrentObject: TTestAncestor;
+  Failed: Boolean;
+  X: Integer;
+  SummedUpAverageDuration, AverageDuration : Double;
+begin
+  SummedUpAverageDuration := 0.0;
+  Failed := False;
+  WriteLn('Division compilation and timing test (using constants from System and Sysutils)');
+  WriteLn('-------------------------------------------------------------------------------');
+  for X := Low(TestClasses) to High(TestClasses) do
+    begin
+      try
+        CurrentObject := TestClasses[X].Create;
+        try
+          Write(CurrentObject.TestTitle:43, ' - ');
+          CurrentObject.Run;
+
+          if CurrentObject.WriteResults then
+            begin
+              AverageDuration := ((CurrentObject.RunTime * 1000000000.0) / (ITERATIONS * INTERNAL_LOOPS));
+              WriteLn('Pass - average iteration duration: ', AverageDuration:1:3, ' ns');
+              SummedUpAverageDuration := SummedUpAverageDuration + AverageDuration;
+            end
+          else
+            { Final average isn't processed if a test failed, so there's no need
+              to calculate and add the average duration to it }
+            Failed := True;
+
+        finally
+          CurrentObject.Free;
+        end;
+      except on E: Exception do
+        begin
+          WriteLn('Exception "', E.ClassName, '" raised while running test object of class "', TestClasses[X].ClassName, '"');
+          Failed := True;
+        end;
+      end;
+    end;
+
+  if Failed then
+    Halt(1);
+
+  WriteLn(#10'ok');
+  WriteLn('- Sum of average durations: ', SummedUpAverageDuration:1:3, ' ns');
+  WriteLn('- Overall average duration: ', (SummedUpAverageDuration / Length(TestClasses)):1:3, ' ns');
+end.

tests/bench/bdiv_s32.inc

@@ -0,0 +1,208 @@
+type
+  { TSInt32Bit1Test }
+
+  TSInt32Bit1Test = class(TSInt32DivTest)
+    protected
+      function GetDivisor: Integer; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TSInt32Bit1ModTest }
+
+  TSInt32Bit1ModTest = class(TSInt32ModTest)
+    protected
+      function GetDivisor: Integer; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TSInt32Bit100Test }
+
+  TSInt32Bit100Test = class(TSInt32DivTest)
+    protected
+      function GetDivisor: Integer; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TSInt32Bit100ModTest }
+
+  TSInt32Bit100ModTest = class(TSInt32ModTest)
+    protected
+      function GetDivisor: Integer; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+{ TSInt32Bit1Test }
+
+function TSInt32Bit1Test.TestTitle: shortstring;
+  begin
+    Result := 'Signed 32-bit division by 1';
+  end;
+
+function TSInt32Bit1Test.GetDivisor: Integer;
+  begin
+    Result := 1;
+  end;
+
+procedure TSInt32Bit1Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Integer;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      0:
+        Numerator := -2147483648;
+      1:
+        Numerator := -2147483600;
+      2:
+        Numerator := -2147483599;
+      253:
+        Numerator := 2147483599;
+      254:
+        Numerator := 2147483600;
+      255:
+        Numerator := 2147483647;
+      else
+        Numerator := Index - 128;
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 1;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TSInt32Bit1ModTest }
+
+function TSInt32Bit1ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Signed 32-bit modulus by 1';
+  end;
+
+function TSInt32Bit1ModTest.GetDivisor: Integer;
+  begin
+    Result := 1;
+  end;
+
+procedure TSInt32Bit1ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Integer;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      0:
+        Numerator := -2147483648;
+      1:
+        Numerator := -2147483600;
+      2:
+        Numerator := -2147483599;
+      253:
+        Numerator := 2147483599;
+      254:
+        Numerator := 2147483600;
+      255:
+        Numerator := 2147483647;
+      else
+        Numerator := Index - 128;
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 1;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TSInt32Bit100Test }
+
+function TSInt32Bit100Test.TestTitle: shortstring;
+  begin
+    Result := 'Signed 32-bit division by 100';
+  end;
+
+function TSInt32Bit100Test.GetDivisor: Integer;
+  begin
+    Result := 100;
+  end;
+
+procedure TSInt32Bit100Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Integer;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      0:
+        Numerator := -2147483648;
+      1:
+        Numerator := -2147483600;
+      2:
+        Numerator := -2147483599;
+      253:
+        Numerator := 2147483599;
+      254:
+        Numerator := 2147483600;
+      255:
+        Numerator := 2147483647;
+      else
+        Numerator := Index - 128;
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 100;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TSInt32Bit100ModTest }
+
+function TSInt32Bit100ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Signed 32-bit modulus by 100';
+  end;
+
+function TSInt32Bit100ModTest.GetDivisor: Integer;
+  begin
+    Result := 100;
+  end;
+
+procedure TSInt32Bit100ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Integer;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      0:
+        Numerator := -2147483648;
+      1:
+        Numerator := -2147483600;
+      2:
+        Numerator := -2147483599;
+      253:
+        Numerator := 2147483599;
+      254:
+        Numerator := 2147483600;
+      255:
+        Numerator := 2147483647;
+      else
+        Numerator := Index - 128;
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 100;
+      
+    FResultArray[Index] := Answer;
+  end;

tests/bench/bdiv_s64.inc

@@ -0,0 +1,772 @@
+type
+  { TSInt64Bit1Test }
+
+  TSInt64Bit1Test = class(TSInt64DivTest)
+    protected
+      function GetDivisor: Int64; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TSInt64Bit1ModTest }
+
+  TSInt64Bit1ModTest = class(TSInt64ModTest)
+    protected
+      function GetDivisor: Int64; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TSInt64Bit10Test }
+
+  TSInt64Bit10Test = class(TSInt64DivTest)
+    protected
+      function GetDivisor: Int64; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TSInt64Bit10ModTest }
+
+  TSInt64Bit10ModTest = class(TSInt64ModTest)
+    protected
+      function GetDivisor: Int64; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TSInt64Bit18Test }
+
+  TSInt64Bit18Test = class(TSInt64DivTest)
+    protected
+      function GetDivisor: Int64; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TSInt64Bit18ModTest }
+
+  TSInt64Bit18ModTest = class(TSInt64ModTest)
+    protected
+      function GetDivisor: Int64; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TSInt64Bit24Test }
+
+  TSInt64Bit24Test = class(TSInt64DivTest)
+    protected
+      function GetDivisor: Int64; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TSInt64Bit24ModTest }
+
+  TSInt64Bit24ModTest = class(TSInt64ModTest)
+    protected
+      function GetDivisor: Int64; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TSInt64Bit100Test }
+
+  TSInt64Bit100Test = class(TSInt64DivTest)
+    protected
+      function GetDivisor: Int64; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TSInt64Bit100ModTest }
+
+  TSInt64Bit100ModTest = class(TSInt64ModTest)
+    protected
+      function GetDivisor: Int64; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TSInt64Bit153Test }
+const
+  FS64_153Input: array[$0..$F] of Int64 =
+    (0, 1, 152, 153, 154, -1, -152, -153, -154,
+    8000000000000000117, 8000000000000000118, 8000000000000000119, 
+    -8000000000000000117, -8000000000000000118, -8000000000000000119,
+    Int64($8000000000000000));
+
+type
+  TSInt64Bit153Test = class(TSInt64DivTest)
+    protected
+      function GetDivisor: Int64; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TSInt64Bit153ModTest }
+
+  TSInt64Bit153ModTest = class(TSInt64ModTest)
+    protected
+      function GetDivisor: Int64; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TSInt64Bit1461Test }
+const
+  FS64_1461Input: array[$0..$F] of Int64 =
+    (0, 1, 1460, 1461, 1462, -1, -1460, -1461, -1462,
+    8000000000000000582, 8000000000000000583, 8000000000000000584, 
+    -8000000000000000582, -8000000000000000583, -8000000000000000584,
+    Int64($8000000000000000));
+
+type
+  TSInt64Bit1461Test = class(TSInt64DivTest)
+    protected
+      function GetDivisor: Int64; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TSInt64Bit1461ModTest }
+
+  TSInt64Bit1461ModTest = class(TSInt64ModTest)
+    protected
+      function GetDivisor: Int64; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TSInt64Bit10000Test }
+const
+  FS64_10000Input: array[$0..$F] of Int64 =
+    (0, 1, 9999, 10000, 10001, -1, -9999, -10000, -10001,
+    7999999999999999999, 8000000000000000000, 8000000000000000001, 
+    -7999999999999999999, -8000000000000000000, -8000000000000000001,
+    Int64($8000000000000000));
+
+type
+  TSInt64Bit10000Test = class(TSInt64DivTest)
+    protected
+      function GetDivisor: Int64; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TSInt64Bit10000ModTest }
+
+  TSInt64Bit10000ModTest = class(TSInt64ModTest)
+    protected
+      function GetDivisor: Int64; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+  
+  { TSInt64Bit86400000Test }
+const
+  FS64_86400000Input: array[$0..$F] of Int64 =
+    (0, 1, 86399999, 86400000, 86400001, -1, -86399999, -86400000, -86400001,
+    8639999999999999999, 8640000000000000000, 8640000000000000001, 
+    -8639999999999999999, -8640000000000000000, -8640000000000000001,
+    Int64($8000000000000000));
+
+type
+  TSInt64Bit86400000Test = class(TSInt64DivTest)
+    protected
+      function GetDivisor: Int64; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TSInt64Bit86400000ModTest }
+
+  TSInt64Bit86400000ModTest = class(TSInt64ModTest)
+    protected
+      function GetDivisor: Int64; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+{ TSInt64Bit1Test }
+
+function TSInt64Bit1Test.TestTitle: shortstring;
+  begin
+    Result := 'Signed 64-bit division by 1';
+  end;
+
+function TSInt64Bit1Test.GetDivisor: Int64;
+  begin
+    Result := 1;
+  end;
+
+procedure TSInt64Bit1Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Int64;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      0:
+        Numerator := Int64($8000000000000000);
+      1:
+        Numerator := Int64($8000000000000006);
+      2:
+        Numerator := Int64($8000000000000007);
+      253:
+        Numerator := Int64($7FFFFFFFFFFFFFF9);
+      254:
+        Numerator := Int64($7FFFFFFFFFFFFFFA);
+      255:
+        Numerator := Int64($7FFFFFFFFFFFFFFF);
+      else
+        Numerator := Index - 128;
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 1;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TSInt64Bit1ModTest }
+
+function TSInt64Bit1ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Signed 64-bit modulus by 1';
+  end;
+
+function TSInt64Bit1ModTest.GetDivisor: Int64;
+  begin
+    Result := 1;
+  end;
+
+procedure TSInt64Bit1ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Int64;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      0:
+        Numerator := Int64($8000000000000000);
+      1:
+        Numerator := Int64($8000000000000006);
+      2:
+        Numerator := Int64($8000000000000007);
+      253:
+        Numerator := Int64($7FFFFFFFFFFFFFF9);
+      254:
+        Numerator := Int64($7FFFFFFFFFFFFFFA);
+      255:
+        Numerator := Int64($7FFFFFFFFFFFFFFF);
+      else
+        Numerator := Index - 128;
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 1;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TSInt64Bit10Test }
+
+function TSInt64Bit10Test.TestTitle: shortstring;
+  begin
+    Result := 'Signed 64-bit division by 10';
+  end;
+
+function TSInt64Bit10Test.GetDivisor: Int64;
+  begin
+    Result := 10;
+  end;
+
+procedure TSInt64Bit10Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Int64;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      0:
+        Numerator := Int64($8000000000000000);
+      1:
+        Numerator := Int64($8000000000000006);
+      2:
+        Numerator := Int64($8000000000000007);
+      253:
+        Numerator := Int64($7FFFFFFFFFFFFFF9);
+      254:
+        Numerator := Int64($7FFFFFFFFFFFFFFA);
+      255:
+        Numerator := Int64($7FFFFFFFFFFFFFFF);
+      else
+        Numerator := Index - 128;
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 10;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TSInt64Bit10ModTest }
+
+function TSInt64Bit10ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Signed 64-bit modulus by 10';
+  end;
+
+function TSInt64Bit10ModTest.GetDivisor: Int64;
+  begin
+    Result := 10;
+  end;
+
+procedure TSInt64Bit10ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Int64;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      0:
+        Numerator := Int64($8000000000000000);
+      1:
+        Numerator := Int64($8000000000000006);
+      2:
+        Numerator := Int64($8000000000000007);
+      253:
+        Numerator := Int64($7FFFFFFFFFFFFFF9);
+      254:
+        Numerator := Int64($7FFFFFFFFFFFFFFA);
+      255:
+        Numerator := Int64($7FFFFFFFFFFFFFFF);
+      else
+        Numerator := Index - 128;
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 10;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TSInt64Bit18Test }
+
+function TSInt64Bit18Test.TestTitle: shortstring;
+  begin
+    Result := 'Signed 64-bit division by 18';
+  end;
+
+function TSInt64Bit18Test.GetDivisor: Int64;
+  begin
+    Result := 18;
+  end;
+
+procedure TSInt64Bit18Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Int64;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    Numerator := Index - 128;
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 18;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TSInt64Bit18ModTest }
+
+function TSInt64Bit18ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Signed 64-bit modulus by 18';
+  end;
+
+function TSInt64Bit18ModTest.GetDivisor: Int64;
+  begin
+    Result := 18;
+  end;
+
+procedure TSInt64Bit18ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Int64;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    Numerator := Index - 128;
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 18;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TSInt64Bit24Test }
+
+function TSInt64Bit24Test.TestTitle: shortstring;
+  begin
+    Result := 'Signed 64-bit division by 24';
+  end;
+
+function TSInt64Bit24Test.GetDivisor: Int64;
+  begin
+    Result := 24;
+  end;
+
+procedure TSInt64Bit24Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Int64;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    Numerator := Index - 128;
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 24;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TSInt64Bit24ModTest }
+
+function TSInt64Bit24ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Signed 64-bit modulus by 24';
+  end;
+
+function TSInt64Bit24ModTest.GetDivisor: Int64;
+  begin
+    Result := 24;
+  end;
+
+procedure TSInt64Bit24ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Int64;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    Numerator := Index - 128;
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 24;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TSInt64Bit100Test }
+
+function TSInt64Bit100Test.TestTitle: shortstring;
+  begin
+    Result := 'Signed 64-bit division by 100';
+  end;
+
+function TSInt64Bit100Test.GetDivisor: Int64;
+  begin
+    Result := 100;
+  end;
+
+procedure TSInt64Bit100Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Int64;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      0:
+        Numerator := Int64($8000000000000000);
+      1:
+        Numerator := Int64($8000000000000008);
+      2:
+        Numerator := Int64($8000000000000009);
+      253:
+        Numerator := Int64($7FFFFFFFFFFFFFF7);
+      254:
+        Numerator := Int64($7FFFFFFFFFFFFFF8);
+      255:
+        Numerator := Int64($7FFFFFFFFFFFFFFF);
+      else
+        Numerator := Index - 128;
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 100;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TSInt64Bit100ModTest }
+
+function TSInt64Bit100ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Signed 64-bit modulus by 100';
+  end;
+
+function TSInt64Bit100ModTest.GetDivisor: Int64;
+  begin
+    Result := 100;
+  end;
+
+procedure TSInt64Bit100ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Int64;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      0:
+        Numerator := Int64($8000000000000000);
+      1:
+        Numerator := Int64($8000000000000008);
+      2:
+        Numerator := Int64($8000000000000009);
+      253:
+        Numerator := Int64($7FFFFFFFFFFFFFF7);
+      254:
+        Numerator := Int64($7FFFFFFFFFFFFFF8);
+      255:
+        Numerator := Int64($7FFFFFFFFFFFFFFF);
+      else
+        Numerator := Index - 128;
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 100;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TSInt64Bit153Test }
+
+function TSInt64Bit153Test.TestTitle: shortstring;
+  begin
+    Result := 'Signed 64-bit division by 153';
+  end;
+
+function TSInt64Bit153Test.GetDivisor: Int64;
+  begin
+    Result := 153;
+  end;
+
+procedure TSInt64Bit153Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Int64;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    Numerator := FS64_153Input[Index and $F];
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 153;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TSInt64Bit153ModTest }
+
+function TSInt64Bit153ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Signed 64-bit modulus by 153';
+  end;
+
+function TSInt64Bit153ModTest.GetDivisor: Int64;
+  begin
+    Result := 153;
+  end;
+
+procedure TSInt64Bit153ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Int64;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    Numerator := FS64_153Input[Index and $F];
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 153;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TSInt64Bit1461Test }
+
+function TSInt64Bit1461Test.TestTitle: shortstring;
+  begin
+    Result := 'Signed 64-bit division by 1,461';
+  end;
+
+function TSInt64Bit1461Test.GetDivisor: Int64;
+  begin
+    Result := 1461;
+  end;
+
+procedure TSInt64Bit1461Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Int64;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    Numerator := FS64_1461Input[Index and $F];
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 1461;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TSInt64Bit1461ModTest }
+
+function TSInt64Bit1461ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Signed 64-bit modulus by 1,461';
+  end;
+
+function TSInt64Bit1461ModTest.GetDivisor: Int64;
+  begin
+    Result := 1461;
+  end;
+
+procedure TSInt64Bit1461ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Int64;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    Numerator := FS64_1461Input[Index and $F];
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 1461;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TSInt64Bit10000Test }
+
+function TSInt64Bit10000Test.TestTitle: shortstring;
+  begin
+    Result := 'Signed 64-bit division by 10,000 (Currency)';
+  end;
+
+function TSInt64Bit10000Test.GetDivisor: Int64;
+  begin
+    Result := 10000;
+  end;
+
+procedure TSInt64Bit10000Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Int64;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    Numerator := FS64_10000Input[Index and $F];
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 10000;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TSInt64Bit10000ModTest }
+
+function TSInt64Bit10000ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Signed 64-bit modulus by 10,000 (Currency)';
+  end;
+
+function TSInt64Bit10000ModTest.GetDivisor: Int64;
+  begin
+    Result := 10000;
+  end;
+
+procedure TSInt64Bit10000ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Int64;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    Numerator := FS64_10000Input[Index and $F];
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 10000;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TSInt64Bit86400000Test }
+
+function TSInt64Bit86400000Test.TestTitle: shortstring;
+  begin
+    Result := 'Signed 64-bit division by 86,400,000';
+  end;
+
+function TSInt64Bit86400000Test.GetDivisor: Int64;
+  begin
+    Result := 86400000;
+  end;
+
+procedure TSInt64Bit86400000Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Int64;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    Numerator := FS64_86400000Input[Index and $F];
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 86400000;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TSInt64Bit86400000ModTest }
+
+function TSInt64Bit86400000ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Signed 64-bit modulus by 86,400,000';
+  end;
+
+function TSInt64Bit86400000ModTest.GetDivisor: Int64;
+  begin
+    Result := 86400000;
+  end;
+
+procedure TSInt64Bit86400000ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Int64;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    Numerator := FS64_86400000Input[Index and $F];
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 86400000;
+      
+    FResultArray[Index] := Answer;
+  end;

tests/bench/bdiv_u32.inc

@@ -0,0 +1,769 @@
+type
+  { TUInt32Bit1Test }
+
+  TUInt32Bit1Test = class(TUInt32DivTest)
+    protected
+      function GetDivisor: Cardinal; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt32Bit1ModTest }
+
+  TUInt32Bit1ModTest = class(TUInt32ModTest)
+    protected
+      function GetDivisor: Cardinal; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt32Bit2Test }
+
+  TUInt32Bit2Test = class(TUInt32DivTest)
+    protected
+      function GetDivisor: Cardinal; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt32Bit2ModTest }
+
+  TUInt32Bit2ModTest = class(TUInt32ModTest)
+    protected
+      function GetDivisor: Cardinal; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt32Bit3Test }
+
+  TUInt32Bit3Test = class(TUInt32DivTest)
+    protected
+      function GetDivisor: Cardinal; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt32Bit3ModTest }
+
+  TUInt32Bit3ModTest = class(TUInt32ModTest)
+    protected
+      function GetDivisor: Cardinal; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt32Bit10Test }
+
+  TUInt32Bit10Test = class(TUInt32DivTest)
+    protected
+      function GetDivisor: Cardinal; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt32Bit10ModTest }
+
+  TUInt32Bit10ModTest = class(TUInt32ModTest)
+    protected
+      function GetDivisor: Cardinal; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt32Bit100Test }
+
+  TUInt32Bit100Test = class(TUInt32DivTest)
+    protected
+      function GetDivisor: Cardinal; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt32Bit100ModTest }
+
+  TUInt32Bit100ModTest = class(TUInt32ModTest)
+    protected
+      function GetDivisor: Cardinal; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt32Bit1000Test }
+const
+  FU32_1000Input: array[$0..$F] of Cardinal =
+    (0, 1, 999, 1000, 1001, 1999, 2000, 2001,
+    4294958999, 4294959000, 4294959001,
+    $7FFFFFFE, $7FFFFFFF, $80000000, $80000001, $FFFFFFFF);
+
+type
+  TUInt32Bit1000Test = class(TUInt32DivTest)
+    protected
+      function GetDivisor: Cardinal; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt32Bit1000ModTest }
+
+  TUInt32Bit1000ModTest = class(TUInt32ModTest)
+    protected
+      function GetDivisor: Cardinal; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt32Bit60000Test }
+const
+  FU32_60000Input: array[$0..$F] of Cardinal =
+    (0, 1, 59999, 60000, 60001, 119999, 120000, 120001,
+    4294919999, 4294920000, 4294920001,
+    $7FFFFFFE, $7FFFFFFF, $80000000, $80000001, $FFFFFFFF);
+
+type
+  TUInt32Bit60000Test = class(TUInt32DivTest)
+    protected
+      function GetDivisor: Cardinal; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt32Bit60000ModTest }
+
+  TUInt32Bit60000ModTest = class(TUInt32ModTest)
+    protected
+      function GetDivisor: Cardinal; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt32Bit146097Test }
+const
+  FU32_146097Input: array[$0..$F] of Cardinal =
+    (0, 1, 146096, 146097, 146098, 292193, 292194, 292195,
+    4294959605, 4294959606, 4294959607,    
+    $7FFFFFFE, $7FFFFFFF, $80000000, $80000001, $FFFFFFFF);
+
+type
+  TUInt32Bit146097Test = class(TUInt32DivTest)
+    protected
+      function GetDivisor: Cardinal; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt32Bit146097ModTest }
+
+  TUInt32Bit146097ModTest = class(TUInt32ModTest)
+    protected
+      function GetDivisor: Cardinal; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+  
+  { TUInt32Bit3600000Test }
+const
+  FU32_3600000Input: array[$0..$F] of Cardinal =
+    (0, 1, 3599999, 3600000, 3600001, 7199999, 7200000, 7200001,
+    3600000000, 4294799999, 4294800000, 4294800001,
+    $7FFFFFFF, $80000000, $80000001, $FFFFFFFF);
+
+type
+  TUInt32Bit3600000Test = class(TUInt32DivTest)
+    protected
+      function GetDivisor: Cardinal; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt32Bit3600000ModTest }
+
+  TUInt32Bit3600000ModTest = class(TUInt32ModTest)
+    protected
+      function GetDivisor: Cardinal; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+
+{ TUInt32Bit1Test }
+
+function TUInt32Bit1Test.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 32-bit division by 1';
+  end;
+
+function TUInt32Bit1Test.GetDivisor: Cardinal;
+  begin
+    Result := 1;
+  end;
+
+procedure TUInt32Bit1Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Cardinal;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      253:
+        Numerator := 4294967293;
+      254:
+        Numerator := 4294967294;
+      255:
+        Numerator := 4294967295;
+      else
+        Numerator := Cardinal(Index);
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 1;
+
+    FResultArray[Index] := Answer;
+  end;
+  
+{ TUInt32Bit1Test }
+
+function TUInt32Bit1ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 32-bit modulus by 1';
+  end;
+
+function TUInt32Bit1ModTest.GetDivisor: Cardinal;
+  begin
+    Result := 1;
+  end;
+
+procedure TUInt32Bit1ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Cardinal;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      253:
+        Numerator := 4294967293;
+      254:
+        Numerator := 4294967294;
+      255:
+        Numerator := 4294967295;
+      else
+        Numerator := Cardinal(Index);
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 1;
+
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt32Bit2Test }
+
+function TUInt32Bit2Test.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 32-bit division by 2';
+  end;
+
+function TUInt32Bit2Test.GetDivisor: Cardinal;
+  begin
+    Result := 2;
+  end;
+
+procedure TUInt32Bit2Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Cardinal;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      253:
+        Numerator := 4294967293;
+      254:
+        Numerator := 4294967294;
+      255:
+        Numerator := 4294967295;
+      else
+        Numerator := Cardinal(Index);
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 2;
+
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt32Bit2ModTest }
+
+function TUInt32Bit2ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 32-bit modulus by 2';
+  end;
+
+function TUInt32Bit2ModTest.GetDivisor: Cardinal;
+  begin
+    Result := 2;
+  end;
+
+procedure TUInt32Bit2ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Cardinal;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      253:
+        Numerator := 4294967293;
+      254:
+        Numerator := 4294967294;
+      255:
+        Numerator := 4294967295;
+      else
+        Numerator := Cardinal(Index);
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 2;
+
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt32Bit3Test }
+
+function TUInt32Bit3Test.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 32-bit division by 3';
+  end;
+
+function TUInt32Bit3Test.GetDivisor: Cardinal;
+  begin
+    Result := 3;
+  end;
+
+procedure TUInt32Bit3Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Cardinal;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      254:
+        Numerator := 4294967294;
+      255:
+        Numerator := 4294967295;
+      else
+        Numerator := Cardinal(Index);
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 3;
+
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt32Bit3ModTest }
+
+function TUInt32Bit3ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 32-bit modulus by 3';
+  end;
+
+function TUInt32Bit3ModTest.GetDivisor: Cardinal;
+  begin
+    Result := 3;
+  end;
+
+procedure TUInt32Bit3ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Cardinal;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      254:
+        Numerator := 4294967294;
+      255:
+        Numerator := 4294967295;
+      else
+        Numerator := Cardinal(Index);
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 3;
+
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt32Bit10Test }
+
+function TUInt32Bit10Test.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 32-bit division by 10';
+  end;
+
+function TUInt32Bit10Test.GetDivisor: Cardinal;
+  begin
+    Result := 10;
+  end;
+
+procedure TUInt32Bit10Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Cardinal;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      253:
+        Numerator := 4294967289;
+      254:
+        Numerator := 4294967290;
+      255:
+        Numerator := 4294967295;
+      else
+        Numerator := Cardinal(Index);
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 10;
+
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt32Bit10ModTest }
+
+function TUInt32Bit10ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 32-bit modulus by 10';
+  end;
+
+function TUInt32Bit10ModTest.GetDivisor: Cardinal;
+  begin
+    Result := 10;
+  end;
+
+procedure TUInt32Bit10ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Cardinal;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      253:
+        Numerator := 4294967289;
+      254:
+        Numerator := 4294967290;
+      255:
+        Numerator := 4294967295;
+      else
+        Numerator := Cardinal(Index);
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 10;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt32Bit100Test }
+
+function TUInt32Bit100Test.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 32-bit division by 100';
+  end;
+
+function TUInt32Bit100Test.GetDivisor: Cardinal;
+  begin
+    Result := 100;
+  end;
+
+procedure TUInt32Bit100Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Cardinal;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      253:
+        Numerator := 4294967199;
+      254:
+        Numerator := 4294967200;
+      255:
+        Numerator := 4294967295;
+      else
+        Numerator := Cardinal(Index);
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 100;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt32Bit100ModTest }
+
+function TUInt32Bit100ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 32-bit modulus by 100';
+  end;
+
+function TUInt32Bit100ModTest.GetDivisor: Cardinal;
+  begin
+    Result := 100;
+  end;
+
+procedure TUInt32Bit100ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Cardinal;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      253:
+        Numerator := 4294967199;
+      254:
+        Numerator := 4294967200;
+      255:
+        Numerator := 4294967295;
+      else
+        Numerator := Cardinal(Index);
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 100;
+
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt32Bit1000Test }
+
+function TUInt32Bit1000Test.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 32-bit division by 1,000';
+  end;
+
+function TUInt32Bit1000Test.GetDivisor: Cardinal;
+  begin
+    Result := 1000;
+  end;
+
+procedure TUInt32Bit1000Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Cardinal;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    Numerator := FU32_1000Input[Index and $F];
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 1000;
+
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt32Bit1000ModTest }
+
+function TUInt32Bit1000ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 32-bit modulus by 1,000';
+  end;
+
+function TUInt32Bit1000ModTest.GetDivisor: Cardinal;
+  begin
+    Result := 1000;
+  end;
+
+procedure TUInt32Bit1000ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Cardinal;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    Numerator := FU32_1000Input[Index and $F];
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 1000;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt32Bit60000Test }
+
+function TUInt32Bit60000Test.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 32-bit division by 60,000';
+  end;
+
+function TUInt32Bit60000Test.GetDivisor: Cardinal;
+  begin
+    Result := 60000;
+  end;
+
+procedure TUInt32Bit60000Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Cardinal;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    Numerator := FU32_60000Input[Index and $F];
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 60000;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt32Bit60000ModTest }
+
+function TUInt32Bit60000ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 32-bit modulus by 60,000';
+  end;
+
+function TUInt32Bit60000ModTest.GetDivisor: Cardinal;
+  begin
+    Result := 60000;
+  end;
+
+procedure TUInt32Bit60000ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Cardinal;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    Numerator := FU32_60000Input[Index and $F];
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 60000;
+
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt32Bit146097Test }
+
+function TUInt32Bit146097Test.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 32-bit division by 146,097';
+  end;
+
+function TUInt32Bit146097Test.GetDivisor: Cardinal;
+  begin
+    Result := 146097;
+  end;
+
+procedure TUInt32Bit146097Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Cardinal;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    Numerator := FU32_146097Input[Index and $F];
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 146097;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt32Bit146097ModTest }
+
+function TUInt32Bit146097ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 32-bit modulus by 146,097';
+  end;
+
+function TUInt32Bit146097ModTest.GetDivisor: Cardinal;
+  begin
+    Result := 146097;
+  end;
+
+procedure TUInt32Bit146097ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Cardinal;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    Numerator := FU32_146097Input[Index and $F];
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 146097;
+
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt32Bit3600000Test }
+
+function TUInt32Bit3600000Test.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 32-bit division by 3,600,000';
+  end;
+
+function TUInt32Bit3600000Test.GetDivisor: Cardinal;
+  begin
+    Result := 3600000;
+  end;
+
+procedure TUInt32Bit3600000Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Cardinal;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    Numerator := FU32_3600000Input[Index and $F];
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 3600000;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt32Bit3600000ModTest }
+
+function TUInt32Bit3600000ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 32-bit modulus by 3,600,000';
+  end;
+
+function TUInt32Bit3600000ModTest.GetDivisor: Cardinal;
+  begin
+    Result := 3600000;
+  end;
+
+procedure TUInt32Bit3600000ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: Cardinal;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    Numerator := FU32_3600000Input[Index and $F];
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 3600000;
+
+    FResultArray[Index] := Answer;
+  end;

tests/bench/bdiv_u64.inc

@@ -0,0 +1,621 @@
+type
+  { TUInt64Bit1Test }
+
+  TUInt64Bit1Test = class(TUInt64DivTest)
+    protected
+      function GetDivisor: QWord; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt64Bit1ModTest }
+
+  TUInt64Bit1ModTest = class(TUInt64ModTest)
+    protected
+      function GetDivisor: QWord; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt64Bit2Test }
+
+  TUInt64Bit2Test = class(TUInt64DivTest)
+    protected
+      function GetDivisor: QWord; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt64Bit2ModTest }
+
+  TUInt64Bit2ModTest = class(TUInt64ModTest)
+    protected
+      function GetDivisor: QWord; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt64Bit3Test }
+
+  TUInt64Bit3Test = class(TUInt64DivTest)
+    protected
+      function GetDivisor: QWord; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt64Bit3ModTest }
+
+  TUInt64Bit3ModTest = class(TUInt64ModTest)
+    protected
+      function GetDivisor: QWord; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt64Bit5Test }
+
+  TUInt64Bit5Test = class(TUInt64DivTest)
+    protected
+      function GetDivisor: QWord; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt64Bit5ModTest }
+
+  TUInt64Bit5ModTest = class(TUInt64ModTest)
+    protected
+      function GetDivisor: QWord; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt64Bit10Test }
+
+  TUInt64Bit10Test = class(TUInt64DivTest)
+    protected
+      function GetDivisor: QWord; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt64Bit10ModTest }
+
+  TUInt64Bit10ModTest = class(TUInt64ModTest)
+    protected
+      function GetDivisor: QWord; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt64Bit100Test }
+
+  TUInt64Bit100Test = class(TUInt64DivTest)
+    protected
+      function GetDivisor: QWord; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt64Bit100ModTest }
+
+  TUInt64Bit100ModTest = class(TUInt64ModTest)
+    protected
+      function GetDivisor: QWord; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  { TUInt64Bit1000000000Test }
+const
+  FU64_1000000000Input: array[$0..$F] of QWord =
+    (0, 1, 999999999, 1000000000, 1000000001, 5000000000,
+    7999999999999999999, 8000000000000000000, 8000000000000000001,
+    QWord(15999999999999999999), QWord(16000000000000000000), QWord(16000000000000000001),
+    $7FFFFFFFFFFFFFFF, QWord($8000000000000000), QWord($8000000000000001), QWord($FFFFFFFFFFFFFFFF));
+
+type
+  TUInt64Bit1000000000Test = class(TUInt64DivTest)
+    protected
+      function GetDivisor: QWord; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+  TUInt64Bit1000000000ModTest = class(TUInt64ModTest)
+    protected
+      function GetDivisor: QWord; override;
+      procedure DoTestIteration(Iteration: Integer); override;
+    public
+      function TestTitle: shortstring; override;
+  end;
+
+{ TUInt64Bit1Test }
+
+function TUInt64Bit1Test.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 64-bit division by 1';
+  end;
+
+function TUInt64Bit1Test.GetDivisor: QWord;
+  begin
+    Result := 1;
+  end;
+
+procedure TUInt64Bit1Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: QWord;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      253:
+        Numerator := QWord($FFFFFFFFFFFFFFFD);
+      254:
+        Numerator := QWord($FFFFFFFFFFFFFFFE);
+      255:
+        Numerator := QWord($FFFFFFFFFFFFFFFF);
+      else
+        Numerator := QWord(Index);
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 1;
+
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt64Bit1ModTest }
+
+function TUInt64Bit1ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 64-bit modulus by 1';
+  end;
+
+function TUInt64Bit1ModTest.GetDivisor: QWord;
+  begin
+    Result := 1;
+  end;
+
+procedure TUInt64Bit1ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: QWord;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      253:
+        Numerator := QWord($FFFFFFFFFFFFFFFD);
+      254:
+        Numerator := QWord($FFFFFFFFFFFFFFFE);
+      255:
+        Numerator := QWord($FFFFFFFFFFFFFFFF);
+      else
+        Numerator := QWord(Index);
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 1;
+
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt64Bit2Test }
+
+function TUInt64Bit2Test.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 64-bit division by 2';
+  end;
+
+function TUInt64Bit2Test.GetDivisor: QWord;
+  begin
+    Result := 2;
+  end;
+
+procedure TUInt64Bit2Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: QWord;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      253:
+        Numerator := QWord($FFFFFFFFFFFFFFFD);
+      254:
+        Numerator := QWord($FFFFFFFFFFFFFFFE);
+      255:
+        Numerator := QWord($FFFFFFFFFFFFFFFF);
+      else
+        Numerator := QWord(Index);
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 2;
+
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt64Bit2ModTest }
+
+function TUInt64Bit2ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 64-bit modulus by 2';
+  end;
+
+function TUInt64Bit2ModTest.GetDivisor: QWord;
+  begin
+    Result := 2;
+  end;
+
+procedure TUInt64Bit2ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: QWord;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      253:
+        Numerator := QWord($FFFFFFFFFFFFFFFD);
+      254:
+        Numerator := QWord($FFFFFFFFFFFFFFFE);
+      255:
+        Numerator := QWord($FFFFFFFFFFFFFFFF);
+      else
+        Numerator := QWord(Index);
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 2;
+
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt64Bit3Test }
+
+function TUInt64Bit3Test.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 64-bit division by 3';
+  end;
+
+function TUInt64Bit3Test.GetDivisor: QWord;
+  begin
+    Result := 3;
+  end;
+
+procedure TUInt64Bit3Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: QWord;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      254:
+        Numerator := QWord($FFFFFFFFFFFFFFFE);
+      255:
+        Numerator := QWord($FFFFFFFFFFFFFFFF);
+      else
+        Numerator := QWord(Index);
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 3;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt64Bit3ModTest }
+
+function TUInt64Bit3ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 64-bit modulus by 3';
+  end;
+
+function TUInt64Bit3ModTest.GetDivisor: QWord;
+  begin
+    Result := 3;
+  end;
+
+procedure TUInt64Bit3ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: QWord;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      254:
+        Numerator := QWord($FFFFFFFFFFFFFFFE);
+      255:
+        Numerator := QWord($FFFFFFFFFFFFFFFF);
+      else
+        Numerator := QWord(Index);
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 3;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt64Bit5Test }
+
+function TUInt64Bit5Test.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 64-bit division by 5';
+  end;
+
+function TUInt64Bit5Test.GetDivisor: QWord;
+  begin
+    Result := 5;
+  end;
+
+procedure TUInt64Bit5Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: QWord;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      254:
+        Numerator := QWord($FFFFFFFFFFFFFFFE);
+      255:
+        Numerator := QWord($FFFFFFFFFFFFFFFF);
+      else
+        Numerator := QWord(Index);
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 5;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt64Bit5ModTest }
+
+function TUInt64Bit5ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 64-bit modulus by 5';
+  end;
+
+function TUInt64Bit5ModTest.GetDivisor: QWord;
+  begin
+    Result := 5;
+  end;
+
+procedure TUInt64Bit5ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: QWord;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      254:
+        Numerator := QWord($FFFFFFFFFFFFFFFE);
+      255:
+        Numerator := QWord($FFFFFFFFFFFFFFFF);
+      else
+        Numerator := QWord(Index);
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 5;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt64Bit10Test }
+
+function TUInt64Bit10Test.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 64-bit division by 10';
+  end;
+
+function TUInt64Bit10Test.GetDivisor: QWord;
+  begin
+    Result := 10;
+  end;
+
+procedure TUInt64Bit10Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: QWord;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      253:
+        Numerator := QWord($FFFFFFFFFFFFFFF9);
+      254:
+        Numerator := QWord($FFFFFFFFFFFFFFFA);
+      255:
+        Numerator := QWord($FFFFFFFFFFFFFFFF);
+      else
+        Numerator := QWord(Index);
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 10;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt64Bit10ModTest }
+
+function TUInt64Bit10ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 64-bit modulus by 10';
+  end;
+
+function TUInt64Bit10ModTest.GetDivisor: QWord;
+  begin
+    Result := 10;
+  end;
+
+procedure TUInt64Bit10ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: QWord;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      253:
+        Numerator := QWord($FFFFFFFFFFFFFFF9);
+      254:
+        Numerator := QWord($FFFFFFFFFFFFFFFA);
+      255:
+        Numerator := QWord($FFFFFFFFFFFFFFFF);
+      else
+        Numerator := QWord(Index);
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 10;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt64Bit100Test }
+
+function TUInt64Bit100Test.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 64-bit division by 100';
+  end;
+
+function TUInt64Bit100Test.GetDivisor: QWord;
+  begin
+    Result := 100;
+  end;
+
+procedure TUInt64Bit100Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: QWord;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      253:
+        Numerator := QWord($FFFFFFFFFFFFFFEF);
+      254:
+        Numerator := QWord($FFFFFFFFFFFFFFF0);
+      255:
+        Numerator := QWord($FFFFFFFFFFFFFFFF);
+      else
+        Numerator := Cardinal(Index);
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 100;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt64Bit100ModTest }
+
+function TUInt64Bit100ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 64-bit modulus by 100';
+  end;
+
+function TUInt64Bit100ModTest.GetDivisor: QWord;
+  begin
+    Result := 100;
+  end;
+
+procedure TUInt64Bit100ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: QWord;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    case Index of
+      253:
+        Numerator := QWord($FFFFFFFFFFFFFFEF);
+      254:
+        Numerator := QWord($FFFFFFFFFFFFFFF0);
+      255:
+        Numerator := QWord($FFFFFFFFFFFFFFFF);
+      else
+        Numerator := Cardinal(Index);
+    end;
+
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 100;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt64Bit1000000000Test }
+
+function TUInt64Bit1000000000Test.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 64-bit division by 1,000,000,000';
+  end;
+
+function TUInt64Bit1000000000Test.GetDivisor: QWord;
+  begin
+    Result := 1000000000;
+  end;
+
+procedure TUInt64Bit1000000000Test.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: QWord;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    Numerator := FU64_1000000000Input[Index and $F];
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator div 1000000000;
+      
+    FResultArray[Index] := Answer;
+  end;
+
+{ TUInt64Bit1000000000ModTest }
+
+function TUInt64Bit1000000000ModTest.TestTitle: shortstring;
+  begin
+    Result := 'Unsigned 64-bit modulus by 1,000,000,000';
+  end;
+
+function TUInt64Bit1000000000ModTest.GetDivisor: QWord;
+  begin
+    Result := 1000000000;
+  end;
+
+procedure TUInt64Bit1000000000ModTest.DoTestIteration(Iteration: Integer);
+  var
+    Numerator, Answer: QWord;
+    Index, X: Integer;
+  begin
+    Index := Iteration and $FF;
+    Numerator := FU64_1000000000Input[Index and $F];
+    FInputArray[Index] := Numerator;
+    for X := 0 to INTERNAL_LOOPS - 1 do
+      Answer := Numerator mod 1000000000;
+      
+    FResultArray[Index] := Answer;
+  end;

tests/test/cg/tmoddiv6.pp

@@ -0,0 +1,3 @@
+{ %OPT=-O2 }
+{ this benchmark can be used also as a test case }
+{$I ../../bench/bdiv.pp}

tests/test/units/system/ttxtflsh.pp

@@ -0,0 +1,189 @@
+{ $DEFINE VERBOSE}
+{ $DEFINE DEBUG}
+(* Define the following if the test will be run manually in a console       *)
+(* (no output redirection) - otherwise the test will fail for some targets. *)
+{ $DEFINE TESTINCONSOLE}
+{$I-}
+uses
+ Dos;
+var
+ T: text;
+ IOR: integer;
+ TElapsed1, TElapsed2: int64;
+ I: longint;
+const
+ TestFName = 'ttxtflsh.txt';
+ NoTestFName = '_NoSuchF.FFF';
+{$IF DEFINED(OS2) or DEFINED(WINDOWS) or DEFINED(GO32V2) or DEFINED(WATCOM) or DEFINED(MSDOS)}
+ ConsoleDeviceName = 'CON';
+ {$DEFINE TESTCONSOLEOK}
+{$ELSE}
+(* {$IF DEFINED(UNIX)}
+{ I don't know whether there's a device on Unix allowing to enforce output to console even if standard output is redirected for the given process... }
+ ConsoleDeviceName = '/dev/tty';
+  {$DEFINE TESTCONSOLEOK}
+ {$ELSE}
+*)
+  {$IFDEF TESTINCONSOLE}
+ ConsoleDeviceName = '';
+   {$DEFINE TESTCONSOLEOK}
+  {$ENDIF TESTINCONSOLE}
+ { $ENDIF}
+{$ENDIF}
+
+
+procedure ChkErr (Err: boolean; MsgOK, MsgErr: string; N: byte);
+begin
+ if Err then
+  begin
+   if IOResult = 0 then
+    begin
+    end;
+   WriteLn ('Error: ', MsgErr);
+{$IFDEF VERBOSE}
+   WriteLn ('Exit value: ', N);
+{$ENDIF VERBOSE}
+   Halt (N);
+  end
+{$IFDEF VERBOSE}
+ else
+  WriteLn (MsgOK)
+{$ENDIF VERBOSE}
+     ;
+end;
+
+function PerfTest: int64;
+var
+ T1: int64;
+begin
+ T1 := GetMsCount;
+ for I := 0 to 50000 do
+  Write (T, I);
+ PerfTest := GetMsCount - T1;
+ ChkErr (IOResult <> 0, 'Test text output successful.',
+  'Test text output failed!', 255);
+end;
+
+begin
+ Assign (T, NoTestFName);
+ Reset (T);
+ SetTextAutoFlush (T, true);
+ ChkErr (GetTextAutoFlush (T),
+  'Set/GetTextAutoFlush call correctly ignored with non-zero InOutRes.',
+  'Set/GetTextAutoFlush call not ignored in spite of non-zero InOutRes!', 1);
+ if IOResult <> 0 then
+  begin
+  end;
+ SetTextAutoFlush (T, true);
+ IOR := IOResult;
+{$IFDEF DEBUG}
+ WriteLn (StdErr, IOR);
+{$ENDIF DEBUG}
+ ChkErr (IOR <> 103,
+  'SetTextAutoFlush correctly errors out with expected RTE if file not open.',
+  'SetTextAutoFlush does not finish with expected RTE if file not open!', 2);
+ Assign (T, TestFName);
+ Rewrite (T);
+ ChkErr (IOResult <> 0, 'Test file ' + TestFName + ' created successfully.',
+  'Test file ' + TestFName + ' creation failed!', 3);
+ Close (T);
+ Reset (T);
+ SetTextAutoFlush (T, true);
+ IOR := IOResult;
+{$IFDEF DEBUG}
+ WriteLn (StdErr, IOR);
+{$ENDIF DEBUG}
+ ChkErr (IOR <> 105,
+  'SetTextAutoFlush correctly errors out if file not open for writing.',
+  'SetTextAutoFlush does not finish with expected RTE if file not open for writing!', 4);
+ Close (T);
+ Rewrite (T);
+{$IFDEF DEBUG}
+ WriteLn (StdErr, Longint (TextRec(T).FlushFunc));
+{$ENDIF DEBUG}
+ ChkErr (GetTextAutoFlush (T) or (IOResult <> 0),
+  'GetTextAutoFlush returns expected default value for a regular file.',
+  'GetTextAutoFlush returns unexpected default value for a regular file!', 5);
+ SetTextAutoFlush (T, true);
+{$IFDEF DEBUG}
+ WriteLn (StdErr, Longint (TextRec(T).FlushFunc));
+{$ENDIF DEBUG}
+ ChkErr (not (GetTextAutoFlush (T)) or (IOResult <> 0),
+  'GetTextAutoFlush returns expected modified value after SetTextAutoFlush.',
+  'GetTextAutoFlush does not return expected modified value after SetTextAutoFlush!', 6);
+ TElapsed1 := PerfTest;
+{$IFDEF DEBUG}
+ WriteLn (StdErr, 'Run 1: ', TElapsed1, ' ms');
+{$ENDIF DEBUG}
+ Close (T);
+ Rewrite (T);
+{$IFDEF DEBUG}
+ WriteLn (StdErr, Longint (TextRec(T).FlushFunc));
+{$ENDIF DEBUG}
+ ChkErr (GetTextAutoFlush (T) or (IOResult <> 0),
+  'GetTextAutoFlush returns expected default value after file reopening.',
+  'GetTextAutoFlush does not return expected default value after file reopening!', 7);
+ TElapsed2 := PerfTest;
+{$IFDEF DEBUG}
+ WriteLn (StdErr, 'Run 2: ', TElapsed2, ' ms');
+{$ENDIF DEBUG}
+ ChkErr (TElapsed1 <= TElapsed2,
+  'Output performance lower with enforced flushing as expected.',
+  'Output performance not lower with enforced flushing!', 11);
+ Close (T);
+ Append (T);
+{$IFDEF DEBUG}
+ WriteLn (StdErr, Longint (TextRec(T).FlushFunc));
+{$ENDIF DEBUG}
+ ChkErr (GetTextAutoFlush (T) or (IOResult <> 0),
+  'GetTextAutoFlush returns expected default value after file reopening for appending.',
+  'GetTextAutoFlush does not return expected default value after file reopening for appending!', 13);
+ Close (T);
+ Erase (T);
+ if IOResult <> 0 then
+  begin
+  end;
+
+{$IFDEF TESTCONSOLEOK}
+ Assign (T, ConsoleDeviceName);
+ Rewrite (T);
+{$IFDEF DEBUG}
+ WriteLn (StdErr, Longint (TextRec(T).FlushFunc));
+{$ENDIF DEBUG}
+ ChkErr (not (GetTextAutoFlush (T)) or (IOResult <> 0),
+  'GetTextAutoFlush returns expected default value for console output.',
+  'GetTextAutoFlush returns unexpected default value for console output!', 8);
+ SetTextAutoFlush (T, false);
+{$IFDEF DEBUG}
+ WriteLn (StdErr, Longint (TextRec(T).FlushFunc));
+{$ENDIF DEBUG}
+ ChkErr (GetTextAutoFlush (T) or (IOResult <> 0),
+  'GetTextAutoFlush returns expected modified value after SetTextAutoFlush with console.',
+  'GetTextAutoFlush does not return expected modified value after SetTextAutoFlush with console!', 9);
+ TElapsed1 := PerfTest;
+{$IFDEF DEBUG}
+ WriteLn (StdErr, 'Run 1: ', TElapsed1, ' ms');
+{$ENDIF DEBUG}
+ Close (T);
+ Rewrite (T);
+{$IFDEF DEBUG}
+ WriteLn (StdErr, Longint (TextRec(T).FlushFunc));
+{$ENDIF DEBUG}
+ ChkErr (not (GetTextAutoFlush (T)) or (IOResult <> 0),
+  'GetTextAutoFlush returns expected default value after file reopening for console.',
+  'GetTextAutoFlush returns unexpected default value after file reopening for console!', 10);
+ TElapsed2 := PerfTest;
+{$IFDEF DEBUG}
+ WriteLn (StdErr, 'Run 2: ', TElapsed2, ' ms');
+{$ENDIF DEBUG}
+ ChkErr (TElapsed1 >= TElapsed2,
+  'Output performance higher with disabled flushing as expected.',
+  'Output performance not higher with disabled flushing!', 12);
+ Close (T);
+
+{$ENDIF TESTCONSOLEOK}
+
+{$IFDEF VERBOSE}
+ WriteLn ('TTxtFlsh finished successfully.');
+{$ENDIF VERBOSE}
+end.

tests/webtbs/tw38832.pp

@@ -0,0 +1,21 @@
+program Math1;
+
+{$mode delphi}{$H+}
+
+uses
+ {$IFDEF UNIX}
+ cthreads,
+ {$ENDIF}
+ Classes,
+ Math
+ { you can add units after this };
+
+var x:double;
+begin
+ SetExceptionMask([exInvalidOp,exDenormalized,exZeroDivide,exOverflow,exUnderflow,exPrecision]);
+ x:=0;
+ writeln('ln(x)');
+ writeln(ln(x));
+ writeln('1/x');
+ writeln(1/x);
+end.

tests/webtbs/tw38833.pp

@@ -0,0 +1,18 @@
+program EmptyTryFinally1;
+
+{$mode delphi}
+{$apptype console}
+
+var
+  finallyrun: boolean;
+begin
+  finallyrun:=false;
+  try
+   // Empty try statement block
+  finally
+    WriteLn('I should actually visible . . .'); // but I'm not
+    finallyrun:=true;
+  end;
+  if not finallyrun then
+    halt(1);
+end.

utils/pas2js/dist/rtl.js

@@ -229,7 +229,10 @@ var rtl = {
   createCallback: function(scope, fn){
     var cb;
     if (typeof(fn)==='string'){
-      cb = function(){
+      if (!scope.hasOwnProperty('$events')) scope.$events = {};
+      cb = scope.$events[fn];
+      if (cb) return cb;
+      scope.$events[fn] = cb = function(){
         return scope[fn].apply(scope,arguments);
       };
     } else {
@@ -243,32 +246,38 @@ var rtl = {
   },
 
   createSafeCallback: function(scope, fn){
-    var cb = function(){
-      try{
-        if (typeof(fn)==='string'){
+    var cb;
+    if (typeof(fn)==='string'){
+      if (!scope.hasOwnProperty('$events')) scope.$events = {};
+      cb = scope.$events[fn];
+      if (cb) return cb;
+      scope.$events[fn] = cb = function(){
+        try{
           return scope[fn].apply(scope,arguments);
-        } else {
+        } catch (err) {
+          if (!rtl.handleUncaughtException(err)) throw err;
+        }
+      };
+    } else {
+      cb = function(){
+        try{
           return fn.apply(scope,arguments);
-        };
-      } catch (err) {
-        if (!rtl.handleUncaughtException(err)) throw err;
-      }
+        } catch (err) {
+          if (!rtl.handleUncaughtException(err)) throw err;
+        }
+      };
     };
     cb.scope = scope;
     cb.fn = fn;
     return cb;
   },
 
-  cloneCallback: function(cb){
-    return rtl.createCallback(cb.scope,cb.fn);
-  },
-
   eqCallback: function(a,b){
     // can be a function or a function wrapper
-    if (a==b){
+    if (a===b){
       return true;
     } else {
-      return (a!=null) && (b!=null) && (a.fn) && (a.scope===b.scope) && (a.fn==b.fn);
+      return (a!=null) && (b!=null) && (a.fn) && (a.scope===b.scope) && (a.fn===b.fn);
     }
   },