Browse Source

* synchronized with trunk

git-svn-id: branches/z80@44740 -
nickysn 5 years ago
parent
commit
9b78276760

+ 6 - 167
compiler/aarch64/aoptcpu.pas

@@ -42,13 +42,10 @@ Interface
         function PostPeepHoleOptsCpu(var p: tai): boolean; override;
         function PostPeepHoleOptsCpu(var p: tai): boolean; override;
         function RegLoadedWithNewValue(reg: tregister; hp: tai): boolean;override;
         function RegLoadedWithNewValue(reg: tregister; hp: tai): boolean;override;
         function InstructionLoadsFromReg(const reg: TRegister; const hp: tai): boolean;override;
         function InstructionLoadsFromReg(const reg: TRegister; const hp: tai): boolean;override;
-        function GetNextInstructionUsingReg(Current : tai; out Next : tai; reg : TRegister) : Boolean;
         function LookForPostindexedPattern(p : taicpu) : boolean;
         function LookForPostindexedPattern(p : taicpu) : boolean;
-        procedure DebugMsg(const s : string; p : tai);
       private
       private
         function OptPass1Shift(var p: tai): boolean;
         function OptPass1Shift(var p: tai): boolean;
         function OptPostCMP(var p: tai): boolean;
         function OptPostCMP(var p: tai): boolean;
-        function RemoveSuperfluousMove(const p: tai; movp: tai; const optimizer: string): boolean;
         function OptPass1Data(var p: tai): boolean;
         function OptPass1Data(var p: tai): boolean;
       End;
       End;
 
 
@@ -60,98 +57,12 @@ Implementation
     cgutils,
     cgutils,
     verbose;
     verbose;
 
 
-{$ifdef DEBUG_AOPTCPU}
-  procedure TCpuAsmOptimizer.DebugMsg(const s: string;p : tai);
-    begin
-      asml.insertbefore(tai_comment.Create(strpnew(s)), p);
-    end;
-{$else DEBUG_AOPTCPU}
-  procedure TCpuAsmOptimizer.DebugMsg(const s: string;p : tai);inline;
-    begin
-    end;
-{$endif DEBUG_AOPTCPU}
-
   function CanBeCond(p : tai) : boolean;
   function CanBeCond(p : tai) : boolean;
     begin
     begin
       result:=(p.typ=ait_instruction) and (taicpu(p).condition=C_None);
       result:=(p.typ=ait_instruction) and (taicpu(p).condition=C_None);
     end;
     end;
 
 
 
 
-  function RefsEqual(const r1, r2: treference): boolean;
-    begin
-      refsequal :=
-        (r1.offset = r2.offset) and
-        (r1.base = r2.base) and
-        (r1.index = r2.index) and (r1.scalefactor = r2.scalefactor) and
-        (r1.symbol=r2.symbol) and (r1.refaddr = r2.refaddr) and
-        (r1.relsymbol = r2.relsymbol) and
-        (r1.shiftimm = r2.shiftimm) and
-        (r1.addressmode = r2.addressmode) and
-        (r1.shiftmode = r2.shiftmode) and
-        (r1.volatility=[]) and
-        (r2.volatility=[]);
-    end;
-
-
-  function MatchInstruction(const instr: tai; const op: TAsmOps; const postfix: TOpPostfixes): boolean;
-    begin
-      result :=
-        (instr.typ = ait_instruction) and
-        ((op = []) or (taicpu(instr).opcode in op)) and
-        ((postfix = []) or (taicpu(instr).oppostfix in postfix));
-    end;
-
-
-  function MatchInstruction(const instr: tai; const op: TAsmOp; const postfix: TOpPostfixes): boolean;
-    begin
-      result :=
-        (instr.typ = ait_instruction) and
-        (taicpu(instr).opcode = op) and
-        ((postfix = []) or (taicpu(instr).oppostfix in postfix));
-    end;
-
-
-  function MatchOperand(const oper: TOper; const reg: TRegister): boolean; inline;
-    begin
-      result := (oper.typ = top_reg) and (oper.reg = reg);
-    end;
-
-
-  function MatchOperand(const oper1: TOper; const oper2: TOper): boolean; inline;
-    begin
-      result := oper1.typ = oper2.typ;
-
-      if result then
-        case oper1.typ of
-          top_const:
-            Result:=oper1.val = oper2.val;
-          top_reg:
-            Result:=oper1.reg = oper2.reg;
-          top_conditioncode:
-            Result:=oper1.cc = oper2.cc;
-          top_realconst:
-            Result:=oper1.val_real = oper2.val_real;
-          top_ref:
-            Result:=RefsEqual(oper1.ref^, oper2.ref^);
-          else Result:=false;
-        end
-    end;
-
-
-  function TCpuAsmOptimizer.GetNextInstructionUsingReg(Current: tai;
-    Out Next: tai; reg: TRegister): Boolean;
-    begin
-      Next:=Current;
-      repeat
-        Result:=GetNextInstruction(Next,Next);
-      until not (Result) or
-            not(cs_opt_level3 in current_settings.optimizerswitches) or
-            (Next.typ<>ait_instruction) or
-            RegInInstruction(reg,Next) or
-            is_calljmp(taicpu(Next).opcode);
-    end;
-
-
   function TCpuAsmOptimizer.RegLoadedWithNewValue(reg: tregister; hp: tai): boolean;
   function TCpuAsmOptimizer.RegLoadedWithNewValue(reg: tregister; hp: tai): boolean;
     var
     var
       p: taicpu;
       p: taicpu;
@@ -234,84 +145,6 @@ Implementation
         end;
         end;
     end;
     end;
 
 
-
-  function TCpuAsmOptimizer.RemoveSuperfluousMove(const p: tai; movp: tai; const optimizer: string):boolean;
-    var
-      alloc,
-      dealloc : tai_regalloc;
-      hp1 : tai;
-    begin
-      Result:=false;
-      if MatchInstruction(movp, A_MOV, [PF_None]) and
-        (taicpu(p).ops>=3) and
-        { We can't optimize if there is a shiftop }
-        (taicpu(movp).ops=2) and
-        MatchOperand(taicpu(movp).oper[1]^, taicpu(p).oper[0]^.reg) and
-        { don't mess with moves to fp }
-        (taicpu(movp).oper[0]^.reg<>NR_FP) and
-        { the destination register of the mov might not be used beween p and movp }
-        not(RegUsedBetween(taicpu(movp).oper[0]^.reg,p,movp)) and
-        { Take care to only do this for instructions which REALLY load to the first register.
-          Otherwise
-            str reg0, [reg1]
-            mov reg2, reg0
-          will be optimized to
-            str reg2, [reg1]
-        }
-        RegLoadedWithNewValue(taicpu(p).oper[0]^.reg, p) then
-        begin
-          dealloc:=FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(movp.Next));
-          if assigned(dealloc) then
-            begin
-              DebugMsg('Peephole '+optimizer+' removed superfluous mov', movp);
-              result:=true;
-
-              { taicpu(p).oper[0]^.reg is not used anymore, try to find its allocation
-                and remove it if possible }
-              asml.Remove(dealloc);
-              alloc:=FindRegAllocBackward(taicpu(p).oper[0]^.reg,tai(p.previous));
-              if assigned(alloc) then
-                begin
-                  asml.Remove(alloc);
-                  alloc.free;
-                  dealloc.free;
-                end
-              else
-                asml.InsertAfter(dealloc,p);
-
-              { try to move the allocation of the target register }
-              GetLastInstruction(movp,hp1);
-              alloc:=FindRegAlloc(taicpu(movp).oper[0]^.reg,tai(hp1.Next));
-              if assigned(alloc) then
-                begin
-                  asml.Remove(alloc);
-                  asml.InsertBefore(alloc,p);
-                  { adjust used regs }
-                  IncludeRegInUsedRegs(taicpu(movp).oper[0]^.reg,UsedRegs);
-                end;
-
-              { finally get rid of the mov }
-              taicpu(p).loadreg(0,taicpu(movp).oper[0]^.reg);
-              { Remove preindexing and postindexing for LDR in some cases.
-                For example:
-                  ldr	reg2,[reg1, xxx]!
-                  mov reg1,reg2
-                must be translated to:
-                  ldr	reg1,[reg1, xxx]
-
-                Preindexing must be removed there, since the same register is used as the base and as the target.
-                Such case is not allowed for ARM CPU and produces crash. }
-              if (taicpu(p).opcode = A_LDR) and (taicpu(p).oper[1]^.typ = top_ref)
-                and (taicpu(movp).oper[0]^.reg = taicpu(p).oper[1]^.ref^.base)
-              then
-                taicpu(p).oper[1]^.ref^.addressmode:=AM_OFFSET;
-              asml.remove(movp);
-              movp.free;
-            end;
-        end;
-    end;
-
-
   {
   {
     optimize
     optimize
       ldr/str regX,[reg1]
       ldr/str regX,[reg1]
@@ -541,6 +374,12 @@ Implementation
             A_ORR,
             A_ORR,
             A_MUL:
             A_MUL:
               Result:=OptPass1Data(p);
               Result:=OptPass1Data(p);
+            A_UXTB:
+              Result:=OptPass1UXTB(p);
+            A_SXTB:
+              Result:=OptPass1SXTB(p);
+            A_SXTH:
+              Result:=OptPass1SXTH(p);
             else
             else
               ;
               ;
           end;
           end;

+ 2 - 0
compiler/aarch64/cpubase.pas

@@ -49,6 +49,8 @@ unit cpubase;
       TAsmOp= {$i a64op.inc}
       TAsmOp= {$i a64op.inc}
 
 
       TAsmOps = set of TAsmOp;
       TAsmOps = set of TAsmOp;
+      { AArch64 has less than 256 opcodes so far }
+      TCommonAsmOps = Set of TAsmOp;
 
 
       { This should define the array of instructions as string }
       { This should define the array of instructions as string }
       op2strtable=array[tasmop] of string[11];
       op2strtable=array[tasmop] of string[11];

+ 5 - 560
compiler/arm/aoptcpu.pas

@@ -26,7 +26,7 @@ Unit aoptcpu;
 {$i fpcdefs.inc}
 {$i fpcdefs.inc}
 
 
 { $define DEBUG_PREREGSCHEDULER}
 { $define DEBUG_PREREGSCHEDULER}
-{$define DEBUG_AOPTCPU}
+{ $define DEBUG_AOPTCPU}
 
 
 Interface
 Interface
 
 
@@ -44,7 +44,6 @@ Type
     function PeepHoleOptPass1Cpu(var p: tai): boolean; override;
     function PeepHoleOptPass1Cpu(var p: tai): boolean; override;
     procedure PeepHoleOptPass2;override;
     procedure PeepHoleOptPass2;override;
     Function RegInInstruction(Reg: TRegister; p1: tai): Boolean;override;
     Function RegInInstruction(Reg: TRegister; p1: tai): Boolean;override;
-    function RemoveSuperfluousMove(const p: tai; movp: tai; const optimizer: string): boolean;
     function RemoveSuperfluousVMov(const p : tai; movp : tai; const optimizer : string) : boolean;
     function RemoveSuperfluousVMov(const p : tai; movp : tai; const optimizer : string) : boolean;
 
 
     { gets the next tai object after current that contains info relevant
     { gets the next tai object after current that contains info relevant
@@ -52,7 +51,6 @@ Type
       change in program flow.
       change in program flow.
       If there is none, it returns false and
       If there is none, it returns false and
       sets p1 to nil                                                     }
       sets p1 to nil                                                     }
-    Function GetNextInstructionUsingReg(Current: tai; Out Next: tai; reg: TRegister): Boolean;
     Function GetNextInstructionUsingRef(Current: tai; Out Next: tai; const ref: TReference; StopOnStore: Boolean = true): Boolean;
     Function GetNextInstructionUsingRef(Current: tai; Out Next: tai; const ref: TReference; StopOnStore: Boolean = true): Boolean;
 
 
     { outputs a debug message into the assembler file }
     { outputs a debug message into the assembler file }
@@ -112,63 +110,6 @@ Implementation
     end;
     end;
 
 
 
 
-  function RefsEqual(const r1, r2: treference): boolean;
-    begin
-      refsequal :=
-        (r1.offset = r2.offset) and
-        (r1.base = r2.base) and
-        (r1.index = r2.index) and (r1.scalefactor = r2.scalefactor) and
-        (r1.symbol=r2.symbol) and (r1.refaddr = r2.refaddr) and
-        (r1.relsymbol = r2.relsymbol) and
-        (r1.signindex = r2.signindex) and
-        (r1.shiftimm = r2.shiftimm) and
-        (r1.addressmode = r2.addressmode) and
-        (r1.shiftmode = r2.shiftmode) and
-        (r1.volatility=[]) and
-        (r2.volatility=[]);
-    end;
-
-  function MatchInstruction(const instr: tai; const op: TCommonAsmOps; const cond: TAsmConds; const postfix: TOpPostfixes): boolean;
-  begin
-    result :=
-      (instr.typ = ait_instruction) and
-      ((op = []) or ((ord(taicpu(instr).opcode)<256) and (taicpu(instr).opcode in op))) and
-      ((cond = []) or (taicpu(instr).condition in cond)) and
-      ((postfix = []) or (taicpu(instr).oppostfix in postfix));
-  end;
-
-  function MatchInstruction(const instr: tai; const op: TAsmOp; const cond: TAsmConds; const postfix: TOpPostfixes): boolean;
-  begin
-    result :=
-      (instr.typ = ait_instruction) and
-      (taicpu(instr).opcode = op) and
-      ((cond = []) or (taicpu(instr).condition in cond)) and
-      ((postfix = []) or (taicpu(instr).oppostfix in postfix));
-  end;
-
-  function MatchOperand(const oper1: TOper; const oper2: TOper): boolean; inline;
-    begin
-      result := oper1.typ = oper2.typ;
-
-      if result then
-        case oper1.typ of
-          top_const:
-            Result:=oper1.val = oper2.val;
-          top_reg:
-            Result:=oper1.reg = oper2.reg;
-          top_conditioncode:
-            Result:=oper1.cc = oper2.cc;
-          top_ref:
-            Result:=RefsEqual(oper1.ref^, oper2.ref^);
-          else Result:=false;
-        end
-    end;
-
-  function MatchOperand(const oper: TOper; const reg: TRegister): boolean; inline;
-    begin
-      result := (oper.typ = top_reg) and (oper.reg = reg);
-    end;
-
   function RemoveRedundantMove(const cmpp: tai; movp: tai; asml: TAsmList):Boolean;
   function RemoveRedundantMove(const cmpp: tai; movp: tai; asml: TAsmList):Boolean;
     begin
     begin
       Result:=false;
       Result:=false;
@@ -332,20 +273,6 @@ Implementation
     end;
     end;
 
 
 
 
-  function TCpuAsmOptimizer.GetNextInstructionUsingReg(Current: tai;
-    Out Next: tai; reg: TRegister): Boolean;
-    begin
-      Next:=Current;
-      repeat
-        Result:=GetNextInstruction(Next,Next);
-      until not (Result) or
-            not(cs_opt_level3 in current_settings.optimizerswitches) or
-            (Next.typ<>ait_instruction) or
-            RegInInstruction(reg,Next) or
-            is_calljmp(taicpu(Next).opcode) or
-            RegModifiedByInstruction(NR_PC,Next);
-    end;
-
   function TCpuAsmOptimizer.GetNextInstructionUsingRef(Current: tai;
   function TCpuAsmOptimizer.GetNextInstructionUsingRef(Current: tai;
     Out Next: tai; const ref: TReference; StopOnStore: Boolean = true): Boolean;
     Out Next: tai; const ref: TReference; StopOnStore: Boolean = true): Boolean;
     begin
     begin
@@ -395,92 +322,6 @@ Implementation
     end;
     end;
 
 
 
 
-  function TCpuAsmOptimizer.RemoveSuperfluousMove(const p: tai; movp: tai; const optimizer: string):boolean;
-    var
-      alloc,
-      dealloc : tai_regalloc;
-      hp1 : tai;
-    begin
-      Result:=false;
-      if MatchInstruction(movp, A_MOV, [taicpu(p).condition], [PF_None]) and
-         (taicpu(movp).ops=2) and {We can't optimize if there is a shiftop}
-         MatchOperand(taicpu(movp).oper[1]^, taicpu(p).oper[0]^.reg) and
-         { don't mess with moves to pc }
-         (taicpu(movp).oper[0]^.reg<>NR_PC) and
-         { don't mess with moves to lr }
-         (taicpu(movp).oper[0]^.reg<>NR_R14) and
-         { the destination register of the mov might not be used beween p and movp }
-         not(RegUsedBetween(taicpu(movp).oper[0]^.reg,p,movp)) and
-         { cb[n]z are thumb instructions which require specific registers, with no wide forms }
-         (taicpu(p).opcode<>A_CBZ) and
-         (taicpu(p).opcode<>A_CBNZ) and
-         {There is a special requirement for MUL and MLA, oper[0] and oper[1] are not allowed to be the same}
-         not (
-           (taicpu(p).opcode in [A_MLA, A_MUL]) and
-           (taicpu(p).oper[1]^.reg = taicpu(movp).oper[0]^.reg) and
-           (current_settings.cputype < cpu_armv6)
-         ) and
-         { Take care to only do this for instructions which REALLY load to the first register.
-           Otherwise
-             str reg0, [reg1]
-             mov reg2, reg0
-           will be optimized to
-             str reg2, [reg1]
-         }
-         regLoadedWithNewValue(taicpu(p).oper[0]^.reg, p) then
-        begin
-          dealloc:=FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(movp.Next));
-          if assigned(dealloc) then
-            begin
-              DebugMsg('Peephole '+optimizer+' removed superfluous mov', movp);
-              result:=true;
-
-              { taicpu(p).oper[0]^.reg is not used anymore, try to find its allocation
-                and remove it if possible }
-              asml.Remove(dealloc);
-              alloc:=FindRegAllocBackward(taicpu(p).oper[0]^.reg,tai(p.previous));
-              if assigned(alloc) then
-                begin
-                  asml.Remove(alloc);
-                  alloc.free;
-                  dealloc.free;
-                end
-              else
-                asml.InsertAfter(dealloc,p);
-
-              { try to move the allocation of the target register }
-              GetLastInstruction(movp,hp1);
-              alloc:=FindRegAlloc(taicpu(movp).oper[0]^.reg,tai(hp1.Next));
-              if assigned(alloc) then
-                begin
-                  asml.Remove(alloc);
-                  asml.InsertBefore(alloc,p);
-                  { adjust used regs }
-                  IncludeRegInUsedRegs(taicpu(movp).oper[0]^.reg,UsedRegs);
-                end;
-
-              { finally get rid of the mov }
-              taicpu(p).loadreg(0,taicpu(movp).oper[0]^.reg);
-              { Remove preindexing and postindexing for LDR in some cases.
-                For example:
-                  ldr	reg2,[reg1, xxx]!
-                  mov reg1,reg2
-                must be translated to:
-                  ldr	reg1,[reg1, xxx]
-
-                Preindexing must be removed there, since the same register is used as the base and as the target.
-                Such case is not allowed for ARM CPU and produces crash. }
-              if (taicpu(p).opcode = A_LDR) and (taicpu(p).oper[1]^.typ = top_ref)
-                and (taicpu(movp).oper[0]^.reg = taicpu(p).oper[1]^.ref^.base)
-              then
-                taicpu(p).oper[1]^.ref^.addressmode:=AM_OFFSET;
-              asml.remove(movp);
-              movp.free;
-            end;
-        end;
-    end;
-
-
   function TCpuAsmOptimizer.RemoveSuperfluousVMov(const p: tai; movp: tai; const optimizer: string):boolean;
   function TCpuAsmOptimizer.RemoveSuperfluousVMov(const p: tai; movp: tai; const optimizer: string):boolean;
     var
     var
       alloc,
       alloc,
@@ -2049,409 +1890,13 @@ Implementation
                   end;
                   end;
 {$endif dummy}
 {$endif dummy}
                 A_UXTB:
                 A_UXTB:
-                  begin
-                    {
-                      change
-                      uxtb reg2,reg1
-                      strb reg2,[...]
-                      dealloc reg2
-                      to
-                      strb reg1,[...]
-                    }
-                    if MatchInstruction(p, taicpu(p).opcode, [C_None], [PF_None]) and
-                      (taicpu(p).ops=2) and
-                      GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
-                      MatchInstruction(hp1, A_STR, [C_None], [PF_B]) and
-                      assigned(FindRegDealloc(taicpu(p).oper[0]^.reg,tai(hp1.Next))) and
-                      { the reference in strb might not use reg2 }
-                      not(RegInRef(taicpu(p).oper[0]^.reg,taicpu(hp1).oper[1]^.ref^)) and
-                      { reg1 might not be modified inbetween }
-                      not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
-                      begin
-                        DebugMsg('Peephole UxtbStrb2Strb done', p);
-                        taicpu(hp1).loadReg(0,taicpu(p).oper[1]^.reg);
-                        GetNextInstruction(p,hp2);
-                        asml.remove(p);
-                        p.free;
-                        p:=hp2;
-                        result:=true;
-                      end
-                    {
-                      change
-                      uxtb reg2,reg1
-                      uxth reg3,reg2
-                      dealloc reg2
-                      to
-                      uxtb reg3,reg1
-                    }
-                    else if MatchInstruction(p, A_UXTB, [C_None], [PF_None]) and
-                      (taicpu(p).ops=2) and
-                      GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
-                      MatchInstruction(hp1, A_UXTH, [C_None], [PF_None]) and
-                      (taicpu(hp1).ops = 2) and
-                      MatchOperand(taicpu(hp1).oper[1]^, taicpu(p).oper[0]^.reg) and
-                      RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and
-                      { reg1 might not be modified inbetween }
-                      not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
-                      begin
-                        DebugMsg('Peephole UxtbUxth2Uxtb done', p);
-                        AllocRegBetween(taicpu(hp1).oper[0]^.reg,p,hp1,UsedRegs);
-                        taicpu(p).loadReg(0,taicpu(hp1).oper[0]^.reg);
-                        asml.remove(hp1);
-                        hp1.free;
-                        result:=true;
-                      end
-                    {
-                      change
-                      uxtb reg2,reg1
-                      uxtb reg3,reg2
-                      dealloc reg2
-                      to
-                      uxtb reg3,reg1
-                    }
-                    else if MatchInstruction(p, A_UXTB, [C_None], [PF_None]) and
-                      (taicpu(p).ops=2) and
-                      GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
-                      MatchInstruction(hp1, A_UXTB, [C_None], [PF_None]) and
-                      (taicpu(hp1).ops = 2) and
-                      MatchOperand(taicpu(hp1).oper[1]^, taicpu(p).oper[0]^.reg) and
-                      RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and
-                      { reg1 might not be modified inbetween }
-                      not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
-                      begin
-                        DebugMsg('Peephole UxtbUxtb2Uxtb done', p);
-                        AllocRegBetween(taicpu(hp1).oper[0]^.reg,p,hp1,UsedRegs);
-                        taicpu(p).loadReg(0,taicpu(hp1).oper[0]^.reg);
-                        asml.remove(hp1);
-                        hp1.free;
-                        result:=true;
-                      end
-                    {
-                      change
-                      uxtb reg2,reg1
-                      and reg3,reg2,#0x*FF
-                      dealloc reg2
-                      to
-                      uxtb reg3,reg1
-                    }
-                    else if MatchInstruction(p, A_UXTB, [C_None], [PF_None]) and
-                      (taicpu(p).ops=2) and
-                      GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
-                      MatchInstruction(hp1, A_AND, [C_None], [PF_None]) and
-                      (taicpu(hp1).ops=3) and
-                      (taicpu(hp1).oper[2]^.typ=top_const) and
-                      ((taicpu(hp1).oper[2]^.val and $FF)=$FF) and
-                      MatchOperand(taicpu(hp1).oper[1]^, taicpu(p).oper[0]^.reg) and
-                      RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and
-                      { reg1 might not be modified inbetween }
-                      not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
-                      begin
-                        DebugMsg('Peephole UxtbAndImm2Uxtb done', p);
-                        taicpu(hp1).opcode:=A_UXTB;
-                        taicpu(hp1).ops:=2;
-                        taicpu(hp1).loadReg(1,taicpu(p).oper[1]^.reg);
-                        GetNextInstruction(p,hp2);
-                        asml.remove(p);
-                        p.free;
-                        p:=hp2;
-                        result:=true;
-                      end
-                    else if GetNextInstructionUsingReg(p, hp1, taicpu(p).oper[0]^.reg) and
-                         RemoveSuperfluousMove(p, hp1, 'UxtbMov2Data') then
-                      Result:=true;
-                  end;
+                  Result:=OptPass1UXTB(p);
                 A_UXTH:
                 A_UXTH:
-                  begin
-                    {
-                      change
-                      uxth reg2,reg1
-                      strh reg2,[...]
-                      dealloc reg2
-                      to
-                      strh reg1,[...]
-                    }
-                    if MatchInstruction(p, taicpu(p).opcode, [C_None], [PF_None]) and
-                      (taicpu(p).ops=2) and
-                      GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
-                      MatchInstruction(hp1, A_STR, [C_None], [PF_H]) and
-                      RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and
-                      { the reference in strb might not use reg2 }
-                      not(RegInRef(taicpu(p).oper[0]^.reg,taicpu(hp1).oper[1]^.ref^)) and
-                      { reg1 might not be modified inbetween }
-                      not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
-                      begin
-                        DebugMsg('Peephole UXTHStrh2Strh done', p);
-                        taicpu(hp1).loadReg(0,taicpu(p).oper[1]^.reg);
-                        GetNextInstruction(p, hp1);
-                        asml.remove(p);
-                        p.free;
-                        p:=hp1;
-                        result:=true;
-                      end
-                    {
-                      change
-                      uxth reg2,reg1
-                      uxth reg3,reg2
-                      dealloc reg2
-                      to
-                      uxth reg3,reg1
-                    }
-                    else if MatchInstruction(p, A_UXTH, [C_None], [PF_None]) and
-                      (taicpu(p).ops=2) and
-                      GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
-                      MatchInstruction(hp1, A_UXTH, [C_None], [PF_None]) and
-                      (taicpu(hp1).ops=2) and
-                      MatchOperand(taicpu(hp1).oper[1]^, taicpu(p).oper[0]^.reg) and
-                      RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and
-                      { reg1 might not be modified inbetween }
-                      not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
-                      begin
-                        DebugMsg('Peephole UxthUxth2Uxth done', p);
-                        AllocRegBetween(taicpu(p).oper[1]^.reg,p,hp1,UsedRegs);
-                        taicpu(hp1).opcode:=A_UXTH;
-                        taicpu(hp1).loadReg(1,taicpu(p).oper[1]^.reg);
-                        GetNextInstruction(p, hp1);
-                        asml.remove(p);
-                        p.free;
-                        p:=hp1;
-                        result:=true;
-                      end
-                    {
-                      change
-                      uxth reg2,reg1
-                      and reg3,reg2,#65535
-                      dealloc reg2
-                      to
-                      uxth reg3,reg1
-                    }
-                    else if MatchInstruction(p, A_UXTH, [C_None], [PF_None]) and
-                      (taicpu(p).ops=2) and
-                      GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
-                      MatchInstruction(hp1, A_AND, [C_None], [PF_None]) and
-                      (taicpu(hp1).ops=3) and
-                      (taicpu(hp1).oper[2]^.typ=top_const) and
-                      ((taicpu(hp1).oper[2]^.val and $FFFF)=$FFFF) and
-                      MatchOperand(taicpu(hp1).oper[1]^, taicpu(p).oper[0]^.reg) and
-                      RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and
-                      { reg1 might not be modified inbetween }
-                      not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
-                      begin
-                        DebugMsg('Peephole UxthAndImm2Uxth done', p);
-                        taicpu(hp1).opcode:=A_UXTH;
-                        taicpu(hp1).ops:=2;
-                        taicpu(hp1).loadReg(1,taicpu(p).oper[1]^.reg);
-                        GetNextInstruction(p, hp1);
-                        asml.remove(p);
-                        p.free;
-                        p:=hp1;
-                        result:=true;
-                      end
-                    else if GetNextInstructionUsingReg(p, hp1, taicpu(p).oper[0]^.reg) and
-                         RemoveSuperfluousMove(p, hp1, 'UxthMov2Data') then
-                      Result:=true;
-                  end;
+                  Result:=OptPass1UXTH(p);
                 A_SXTB:
                 A_SXTB:
-                  begin
-                    {
-                      change
-                      sxtb reg2,reg1
-                      strb reg2,[...]
-                      dealloc reg2
-                      to
-                      strb reg1,[...]
-                    }
-                    if MatchInstruction(p, taicpu(p).opcode, [C_None], [PF_None]) and
-                      (taicpu(p).ops=2) and
-                      GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
-                      MatchInstruction(hp1, A_STR, [C_None], [PF_B]) and
-                      assigned(FindRegDealloc(taicpu(p).oper[0]^.reg,tai(hp1.Next))) and
-                      { the reference in strb might not use reg2 }
-                      not(RegInRef(taicpu(p).oper[0]^.reg,taicpu(hp1).oper[1]^.ref^)) and
-                      { reg1 might not be modified inbetween }
-                      not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
-                      begin
-                        DebugMsg('Peephole SxtbStrb2Strb done', p);
-                        taicpu(hp1).loadReg(0,taicpu(p).oper[1]^.reg);
-                        GetNextInstruction(p,hp2);
-                        asml.remove(p);
-                        p.free;
-                        p:=hp2;
-                        result:=true;
-                      end
-                    {
-                      change
-                      sxtb reg2,reg1
-                      sxth reg3,reg2
-                      dealloc reg2
-                      to
-                      sxtb reg3,reg1
-                    }
-                    else if MatchInstruction(p, A_SXTB, [C_None], [PF_None]) and
-                      (taicpu(p).ops=2) and
-                      GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
-                      MatchInstruction(hp1, A_SXTH, [C_None], [PF_None]) and
-                      (taicpu(hp1).ops = 2) and
-                      MatchOperand(taicpu(hp1).oper[1]^, taicpu(p).oper[0]^.reg) and
-                      RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and
-                      { reg1 might not be modified inbetween }
-                      not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
-                      begin
-                        DebugMsg('Peephole SxtbSxth2Sxtb done', p);
-                        AllocRegBetween(taicpu(hp1).oper[0]^.reg,p,hp1,UsedRegs);
-                        taicpu(p).loadReg(0,taicpu(hp1).oper[0]^.reg);
-                        asml.remove(hp1);
-                        hp1.free;
-                        result:=true;
-                      end
-                    {
-                      change
-                      sxtb reg2,reg1
-                      sxtb reg3,reg2
-                      dealloc reg2
-                      to
-                      uxtb reg3,reg1
-                    }
-                    else if MatchInstruction(p, A_SXTB, [C_None], [PF_None]) and
-                      (taicpu(p).ops=2) and
-                      GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
-                      MatchInstruction(hp1, A_SXTB, [C_None], [PF_None]) and
-                      (taicpu(hp1).ops = 2) and
-                      MatchOperand(taicpu(hp1).oper[1]^, taicpu(p).oper[0]^.reg) and
-                      RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and
-                      { reg1 might not be modified inbetween }
-                      not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
-                      begin
-                        DebugMsg('Peephole SxtbSxtb2Sxtb done', p);
-                        AllocRegBetween(taicpu(hp1).oper[0]^.reg,p,hp1,UsedRegs);
-                        taicpu(p).loadReg(0,taicpu(hp1).oper[0]^.reg);
-                        asml.remove(hp1);
-                        hp1.free;
-                        result:=true;
-                      end
-                    {
-                      change
-                      sxtb reg2,reg1
-                      and reg3,reg2,#0x*FF
-                      dealloc reg2
-                      to
-                      uxtb reg3,reg1
-                    }
-                    else if MatchInstruction(p, A_SXTB, [C_None], [PF_None]) and
-                      (taicpu(p).ops=2) and
-                      GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
-                      MatchInstruction(hp1, A_AND, [C_None], [PF_None]) and
-                      (taicpu(hp1).ops=3) and
-                      (taicpu(hp1).oper[2]^.typ=top_const) and
-                      ((taicpu(hp1).oper[2]^.val and $FF)=$FF) and
-                      MatchOperand(taicpu(hp1).oper[1]^, taicpu(p).oper[0]^.reg) and
-                      RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and
-                      { reg1 might not be modified inbetween }
-                      not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
-                      begin
-                        DebugMsg('Peephole SxtbAndImm2Sxtb done', p);
-                        taicpu(hp1).opcode:=A_SXTB;
-                        taicpu(hp1).ops:=2;
-                        taicpu(hp1).loadReg(1,taicpu(p).oper[1]^.reg);
-                        GetNextInstruction(p,hp2);
-                        asml.remove(p);
-                        p.free;
-                        p:=hp2;
-                        result:=true;
-                      end
-                    else if GetNextInstructionUsingReg(p, hp1, taicpu(p).oper[0]^.reg) and
-                         RemoveSuperfluousMove(p, hp1, 'SxtbMov2Data') then
-                      Result:=true;
-                  end;
+                  Result:=OptPass1SXTB(p);
                 A_SXTH:
                 A_SXTH:
-                  begin
-                    {
-                      change
-                      sxth reg2,reg1
-                      strh reg2,[...]
-                      dealloc reg2
-                      to
-                      strh reg1,[...]
-                    }
-                    if MatchInstruction(p, taicpu(p).opcode, [C_None], [PF_None]) and
-                      (taicpu(p).ops=2) and
-                      GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
-                      MatchInstruction(hp1, A_STR, [C_None], [PF_H]) and
-                      RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and
-                      { the reference in strb might not use reg2 }
-                      not(RegInRef(taicpu(p).oper[0]^.reg,taicpu(hp1).oper[1]^.ref^)) and
-                      { reg1 might not be modified inbetween }
-                      not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
-                      begin
-                        DebugMsg('Peephole SXTHStrh2Strh done', p);
-                        taicpu(hp1).loadReg(0,taicpu(p).oper[1]^.reg);
-                        GetNextInstruction(p, hp1);
-                        asml.remove(p);
-                        p.free;
-                        p:=hp1;
-                        result:=true;
-                      end
-                    {
-                      change
-                      sxth reg2,reg1
-                      sxth reg3,reg2
-                      dealloc reg2
-                      to
-                      sxth reg3,reg1
-                    }
-                    else if MatchInstruction(p, A_SXTH, [C_None], [PF_None]) and
-                      (taicpu(p).ops=2) and
-                      GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
-                      MatchInstruction(hp1, A_SXTH, [C_None], [PF_None]) and
-                      (taicpu(hp1).ops=2) and
-                      MatchOperand(taicpu(hp1).oper[1]^, taicpu(p).oper[0]^.reg) and
-                      RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and
-                      { reg1 might not be modified inbetween }
-                      not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
-                      begin
-                        DebugMsg('Peephole SxthSxth2Sxth done', p);
-                        AllocRegBetween(taicpu(p).oper[1]^.reg,p,hp1,UsedRegs);
-                        taicpu(hp1).opcode:=A_SXTH;
-                        taicpu(hp1).loadReg(1,taicpu(p).oper[1]^.reg);
-                        GetNextInstruction(p, hp1);
-                        asml.remove(p);
-                        p.free;
-                        p:=hp1;
-                        result:=true;
-                      end
-                    {
-                      change
-                      sxth reg2,reg1
-                      and reg3,reg2,#65535
-                      dealloc reg2
-                      to
-                      sxth reg3,reg1
-                    }
-                    else if MatchInstruction(p, A_SXTH, [C_None], [PF_None]) and
-                      (taicpu(p).ops=2) and
-                      GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
-                      MatchInstruction(hp1, A_AND, [C_None], [PF_None]) and
-                      (taicpu(hp1).ops=3) and
-                      (taicpu(hp1).oper[2]^.typ=top_const) and
-                      ((taicpu(hp1).oper[2]^.val and $FFFF)=$FFFF) and
-                      MatchOperand(taicpu(hp1).oper[1]^, taicpu(p).oper[0]^.reg) and
-                      RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and
-                      { reg1 might not be modified inbetween }
-                      not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
-                      begin
-                        DebugMsg('Peephole SxthAndImm2Sxth done', p);
-                        taicpu(hp1).opcode:=A_SXTH;
-                        taicpu(hp1).ops:=2;
-                        taicpu(hp1).loadReg(1,taicpu(p).oper[1]^.reg);
-                        GetNextInstruction(p, hp1);
-                        asml.remove(p);
-                        p.free;
-                        p:=hp1;
-                        result:=true;
-                      end
-                    else if GetNextInstructionUsingReg(p, hp1, taicpu(p).oper[0]^.reg) and
-                         RemoveSuperfluousMove(p, hp1, 'SxthMov2Data') then
-                      Result:=true;
-                  end;
+                  Result:=OptPass1SXTH(p);
                 A_CMP:
                 A_CMP:
                   begin
                   begin
                     {
                     {

+ 1 - 1
compiler/arm/narmmat.pas

@@ -368,7 +368,7 @@ implementation
           end;
           end;
 
 
         if (FPUARM_HAS_VFP_DOUBLE in fpu_capabilities[current_settings.fputype]) or
         if (FPUARM_HAS_VFP_DOUBLE in fpu_capabilities[current_settings.fputype]) or
-          (tfloatdef(resultdef).floattype=s32real) then
+          is_single(resultdef) then
           exit(inherited pass_1);
           exit(inherited pass_1);
 
 
         result:=nil;
         result:=nil;

+ 644 - 0
compiler/armgen/aoptarm.pas

@@ -37,8 +37,29 @@ Type
   { while ARM and AAarch64 look not very similar at a first glance,
   { while ARM and AAarch64 look not very similar at a first glance,
     several optimizations can be shared between both }
     several optimizations can be shared between both }
   TARMAsmOptimizer = class(TAsmOptimizer)
   TARMAsmOptimizer = class(TAsmOptimizer)
+    procedure DebugMsg(const s : string; p : tai);
+
+    function RemoveSuperfluousMove(const p: tai; movp: tai; const optimizer: string): boolean;
+    function GetNextInstructionUsingReg(Current: tai; out Next: tai; 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;
   End;
   End;
 
 
+  function MatchInstruction(const instr: tai; const op: TCommonAsmOps; const cond: TAsmConds; const postfix: TOpPostfixes): boolean;
+  function MatchInstruction(const instr: tai; const op: TAsmOp; const cond: TAsmConds; const postfix: TOpPostfixes): boolean;
+{$ifdef AARCH64}
+  function MatchInstruction(const instr: tai; const op: TAsmOps; const postfix: TOpPostfixes): boolean;
+{$endif AARCH64}
+  function MatchInstruction(const instr: tai; const op: TAsmOp; const postfix: TOpPostfixes): boolean;
+
+  function RefsEqual(const r1, r2: treference): boolean;
+
+  function MatchOperand(const oper: TOper; const reg: TRegister): boolean; inline;
+  function MatchOperand(const oper1: TOper; const oper2: TOper): boolean; inline;
+
 Implementation
 Implementation
 
 
   uses
   uses
@@ -48,5 +69,628 @@ Implementation
     cgobj,procinfo,
     cgobj,procinfo,
     aasmbase,aasmdata;
     aasmbase,aasmdata;
 
 
+
+{$ifdef DEBUG_AOPTCPU}
+  procedure TARMAsmOptimizer.DebugMsg(const s: string;p : tai);
+    begin
+      asml.insertbefore(tai_comment.Create(strpnew(s)), p);
+    end;
+{$else DEBUG_AOPTCPU}
+  procedure TARMAsmOptimizer.DebugMsg(const s: string;p : tai);inline;
+    begin
+    end;
+{$endif DEBUG_AOPTCPU}
+
+  function MatchInstruction(const instr: tai; const op: TCommonAsmOps; const cond: TAsmConds; const postfix: TOpPostfixes): boolean;
+    begin
+      result :=
+        (instr.typ = ait_instruction) and
+        ((op = []) or ((ord(taicpu(instr).opcode)<256) and (taicpu(instr).opcode in op))) and
+        ((cond = []) or (taicpu(instr).condition in cond)) and
+        ((postfix = []) or (taicpu(instr).oppostfix in postfix));
+    end;
+
+
+  function MatchInstruction(const instr: tai; const op: TAsmOp; const cond: TAsmConds; const postfix: TOpPostfixes): boolean;
+    begin
+      result :=
+        (instr.typ = ait_instruction) and
+        (taicpu(instr).opcode = op) and
+        ((cond = []) or (taicpu(instr).condition in cond)) and
+        ((postfix = []) or (taicpu(instr).oppostfix in postfix));
+    end;
+
+
+{$ifdef AARCH64}
+  function MatchInstruction(const instr: tai; const op: TAsmOps; const postfix: TOpPostfixes): boolean;
+    begin
+      result :=
+        (instr.typ = ait_instruction) and
+        ((op = []) or (taicpu(instr).opcode in op)) and
+        ((postfix = []) or (taicpu(instr).oppostfix in postfix));
+    end;
+{$endif AARCH64}
+
+  function MatchInstruction(const instr: tai; const op: TAsmOp; const postfix: TOpPostfixes): boolean;
+    begin
+      result :=
+        (instr.typ = ait_instruction) and
+        (taicpu(instr).opcode = op) and
+        ((postfix = []) or (taicpu(instr).oppostfix in postfix));
+    end;
+
+
+  function MatchOperand(const oper: TOper; const reg: TRegister): boolean; inline;
+    begin
+      result := (oper.typ = top_reg) and (oper.reg = reg);
+    end;
+
+
+  function RefsEqual(const r1, r2: treference): boolean;
+    begin
+      refsequal :=
+        (r1.offset = r2.offset) and
+        (r1.base = r2.base) and
+        (r1.index = r2.index) and (r1.scalefactor = r2.scalefactor) and
+        (r1.symbol=r2.symbol) and (r1.refaddr = r2.refaddr) and
+        (r1.relsymbol = r2.relsymbol) and
+{$ifdef ARM}
+        (r1.signindex = r2.signindex) and
+{$endif ARM}
+        (r1.shiftimm = r2.shiftimm) and
+        (r1.addressmode = r2.addressmode) and
+        (r1.shiftmode = r2.shiftmode) and
+        (r1.volatility=[]) and
+        (r2.volatility=[]);
+    end;
+
+
+  function MatchOperand(const oper1: TOper; const oper2: TOper): boolean; inline;
+    begin
+      result := oper1.typ = oper2.typ;
+
+      if result then
+        case oper1.typ of
+          top_const:
+            Result:=oper1.val = oper2.val;
+          top_reg:
+            Result:=oper1.reg = oper2.reg;
+          top_conditioncode:
+            Result:=oper1.cc = oper2.cc;
+          top_realconst:
+            Result:=oper1.val_real = oper2.val_real;
+          top_ref:
+            Result:=RefsEqual(oper1.ref^, oper2.ref^);
+          else Result:=false;
+        end
+    end;
+
+
+  function TARMAsmOptimizer.GetNextInstructionUsingReg(Current: tai;
+    Out Next: tai; reg: TRegister): Boolean;
+    begin
+      Next:=Current;
+      repeat
+        Result:=GetNextInstruction(Next,Next);
+      until not (Result) or
+            not(cs_opt_level3 in current_settings.optimizerswitches) or
+            (Next.typ<>ait_instruction) or
+            RegInInstruction(reg,Next) or
+            is_calljmp(taicpu(Next).opcode)
+{$ifdef ARM}
+            or RegModifiedByInstruction(NR_PC,Next);
+{$endif ARM}
+    end;
+
+
+  function TARMAsmOptimizer.RemoveSuperfluousMove(const p: tai; movp: tai; const optimizer: string):boolean;
+    var
+      alloc,
+      dealloc : tai_regalloc;
+      hp1 : tai;
+    begin
+      Result:=false;
+      if MatchInstruction(movp, A_MOV, [taicpu(p).condition], [PF_None]) and
+        { We can't optimize if there is a shiftop }
+        (taicpu(movp).ops=2) and
+        MatchOperand(taicpu(movp).oper[1]^, taicpu(p).oper[0]^.reg) and
+        { don't mess with moves to fp }
+        (taicpu(movp).oper[0]^.reg<>current_procinfo.framepointer) and
+        { the destination register of the mov might not be used beween p and movp }
+        not(RegUsedBetween(taicpu(movp).oper[0]^.reg,p,movp)) and
+{$ifdef ARM}
+        { cb[n]z are thumb instructions which require specific registers, with no wide forms }
+        (taicpu(p).opcode<>A_CBZ) and
+        (taicpu(p).opcode<>A_CBNZ) and
+        {There is a special requirement for MUL and MLA, oper[0] and oper[1] are not allowed to be the same}
+        not (
+          (taicpu(p).opcode in [A_MLA, A_MUL]) and
+          (taicpu(p).oper[1]^.reg = taicpu(movp).oper[0]^.reg) and
+          (current_settings.cputype < cpu_armv6)
+        ) and
+{$endif ARM}
+        { Take care to only do this for instructions which REALLY load to the first register.
+          Otherwise
+            str reg0, [reg1]
+            mov reg2, reg0
+          will be optimized to
+            str reg2, [reg1]
+        }
+        RegLoadedWithNewValue(taicpu(p).oper[0]^.reg, p) then
+        begin
+          dealloc:=FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(movp.Next));
+          if assigned(dealloc) then
+            begin
+              DebugMsg('Peephole '+optimizer+' removed superfluous mov', movp);
+              result:=true;
+
+              { taicpu(p).oper[0]^.reg is not used anymore, try to find its allocation
+                and remove it if possible }
+              asml.Remove(dealloc);
+              alloc:=FindRegAllocBackward(taicpu(p).oper[0]^.reg,tai(p.previous));
+              if assigned(alloc) then
+                begin
+                  asml.Remove(alloc);
+                  alloc.free;
+                  dealloc.free;
+                end
+              else
+                asml.InsertAfter(dealloc,p);
+
+              { try to move the allocation of the target register }
+              GetLastInstruction(movp,hp1);
+              alloc:=FindRegAlloc(taicpu(movp).oper[0]^.reg,tai(hp1.Next));
+              if assigned(alloc) then
+                begin
+                  asml.Remove(alloc);
+                  asml.InsertBefore(alloc,p);
+                  { adjust used regs }
+                  IncludeRegInUsedRegs(taicpu(movp).oper[0]^.reg,UsedRegs);
+                end;
+
+              { finally get rid of the mov }
+              taicpu(p).loadreg(0,taicpu(movp).oper[0]^.reg);
+              { Remove preindexing and postindexing for LDR in some cases.
+                For example:
+                  ldr	reg2,[reg1, xxx]!
+                  mov reg1,reg2
+                must be translated to:
+                  ldr	reg1,[reg1, xxx]
+
+                Preindexing must be removed there, since the same register is used as the base and as the target.
+                Such case is not allowed for ARM CPU and produces crash. }
+              if (taicpu(p).opcode = A_LDR) and (taicpu(p).oper[1]^.typ = top_ref)
+                and (taicpu(movp).oper[0]^.reg = taicpu(p).oper[1]^.ref^.base)
+              then
+                taicpu(p).oper[1]^.ref^.addressmode:=AM_OFFSET;
+              asml.remove(movp);
+              movp.free;
+            end;
+        end;
+    end;
+
+
+  function TARMAsmOptimizer.OptPass1UXTB(var p : tai) : Boolean;
+    var
+      hp1, hp2: tai;
+    begin
+      Result:=false;
+      {
+        change
+        uxtb reg2,reg1
+        strb reg2,[...]
+        dealloc reg2
+        to
+        strb reg1,[...]
+      }
+      if MatchInstruction(p, taicpu(p).opcode, [C_None], [PF_None]) and
+        (taicpu(p).ops=2) and
+        GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
+        MatchInstruction(hp1, A_STR, [C_None], [PF_B]) and
+        assigned(FindRegDealloc(taicpu(p).oper[0]^.reg,tai(hp1.Next))) and
+        { the reference in strb might not use reg2 }
+        not(RegInRef(taicpu(p).oper[0]^.reg,taicpu(hp1).oper[1]^.ref^)) and
+        { reg1 might not be modified inbetween }
+        not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
+        begin
+          DebugMsg('Peephole UxtbStrb2Strb done', p);
+          taicpu(hp1).loadReg(0,taicpu(p).oper[1]^.reg);
+          GetNextInstruction(p,hp2);
+          asml.remove(p);
+          p.free;
+          p:=hp2;
+          result:=true;
+        end
+      {
+        change
+        uxtb reg2,reg1
+        uxth reg3,reg2
+        dealloc reg2
+        to
+        uxtb reg3,reg1
+      }
+      else if MatchInstruction(p, A_UXTB, [C_None], [PF_None]) and
+        (taicpu(p).ops=2) and
+        GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
+        MatchInstruction(hp1, A_UXTH, [C_None], [PF_None]) and
+        (taicpu(hp1).ops = 2) and
+        MatchOperand(taicpu(hp1).oper[1]^, taicpu(p).oper[0]^.reg) and
+        RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and
+        { reg1 might not be modified inbetween }
+        not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
+        begin
+          DebugMsg('Peephole UxtbUxth2Uxtb done', p);
+          AllocRegBetween(taicpu(hp1).oper[0]^.reg,p,hp1,UsedRegs);
+          taicpu(p).loadReg(0,taicpu(hp1).oper[0]^.reg);
+          asml.remove(hp1);
+          hp1.free;
+          result:=true;
+        end
+      {
+        change
+        uxtb reg2,reg1
+        uxtb reg3,reg2
+        dealloc reg2
+        to
+        uxtb reg3,reg1
+      }
+      else if MatchInstruction(p, A_UXTB, [C_None], [PF_None]) and
+        (taicpu(p).ops=2) and
+        GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
+        MatchInstruction(hp1, A_UXTB, [C_None], [PF_None]) and
+        (taicpu(hp1).ops = 2) and
+        MatchOperand(taicpu(hp1).oper[1]^, taicpu(p).oper[0]^.reg) and
+        RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and
+        { reg1 might not be modified inbetween }
+        not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
+        begin
+          DebugMsg('Peephole UxtbUxtb2Uxtb done', p);
+          AllocRegBetween(taicpu(hp1).oper[0]^.reg,p,hp1,UsedRegs);
+          taicpu(p).loadReg(0,taicpu(hp1).oper[0]^.reg);
+          asml.remove(hp1);
+          hp1.free;
+          result:=true;
+        end
+      {
+        change
+        uxtb reg2,reg1
+        and reg3,reg2,#0x*FF
+        dealloc reg2
+        to
+        uxtb reg3,reg1
+      }
+      else if MatchInstruction(p, A_UXTB, [C_None], [PF_None]) and
+        (taicpu(p).ops=2) and
+        GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
+        MatchInstruction(hp1, A_AND, [C_None], [PF_None]) and
+        (taicpu(hp1).ops=3) and
+        (taicpu(hp1).oper[2]^.typ=top_const) and
+        ((taicpu(hp1).oper[2]^.val and $FF)=$FF) and
+        MatchOperand(taicpu(hp1).oper[1]^, taicpu(p).oper[0]^.reg) and
+        RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and
+        { reg1 might not be modified inbetween }
+        not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
+        begin
+          DebugMsg('Peephole UxtbAndImm2Uxtb done', p);
+          taicpu(hp1).opcode:=A_UXTB;
+          taicpu(hp1).ops:=2;
+          taicpu(hp1).loadReg(1,taicpu(p).oper[1]^.reg);
+          GetNextInstruction(p,hp2);
+          asml.remove(p);
+          p.free;
+          p:=hp2;
+          result:=true;
+        end
+      else if GetNextInstructionUsingReg(p, hp1, taicpu(p).oper[0]^.reg) and
+        RemoveSuperfluousMove(p, hp1, 'UxtbMov2Data') then
+        Result:=true;
+    end;
+
+
+  function TARMAsmOptimizer.OptPass1UXTH(var p : tai) : Boolean;
+    var
+      hp1: tai;
+    begin
+      Result:=false;
+      {
+        change
+        uxth reg2,reg1
+        strh reg2,[...]
+        dealloc reg2
+        to
+        strh reg1,[...]
+      }
+      if MatchInstruction(p, taicpu(p).opcode, [C_None], [PF_None]) and
+        (taicpu(p).ops=2) and
+        GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
+        MatchInstruction(hp1, A_STR, [C_None], [PF_H]) and
+        RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and
+        { the reference in strb might not use reg2 }
+        not(RegInRef(taicpu(p).oper[0]^.reg,taicpu(hp1).oper[1]^.ref^)) and
+        { reg1 might not be modified inbetween }
+        not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
+        begin
+          DebugMsg('Peephole UXTHStrh2Strh done', p);
+          taicpu(hp1).loadReg(0,taicpu(p).oper[1]^.reg);
+          GetNextInstruction(p, hp1);
+          asml.remove(p);
+          p.free;
+          p:=hp1;
+          result:=true;
+        end
+      {
+        change
+        uxth reg2,reg1
+        uxth reg3,reg2
+        dealloc reg2
+        to
+        uxth reg3,reg1
+      }
+      else if MatchInstruction(p, A_UXTH, [C_None], [PF_None]) and
+        (taicpu(p).ops=2) and
+        GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
+        MatchInstruction(hp1, A_UXTH, [C_None], [PF_None]) and
+        (taicpu(hp1).ops=2) and
+        MatchOperand(taicpu(hp1).oper[1]^, taicpu(p).oper[0]^.reg) and
+        RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and
+        { reg1 might not be modified inbetween }
+        not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
+        begin
+          DebugMsg('Peephole UxthUxth2Uxth done', p);
+          AllocRegBetween(taicpu(p).oper[1]^.reg,p,hp1,UsedRegs);
+          taicpu(hp1).opcode:=A_UXTH;
+          taicpu(hp1).loadReg(1,taicpu(p).oper[1]^.reg);
+          GetNextInstruction(p, hp1);
+          asml.remove(p);
+          p.free;
+          p:=hp1;
+          result:=true;
+        end
+      {
+        change
+        uxth reg2,reg1
+        and reg3,reg2,#65535
+        dealloc reg2
+        to
+        uxth reg3,reg1
+      }
+      else if MatchInstruction(p, A_UXTH, [C_None], [PF_None]) and
+        (taicpu(p).ops=2) and
+        GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
+        MatchInstruction(hp1, A_AND, [C_None], [PF_None]) and
+        (taicpu(hp1).ops=3) and
+        (taicpu(hp1).oper[2]^.typ=top_const) and
+        ((taicpu(hp1).oper[2]^.val and $FFFF)=$FFFF) and
+        MatchOperand(taicpu(hp1).oper[1]^, taicpu(p).oper[0]^.reg) and
+        RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and
+        { reg1 might not be modified inbetween }
+        not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
+        begin
+          DebugMsg('Peephole UxthAndImm2Uxth done', p);
+          taicpu(hp1).opcode:=A_UXTH;
+          taicpu(hp1).ops:=2;
+          taicpu(hp1).loadReg(1,taicpu(p).oper[1]^.reg);
+          GetNextInstruction(p, hp1);
+          asml.remove(p);
+          p.free;
+          p:=hp1;
+          result:=true;
+        end
+      else if GetNextInstructionUsingReg(p, hp1, taicpu(p).oper[0]^.reg) and
+           RemoveSuperfluousMove(p, hp1, 'UxthMov2Data') then
+        Result:=true;
+    end;
+
+
+  function TARMAsmOptimizer.OptPass1SXTB(var p : tai) : Boolean;
+    var
+      hp1, hp2: tai;
+    begin
+      Result:=false;
+      {
+        change
+        sxtb reg2,reg1
+        strb reg2,[...]
+        dealloc reg2
+        to
+        strb reg1,[...]
+      }
+      if MatchInstruction(p, taicpu(p).opcode, [C_None], [PF_None]) and
+        (taicpu(p).ops=2) and
+        GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
+        MatchInstruction(hp1, A_STR, [C_None], [PF_B]) and
+        assigned(FindRegDealloc(taicpu(p).oper[0]^.reg,tai(hp1.Next))) and
+        { the reference in strb might not use reg2 }
+        not(RegInRef(taicpu(p).oper[0]^.reg,taicpu(hp1).oper[1]^.ref^)) and
+        { reg1 might not be modified inbetween }
+        not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
+        begin
+          DebugMsg('Peephole SxtbStrb2Strb done', p);
+          taicpu(hp1).loadReg(0,taicpu(p).oper[1]^.reg);
+          GetNextInstruction(p,hp2);
+          asml.remove(p);
+          p.free;
+          p:=hp2;
+          result:=true;
+        end
+      {
+        change
+        sxtb reg2,reg1
+        sxth reg3,reg2
+        dealloc reg2
+        to
+        sxtb reg3,reg1
+      }
+      else if MatchInstruction(p, A_SXTB, [C_None], [PF_None]) and
+        (taicpu(p).ops=2) and
+        GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
+        MatchInstruction(hp1, A_SXTH, [C_None], [PF_None]) and
+        (taicpu(hp1).ops = 2) and
+        MatchOperand(taicpu(hp1).oper[1]^, taicpu(p).oper[0]^.reg) and
+        RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and
+        { reg1 might not be modified inbetween }
+        not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
+        begin
+          DebugMsg('Peephole SxtbSxth2Sxtb done', p);
+          AllocRegBetween(taicpu(hp1).oper[0]^.reg,p,hp1,UsedRegs);
+          taicpu(p).loadReg(0,taicpu(hp1).oper[0]^.reg);
+          asml.remove(hp1);
+          hp1.free;
+          result:=true;
+        end
+      {
+        change
+        sxtb reg2,reg1
+        sxtb reg3,reg2
+        dealloc reg2
+        to
+        uxtb reg3,reg1
+      }
+      else if MatchInstruction(p, A_SXTB, [C_None], [PF_None]) and
+        (taicpu(p).ops=2) and
+        GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
+        MatchInstruction(hp1, A_SXTB, [C_None], [PF_None]) and
+        (taicpu(hp1).ops = 2) and
+        MatchOperand(taicpu(hp1).oper[1]^, taicpu(p).oper[0]^.reg) and
+        RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and
+        { reg1 might not be modified inbetween }
+        not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
+        begin
+          DebugMsg('Peephole SxtbSxtb2Sxtb done', p);
+          AllocRegBetween(taicpu(hp1).oper[0]^.reg,p,hp1,UsedRegs);
+          taicpu(p).loadReg(0,taicpu(hp1).oper[0]^.reg);
+          asml.remove(hp1);
+          hp1.free;
+          result:=true;
+        end
+      {
+        change
+        sxtb reg2,reg1
+        and reg3,reg2,#0x*FF
+        dealloc reg2
+        to
+        uxtb reg3,reg1
+      }
+      else if MatchInstruction(p, A_SXTB, [C_None], [PF_None]) and
+        (taicpu(p).ops=2) and
+        GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
+        MatchInstruction(hp1, A_AND, [C_None], [PF_None]) and
+        (taicpu(hp1).ops=3) and
+        (taicpu(hp1).oper[2]^.typ=top_const) and
+        ((taicpu(hp1).oper[2]^.val and $FF)=$FF) and
+        MatchOperand(taicpu(hp1).oper[1]^, taicpu(p).oper[0]^.reg) and
+        RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and
+        { reg1 might not be modified inbetween }
+        not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
+        begin
+          DebugMsg('Peephole SxtbAndImm2Sxtb done', p);
+          taicpu(hp1).opcode:=A_SXTB;
+          taicpu(hp1).ops:=2;
+          taicpu(hp1).loadReg(1,taicpu(p).oper[1]^.reg);
+          GetNextInstruction(p,hp2);
+          asml.remove(p);
+          p.free;
+          p:=hp2;
+          result:=true;
+        end
+      else if GetNextInstructionUsingReg(p, hp1, taicpu(p).oper[0]^.reg) and
+           RemoveSuperfluousMove(p, hp1, 'SxtbMov2Data') then
+        Result:=true;
+    end;
+
+
+  function TARMAsmOptimizer.OptPass1SXTH(var p : tai) : Boolean;
+    var
+      hp1: tai;
+    begin
+      Result:=false;
+      {
+        change
+        sxth reg2,reg1
+        strh reg2,[...]
+        dealloc reg2
+        to
+        strh reg1,[...]
+      }
+      if MatchInstruction(p, taicpu(p).opcode, [C_None], [PF_None]) and
+        (taicpu(p).ops=2) and
+        GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
+        MatchInstruction(hp1, A_STR, [C_None], [PF_H]) and
+        RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and
+        { the reference in strb might not use reg2 }
+        not(RegInRef(taicpu(p).oper[0]^.reg,taicpu(hp1).oper[1]^.ref^)) and
+        { reg1 might not be modified inbetween }
+        not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
+        begin
+          DebugMsg('Peephole SXTHStrh2Strh done', p);
+          taicpu(hp1).loadReg(0,taicpu(p).oper[1]^.reg);
+          GetNextInstruction(p, hp1);
+          asml.remove(p);
+          p.free;
+          p:=hp1;
+          result:=true;
+        end
+      {
+        change
+        sxth reg2,reg1
+        sxth reg3,reg2
+        dealloc reg2
+        to
+        sxth reg3,reg1
+      }
+      else if MatchInstruction(p, A_SXTH, [C_None], [PF_None]) and
+        (taicpu(p).ops=2) and
+        GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
+        MatchInstruction(hp1, A_SXTH, [C_None], [PF_None]) and
+        (taicpu(hp1).ops=2) and
+        MatchOperand(taicpu(hp1).oper[1]^, taicpu(p).oper[0]^.reg) and
+        RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and
+        { reg1 might not be modified inbetween }
+        not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
+        begin
+          DebugMsg('Peephole SxthSxth2Sxth done', p);
+          AllocRegBetween(taicpu(p).oper[1]^.reg,p,hp1,UsedRegs);
+          taicpu(hp1).opcode:=A_SXTH;
+          taicpu(hp1).loadReg(1,taicpu(p).oper[1]^.reg);
+          GetNextInstruction(p, hp1);
+          asml.remove(p);
+          p.free;
+          p:=hp1;
+          result:=true;
+        end
+      {
+        change
+        sxth reg2,reg1
+        and reg3,reg2,#65535
+        dealloc reg2
+        to
+        sxth reg3,reg1
+      }
+      else if MatchInstruction(p, A_SXTH, [C_None], [PF_None]) and
+        (taicpu(p).ops=2) and
+        GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
+        MatchInstruction(hp1, A_AND, [C_None], [PF_None]) and
+        (taicpu(hp1).ops=3) and
+        (taicpu(hp1).oper[2]^.typ=top_const) and
+        ((taicpu(hp1).oper[2]^.val and $FFFF)=$FFFF) and
+        MatchOperand(taicpu(hp1).oper[1]^, taicpu(p).oper[0]^.reg) and
+        RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and
+        { reg1 might not be modified inbetween }
+        not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
+        begin
+          DebugMsg('Peephole SxthAndImm2Sxth done', p);
+          taicpu(hp1).opcode:=A_SXTH;
+          taicpu(hp1).ops:=2;
+          taicpu(hp1).loadReg(1,taicpu(p).oper[1]^.reg);
+          GetNextInstruction(p, hp1);
+          asml.remove(p);
+          p.free;
+          p:=hp1;
+          result:=true;
+        end
+      else if GetNextInstructionUsingReg(p, hp1, taicpu(p).oper[0]^.reg) and
+           RemoveSuperfluousMove(p, hp1, 'SxthMov2Data') then
+        Result:=true;
+    end;
 end.
 end.
 
 

+ 4 - 7
rtl/amiga/m68k/doslibf.inc

@@ -666,6 +666,9 @@ function SameDevice(lock1: LongInt location 'd1';
                     lock2: LongInt location 'd2'): LongBool;
                     lock2: LongInt location 'd2'): LongBool;
 SysCall AOS_DOSBase 984;
 SysCall AOS_DOSBase 984;
 
 
+// these functions are only available on v39+ (OS Release 3.0+)
+{$IFNDEF AMIGA_V2_0_ONLY}
+
 procedure ExAllEnd(lock   : LongInt       location 'd1';
 procedure ExAllEnd(lock   : LongInt       location 'd1';
                    buffer : PExAllData    location 'd2';
                    buffer : PExAllData    location 'd2';
                    size   : LongInt       location 'd3';
                    size   : LongInt       location 'd3';
@@ -677,12 +680,6 @@ function SetOwner(name      : PChar   location 'd1';
                   owner_info: LongInt location 'd2'): LongBool;
                   owner_info: LongInt location 'd2'): LongBool;
 SysCall AOS_DOSBase 996;
 SysCall AOS_DOSBase 996;
 
 
-function AddSegmentTagList(tags: PTagItem location 'a0'): LongInt;
-SysCall AOS_DOSBase 1002;
-
-function FindSegmentTagList(tags: PTagItem location 'a0'): PSegment;
-SysCall AOS_DOSBase 1008;
-
+{$ENDIF AMIGA_V2_0_ONLY}
 {$ENDIF AMIGA_V1_2_ONLY}
 {$ENDIF AMIGA_V1_2_ONLY}
 {$ENDIF AMIGA_V1_0_ONLY}
 {$ENDIF AMIGA_V1_0_ONLY}
-

+ 13 - 0
rtl/amiga/m68k/execf.inc

@@ -394,6 +394,13 @@ SysCall AOS_ExecBase 684;
 procedure FreeVec(memoryBlock: Pointer location 'a1');
 procedure FreeVec(memoryBlock: Pointer location 'a1');
 SysCall AOS_ExecBase 690;
 SysCall AOS_ExecBase 690;
 
 
+// these functions are only available v39+ (OS Release 3.0+)
+{$IFNDEF AMIGA_V2_0_ONLY}
+
+{ Pool functions seem to be there in OS2.0 SDK, but not
+  publicly available/documented? Later NDK 3.9 marks them as
+  v39+ (KB) }
+
 function CreatePool(requirements: Cardinal location 'd0';
 function CreatePool(requirements: Cardinal location 'd0';
                     puddleSize  : Cardinal location 'd1';
                     puddleSize  : Cardinal location 'd1';
                     threshSize  : Cardinal location 'd2'): Pointer;
                     threshSize  : Cardinal location 'd2'): Pointer;
@@ -411,6 +418,8 @@ procedure FreePooled(poolHeader: Pointer  location 'a0';
                       memSize   : Cardinal location 'd0');
                       memSize   : Cardinal location 'd0');
 SysCall AOS_ExecBase 714;
 SysCall AOS_ExecBase 714;
 
 
+{$ENDIF}
+
 function AttemptSemaphoreShared(sigSem: pSignalSemaphore location 'a0'): Cardinal;
 function AttemptSemaphoreShared(sigSem: pSignalSemaphore location 'a0'): Cardinal;
 SysCall AOS_ExecBase 720;
 SysCall AOS_ExecBase 720;
 
 
@@ -430,6 +439,9 @@ procedure CachePostDMA(address   : Pointer  location 'a0';
                        flags     : Cardinal location 'd0');
                        flags     : Cardinal location 'd0');
 SysCall AOS_ExecBase 768;
 SysCall AOS_ExecBase 768;
 
 
+// these functions are only available v39+ (OS Release 3.0+)
+{$IFNDEF AMIGA_V2_0_ONLY}
+
 procedure AddMemHandler(memhand: PInterrupt location 'a1');
 procedure AddMemHandler(memhand: PInterrupt location 'a1');
 SysCall AOS_ExecBase 774;
 SysCall AOS_ExecBase 774;
 
 
@@ -439,6 +451,7 @@ SysCall AOS_ExecBase 780;
 function ObtainQuickVector(interruptCode: Pointer location 'a0'): Cardinal;
 function ObtainQuickVector(interruptCode: Pointer location 'a0'): Cardinal;
 SysCall AOS_ExecBase 786;
 SysCall AOS_ExecBase 786;
 
 
+{$ENDIF AMIGA_V2_0_ONLY}
 {$ENDIF AMIGA_V1_2_ONLY}
 {$ENDIF AMIGA_V1_2_ONLY}
 {$ENDIF AMIGA_V1_0_ONLY}
 {$ENDIF AMIGA_V1_0_ONLY}
 
 

+ 7 - 1
rtl/amiga/m68k/legacyexec.inc

@@ -21,7 +21,7 @@
   Please note that this code doesn't aim to be API feature complete, just
   Please note that this code doesn't aim to be API feature complete, just
   functional enough for the RTL code.
   functional enough for the RTL code.
 }
 }
-
+{$IFNDEF AMIGA_V2_0_ONLY}
 
 
 function AllocVec(byteSize    : Cardinal;
 function AllocVec(byteSize    : Cardinal;
                   requirements: Cardinal): Pointer; public name '_fpc_amiga_allocvec';
                   requirements: Cardinal): Pointer; public name '_fpc_amiga_allocvec';
@@ -46,6 +46,8 @@ begin
     end;
     end;
 end;
 end;
 
 
+{$ENDIF NOT AMIGA_V2_0_ONLY}
+
 type
 type
   TAmigaLegacyPoolEntry = record
   TAmigaLegacyPoolEntry = record
     pe_node: TMinNode;
     pe_node: TMinNode;
@@ -131,6 +133,8 @@ begin
     end;
     end;
 end;
 end;
 
 
+{$IFNDEF AMIGA_V2_0_ONLY}
+
 procedure StackSwap(newStack: PStackSwapStruct); assembler; nostackframe; public name '_fpc_amiga_stackswap';
 procedure StackSwap(newStack: PStackSwapStruct); assembler; nostackframe; public name '_fpc_amiga_stackswap';
 asm
 asm
     move.l   a6,-(sp)
     move.l   a6,-(sp)
@@ -180,3 +184,5 @@ begin
     at least in the way it's currently used in athreads. }
     at least in the way it's currently used in athreads. }
   ObtainSemaphore(sigSem);
   ObtainSemaphore(sigSem);
 end;
 end;
+
+{$ENDIF NOT AMIGA_V2_0_ONLY}

+ 4 - 1
rtl/amiga/m68k/legacyexech.inc

@@ -16,9 +16,11 @@
 
 
 {* exec.library *}
 {* exec.library *}
 
 
+{$IFNDEF AMIGA_V2_0_ONLY}
 function AllocVec(byteSize    : Cardinal;
 function AllocVec(byteSize    : Cardinal;
                   requirements: Cardinal): Pointer; external name '_fpc_amiga_allocvec';
                   requirements: Cardinal): Pointer; external name '_fpc_amiga_allocvec';
 procedure FreeVec(memoryBlock: Pointer); external name '_fpc_amiga_freevec';
 procedure FreeVec(memoryBlock: Pointer); external name '_fpc_amiga_freevec';
+{$ENDIF}
 function CreatePool(requirements: Cardinal;
 function CreatePool(requirements: Cardinal;
                     puddleSize  : Cardinal;
                     puddleSize  : Cardinal;
                     threshSize  : Cardinal): Pointer; external name '_fpc_amiga_createpool';
                     threshSize  : Cardinal): Pointer; external name '_fpc_amiga_createpool';
@@ -28,6 +30,7 @@ procedure FreePooled(poolHeader: Pointer;
                     memory    : Pointer;
                     memory    : Pointer;
                     memSize   : Cardinal); external name '_fpc_amiga_freepooled';
                     memSize   : Cardinal); external name '_fpc_amiga_freepooled';
 procedure DeletePool(poolHeader: Pointer); external name '_fpc_amiga_deletepool';
 procedure DeletePool(poolHeader: Pointer); external name '_fpc_amiga_deletepool';
-
+{$IFNDEF AMIGA_V2_0_ONLY}
 procedure StackSwap(newStack: PStackSwapStruct); external name '_fpc_amiga_stackswap';
 procedure StackSwap(newStack: PStackSwapStruct); external name '_fpc_amiga_stackswap';
 procedure ObtainSemaphoreShared(sigSem: PSignalSemaphore); external name '_fpc_amiga_obtainsemaphoreshared';
 procedure ObtainSemaphoreShared(sigSem: PSignalSemaphore); external name '_fpc_amiga_obtainsemaphoreshared';
+{$ENDIF}

+ 31 - 1
rtl/amiga/m68k/si_prc.pp

@@ -21,6 +21,7 @@ implementation
 
 
 var
 var
   AOS_ExecBase: Pointer; public name '_ExecBase';
   AOS_ExecBase: Pointer; public name '_ExecBase';
+  AOS_DosBase: Pointer; external name '_DOSBase';
   realExecBase: Pointer absolute $4;
   realExecBase: Pointer absolute $4;
   StkLen: LongInt; external name '__stklen';
   StkLen: LongInt; external name '__stklen';
   sysinit_jmpbuf: jmp_buf;
   sysinit_jmpbuf: jmp_buf;
@@ -29,6 +30,9 @@ var
 { the definitions in there need AOS_Execbase }
 { the definitions in there need AOS_Execbase }
 {$include execd.inc}
 {$include execd.inc}
 {$include execf.inc}
 {$include execf.inc}
+{$include timerd.inc}
+{$include doslibd.inc}
+{$include doslibf.inc}
 
 
 {$if defined(AMIGA_V1_0_ONLY) or defined(AMIGA_V1_2_ONLY)}
 {$if defined(AMIGA_V1_0_ONLY) or defined(AMIGA_V1_2_ONLY)}
 {$define AMIGA_LEGACY}
 {$define AMIGA_LEGACY}
@@ -44,6 +48,21 @@ var
 var
 var
   sst: TStackSwapStruct;
   sst: TStackSwapStruct;
 
 
+const
+{$if defined(AMIGA_V1_0_ONLY)}
+  NEEDS_NEWER_OS = 'This program needs newer OS.'+LineEnding;
+{$else}
+{$if defined(AMIGA_V1_2_ONLY)}
+  NEEDS_NEWER_OS = 'This program needs OS 1.2 or newer.'+LineEnding;
+{$else}
+{$if defined(AMIGA_V2_0_ONLY)}
+  NEEDS_NEWER_OS = 'This program needs OS 2.04 or newer.'+LineEnding;
+{$else}
+  NEEDS_NEWER_OS = 'This program needs OS 3.0 or newer.'+LineEnding;
+{$endif}
+{$endif}
+{$endif}
+
 procedure PascalMain; external name 'PASCALMAIN';
 procedure PascalMain; external name 'PASCALMAIN';
 
 
 
 
@@ -60,8 +79,19 @@ begin
   end;
   end;
 {$ENDIF}
 {$ENDIF}
   AOS_ExecBase:=realExecBase;
   AOS_ExecBase:=realExecBase;
-  newStack:=nil;
 
 
+  if PLibrary(AOS_ExecBase)^.lib_Version < AMIGA_OS_MINVERSION then
+    begin
+      AOS_DOSBase:=OpenLibrary('dos.library',0);
+      if AOS_DOSBase <> nil then
+        begin
+          dosWrite(dosOutput,PChar(NEEDS_NEWER_OS),length(NEEDS_NEWER_OS));
+          CloseLibrary(AOS_DOSBase);
+        end;
+      exit(20);
+    end;
+
+  newStack:=nil;
   task:=FindTask(nil);
   task:=FindTask(nil);
   if (task^.tc_SPUpper-task^.tc_SPLower < StkLen) then
   if (task^.tc_SPUpper-task^.tc_SPLower < StkLen) then
     begin
     begin

+ 14 - 6
rtl/amiga/system.pp

@@ -49,12 +49,20 @@ interface
 
 
 const
 const
 {$if defined(AMIGA_V1_0_ONLY)}
 {$if defined(AMIGA_V1_0_ONLY)}
-  OS_MINVERSION = 0;
+  AMIGA_OS_MINVERSION = 0;
 {$else}
 {$else}
 {$if defined(AMIGA_V1_2_ONLY)}
 {$if defined(AMIGA_V1_2_ONLY)}
-  OS_MINVERSION = 33;
+  AMIGA_OS_MINVERSION = 33;
 {$else}
 {$else}
-  OS_MINVERSION = 37;
+{$if defined(AMIGA_V2_0_ONLY)}
+  AMIGA_OS_MINVERSION = 37;
+{$else}
+{$ifndef cpupowerpc}
+  AMIGA_OS_MINVERSION = 39;
+{$else}
+  AMIGA_OS_MINVERSION = 50;
+{$endif}
+{$endif}
 {$endif}
 {$endif}
 {$endif}
 {$endif}
 
 
@@ -267,13 +275,13 @@ begin
     AOS_wbMsg:=GetMsg(@self^.pr_MsgPort);
     AOS_wbMsg:=GetMsg(@self^.pr_MsgPort);
   end;
   end;
 
 
-  AOS_DOSBase:=OpenLibrary('dos.library',OS_MINVERSION);
+  AOS_DOSBase:=OpenLibrary('dos.library',AMIGA_OS_MINVERSION);
   if AOS_DOSBase=nil then Halt(1);
   if AOS_DOSBase=nil then Halt(1);
 {$ifndef AMIGA_LEGACY}
 {$ifndef AMIGA_LEGACY}
-  AOS_UtilityBase:=OpenLibrary('utility.library',OS_MINVERSION);
+  AOS_UtilityBase:=OpenLibrary('utility.library',AMIGA_OS_MINVERSION);
   if AOS_UtilityBase=nil then Halt(1);
   if AOS_UtilityBase=nil then Halt(1);
 {$endif}
 {$endif}
-  AOS_IntuitionBase:=OpenLibrary('intuition.library',OS_MINVERSION); { amunits support kludge }
+  AOS_IntuitionBase:=OpenLibrary('intuition.library',AMIGA_OS_MINVERSION); { amunits support kludge }
   if AOS_IntuitionBase=nil then Halt(1);
   if AOS_IntuitionBase=nil then Halt(1);
 
 
 {$IFDEF AMIGAOS4}
 {$IFDEF AMIGAOS4}