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 RegLoadedWithNewValue(reg: tregister; 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;
-        procedure DebugMsg(const s : string; p : tai);
       private
         function OptPass1Shift(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;
       End;
 
@@ -60,98 +57,12 @@ Implementation
     cgutils,
     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;
     begin
       result:=(p.typ=ait_instruction) and (taicpu(p).condition=C_None);
     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;
     var
       p: taicpu;
@@ -234,84 +145,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, [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
       ldr/str regX,[reg1]
@@ -541,6 +374,12 @@ Implementation
             A_ORR,
             A_MUL:
               Result:=OptPass1Data(p);
+            A_UXTB:
+              Result:=OptPass1UXTB(p);
+            A_SXTB:
+              Result:=OptPass1SXTB(p);
+            A_SXTH:
+              Result:=OptPass1SXTH(p);
             else
               ;
           end;

+ 2 - 0
compiler/aarch64/cpubase.pas

@@ -49,6 +49,8 @@ unit cpubase;
       TAsmOp= {$i a64op.inc}
 
       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 }
       op2strtable=array[tasmop] of string[11];

+ 5 - 560
compiler/arm/aoptcpu.pas

@@ -26,7 +26,7 @@ Unit aoptcpu;
 {$i fpcdefs.inc}
 
 { $define DEBUG_PREREGSCHEDULER}
-{$define DEBUG_AOPTCPU}
+{ $define DEBUG_AOPTCPU}
 
 Interface
 
@@ -44,7 +44,6 @@ Type
     function PeepHoleOptPass1Cpu(var p: tai): boolean; override;
     procedure PeepHoleOptPass2;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;
 
     { gets the next tai object after current that contains info relevant
@@ -52,7 +51,6 @@ Type
       change in program flow.
       If there is none, it returns false and
       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;
 
     { outputs a debug message into the assembler file }
@@ -112,63 +110,6 @@ Implementation
     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;
     begin
       Result:=false;
@@ -332,20 +273,6 @@ Implementation
     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;
     Out Next: tai; const ref: TReference; StopOnStore: Boolean = true): Boolean;
     begin
@@ -395,92 +322,6 @@ Implementation
     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;
     var
       alloc,
@@ -2049,409 +1890,13 @@ Implementation
                   end;
 {$endif dummy}
                 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:
-                  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:
-                  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:
-                  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:
                   begin
                     {

+ 1 - 1
compiler/arm/narmmat.pas

@@ -368,7 +368,7 @@ implementation
           end;
 
         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);
 
         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,
     several optimizations can be shared between both }
   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;
 
+  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
 
   uses
@@ -48,5 +69,628 @@ Implementation
     cgobj,procinfo,
     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.
 

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

@@ -666,6 +666,9 @@ function SameDevice(lock1: LongInt location 'd1';
                     lock2: LongInt location 'd2'): LongBool;
 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';
                    buffer : PExAllData    location 'd2';
                    size   : LongInt       location 'd3';
@@ -677,12 +680,6 @@ function SetOwner(name      : PChar   location 'd1';
                   owner_info: LongInt location 'd2'): LongBool;
 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_0_ONLY}
-

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

@@ -394,6 +394,13 @@ SysCall AOS_ExecBase 684;
 procedure FreeVec(memoryBlock: Pointer location 'a1');
 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';
                     puddleSize  : Cardinal location 'd1';
                     threshSize  : Cardinal location 'd2'): Pointer;
@@ -411,6 +418,8 @@ procedure FreePooled(poolHeader: Pointer  location 'a0';
                       memSize   : Cardinal location 'd0');
 SysCall AOS_ExecBase 714;
 
+{$ENDIF}
+
 function AttemptSemaphoreShared(sigSem: pSignalSemaphore location 'a0'): Cardinal;
 SysCall AOS_ExecBase 720;
 
@@ -430,6 +439,9 @@ procedure CachePostDMA(address   : Pointer  location 'a0';
                        flags     : Cardinal location 'd0');
 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');
 SysCall AOS_ExecBase 774;
 
@@ -439,6 +451,7 @@ SysCall AOS_ExecBase 780;
 function ObtainQuickVector(interruptCode: Pointer location 'a0'): Cardinal;
 SysCall AOS_ExecBase 786;
 
+{$ENDIF AMIGA_V2_0_ONLY}
 {$ENDIF AMIGA_V1_2_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
   functional enough for the RTL code.
 }
-
+{$IFNDEF AMIGA_V2_0_ONLY}
 
 function AllocVec(byteSize    : Cardinal;
                   requirements: Cardinal): Pointer; public name '_fpc_amiga_allocvec';
@@ -46,6 +46,8 @@ begin
     end;
 end;
 
+{$ENDIF NOT AMIGA_V2_0_ONLY}
+
 type
   TAmigaLegacyPoolEntry = record
     pe_node: TMinNode;
@@ -131,6 +133,8 @@ begin
     end;
 end;
 
+{$IFNDEF AMIGA_V2_0_ONLY}
+
 procedure StackSwap(newStack: PStackSwapStruct); assembler; nostackframe; public name '_fpc_amiga_stackswap';
 asm
     move.l   a6,-(sp)
@@ -180,3 +184,5 @@ begin
     at least in the way it's currently used in athreads. }
   ObtainSemaphore(sigSem);
 end;
+
+{$ENDIF NOT AMIGA_V2_0_ONLY}

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

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

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

@@ -21,6 +21,7 @@ implementation
 
 var
   AOS_ExecBase: Pointer; public name '_ExecBase';
+  AOS_DosBase: Pointer; external name '_DOSBase';
   realExecBase: Pointer absolute $4;
   StkLen: LongInt; external name '__stklen';
   sysinit_jmpbuf: jmp_buf;
@@ -29,6 +30,9 @@ var
 { the definitions in there need AOS_Execbase }
 {$include execd.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)}
 {$define AMIGA_LEGACY}
@@ -44,6 +48,21 @@ var
 var
   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';
 
 
@@ -60,8 +79,19 @@ begin
   end;
 {$ENDIF}
   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);
   if (task^.tc_SPUpper-task^.tc_SPLower < StkLen) then
     begin

+ 14 - 6
rtl/amiga/system.pp

@@ -49,12 +49,20 @@ interface
 
 const
 {$if defined(AMIGA_V1_0_ONLY)}
-  OS_MINVERSION = 0;
+  AMIGA_OS_MINVERSION = 0;
 {$else}
 {$if defined(AMIGA_V1_2_ONLY)}
-  OS_MINVERSION = 33;
+  AMIGA_OS_MINVERSION = 33;
 {$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}
 
@@ -267,13 +275,13 @@ begin
     AOS_wbMsg:=GetMsg(@self^.pr_MsgPort);
   end;
 
-  AOS_DOSBase:=OpenLibrary('dos.library',OS_MINVERSION);
+  AOS_DOSBase:=OpenLibrary('dos.library',AMIGA_OS_MINVERSION);
   if AOS_DOSBase=nil then Halt(1);
 {$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);
 {$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);
 
 {$IFDEF AMIGAOS4}