Quellcode durchsuchen

Merge branch 'main' into basemath

florian vor 1 Jahr
Ursprung
Commit
42d9175fd1

+ 33 - 4
compiler/fmodule.pas

@@ -251,13 +251,14 @@ interface
         to that when creating link.res!!!!(mazen)}
         constructor create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean);
         destructor destroy;override;
-        procedure reset;virtual;
+        procedure reset(for_recompile: boolean);virtual;
         procedure loadlocalnamespacelist;
         procedure adddependency(callermodule:tmodule; frominterface : boolean);
         procedure flagdependent(callermodule:tmodule);
         procedure addimportedsym(sym:TSymEntry);
         function  addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit;
         function  usesmodule_in_interface(m : tmodule) : boolean;
+        function findusedunit(m : tmodule) : tused_unit;
         function usedunitsloaded(interface_units: boolean; out firstwaiting : tmodule): boolean;
         function nowaitingforunits(out firstwaiting : tmodule) : Boolean;
         procedure updatemaps;
@@ -276,6 +277,8 @@ interface
         function ToString: RTLString; override;
       end;
 
+       { tused_unit }
+
        tused_unit = class(tlinkedlistitem)
           checksum,
           interface_checksum,
@@ -789,13 +792,14 @@ implementation
       end;
 
 
-    procedure tmodule.reset;
+    procedure tmodule.reset(for_recompile: boolean);
       var
         i   : longint;
         current_debuginfo_reset : boolean;
         m : tmodule;
       begin
         is_reset:=true;
+        LoadCount:=0;
         if assigned(scanner) then
           begin
             { also update current_scanner if it was pointing
@@ -895,8 +899,18 @@ implementation
         _exports:=tlinkedlist.create;
         dllscannerinputlist.free;
         dllscannerinputlist:=TFPHashList.create;
-        used_units.free;
-        used_units:=TLinkedList.Create;
+        { During reload, the list of used units cannot change.
+          It can only change while recompiling.
+          Because the used_units is used in loops in the load cycle(s) which
+          can recurse into the same unit due to circular dependencies,
+          we do not destroy the list, we only update the contents.
+          As a result so the loop variable does not get reset during the loop.
+          For recompile, we recreate the list }
+        if for_recompile then
+          begin
+          used_units.free;
+          used_units:=TLinkedList.Create;
+          end;
         dependent_units.free;
         dependent_units:=TLinkedList.Create;
         resourcefiles.Free;
@@ -1111,6 +1125,21 @@ implementation
           end;
       end;
 
+    function tmodule.findusedunit(m: tmodule): tused_unit;
+    var
+      u : tused_unit;
+
+    begin
+      result:=nil;
+      u:=tused_unit(used_units.First);
+      while assigned(u) do
+        begin
+        if (u.u=m) then
+          exit(u);
+        u:=tused_unit(u.next);
+        end;
+    end;
+
     procedure tmodule.updatemaps;
       var
         oldmapsize : longint;

+ 22 - 10
compiler/fppu.pas

@@ -65,7 +65,7 @@ interface
 {$endif def Test_Double_checksum}
           constructor create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean);
           destructor destroy;override;
-          procedure reset;override;
+          procedure reset(for_recompile: boolean);override;
           procedure re_resolve(loadfrom: tmodule);
           function  openppufile:boolean;
           function  openppustream(strm:TCStream):boolean;
@@ -182,14 +182,14 @@ var
       end;
 
 
-    procedure tppumodule.reset;
+    procedure tppumodule.reset(for_recompile : boolean);
       begin
         inc(currentdefgeneration);
         discardppu;
         freederefunitimportsyms;
         unitimportsymsderefs.free;
         unitimportsymsderefs:=tfplist.create;
-        inherited reset;
+        inherited reset(for_recompile);
       end;
 
     procedure tppumodule.re_resolve(loadfrom: tmodule);
@@ -1318,6 +1318,7 @@ var
         isnew : boolean;
 
       begin
+
         while not ppufile.endofentry do
          begin
            hs:=ppufile.getstring;
@@ -1329,8 +1330,16 @@ var
            hp:=registerunit(self,hs,'',isnew);
            if isnew then
              usedunits.Concat(tused_unit.create(hp,in_interface,true,nil));
-
-           pu:=addusedunit(hp,false,nil);
+           if LoadCount=1 then
+             pu:=addusedunit(hp,false,nil)
+           else
+             begin
+             pu:=findusedunit(hp);
+             { Safety, normally this should not happen:
+               The used units list cannot change between loads unless recompiled and then loadcount is 1... }
+             if pu=nil then
+               pu:=addusedunit(hp,false,nil);
+             end;
            pu.checksum:=checksum;
            pu.interface_checksum:=intfchecksum;
            pu.indirect_checksum:=indchecksum;
@@ -1944,7 +1953,6 @@ var
       begin
         if current_module<>self then
          internalerror(200212284);
-
         { load the used units from interface }
         in_interface:=true;
         pu:=tused_unit(used_units.first);
@@ -1953,8 +1961,8 @@ var
            if pu.in_interface then
             begin
               tppumodule(pu.u).loadppu(self);
-              { if this unit is compiled we can stop }
-              if state in [ms_compiled,ms_processed] then
+              { if this unit is scheduled for compilation or compiled we can stop }
+              if state in [ms_compile,ms_compiled,ms_processed] then
                exit;
               { add this unit to the dependencies }
               pu.u.adddependency(self,true);
@@ -2196,7 +2204,7 @@ var
           { Flag modules to reload }
           flagdependent(from_module);
           { Reset the module }
-          reset;
+          reset(false);
           if state in CompileStates then
             begin
               Message1(unit_u_second_compile_unit,modulename^);
@@ -2269,7 +2277,7 @@ var
         { Flag modules to reload }
         flagdependent(from_module);
         { Reset the module }
-        reset;
+        reset(true);
         { mark this module for recompilation }
         if not (state in [ms_compile]) then
           state:=ms_compile;
@@ -2307,6 +2315,7 @@ var
         second_time        : boolean;
 
       begin
+        Inc(LoadCount);
 
         Result:=false;
         Message3(unit_u_load_unit,from_module.modulename^,
@@ -2382,6 +2391,9 @@ var
 
         { we are back, restore current_module }
         set_current_module(from_module);
+        { safety, so it does not become negative }
+        if LoadCount>0 then
+          Dec(LoadCount);
       end;
 
     procedure tppumodule.discardppu;

+ 6 - 0
compiler/ppu.pas

@@ -419,8 +419,10 @@ begin
             (implementation_crc_array^[implementation_read_crc_index]<>crc) then
            begin
              do_comment(CRC_implementation_Change_Message_Level,'implementation CRC changed at index '+tostr(implementation_read_crc_index));
+             {$IFDEF TEST_CRC_ERROR}
              if CRC_implementation_Change_Message_Level=V_Error then
                do_internalerror(2020113001);
+             {$ENDIF}
 {$ifdef Test_Double_checksum_write}
              Writeln(CRCFile,'!!!imp_crc ',implementation_read_crc_index:5,'$',hexstr(crc,8),'<>$',hexstr(implementation_crc_array^[implementation_read_crc_index],8));
            end
@@ -455,8 +457,10 @@ begin
                (interface_crc_array^[interface_read_crc_index]<>interface_crc) then
               begin
                 do_comment(CRC_Interface_Change_Message_Level,'interface CRC changed at index '+tostr(interface_read_crc_index));
+                {$IFDEF TEST_CRC_ERROR}
                 if CRC_interface_Change_Message_Level=V_Error then
                   do_internalerror(2020113002);
+                {$ENDIF}
 {$ifdef Test_Double_checksum_write}
                 Writeln(CRCFile,'!!!int_crc ',interface_read_crc_index:5,'$',hexstr(interface_crc,8),'<>$',hexstr(interface_crc_array^[interface_read_crc_index],8));
               end
@@ -494,8 +498,10 @@ begin
                     (indirect_crc_array^[indirect_read_crc_index]<>indirect_crc) then
                    begin
                      do_comment(CRC_Indirect_Change_Message_Level,'Indirect CRC changed at index '+tostr(indirect_read_crc_index));
+                     {$IFDEF TEST_CRC_ERROR}
                      if CRC_indirect_Change_Message_Level=V_Error then
                        do_internalerror(2020113003);
+                     {$ENDIF}
 {$ifdef Test_Double_checksum_write}
                      Writeln(CRCFile,'!!!ind_crc ',indirect_read_crc_index:5,'$',hexstr(indirect_crc,8),'<>$',hexstr(indirect_crc_array^[indirect_read_crc_index],8));
                    end

+ 4 - 1
compiler/rautils.pas

@@ -45,7 +45,7 @@ type
   TOprType=(OPR_NONE,OPR_CONSTANT,OPR_SYMBOL,OPR_LOCAL,
             OPR_REFERENCE,OPR_REGISTER,OPR_COND,OPR_REGSET,
             OPR_SHIFTEROP,OPR_MODEFLAGS,OPR_SPECIALREG,
-            OPR_REGPAIR,OPR_FENCEFLAGS,OPR_INDEXEDREG);
+            OPR_REGPAIR,OPR_FENCEFLAGS,OPR_INDEXEDREG,OPR_FLOATCONSTANT);
 
   TOprRec = record
     case typ:TOprType of
@@ -89,6 +89,9 @@ type
 {$if defined(riscv32) or defined(riscv64)}
       OPR_FENCEFLAGS: (fenceflags : TFenceFlags);
 {$endif aarch64}
+{$ifdef wasm32}
+      OPR_FLOATCONSTANT: (floatval:double);
+{$endif wasm32}
   end;
 
   TInstruction = class;

+ 142 - 9
compiler/wasm32/rawasmtext.pas

@@ -54,6 +54,8 @@ Unit rawasmtext;
         actasmpattern_origcase: string;
         actasmtoken   : tasmtoken;
         prevasmtoken  : tasmtoken;
+        actinttoken   : aint;
+        actfloattoken : double;
         procedure SetupTables;
         procedure GetToken;
         function consume(t : tasmtoken):boolean;
@@ -61,7 +63,7 @@ Unit rawasmtext;
         function is_valtype(const s: string):boolean;
         procedure HandleInstruction;
         procedure HandleFoldedInstruction;
-        procedure HandlePlainInstruction;
+        function HandlePlainInstruction: TWasmInstruction;
         procedure HandleBlockInstruction;virtual;abstract;
       public
         function Assemble: tlinkedlist;override;
@@ -106,9 +108,61 @@ Unit rawasmtext;
 
 
     procedure twasmreader.GetToken;
+
       var
-        len: Integer;
         has_sign, is_hex, is_float: Boolean;
+
+      function GetIntToken: aint;
+        var
+          s: string;
+          u64: UInt64;
+        begin
+          s:=actasmpattern;
+          if has_sign and (s[1]='-') then
+            begin
+              delete(s,1,1);
+              if is_hex then
+                begin
+                  delete(s,1,2);
+                  Val('$'+s,u64);
+                end
+              else
+                Val(s,u64);
+{$push} {$R-}{$Q-}
+              result:=aint(-u64);
+{$pop}
+            end
+          else
+            begin
+              if has_sign then
+                delete(s,1,1);
+              if is_hex then
+                begin
+                  delete(s,1,2);
+                  Val('$'+s,u64);
+                end
+              else
+                Val(s,u64);
+              result:=aint(u64);
+            end;
+        end;
+
+      function GetFloatToken: double;
+        var
+          s: string;
+        begin
+          s:=actasmpattern;
+          if is_hex then
+            begin
+              { TODO: parse hex floats }
+              internalerror(2024071501);
+            end
+          else
+            Val(s,result);
+        end;
+
+      var
+        len: Integer;
         tmpS: string;
         tmpI, tmpCode: Integer;
       begin
@@ -298,9 +352,15 @@ Unit rawasmtext;
                 end;
               actasmpattern[0]:=chr(len);
               if is_float then
-                actasmtoken:=AS_REALNUM
+                begin
+                  actasmtoken:=AS_REALNUM;
+                  actfloattoken:=GetFloatToken;
+                end
               else
-                actasmtoken:=AS_INTNUM;
+                begin
+                  actasmtoken:=AS_INTNUM;
+                  actinttoken:=GetIntToken;
+                end;
             end;
           '"':
             begin
@@ -641,15 +701,15 @@ Unit rawasmtext;
       end;
 
 
-    procedure twasmreader.HandlePlainInstruction;
-      var
-        instr: TWasmInstruction;
+    function twasmreader.HandlePlainInstruction: TWasmInstruction;
       begin
+        result:=nil;
         case actasmtoken of
           AS_OPCODE:
             begin
-              instr:=TWasmInstruction.create(TWasmOperand);
-              instr.opcode:=actopcode;
+              result:=TWasmInstruction.create(TWasmOperand);
+              result.opcode:=actopcode;
+              Consume(AS_OPCODE);
               case actopcode of
                 { instructions, which require 0 operands }
                 a_nop,
@@ -710,6 +770,79 @@ Unit rawasmtext;
                 a_i64_extend16_s,
                 a_i64_extend32_s:
                   ;
+                { instructions with an integer const operand }
+                a_i32_const,
+                a_i64_const:
+                  begin
+                    if actasmtoken=AS_INTNUM then
+                      begin
+                        result.operands[1].opr.typ:=OPR_CONSTANT;
+                        result.operands[1].opr.val:=actinttoken;
+                        Consume(AS_INTNUM);
+                      end
+                    else
+                      begin
+                        { error: expected integer }
+                        result.Free;
+                        result:=nil;
+                        Consume(AS_INTNUM);
+                      end;
+                  end;
+                { instructions with a float const operand }
+                a_f32_const,
+                a_f64_const:
+                  begin
+                    case actasmtoken of
+                      AS_INTNUM:
+                        begin
+                          result.operands[1].opr.typ:=OPR_FLOATCONSTANT;
+                          result.operands[1].opr.floatval:=actinttoken;
+                          Consume(AS_INTNUM);
+                        end;
+                      AS_REALNUM:
+                        begin
+                          result.operands[1].opr.typ:=OPR_FLOATCONSTANT;
+                          result.operands[1].opr.floatval:=actfloattoken;
+                          Consume(AS_REALNUM);
+                        end;
+                      else
+                        begin
+                          { error: expected real }
+                          result.Free;
+                          result:=nil;
+                          Consume(AS_REALNUM);
+                        end;
+                    end;
+                  end;
+                { instructions with an optional memarg operand }
+                a_i32_load,
+                a_i64_load,
+                a_f32_load,
+                a_f64_load,
+                a_i32_load8_s,
+                a_i32_load8_u,
+                a_i32_load16_s,
+                a_i32_load16_u,
+                a_i64_load8_s,
+                a_i64_load8_u,
+                a_i64_load16_s,
+                a_i64_load16_u,
+                a_i64_load32_s,
+                a_i64_load32_u,
+                a_i32_store,
+                a_i64_store,
+                a_f32_store,
+                a_f64_store,
+                a_i32_store8,
+                a_i32_store16,
+                a_i64_store8,
+                a_i64_store16,
+                a_i64_store32:
+                  begin
+                    { TODO: parse the optional memarg operand }
+                    result.operands[1].opr.typ:=OPR_CONSTANT;
+                    result.operands[1].opr.val:=0;
+                  end;
                 else
                   internalerror(2024071401);
               end;

+ 0 - 8
rtl/i386/cpu.pp

@@ -21,14 +21,6 @@ unit cpu;
 
   interface
 
-{$IFDEF FPC_DOTTEDUNITS}
-    uses
-      System.SysUtils;
-{$ELSE FPC_DOTTEDUNITS}
-    uses
-      sysutils;
-{$ENDIF FPC_DOTTEDUNITS}
-
     { returns true, if the processor supports the cpuid instruction }
     function cpuid_support : boolean;
 

+ 7 - 2
rtl/i386/fastmove.inc

@@ -40,6 +40,8 @@ asm
     pop    %ebx
 end;
 
+{$if not defined(CPUX86_HAS_SSEUNIT) or defined(FASTMOVE_DISABLE_SSE)}
+{$define fastmove_has_ia32_and_mmx}
 procedure Move_8OrMore_IA32; assembler; nostackframe;
 { eax = source, edx = dest, ecx = count (ecx >= 8).
   If FPC_PIC: ebx pushed. }
@@ -217,6 +219,7 @@ asm
     emms
     pop    %ebx
 end;
+{$endif need IA32 and MMX versions}
 
 {$ifndef FASTMOVE_DISABLE_SSE}
 label
@@ -564,13 +567,15 @@ begin
 {$ifndef FASTMOVE_DISABLE_SSE}
   else if fast_large_repmovstosb then
     result:=@Move_8OrMore_SSE_ERMS
-  else if has_sse_support then
+  else {$ifdef fastmove_has_ia32_and_mmx} if has_sse_support then {$endif}
     result:=@Move_8OrMore_SSE
 {$endif ndef FASTMOVE_DISABLE_SSE}
+{$ifdef fastmove_has_ia32_and_mmx}
   else if has_mmx_support then
     result:=@Move_8OrMore_MMX
   else
-    result:=@Move_8OrMore_IA32;
+    result:=@Move_8OrMore_IA32
+{$endif fastmove_has_ia32_and_mmx};
   if fpc_cpucodeinit_performed then
     fastmoveproc:=result;
 end;

+ 58 - 16
rtl/i386/i386.inc

@@ -287,6 +287,7 @@ end;
 {$if not defined(FPC_SYSTEM_HAS_FILLCHAR)
   or not defined(FPC_SYSTEM_HAS_FILLWORD)
   or not defined(FPC_SYSTEM_HAS_FILLDWORD)}
+{$ifndef CPUX86_HAS_SSE2}
 procedure FillXxxx_U32Pattern_Plain_16OrMore; assembler; nostackframe;
 { eax — x, ecx — uint32 pattern, edx — byte count >= 12 (preferably >= 16). }
 asm
@@ -312,6 +313,7 @@ asm
         mov     %esi, 4(%edx)
         pop     %esi
 end;
+{$endif ndef CPUX86_HAS_SSE2 (need Fill*_Plain)}
 
 procedure FillXxxx_U32Pattern_Ladder_4to16; assembler; nostackframe;
 { eax — x, ecx — uint32 pattern, edx — byte count, 4 <= edx <= 16. }
@@ -342,6 +344,7 @@ asm
 .LQuit:
 end;
 
+{$ifndef CPUX86_HAS_SSE2}
 procedure FillChar_Plain(var x;count:SizeInt;value:byte);assembler;nostackframe;
 asm
         cmp     $3, %edx
@@ -353,6 +356,7 @@ asm
         jbe     FillXxxx_U32Pattern_Ladder_4to16
         jmp     FillXxxx_U32Pattern_Plain_16OrMore
 end;
+{$endif ndef CPUX86_HAS_SSE2}
 
 procedure FillChar_SSE2(var x;count:SizeInt;value:byte);assembler;nostackframe;
 asm
@@ -403,15 +407,17 @@ procedure FillChar_Dispatch(var x;count:SizeInt;value:byte);
 begin
   if not fpc_cpucodeinit_performed then
     begin
-      FillChar_Plain(x, count, value);
+      {$ifdef CPUX86_HAS_SSE2} FillChar_SSE2 {$else} FillChar_Plain {$endif} (x, count, value);
       exit;
     end;
   if fast_large_repmovstosb then
     FillChar_Impl := @FillChar_SSE2_ERMS
-  else if has_sse2_support then
+  else {$ifndef CPUX86_HAS_SSE2} if has_sse2_support then {$endif}
     FillChar_Impl := @FillChar_SSE2
+{$ifndef CPUX86_HAS_SSE2}
   else
-    FillChar_Impl := @FillChar_Plain;
+    FillChar_Impl := @FillChar_Plain
+{$endif ndef CPUX86_HAS_SSE2};
   FillChar_Impl(x, count, value);
 end;
 
@@ -435,6 +441,7 @@ asm
 .LQuit:
 end;
 
+{$ifndef CPUX86_HAS_SSE2}
 procedure FillWord_Plain(var x;count:SizeInt;value:word);assembler;nostackframe;
 asm
         cmp     $3, %edx
@@ -447,6 +454,7 @@ asm
         jbe     FillXxxx_U32Pattern_Ladder_4to16
         jmp     FillXxxx_U32Pattern_Plain_16OrMore
 end;
+{$endif ndef CPUX86_HAS_SSE2}
 
 procedure FillWord_SSE2(var x;count:SizeInt;value:word);assembler;nostackframe;
 asm
@@ -487,15 +495,17 @@ procedure FillWord_Dispatch(var x;count:SizeInt;value:word);
 begin
   if not fpc_cpucodeinit_performed then
     begin
-      FillWord_Plain(x, count, value);
+      {$ifdef CPUX86_HAS_SSE2} FillWord_SSE2 {$else} FillWord_Plain {$endif} (x, count, value);
       exit;
     end;
   if fast_large_repmovstosb then
     FillWord_Impl := @FillWord_SSE2_ERMS
-  else if has_sse2_support then
+  else {$ifndef CPUX86_HAS_SSE2} if has_sse2_support then {$endif}
     FillWord_Impl := @FillWord_SSE2
+{$ifndef CPUX86_HAS_SSE2}
   else
-    FillWord_Impl := @FillWord_Plain;
+    FillWord_Impl := @FillWord_Plain
+{$endif ndef CPUX86_HAS_SSE2};
   FillWord_Impl(x, count, value);
 end;
 
@@ -520,6 +530,7 @@ asm
 .LQuit:
 end;
 
+{$ifndef CPUX86_HAS_SSE2}
 procedure FillDWord_Plain(var x;count:SizeInt;value:dword);assembler;nostackframe;
 asm
         cmp     $4, %edx
@@ -527,6 +538,7 @@ asm
         shl     $2, %edx
         jmp     FillXxxx_U32Pattern_Plain_16OrMore
 end;
+{$endif ndef CPUX86_HAS_SSE2}
 
 procedure FillDWord_SSE2(var x;count:SizeInt;value:dword);assembler;nostackframe;
 asm
@@ -557,15 +569,17 @@ procedure FillDWord_Dispatch(var x;count:SizeInt;value:dword);
 begin
   if not fpc_cpucodeinit_performed then
     begin
-      FillDWord_Plain(x, count, value);
+      {$ifdef CPUX86_HAS_SSE2} FillDWord_SSE2 {$else} FillDWord_Plain {$endif}(x, count, value);
       exit;
     end;
   if fast_large_repmovstosb then
     FillDWord_Impl := @FillDWord_SSE2_ERMS
-  else if has_sse2_support then
+  else {$ifndef CPUX86_HAS_SSE2} if has_sse2_support then {$endif}
     FillDWord_Impl := @FillDWord_SSE2
+{$ifndef CPUX86_HAS_SSE2}
   else
-    FillDWord_Impl := @FillDWord_Plain;
+    FillDWord_Impl := @FillDWord_Plain
+{$endif ndef CPUX86_HAS_SSE2};
   FillDWord_Impl(x, count, value);
 end;
 
@@ -578,6 +592,7 @@ end;
 
 {$ifndef FPC_SYSTEM_HAS_FILLQWORD}
 {$define FPC_SYSTEM_HAS_FILLQWORD}
+{$ifndef CPUX86_HAS_SSE2}
 procedure FillQWord_Plain(var x;count:SizeInt;value:QWord);assembler;nostackframe;
 { eax = x, edx = count, [esp + 4] = value }
 asm
@@ -596,8 +611,9 @@ asm
         pop     %esi
 .LQuit:
 end;
+{$endif ndef CPUX86_HAS_SSE2}
 
-procedure FillQWord_SSE2(var x;count:SizeInt;value:QWord);assembler;nostackframe;
+procedure {$ifdef CPUX86_HAS_SSE2} FillQWord {$else} FillQWord_SSE2 {$endif}(var x;count:SizeInt;value:QWord);assembler;nostackframe;
 { eax = x, edx = count, [esp + 4] = value }
 asm
         cmp     $4, %edx
@@ -650,6 +666,7 @@ asm
         mov     %ecx, 4(%eax)
 end;
 
+{$ifndef CPUX86_HAS_SSE2}
 procedure FillQWord_Dispatch(var x;count:SizeInt;value:qword); forward;
 
 var
@@ -673,11 +690,13 @@ procedure FillQWord(var x;count:SizeInt;value:qword);
 begin
   FillQWord_Impl(x, count, value);
 end;
+{$endif ndef CPUX86_HAS_SSE2 (need FillQWord dispatcher)}
 {$endif FPC_SYSTEM_HAS_FILLQWORD}
 
 
 {$ifndef FPC_SYSTEM_HAS_INDEXBYTE}
 {$define FPC_SYSTEM_HAS_INDEXBYTE}
+{$ifndef CPUX86_HAS_SSE2}
 function IndexByte_Plain(Const buf;len:SizeInt;b:byte):SizeInt; assembler; nostackframe;
 { eax = buf, edx = len, cl = b }
 asm
@@ -761,8 +780,9 @@ asm
         pop   %ecx
         sub   %ecx,%eax
 end;
+{$endif ndef CPUX86_HAS_SSE2}
 
-function IndexByte_SSE2(const buf;len:SizeInt;b:byte):SizeInt; assembler; nostackframe;
+function {$ifdef CPUX86_HAS_SSE2} IndexByte {$else} IndexByte_SSE2 {$endif} (const buf;len:SizeInt;b:byte):SizeInt; assembler; nostackframe;
 asm
         test      %edx, %edx
         jz        .Lnotfound                 { exit if len=0 }
@@ -807,6 +827,7 @@ asm
         or        $-1, %eax
 end;
 
+{$ifndef CPUX86_HAS_SSE2}
 function IndexByte_Dispatch(const buf;len:SizeInt;b:byte):SizeInt; forward;
 
 var
@@ -827,11 +848,13 @@ function IndexByte(const buf;len:SizeInt;b:byte):SizeInt;
 begin
   result:=IndexByte_Impl(buf,len,b);
 end;
+{$endif ndef CPUX86_HAS_SSE2}
 {$endif FPC_SYSTEM_HAS_INDEXBYTE}
 
 
 {$ifndef FPC_SYSTEM_HAS_INDEXWORD}
 {$define FPC_SYSTEM_HAS_INDEXWORD}
+{$ifndef CPUX86_HAS_SSE2}
 function IndexWord_Plain(Const buf;len:SizeInt;b:word):SizeInt; assembler; nostackframe;
 asm
         test    %edx, %edx
@@ -853,8 +876,9 @@ asm
         sub     %edx, %eax
         shr     $1, %eax
 end;
+{$endif ndef CPUX86_HAS_SSE2}
 
-function IndexWord_SSE2(const buf;len:SizeInt;b:word):SizeInt; assembler; nostackframe;
+function {$ifdef CPUX86_HAS_SSE2} IndexWord {$else} IndexWord_SSE2 {$endif} (const buf;len:SizeInt;b:word):SizeInt; assembler; nostackframe;
 asm
         test      %edx, %edx       { exit if len=0 }
         je        .Lnotfound
@@ -955,6 +979,7 @@ asm
         pop       %ebx
 end;
 
+{$ifndef CPUX86_HAS_SSE2}
 function IndexWord_Dispatch(const buf;len:SizeInt;b:word):SizeInt; forward;
 
 var
@@ -975,11 +1000,13 @@ function IndexWord(const buf;len:SizeInt;b:word):SizeInt; inline;
 begin
   result:=IndexWord_Impl(buf,len,b);
 end;
+{$endif ndef CPUX86_HAS_SSE2}
 {$endif FPC_SYSTEM_HAS_INDEXWORD}
 
 
 {$ifndef FPC_SYSTEM_HAS_INDEXDWORD}
 {$define FPC_SYSTEM_HAS_INDEXDWORD}
+{$ifndef CPUX86_HAS_SSE2}
 function IndexDWord_Plain(Const buf;len:SizeInt;b:DWord):SizeInt; assembler; nostackframe;
 asm
         push    %eax
@@ -999,8 +1026,9 @@ asm
         pop     %edx
         mov     $-1, %eax
 end;
+{$endif ndef CPUX86_HAS_SSE2}
 
-function IndexDWord_SSE2(const buf;len:SizeInt;b:DWord):SizeInt; assembler; nostackframe;
+function {$ifdef CPUX86_HAS_SSE2} IndexDWord {$else} IndexDWord_SSE2 {$endif} (const buf;len:SizeInt;b:DWord):SizeInt; assembler; nostackframe;
 asm
         push     %eax
         sub      $4, %edx
@@ -1050,6 +1078,7 @@ asm
         or       $-1, %eax
 end;
 
+{$ifndef CPUX86_HAS_SSE2}
 function IndexDWord_Dispatch(const buf;len:SizeInt;b:DWord):SizeInt; forward;
 
 var
@@ -1070,6 +1099,7 @@ function IndexDWord(const buf;len:SizeInt;b:DWord):SizeInt;
 begin
   result:=IndexDWord_Impl(buf,len,b);
 end;
+{$endif CPUX86_HAS_SSE2}
 {$endif FPC_SYSTEM_HAS_INDEXDWORD}
 
 
@@ -1175,6 +1205,7 @@ end;
 
 {$ifndef FPC_SYSTEM_HAS_COMPAREBYTE}
 {$define FPC_SYSTEM_HAS_COMPAREBYTE}
+{$ifndef CPUX86_HAS_SSE2}
 function CompareByte_Plain(Const buf1,buf2;len:SizeInt):SizeInt; assembler; nostackframe;
 asm
         { eax = buf1, edx = buf2, ecx = len }
@@ -1243,8 +1274,9 @@ asm
         xor     %eax, %eax
         pop     %ebx
 end;
+{$endif ndef CPUX86_HAS_SSE2}
 
-function CompareByte_SSE2(const buf1, buf2; len: SizeInt): SizeInt; assembler; nostackframe;
+function {$ifdef CPUX86_HAS_SSE2} CompareByte {$else} CompareByte_SSE2 {$endif} (const buf1, buf2; len: SizeInt): SizeInt; assembler; nostackframe;
 asm
         { eax = buf1, edx = buf2, ecx = len }
         cmp      $1, %ecx
@@ -1472,6 +1504,7 @@ asm
         or       $1, %eax
 end;
 
+{$ifndef CPUX86_HAS_SSE2}
 function CompareByte_Dispatch(const buf1, buf2; len: SizeInt): SizeInt; forward;
 
 var
@@ -1492,11 +1525,13 @@ function CompareByte(const buf1, buf2; len: SizeInt): SizeInt;
 begin
   result:=CompareByte_Impl(buf1, buf2, len);
 end;
+{$endif ndef CPUX86_HAS_SSE2 (need CompareByte dispatcher)}
 {$endif FPC_SYSTEM_HAS_COMPAREBYTE}
 
 
 {$ifndef FPC_SYSTEM_HAS_COMPAREWORD}
 {$define FPC_SYSTEM_HAS_COMPAREWORD}
+{$ifndef CPUX86_HAS_SSE2}
 function CompareWord_Plain(Const buf1,buf2;len:SizeInt):SizeInt; assembler; nostackframe;
 asm
         push    %ebx
@@ -1552,8 +1587,9 @@ asm
         pop     %ebx
         xor     %eax, %eax
 end;
+{$endif ndef CPUX86_HAS_SSE2}
 
-function CompareWord_SSE2(Const buf1,buf2;len:SizeInt):SizeInt; assembler; nostackframe;
+function {$ifdef CPUX86_HAS_SSE2} CompareWord {$else} CompareWord_SSE2 {$endif} (Const buf1,buf2;len:SizeInt):SizeInt; assembler; nostackframe;
 asm
         push     %ebx
         sub      %eax, %edx { edx = buf2 - buf1 }
@@ -1665,6 +1701,7 @@ asm
         pop      %ebx
 end;
 
+{$ifndef CPUX86_HAS_SSE2}
 function CompareWord_Dispatch(const buf1, buf2; len: SizeInt): SizeInt; forward;
 
 var
@@ -1685,11 +1722,13 @@ function CompareWord(const buf1, buf2; len: SizeInt): SizeInt;
 begin
   result:=CompareWord_Impl(buf1, buf2, len);
 end;
+{$endif ndef CPUX86_HAS_SSE2 (need CompareWord dispatcher)}
 {$endif FPC_SYSTEM_HAS_COMPAREWORD}
 
 
 {$ifndef FPC_SYSTEM_HAS_COMPAREDWORD}
 {$define FPC_SYSTEM_HAS_COMPAREDWORD}
+{$ifndef CPUX86_HAS_SSE2}
 function CompareDWord_Plain(Const buf1,buf2;len:SizeInt):SizeInt; assembler; nostackframe;
 asm
         sub     $1, %ecx
@@ -1714,8 +1753,9 @@ asm
         sbb     %eax, %eax
         or      $1, %eax
 end;
+{$endif}
 
-function CompareDWord_SSE2(Const buf1,buf2;len:SizeInt):SizeInt; assembler; nostackframe;
+function {$ifdef CPUX86_HAS_SSE2} CompareDWord {$else} CompareDWord_SSE2 {$endif} (Const buf1,buf2;len:SizeInt):SizeInt; assembler; nostackframe;
 asm
         push     %ebx
         sub      %eax, %edx { edx = buf2 - buf1 }
@@ -1800,6 +1840,7 @@ asm
         xor     %eax, %eax
 end;
 
+{$ifndef CPUX86_HAS_SSE2}
 function CompareDWord_Dispatch(const buf1, buf2; len: SizeInt): SizeInt; forward;
 
 var
@@ -1820,6 +1861,7 @@ function CompareDWord(const buf1, buf2; len: SizeInt): SizeInt;
 begin
   result:=CompareDWord_Impl(buf1, buf2, len);
 end;
+{$endif ndef CPUX86_HAS_SSE2 (need CompareDWord dispatcher)}
 {$endif FPC_SYSTEM_HAS_COMPAREDWORD}
 
 

+ 19 - 7
rtl/inc/systemh.inc

@@ -788,6 +788,18 @@ type
 (* means that default handling should be used. *)
   TCtrlBreakHandler = function (CtrlBreak: boolean): boolean;
 
+  Int128Rec = packed record
+    case integer of
+{$ifdef FPC_LITTLE_ENDIAN}
+      0 : (Lo,Hi : QWord);
+{$else FPC_LITTLE_ENDIAN}
+      0 : (Hi,Lo : QWord);
+{$endif FPC_LITTLE_ENDIAN}
+      1 : (DWords : Array[0..3] of DWord);
+      2 : (Words : Array[0..7] of Word);
+      3 : (Bytes : Array[0..15] of Byte);
+  end;
+
 { Numbers for routines that have compiler magic }
 {$I innr.inc}
 
@@ -913,17 +925,17 @@ Procedure FillChar(var x;count:{$ifdef FILLCHAR_HAS_SIZEUINT_COUNT}SizeUInt{$els
 procedure FillByte(var x;count:{$ifdef FILLCHAR_HAS_SIZEUINT_COUNT}SizeUInt{$else}SizeInt{$endif};value:byte);
 Procedure FillWord(var x;count:SizeInt;Value:Word); {$if defined(cpui386)}inline;{$endif}
 procedure FillDWord(var x;count:SizeInt;value:DWord); {$if defined(cpui386)}inline;{$endif}
-procedure FillQWord(var x;count:SizeInt;value:QWord); {$if defined(cpui386)}inline;{$endif}
+procedure FillQWord(var x;count:SizeInt;value:QWord); {$if defined(cpui386) and not defined(CPUX86_HAS_SSE2)}inline;{$endif}
 function  IndexChar(const buf;len:SizeInt;b:ansichar):SizeInt;
 function  IndexChar(const buf;len:SizeInt;b:widechar):SizeInt;
-function  IndexByte(const buf;len:SizeInt;b:byte):SizeInt; {$if defined(cpui386)} inline; {$endif}
-function  Indexword(const buf;len:SizeInt;b:word):SizeInt; {$if defined(cpui386)} inline; {$endif}
-function  IndexDWord(const buf;len:SizeInt;b:DWord):SizeInt; {$if defined(cpui386)} inline; {$endif}
+function  IndexByte(const buf;len:SizeInt;b:byte):SizeInt; {$if defined(cpui386) and not defined(CPUX86_HAS_SSE2)} inline; {$endif}
+function  Indexword(const buf;len:SizeInt;b:word):SizeInt; {$if defined(cpui386) and not defined(CPUX86_HAS_SSE2)} inline; {$endif}
+function  IndexDWord(const buf;len:SizeInt;b:DWord):SizeInt; {$if defined(cpui386) and not defined(CPUX86_HAS_SSE2)} inline; {$endif}
 function  IndexQWord(const buf;len:SizeInt;b:QWord):SizeInt; {$if defined(cpui386) or defined(cpux86_64)} inline; {$endif}
 function  CompareChar(const buf1,buf2;len:SizeInt):SizeInt;
-function  CompareByte(const buf1,buf2;len:SizeInt):SizeInt; {$if defined(cpui386)} inline; {$endif}
-function  CompareWord(const buf1,buf2;len:SizeInt):SizeInt; {$if defined(cpui386)} inline; {$endif}
-function  CompareDWord(const buf1,buf2;len:SizeInt):SizeInt; {$if defined(cpui386)} inline; {$endif}
+function  CompareByte(const buf1,buf2;len:SizeInt):SizeInt; {$if defined(cpui386) and not defined(CPUX86_HAS_SSE2)} inline; {$endif}
+function  CompareWord(const buf1,buf2;len:SizeInt):SizeInt; {$if defined(cpui386) and not defined(CPUX86_HAS_SSE2)} inline; {$endif}
+function  CompareDWord(const buf1,buf2;len:SizeInt):SizeInt; {$if defined(cpui386) and not defined(CPUX86_HAS_SSE2)} inline; {$endif}
 procedure MoveChar0(const buf1;var buf2;len:SizeInt);
 function  IndexChar0(const buf;len:SizeInt;b:Ansichar):SizeInt;
 function  CompareChar0(const buf1,buf2;len:SizeInt):SizeInt;

+ 1 - 11
rtl/objpas/sysutils/sysutilh.inc

@@ -81,17 +81,7 @@ type
         2 : (Bytes : Array[0..7] of Byte);
    end;
 
-   Int128Rec = packed record
-      case integer of
-{$ifdef FPC_LITTLE_ENDIAN}
-        0 : (Lo,Hi : QWord);
-{$else FPC_LITTLE_ENDIAN}
-        0 : (Hi,Lo : QWord);
-{$endif FPC_LITTLE_ENDIAN}
-        1 : (DWords : Array[0..3] of DWord);
-        2 : (Words : Array[0..7] of Word);
-        3 : (Bytes : Array[0..15] of Byte);
-   end;
+   Int128Rec = System.Int128Rec;
 
    OWordRec = packed record
       case integer of

+ 0 - 8
rtl/x86_64/cpu.pp

@@ -27,14 +27,6 @@ unit cpu;
      {$endif}
   {$endif}
 
-{$IFDEF FPC_DOTTEDUNITS}
-    uses
-      System.SysUtils;
-{$ELSE FPC_DOTTEDUNITS}
-    uses
-      sysutils;
-{$ENDIF FPC_DOTTEDUNITS}
-
 type
     TCpuidResult = record
       eax, ebx, ecx, edx: uint32;