* fixed arm concatcopy

  + arm support in the common compiler sources added
  * moved some generic cg code around
  + tfputype added
  * ...

compiler/aasmtai.pas

@@ -442,12 +442,11 @@ interface
           procedure loadref(opidx:longint;const r:treference);
           procedure loadreg(opidx:longint;r:tregister);
           procedure loadoper(opidx:longint;o:toper);
+          procedure clearop(opidx:longint);
           function is_nop:boolean;virtual;abstract;
           function is_move:boolean;virtual;abstract;
 {$ifdef NEWRA}
           { register allocator }
-          function get_insert_pos(p:Tai;huntfor1,huntfor2,huntfor3:Tsuperregister;var unusedregsint:Tsupregset):Tai;
-          procedure forward_allocation(p:Tai;var unusedregsint:Tsupregset);
           function spill_registers(list:Taasmoutput;
                                    rgget:Trggetproc;
                                    rgunget:Trgungetproc;
@@ -491,7 +490,6 @@ interface
       resourcesection,rttilist,
       resourcestringlist         : taasmoutput;
 
-
     function ppuloadai(ppufile:tcompilerppufile):tai;
     procedure ppuwriteai(ppufile:tcompilerppufile;n:tai);
 
@@ -1491,6 +1489,10 @@ implementation
         case oper[i].typ of
           top_ref:
             dispose(oper[i].ref);
+{$ifdef ARM}
+          top_shifterop:
+            dispose(oper[i].shifterop);
+{$endif ARM}
         end;
         inherited destroy;
       end;
@@ -1506,8 +1508,8 @@ implementation
          ops:=opidx+1;
         with oper[opidx] do
          begin
-           if typ=top_ref then
-            dispose(ref);
+           if typ<>top_const then
+             clearop(opidx);
            val:=l;
            typ:=top_const;
          end;
@@ -1522,8 +1524,8 @@ implementation
          ops:=opidx+1;
         with oper[opidx] do
          begin
-           if typ=top_ref then
-            dispose(ref);
+           if typ<>top_symbol then
+             clearop(opidx);
            sym:=s;
            symofs:=sofs;
            typ:=top_symbol;
@@ -1541,7 +1543,11 @@ implementation
         with oper[opidx] do
           begin
             if typ<>top_ref then
-              new(ref);
+              begin
+                clearop(opidx);
+                new(ref);
+              end;
+
             ref^:=r;
 {$ifdef i386}
             { We allow this exception for i386, since overloading this would be
@@ -1569,8 +1575,8 @@ implementation
          ops:=opidx+1;
         with oper[opidx] do
          begin
-           if typ=top_ref then
-            dispose(ref);
+           if typ<>top_reg then
+             clearop(opidx);
            reg:=r;
            typ:=top_reg;
          end;
@@ -1581,74 +1587,40 @@ implementation
       begin
         if opidx>=ops then
          ops:=opidx+1;
-        if oper[opidx].typ=top_ref then
-         dispose(oper[opidx].ref);
+        clearop(opidx);
         oper[opidx]:=o;
         { copy also the reference }
-        if oper[opidx].typ=top_ref then
-         begin
-           new(oper[opidx].ref);
-           oper[opidx].ref^:=o.ref^;
+        case oper[opidx].typ of
+          top_ref:
+            begin
+              new(oper[opidx].ref);
+              oper[opidx].ref^:=o.ref^;
+            end;
+{$ifdef ARM}
+          top_shifterop:
+            begin
+              new(oper[opidx].shifterop);
+              oper[opidx].shifterop^:=o.shifterop^;
+            end;
+{$endif ARM}
          end;
       end;
 
-{$ifdef NEWRA}
-{ ---------------------------------------------------------------------
-    Register allocator methods.
-  ---------------------------------------------------------------------}
 
-    function taicpu_abstract.get_insert_pos(p:Tai;huntfor1,huntfor2,huntfor3:Tsuperregister;var unusedregsint:Tsupregset):Tai;
-      var
-        back:Tsupregset;
+    procedure taicpu_abstract.clearop(opidx:longint);
       begin
-        back:=unusedregsint;
-        get_insert_pos:=p;
-        while (p<>nil) and (p.typ=ait_regalloc) do
-          begin
-            {Rewind the register allocation.}
-            if Tai_regalloc(p).allocation then
-              include(unusedregsint,Tai_regalloc(p).reg.number shr 8)
-            else
-              begin
-                exclude(unusedregsint,Tai_regalloc(p).reg.number shr 8);
-                if Tai_regalloc(p).reg.number shr 8=huntfor1 then
-                  begin
-                    get_insert_pos:=Tai(p.previous);
-                    back:=unusedregsint;
-                  end;
-                if Tai_regalloc(p).reg.number shr 8=huntfor2 then
-                  begin
-                    get_insert_pos:=Tai(p.previous);
-                    back:=unusedregsint;
-                  end;
-                if Tai_regalloc(p).reg.number shr 8=huntfor3 then
-                  begin
-                    get_insert_pos:=Tai(p.previous);
-                    back:=unusedregsint;
-                  end;
-              end;
-            p:=Tai(p.previous);
+        with oper[opidx] do
+          case typ of
+            top_ref:
+              dispose(ref);
+{$ifdef ARM}
+            top_shifterop:
+              dispose(shifterop);
+{$endif ARM}
           end;
-        unusedregsint:=back;
       end;
 
 
-    procedure taicpu_abstract.forward_allocation(p:Tai;var unusedregsint:Tsupregset);
-      begin
-        {Forward the register allocation again.}
-        while (p<>self) do
-          begin
-            if p.typ<>ait_regalloc then
-              internalerror(200305311);
-            if Tai_regalloc(p).allocation then
-              exclude(unusedregsint,Tai_regalloc(p).reg.number shr 8)
-            else
-              include(unusedregsint,Tai_regalloc(p).reg.number shr 8);
-            p:=Tai(p.next);
-          end;
-      end;
-{$endif NEWRA}
-
 { ---------------------------------------------------------------------
     Miscellaneous methods.
   ---------------------------------------------------------------------}
@@ -1798,7 +1770,7 @@ implementation
            begin
               { find the last file information record }
               if not (tai(last).typ in SkipLineInfo) then
-                 getlasttaifilepos:=@tailineinfo(last).fileinfo
+                getlasttaifilepos:=@tailineinfo(last).fileinfo
               else
                { go through list backwards to find the first entry
                  with line information
@@ -1809,7 +1781,7 @@ implementation
                     hp:=hp.Previous;
                  { found entry }
                  if assigned(hp) then
-                     getlasttaifilepos:=@tailineinfo(hp).fileinfo
+                   getlasttaifilepos:=@tailineinfo(hp).fileinfo
                end;
            end;
       end;
@@ -1819,6 +1791,10 @@ implementation
     var p,q:Tai;
         i:shortint;
         r:Preference;
+{$ifdef arm}
+        so:pshifterop;
+{$endif arm}
+
 
     begin
       p:=Tai(first);
@@ -1831,26 +1807,37 @@ implementation
             ait_instruction:
               begin
                 for i:=0 to Taicpu_abstract(p).ops-1 do
-                  if Taicpu_abstract(p).oper[i].typ=Top_reg then
-                    Taicpu_abstract(p).oper[i].reg.number:=(Taicpu_abstract(p).oper[i].reg.number and $ff) or
-                                                           (table[Taicpu_abstract(p).oper[i].reg.number shr 8] shl 8)
-                  else if Taicpu_abstract(p).oper[i].typ=Top_ref then
+                  case Taicpu_abstract(p).oper[i].typ of
+                    Top_reg:
+                      Taicpu_abstract(p).oper[i].reg.number:=(Taicpu_abstract(p).oper[i].reg.number and $ff) or
+                                                             (table[Taicpu_abstract(p).oper[i].reg.number shr 8] shl 8);
+                    Top_ref:
+                      begin
+                        r:=Taicpu_abstract(p).oper[i].ref;
+                        if r^.base.number<>NR_NO then
+                          r^.base.number:=(r^.base.number and $ff) or
+                                          (table[r^.base.number shr 8] shl 8);
+                        if r^.index.number<>NR_NO then
+                          r^.index.number:=(r^.index.number and $ff) or
+                                           (table[r^.index.number shr 8] shl 8);
+                      end;
+{$ifdef arm}
+                    Top_shifterop:
+                      begin
+                        so:=Taicpu_abstract(p).oper[i].shifterop;
+                        if so^.rs.number<>NR_NO then
+                          so^.rs.number:=(so^.rs.number and $ff) or
+                                          (table[so^.rs.number shr 8] shl 8);
+                      end;
+{$endif arm}
+                  end;
+                  if Taicpu_abstract(p).is_nop then
                     begin
-                      r:=Taicpu_abstract(p).oper[i].ref;
-                      if r^.base.number<>NR_NO then
-                        r^.base.number:=(r^.base.number and $ff) or
-                                        (table[r^.base.number shr 8] shl 8);
-                      if r^.index.number<>NR_NO then
-                        r^.index.number:=(r^.index.number and $ff) or
-                                         (table[r^.index.number shr 8] shl 8);
+                      q:=p;
+                      p:=Tai(p.next);
+                      remove(q);
+                      continue;
                     end;
-                if Taicpu_abstract(p).is_nop then
-                  begin
-                    q:=p;
-                    p:=Tai(p.next);
-                    remove(q);
-                    continue;
-                  end;
               end;
           end;
           p:=Tai(p.next);
@@ -1860,7 +1847,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.35  2003-08-21 14:47:41  peter
+  Revision 1.36  2003-09-03 11:18:36  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.35  2003/08/21 14:47:41  peter
     * remove convert_registers
 
   Revision 1.34  2003/08/20 20:29:06  daniel

compiler/aggas.pas

@@ -83,6 +83,9 @@ implementation
 {$ifdef i386}
       ,itx86att
 {$endif}
+{$ifdef arm}
+      ,agarmgas
+{$endif}
 {$ifdef powerpc}
       ,agppcgas
 {$endif}
@@ -832,7 +835,14 @@ var
 end.
 {
   $Log$
-  Revision 1.29  2003-08-19 11:53:03  daniel
+  Revision 1.30  2003-09-03 11:18:36  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.29  2003/08/19 11:53:03  daniel
     * Fixed PowerPC compilation
 
   Revision 1.28  2003/08/18 11:49:47  daniel
@@ -949,4 +959,3 @@ end.
   + basic GNU assembler writer class
 
 }
-

compiler/arm/aasmcpu.pas

@@ -93,6 +93,10 @@ uses
         { nothing to add }
       end;
 
+    function setoppostfix(i : taicpu;pf : toppostfix) : taicpu;
+    function setroundingmode(i : taicpu;rm : troundingmode) : taicpu;
+    function setcondition(i : taicpu;c : tasmcond) : taicpu;
+
     procedure InitAsm;
     procedure DoneAsm;
 
@@ -720,10 +724,39 @@ implementation
       begin
       end;
 
+
+    function setoppostfix(i : taicpu;pf : toppostfix) : taicpu;
+      begin
+        i.oppostfix:=pf;
+        result:=i;
+      end;
+
+
+    function setroundingmode(i : taicpu;rm : troundingmode) : taicpu;
+      begin
+        i.roundingmode:=rm;
+        result:=i;
+      end;
+
+
+    function setcondition(i : taicpu;c : tasmcond) : taicpu;
+      begin
+        i.condition:=c;
+        result:=i;
+      end;
+
+
 end.
 {
   $Log$
-  Revision 1.7  2003-08-29 21:36:28  florian
+  Revision 1.8  2003-09-03 11:18:37  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.7  2003/08/29 21:36:28  florian
     * fixed procedure entry/exit code
     * started to fix reference handling
 

compiler/arm/cgcpu.pas

@@ -417,7 +417,6 @@ unit cgcpu;
       var
         tmpreg : tregister;
         tmpref : treference;
-        instr : taicpu;
         l : tasmlabel;
       begin
         tmpreg.enum:=R_INTREGISTER;
@@ -473,6 +472,7 @@ unit cgcpu;
                 if ref.index.number<>NR_NO then
                   begin
                     list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg));
+                    rg.ungetregister(list,ref.base);
                     ref.base:=tmpreg;
                   end
                 else
@@ -488,9 +488,7 @@ unit cgcpu;
             ref.offset:=0;
             ref.symbol:=nil;
           end;
-        instr:=taicpu.op_reg_ref(op,reg,ref);
-        instr.oppostfix:=oppostfix;
-        list.concat(instr);
+        list.concat(setoppostfix(taicpu.op_reg_ref(op,reg,ref),oppostfix));
         if (tmpreg.number<>NR_NO) then
           rg.ungetregisterint(list,tmpreg);
       end;
@@ -602,22 +600,44 @@ unit cgcpu;
 
 
      procedure tcgarm.a_loadfpu_reg_reg(list: taasmoutput; size: tcgsize; reg1, reg2: tregister);
-       var
-         instr : taicpu;
        begin
-         instr:=taicpu.op_reg_reg(A_MVF,reg2,reg1);
-         instr.oppostfix:=cgsize2fpuoppostfix[size];
-         list.concat(instr);
+         list.concat(setoppostfix(taicpu.op_reg_reg(A_MVF,reg2,reg1),cgsize2fpuoppostfix[size]));
        end;
 
 
      procedure tcgarm.a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister);
+       var
+         oppostfix:toppostfix;
        begin
+         case size of
+           OS_F32:
+             oppostfix:=PF_S;
+           OS_F64:
+             oppostfix:=PF_D;
+           OS_F80:
+             oppostfix:=PF_E;
+           else
+             InternalError(200309021);
+         end;
+         handle_load_store(list,A_LDF,oppostfix,reg,ref);
        end;
 
 
      procedure tcgarm.a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference);
+       var
+         oppostfix:toppostfix;
        begin
+         case size of
+           OS_F32:
+             oppostfix:=PF_S;
+           OS_F64:
+             oppostfix:=PF_D;
+           OS_F80:
+             oppostfix:=PF_E;
+           else
+             InternalError(200309021);
+         end;
+         handle_load_store(list,A_STF,oppostfix,reg,ref);
        end;
 
 
@@ -695,7 +715,6 @@ unit cgcpu;
     procedure tcgarm.g_stackframe_entry(list : taasmoutput;localsize : longint);
       var
         rip,rsp,rfp : tregister;
-        instr : taicpu;
       begin
         LocalSize:=align(LocalSize,4);
 
@@ -713,9 +732,7 @@ unit cgcpu;
 
         list.concat(taicpu.op_reg_reg(A_MOV,rip,rsp));
         { restore int registers and return }
-        instr:=taicpu.op_reg_regset(A_STM,rsp,rg.used_in_proc_int-[RS_R0..RS_R3]+[RS_R11,RS_R12,RS_R15]);
-        instr.oppostfix:=PF_FD;
-        list.concat(instr);
+        list.concat(setoppostfix(taicpu.op_reg_regset(A_STM,rsp,rg.used_in_proc_int-[RS_R0..RS_R3]+[RS_R11,RS_R12,RS_R15]),PF_FD));
 
         list.concat(taicpu.op_reg_reg_const(A_SUB,rfp,rip,4));
         a_reg_alloc(list,rip);
@@ -728,7 +745,6 @@ unit cgcpu;
     procedure tcgarm.g_return_from_proc(list : taasmoutput;parasize : aword);
       var
         r1,r2 : tregister;
-        instr : taicpu;
       begin
         if (current_procinfo.framepointer.number=NR_STACK_POINTER_REG) then
           begin
@@ -744,9 +760,7 @@ unit cgcpu;
             r1.enum:=R_INTREGISTER;
             r1.number:=NR_R11;
             { restore int registers and return }
-            instr:=taicpu.op_reg_regset(A_LDM,r1,rg.used_in_proc_int-[RS_R0..RS_R3]+[RS_R11,RS_R13,RS_R15]);
-            instr.oppostfix:=PF_EA;
-            list.concat(instr);
+            list.concat(setoppostfix(taicpu.op_reg_regset(A_LDM,r1,rg.used_in_proc_int-[RS_R0..RS_R3]+[RS_R11,RS_R13,RS_R15]),PF_EA));
           end;
       end;
 
@@ -758,12 +772,199 @@ unit cgcpu;
 
 
     procedure tcgarm.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);
+      var
+        tmpreg : tregister;
+        tmpref : treference;
+        instr : taicpu;
+        l : tasmlabel;
       begin
+        {
+        tmpreg.enum:=R_INTREGISTER;
+        tmpreg.number:=NR_NO;
+
+        { Be sure to have a base register }
+        if (ref.base.number=NR_NO) then
+          begin
+            if ref.shiftmode<>SM_None then
+              internalerror(200308294);
+            ref.base:=ref.index;
+            ref.index.number:=NR_NO;
+          end;
+
+        { absolute symbols can't be handled directly, we've to store the symbol reference
+          in the text segment and access it pc relative
+
+          For now, we assume that references where base or index equals to PC are already
+          relative, all other references are assumed to be absolute and thus they need
+          to be handled extra.
+
+          A proper solution would be to change refoptions to a set and store the information
+          if the symbol is absolute or relative there.
+        }
+
+        if (assigned(ref.symbol) and
+            not(is_pc(ref.base)) and
+            not(is_pc(ref.index))
+           ) or
+           (ref.offset<-4095) or
+           (ref.offset>4095) then
+          begin
+            { check consts distance }
+
+            { create consts entry }
+            objectlibrary.getdatalabel(l);
+            current_procinfo.aktlocaldata.concat(Tai_symbol.Create(l,0));
+            if assigned(ref.symbol) then
+              current_procinfo.aktlocaldata.concat(tai_const_symbol.Create_offset(ref.symbol,ref.offset))
+            else
+              current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(ref.offset));
+
+            { load consts entry }
+            tmpreg:=rg.getregisterint(list,OS_INT);
+            reference_reset(tmpref);
+            tmpref.symbol:=l;
+            tmpref.base.enum:=R_INTREGISTER;
+            tmpref.base.number:=NR_R15;
+            list.concat(taicpu.op_reg_ref(A_LDR,tmpreg,tmpref));
+
+            if (ref.base.number<>NR_NO) then
+              begin
+                if ref.index.number<>NR_NO then
+                  begin
+                    list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg));
+                    rg.ungetregister(list,ref.base);
+                    ref.base:=tmpreg;
+                  end
+                else
+                  begin
+                    ref.index:=tmpreg;
+                    ref.shiftimm:=0;
+                    ref.signindex:=1;
+                    ref.shiftmode:=SM_None;
+                  end;
+              end
+            else
+              ref.base:=tmpreg;
+            ref.offset:=0;
+            ref.symbol:=nil;
+          end;
+        list.concat(setoppostfix(taicpu.op_reg_ref(op,reg,ref),oppostfix);
+        if (tmpreg.number<>NR_NO) then
+          rg.ungetregisterint(list,tmpreg);
+        }
       end;
 
 
     procedure tcgarm.g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);
+      var
+        srcref,dstref:treference;
+        srcreg,destreg,countreg,r:tregister;
+        helpsize:aword;
+        copysize:byte;
+        cgsize:Tcgsize;
+
+      procedure genloop(count : aword;size : byte);
+        const
+          size2opsize : array[1..4] of tcgsize = (OS_8,OS_16,OS_NO,OS_32);
+        var
+          l : tasmlabel;
+        begin
+          objectlibrary.getdatalabel(l);
+          a_load_const_reg(list,OS_INT,count,countreg);
+          list.concat(Tai_symbol.Create(l,0));
+          srcref.addressmode:=AM_POSTINDEXED;
+          dstref.addressmode:=AM_POSTINDEXED;
+          srcref.offset:=size;
+          dstref.offset:=size;
+          r:=rg.getregisterint(list,size2opsize[size]);
+          a_load_ref_reg(list,size2opsize[size],size2opsize[size],srcref,r);
+          a_load_reg_ref(list,size2opsize[size],size2opsize[size],r,dstref);
+          rg.ungetregisterint(list,r);
+          list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SUB,countreg,countreg,1),PF_S));
+          list.concat(setcondition(taicpu.op_sym(A_B,l),C_NE));
+        end;
+
       begin
+        helpsize:=12;
+        if cs_littlesize in aktglobalswitches then
+          helpsize:=8;
+        if not loadref and (len<=helpsize) then
+          begin
+            dstref:=dest;
+            srcref:=source;
+            copysize:=4;
+            cgsize:=OS_32;
+            while len<>0 do
+              begin
+                if len<2 then
+                  begin
+                    copysize:=1;
+                    cgsize:=OS_8;
+                  end
+                else if len<4 then
+                  begin
+                    copysize:=2;
+                    cgsize:=OS_16;
+                  end;
+                dec(len,copysize);
+                r:=rg.getregisterint(list,cgsize);
+                a_load_ref_reg(list,cgsize,cgsize,srcref,r);
+                if (len=0) and delsource then
+                  reference_release(list,source);
+                a_load_reg_ref(list,cgsize,cgsize,r,dstref);
+                inc(srcref.offset,copysize);
+                inc(dstref.offset,copysize);
+                rg.ungetregisterint(list,r);
+              end;
+          end
+        else
+          begin
+            destreg:=rg.getregisterint(list,OS_ADDR);
+            a_loadaddr_ref_reg(list,dest,destreg);
+            srcreg:=rg.getregisterint(list,OS_ADDR);
+            if loadref then
+              a_load_ref_reg(list,OS_ADDR,OS_ADDR,source,srcreg)
+            else
+              begin
+                a_loadaddr_ref_reg(list,source,srcreg);
+                if delsource then
+                  begin
+                    srcref:=source;
+                    reference_release(list,srcref);
+                  end;
+              end;
+
+            countreg:=rg.getregisterint(list,OS_32);
+
+//            if cs_littlesize in aktglobalswitches  then
+              genloop(len,1);
+{
+            else
+              begin
+                helpsize:=len shr 2;
+                len:=len and 3;
+                if helpsize>1 then
+                  begin
+                    a_load_const_reg(list,OS_INT,helpsize,countreg);
+                    list.concat(Taicpu.op_none(A_REP,S_NO));
+                  end;
+                if helpsize>0 then
+                  list.concat(Taicpu.op_none(A_MOVSD,S_NO));
+                if len>1 then
+                  begin
+                    dec(len,2);
+                    list.concat(Taicpu.op_none(A_MOVSW,S_NO));
+                  end;
+                if len=1 then
+                  list.concat(Taicpu.op_none(A_MOVSB,S_NO));
+                end;
+}
+            rg.ungetregisterint(list,countreg);
+            rg.ungetregisterint(list,srcreg);
+            rg.ungetregisterint(list,destreg);
+          end;
+        if delsource then
+          tg.ungetiftemp(list,source);
       end;
 
 
@@ -810,14 +1011,11 @@ unit cgcpu;
     procedure tcg64farm.a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64);
       var
         tmpreg : tregister;
-        instr : taicpu;
       begin
         case op of
           OP_NEG:
             begin
-              instr:=taicpu.op_reg_reg_const(A_RSB,regdst.reglo,regsrc.reglo,0);
-              instr.oppostfix:=PF_S;
-              list.concat(instr);
+              list.concat(setoppostfix(taicpu.op_reg_reg_const(A_RSB,regdst.reglo,regsrc.reglo,0),PF_S));
               list.concat(taicpu.op_reg_reg_const(A_RSC,regdst.reghi,regsrc.reghi,0));
             end;
           else
@@ -833,13 +1031,67 @@ unit cgcpu;
 
 
     procedure tcg64farm.a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : qword;regsrc,regdst : tregister64);
+      var
+        tmpreg : tregister;
+        b : byte;
       begin
+        case op of
+          OP_AND,OP_OR,OP_XOR:
+            begin
+              cg.a_op_const_reg_reg(list,op,OS_32,lo(value),regsrc.reglo,regdst.reglo);
+              cg.a_op_const_reg_reg(list,op,OS_32,hi(value),regsrc.reghi,regdst.reghi);
+            end;
+          OP_ADD:
+            begin
+              if is_shifter_const(lo(value),b) then
+                list.concat(setoppostfix(taicpu.op_reg_reg_const(A_ADD,regdst.reglo,regsrc.reglo,lo(value)),PF_S))
+              else
+                begin
+                  tmpreg:=rg.getregisterint(list,OS_32);
+                  cg.a_load_const_reg(list,OS_32,lo(value),tmpreg);
+                  list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc.reglo,tmpreg),PF_S));
+                  rg.ungetregisterint(list,tmpreg);
+                end;
+
+              if is_shifter_const(hi(value),b) then
+                list.concat(taicpu.op_reg_reg_const(A_ADC,regdst.reghi,regsrc.reghi,hi(value)))
+              else
+                begin
+                  tmpreg:=rg.getregisterint(list,OS_32);
+                  cg.a_load_const_reg(list,OS_32,hi(value),tmpreg);
+                  list.concat(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc.reghi,tmpreg));
+                  rg.ungetregisterint(list,tmpreg);
+                end;
+            end;
+          OP_SUB:
+            begin
+              if is_shifter_const(lo(value),b) then
+                list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SUB,regdst.reglo,regsrc.reglo,lo(value)),PF_S))
+              else
+                begin
+                  tmpreg:=rg.getregisterint(list,OS_32);
+                  cg.a_load_const_reg(list,OS_32,lo(value),tmpreg);
+                  list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc.reglo,tmpreg),PF_S));
+                  rg.ungetregisterint(list,tmpreg);
+                end;
+
+              if is_shifter_const(hi(value),b) then
+                list.concat(taicpu.op_reg_reg_const(A_SBC,regdst.reghi,regsrc.reghi,hi(value)))
+              else
+                begin
+                  tmpreg:=rg.getregisterint(list,OS_32);
+                  cg.a_load_const_reg(list,OS_32,hi(value),tmpreg);
+                  list.concat(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc.reghi,tmpreg));
+                  rg.ungetregisterint(list,tmpreg);
+                end;
+            end;
+          else
+            internalerror(2003083101);
+        end;
       end;
 
 
     procedure tcg64farm.a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64);
-      var
-        instr : taicpu;
       begin
         case op of
           OP_AND,OP_OR,OP_XOR:
@@ -849,16 +1101,12 @@ unit cgcpu;
             end;
           OP_ADD:
             begin
-              instr:=taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc1.reglo,regsrc2.reglo);
-              instr.oppostfix:=PF_S;
-              list.concat(instr);
+              list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc1.reglo,regsrc2.reglo),PF_S));
               list.concat(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc1.reghi,regsrc2.reghi));
             end;
           OP_SUB:
             begin
-              instr:=taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc2.reglo,regsrc1.reglo);
-              instr.oppostfix:=PF_S;
-              list.concat(instr);
+              list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc2.reglo,regsrc1.reglo),PF_S));
               list.concat(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc2.reghi,regsrc1.reghi));
             end;
           else
@@ -873,7 +1121,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.10  2003-09-01 15:11:16  florian
+  Revision 1.11  2003-09-03 11:18:37  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.10  2003/09/01 15:11:16  florian
     * fixed reference handling
     * fixed operand postfix for floating point instructions
     * fixed wrong shifter constant handling

compiler/cgobj.pas

@@ -369,7 +369,8 @@ unit cgobj;
           {# Generates overflow checking code for a node }
           procedure g_overflowcheck(list: taasmoutput; const l:tlocation; def:tdef); virtual; abstract;
 
-          procedure g_copyvaluepara_openarray(list : taasmoutput;const arrayref,lenref:treference;elesize:integer);virtual;abstract;
+          procedure g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:integer);virtual;abstract;
+//          procedure g_copyvaluepara_openarray(list : taasmoutput;const arrayref,lenref:tparalocation;elesize:integer);virtual;
           {# Emits instructions which should be emitted when entering
              a routine declared as @var(interrupt). The default
              behavior does nothing, should be overriden as required.
@@ -1812,6 +1813,91 @@ unit cgobj;
                             Entry/Exit Code Functions
 *****************************************************************************}
 
+{    procedure tcg.g_copyvaluepara_openarray(list : taasmoutput;const arrayloc,lenloc : tparalocation;elesize:integer);
+      var
+        power,len  : longint;
+        opsize : topsize;
+        r,r2,rsp:Tregister;
+      begin
+      {
+        { get stack space }
+        r.enum:=R_INTREGISTER;
+        r.number:=NR_EDI;
+        rsp.enum:=R_INTREGISTER;
+        rsp.number:=NR_ESP;
+        r2.enum:=R_INTREGISTER;
+        rg.getexplicitregisterint(list,NR_EDI);
+        list.concat(Taicpu.op_ref_reg(A_MOV,S_L,lenref,r));
+        list.concat(Taicpu.op_reg(A_INC,S_L,r));
+        if (elesize<>1) then
+         begin
+           if ispowerof2(elesize, power) then
+             list.concat(Taicpu.op_const_reg(A_SHL,S_L,power,r))
+           else
+             list.concat(Taicpu.op_const_reg(A_IMUL,S_L,elesize,r));
+         end;
+        list.concat(Taicpu.op_reg_reg(A_SUB,S_L,r,rsp));
+        { align stack on 4 bytes }
+        list.concat(Taicpu.op_const_reg(A_AND,S_L,$fffffff4,rsp));
+        { load destination }
+        a_load_reg_reg(list,OS_INT,OS_INT,rsp,r);
+
+        { don't destroy the registers! }
+        r2.number:=NR_ECX;
+        list.concat(Taicpu.op_reg(A_PUSH,S_L,r2));
+        r2.number:=NR_ESI;
+        list.concat(Taicpu.op_reg(A_PUSH,S_L,r2));
+
+        { load count }
+        r2.number:=NR_ECX;
+        a_load_ref_reg(list,OS_INT,OS_INT,lenref,r2);
+
+        { load source }
+        r2.number:=NR_ESI;
+        a_load_ref_reg(list,OS_INT,OS_INT,ref,r2);
+
+        { scheduled .... }
+        r2.number:=NR_ECX;
+        list.concat(Taicpu.op_reg(A_INC,S_L,r2));
+
+        { calculate size }
+        len:=elesize;
+        opsize:=S_B;
+        if (len and 3)=0 then
+         begin
+           opsize:=S_L;
+           len:=len shr 2;
+         end
+        else
+         if (len and 1)=0 then
+          begin
+            opsize:=S_W;
+            len:=len shr 1;
+          end;
+
+        if ispowerof2(len, power) then
+          list.concat(Taicpu.op_const_reg(A_SHL,S_L,power,r2))
+        else
+          list.concat(Taicpu.op_const_reg(A_IMUL,S_L,len,r2));
+        list.concat(Taicpu.op_none(A_REP,S_NO));
+        case opsize of
+          S_B : list.concat(Taicpu.Op_none(A_MOVSB,S_NO));
+          S_W : list.concat(Taicpu.Op_none(A_MOVSW,S_NO));
+          S_L : list.concat(Taicpu.Op_none(A_MOVSD,S_NO));
+        end;
+        rg.ungetregisterint(list,r);
+        r2.number:=NR_ESI;
+        list.concat(Taicpu.op_reg(A_POP,S_L,r2));
+        r2.number:=NR_ECX;
+        list.concat(Taicpu.op_reg(A_POP,S_L,r2));
+
+        { patch the new address }
+        a_load_reg_ref(list,OS_INT,OS_INT,rsp,ref);
+      }
+      end;
+
+}
+
     procedure tcg.g_interrupt_stackframe_entry(list : taasmoutput);
       begin
       end;
@@ -1879,7 +1965,14 @@ finalization
 end.
 {
   $Log$
-  Revision 1.116  2003-08-17 16:59:20  jonas
+  Revision 1.117  2003-09-03 11:18:36  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.116  2003/08/17 16:59:20  jonas
     * fixed regvars so they work with newra (at least for ppc)
     * fixed some volatile register bugs
     + -dnotranslation option for -dnewra, which causes the registers not to

compiler/compiler.pas

@@ -90,6 +90,14 @@ unit compiler;
    {$endif}
    {$endif}
 
+   {$ifdef ARM}
+   {$ifndef CPUOK}
+   {$DEFINE CPUOK}
+   {$else}
+     {$fatal cannot define two CPU switches}
+   {$endif ARM}
+   {$endif ARM}
+
 
    {$ifndef CPUOK}
    {$fatal One of the switches I386, iA64, Alpha, PowerPC or M68K must be defined}
@@ -391,7 +399,14 @@ end;
 end.
 {
   $Log$
-  Revision 1.38  2003-05-22 21:39:51  peter
+  Revision 1.39  2003-09-03 11:18:36  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.38  2003/05/22 21:39:51  peter
     * add cgcpu
 
   Revision 1.37  2003/03/23 23:20:38  hajny

compiler/fpcdefs.inc

@@ -70,6 +70,7 @@
 
 {$ifdef arm}
   {$define callparatemp}
+  {$define cpuneedsdiv32helper}
 {$endif arm}
 
 { FPU Emulator support }
@@ -84,7 +85,14 @@
 
 {
   $Log$
-  Revision 1.22  2003-08-11 21:18:20  peter
+  Revision 1.23  2003-09-03 11:18:36  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.22  2003/08/11 21:18:20  peter
     * start of sparc support for newra
 
   Revision 1.21  2003/07/21 11:52:57  florian

compiler/globals.pas

@@ -175,6 +175,7 @@ interface
        initalignment      : talignmentinfo;
        initoptprocessor,
        initspecificoptprocessor : tprocessors;
+       initfputype        : tfputype;
        initasmmode        : tasmmode;
        initinterfacetype  : tinterfacetypes;
        initoutputformat   : tasm;
@@ -196,6 +197,7 @@ interface
        aktalignment       : talignmentinfo;
        aktoptprocessor,
        aktspecificoptprocessor : tprocessors;
+       aktfputype        : tfputype;
        aktasmmode         : tasmmode;
        aktinterfacetype   : tinterfacetypes;
        aktoutputformat    : tasm;
@@ -1538,6 +1540,9 @@ implementation
 {$ifdef i386}
         initoptprocessor:=Class386;
         initspecificoptprocessor:=Class386;
+
+        initfputype:=fpu_x87;
+
         initpackenum:=4;
         {$IFDEF testvarsets}
         initsetalloc:=0;
@@ -1559,6 +1564,7 @@ implementation
          initsetalloc:=0;
         {$ENDIF}
         initasmmode:=asmmode_direct;
+        initfputype:=fpu_standard;
 {$endif powerpc}
 {$ifdef sparc}
         initoptprocessor:=SPARC_V8;
@@ -1568,6 +1574,14 @@ implementation
         {$ENDIF}
         initasmmode:=asmmode_direct;
 {$endif sparc}
+{$ifdef arm}
+        initpackenum:=4;
+        {$IFDEF testvarsets}
+        initsetalloc:=0;
+        {$ENDIF}
+        initasmmode:=asmmode_direct;
+        initfputype:=fpu_fpa;
+{$endif arm}
         initinterfacetype:=it_interfacecom;
         initdefproccall:=pocall_none;
         initdefines:=TStringList.Create;
@@ -1583,7 +1597,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.92  2003-05-23 22:33:48  florian
+  Revision 1.93  2003-09-03 11:18:36  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.92  2003/05/23 22:33:48  florian
     * fix some small flaws which prevent sparc linux system unit from compiling
     * some reformatting done
 

compiler/i386/cpubase.inc

@@ -95,6 +95,8 @@
 
       maxfpuvarregs = 8;
 
+      maxmmvarregs = 8;
+
       {# Registers which are defined as scratch and no need to save across
          routine calls or in assembler blocks.
       }
@@ -208,7 +210,14 @@
 
 {
   $Log$
-  Revision 1.7  2003-07-06 17:58:22  peter
+  Revision 1.8  2003-09-03 11:18:37  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.7  2003/07/06 17:58:22  peter
     * framepointer fixes for sparc
     * parent framepointer code more generic
 

compiler/i386/cpuinfo.pas

@@ -54,6 +54,14 @@ Type
        ClassP6
       );
 
+   tfputype =
+     (no_fpuprocessor,
+      fpu_soft,
+      fpu_x87,
+      fpu_sse,
+      fpu_sse2
+     );
+
 
 Const
    {# Size of native extended floating point type }
@@ -77,7 +85,14 @@ Implementation
 end.
 {
   $Log$
-  Revision 1.16  2002-12-05 14:18:09  florian
+  Revision 1.17  2003-09-03 11:18:37  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.16  2002/12/05 14:18:09  florian
     * two comments fixed
 
   Revision 1.15  2002/09/07 20:48:43  carl

compiler/ncgadd.pas

@@ -55,7 +55,7 @@ interface
           procedure second_add64bit;virtual;
           procedure second_addordinal;virtual;
           procedure second_cmpfloat;virtual;abstract;
-          procedure second_cmpboolean;virtual;abstract;
+          procedure second_cmpboolean;virtual;
           procedure second_cmpsmallset;virtual;abstract;
           procedure second_cmp64bit;virtual;abstract;
           procedure second_cmpordinal;virtual;abstract;
@@ -702,6 +702,12 @@ interface
       end;
 
 
+    procedure tcgaddnode.second_cmpboolean;
+      begin
+         second_cmpordinal;
+      end;
+
+
 {*****************************************************************************
                                 pass_2
 *****************************************************************************}
@@ -754,7 +760,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.15  2003-07-08 21:24:59  peter
+  Revision 1.16  2003-09-03 11:18:36  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.15  2003/07/08 21:24:59  peter
     * sparc fixes
 
   Revision 1.14  2003/07/06 17:44:12  peter

compiler/ncgflw.pas

@@ -918,7 +918,6 @@ implementation
      end;
 
 
-
     { does the necessary things to clean up the object stack }
     { in the except block                                    }
     procedure cleanupobjectstack;
@@ -1544,7 +1543,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.76  2003-08-24 21:38:43  olle
+  Revision 1.77  2003-09-03 11:18:36  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.76  2003/08/24 21:38:43  olle
     * made FPC_RAISEEXCEPTION compatible with MacOS
 
   Revision 1.75  2003/08/10 17:25:23  peter

compiler/ncgld.pas

@@ -672,7 +672,7 @@ implementation
          end;
 
         if releaseright then
-         location_release(exprasmlist,right.location);
+          location_release(exprasmlist,right.location);
         location_release(exprasmlist,left.location);
 
         truelabel:=otlabel;
@@ -938,7 +938,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.77  2003-08-20 20:13:08  daniel
+  Revision 1.78  2003-09-03 11:18:37  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.77  2003/08/20 20:13:08  daniel
     * Fixed the fixed trouble
 
   Revision 1.76  2003/08/20 20:11:24  daniel

compiler/ncgmat.pas

@@ -97,6 +97,8 @@ type
       end;
 
       tcgshlshrnode = class(tshlshrnode)
+         procedure second_64bit;virtual;
+         procedure second_integer;virtual;
          procedure pass_2;override;
       end;
 
@@ -354,119 +356,127 @@ implementation
 *****************************************************************************}
 
 
-    procedure tcgshlshrnode.pass_2;
+    procedure tcgshlshrnode.second_64bit;
       var
-         hcountreg : tregister;
-         op : topcg;
-         pushedregs : tmaybesave;
          freescratch : boolean;
+         op : topcg;
       begin
-         freescratch:=false;
-         secondpass(left);
-      {$ifndef newra}
-         maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
-      {$endif newra}
-         secondpass(right);
-      {$ifndef newra}
-         maybe_restore(exprasmlist,left.location,pushedregs);
-      {$endif}
+{$ifdef cpu64bit}
          { determine operator }
          case nodetype of
            shln: op:=OP_SHL;
            shrn: op:=OP_SHR;
          end;
+         freescratch:=false;
+         location_reset(location,LOC_REGISTER,OS_64);
 
-         if is_64bit(left.resulttype.def) then
+         { load left operator in a register }
+         location_force_reg(exprasmlist,left.location,OS_64,false);
+         location_copy(location,left.location);
+
+         if (right.nodetype=ordconstn) then
+           begin
+              cg64.a_op64_const_reg(exprasmlist,op,tordconstnode(right).value,
+                joinreg64(location.registerlow,location.registerhigh));
+           end
+         else
            begin
-              { already hanled in 1st pass }
-              internalerror(2002081501);
-(*  Normally for 64-bit cpu's this here should be here,
-    and only pass_1 need to be overriden, but dunno how to
-    do that!
-              location_reset(location,LOC_REGISTER,OS_64);
-
-              { load left operator in a register }
-              location_force_reg(exprasmlist,left.location,OS_64,false);
-              location_copy(location,left.location);
-
-              if (right.nodetype=ordconstn) then
+             { this should be handled in pass_1 }
+             internalerror(2002081501);
+
+              if right.location.loc<>LOC_REGISTER then
                 begin
-                   cg64.a_op64_const_reg(exprasmlist,op,tordconstnode(right).value,
-                     joinreg64(location.registerlow,location.registerhigh));
+                  if right.location.loc<>LOC_CREGISTER then
+                   location_release(exprasmlist,right.location);
+                  hcountreg:=cg.get_scratch_reg_int(exprasmlist);
+                  cg.a_load_loc_reg(exprasmlist,right.location.size,right.location,hcountreg);
+                  freescratch := true;
                 end
               else
-                begin
-                  { this should be handled in pass_1 }
-                  internalerror(2002081501);
-
-                   if right.location.loc<>LOC_REGISTER then
-                     begin
-                       if right.location.loc<>LOC_CREGISTER then
-                        location_release(exprasmlist,right.location);
-                       hcountreg:=cg.get_scratch_reg_int(exprasmlist);
-                       cg.a_load_loc_reg(exprasmlist,right.location.size,right.location,hcountreg);
-                       freescratch := true;
-                     end
-                   else
-                      hcountreg:=right.location.register;
-                   cg64.a_op64_reg_reg(exprasmlist,op,hcountreg,
-                     joinreg64(location.registerlow,location.registerhigh));
-                   if freescratch then
-                      cg.free_scratch_reg(exprasmlist,hcountreg);
-                end;*)
+                 hcountreg:=right.location.register;
+              cg64.a_op64_reg_reg(exprasmlist,op,hcountreg,
+                joinreg64(location.registerlow,location.registerhigh));
+              if freescratch then
+                 cg.free_scratch_reg(exprasmlist,hcountreg);
+           end;
+{$else cpu64bit}
+         { already hanled in 1st pass }
+         internalerror(2002081501);
+{$endif cpu64bit}
+      end;
+
+    procedure tcgshlshrnode.second_integer;
+      var
+         freescratch : boolean;
+         op : topcg;
+         hcountreg : tregister;
+      begin
+         freescratch:=false;
+         { determine operator }
+         case nodetype of
+           shln: op:=OP_SHL;
+           shrn: op:=OP_SHR;
+         end;
+         { load left operators in a register }
+         location_copy(location,left.location);
+         location_force_reg(exprasmlist,location,OS_INT,false);
+
+         { shifting by a constant directly coded: }
+         if (right.nodetype=ordconstn) then
+           begin
+              { l shl 32 should 0 imho, but neither TP nor Delphi do it in this way (FK)
+              if right.value<=31 then
+              }
+              cg.a_op_const_reg(exprasmlist,op,location.size,
+                tordconstnode(right).value and 31,location.register);
+              {
+              else
+                emit_reg_reg(A_XOR,S_L,hregister1,
+                  hregister1);
+              }
            end
          else
            begin
-              { load left operators in a register }
-              location_copy(location,left.location);
-              location_force_reg(exprasmlist,location,OS_INT,false);
-
-              { shifting by a constant directly coded: }
-              if (right.nodetype=ordconstn) then
+              { load right operators in a register - this
+                is done since most target cpu which will use this
+                node do not support a shift count in a mem. location (cec)
+              }
+              if right.location.loc<>LOC_REGISTER then
                 begin
-                   { l shl 32 should 0 imho, but neither TP nor Delphi do it in this way (FK)
-                   if right.value<=31 then
-                   }
-                   cg.a_op_const_reg(exprasmlist,op,location.size,
-                     tordconstnode(right).value and 31,location.register);
-                   {
-                   else
-                     emit_reg_reg(A_XOR,S_L,hregister1,
-                       hregister1);
-                   }
+                  if right.location.loc<>LOC_CREGISTER then
+                   location_release(exprasmlist,right.location);
+                {$ifdef newra}
+                  hcountreg:=rg.getregisterint(exprasmlist,OS_INT);
+                {$else}
+                  hcountreg:=cg.get_scratch_reg_int(exprasmlist,OS_INT);
+                {$endif}
+                  freescratch := true;
+                  cg.a_load_loc_reg(exprasmlist,right.location.size,right.location,hcountreg);
                 end
               else
-                begin
-                   { load right operators in a register - this
-                     is done since most target cpu which will use this
-                     node do not support a shift count in a mem. location (cec)
-                   }
-                   if right.location.loc<>LOC_REGISTER then
-                     begin
-                       if right.location.loc<>LOC_CREGISTER then
-                        location_release(exprasmlist,right.location);
-                     {$ifdef newra}
-                       hcountreg:=rg.getregisterint(exprasmlist,OS_INT);
-                     {$else}
-                       hcountreg:=cg.get_scratch_reg_int(exprasmlist,OS_INT);
-                     {$endif}
-                       freescratch := true;
-                       cg.a_load_loc_reg(exprasmlist,right.location.size,right.location,hcountreg);
-                     end
-                   else
-                     hcountreg:=right.location.register;
-                   cg.a_op_reg_reg(exprasmlist,op,OS_INT,hcountreg,location.register);
-                 {$ifdef newra}
-                   if freescratch then
-                      rg.ungetregisterint(exprasmlist,hcountreg);
-                 {$else}
-                   if freescratch then
-                      cg.free_scratch_reg(exprasmlist,hcountreg);
-                 {$endif}
-                end;
+                hcountreg:=right.location.register;
+              cg.a_op_reg_reg(exprasmlist,op,OS_INT,hcountreg,location.register);
+            {$ifdef newra}
+              if freescratch then
+                rg.ungetregisterint(exprasmlist,hcountreg);
+            {$else}
+              if freescratch then
+                cg.free_scratch_reg(exprasmlist,hcountreg);
+            {$endif}
            end;
       end;
 
+    procedure tcgshlshrnode.pass_2;
+      begin
+         secondpass(left);
+         secondpass(right);
+
+         if is_64bit(left.resulttype.def) then
+           second_64bit
+         else
+           second_integer;
+      end;
+
 
 {*****************************************************************************
                                TCGNOTNODE
@@ -514,7 +524,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.15  2003-07-02 22:18:04  peter
+  Revision 1.16  2003-09-03 11:18:37  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.15  2003/07/02 22:18:04  peter
     * paraloc splitted in callerparaloc,calleeparaloc
     * sparc calling convention updates
 

compiler/ncgutil.pas

@@ -214,6 +214,8 @@ implementation
                          location_release(list,p.location);
                          cg.a_jmp_always(list,falselabel);
                        end;
+                     LOC_JUMP:
+                       ;
 {$ifdef cpuflags}
                      LOC_FLAGS :
                        begin
@@ -222,6 +224,8 @@ implementation
                          cg.a_jmp_always(list,falselabel);
                        end;
 {$endif cpuflags}
+                     else
+                       internalerror(200308241);
                    end;
                 end;
            end
@@ -2079,7 +2083,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.137  2003-08-20 20:29:06  daniel
+  Revision 1.138  2003-09-03 11:18:37  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.137  2003/08/20 20:29:06  daniel
     * Some more R_NO changes
     * Preventive code to loadref added
 

compiler/nmat.pas

@@ -38,6 +38,7 @@ interface
           { parts explicitely in the code generator (JM)    }
           function first_moddiv64bitint: tnode; virtual;
           function firstoptimize: tnode; virtual;
+          function first_moddivint: tnode; virtual;
        end;
        tmoddivnodeclass = class of tmoddivnode;
 
@@ -236,6 +237,38 @@ implementation
       end;
 
 
+    function tmoddivnode.first_moddivint: tnode;
+      var
+        procname: string[31];
+      begin
+{$ifdef cpuneedsdiv32helper}
+      begin
+        result := nil;
+
+        { otherwise create a call to a helper }
+        if nodetype = divn then
+          procname := 'fpc_div_'
+        else
+          procname := 'fpc_mod_';
+        { only qword needs the unsigned code, the
+          signed code is also used for currency }
+        if is_signed(resulttype.def) then
+          procname := procname + 'longint'
+        else
+          procname := procname + 'dword';
+
+        result := ccallnode.createintern(procname,ccallparanode.create(left,
+          ccallparanode.create(right,nil)));
+        left := nil;
+        right := nil;
+        firstpass(result);
+      end;
+{$else cpuneedsdiv32helper}
+        result:=nil;
+{$endif cpuneedsdiv32helper}
+      end;
+
+
     function tmoddivnode.first_moddiv64bitint: tnode;
       var
         procname: string[31];
@@ -351,6 +384,9 @@ implementation
            end
          else
            begin
+             result := first_moddivint;
+             if assigned(result) then
+               exit;
              left_right_max;
              if left.registers32<=right.registers32 then
               inc(registers32);
@@ -795,7 +831,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.49  2003-05-24 16:32:34  jonas
+  Revision 1.50  2003-09-03 11:18:37  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.49  2003/05/24 16:32:34  jonas
     * fixed expectloc of notnode for all processors that have flags
 
   Revision 1.48  2003/05/09 17:47:02  peter

compiler/nmem.pas

@@ -382,6 +382,7 @@ implementation
          if not(left.expectloc in [LOC_CREFERENCE,LOC_REFERENCE]) then
            begin
              aktfilepos:=left.fileinfo;
+             printnode(output,left);
              CGMessage(cg_e_illegal_expression);
            end;
 
@@ -854,7 +855,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.60  2003-08-10 17:25:23  peter
+  Revision 1.61  2003-09-03 11:18:37  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.60  2003/08/10 17:25:23  peter
     * fixed some reported bugs
 
   Revision 1.59  2003/06/17 19:24:08  jonas

compiler/node.pas

@@ -619,7 +619,8 @@ implementation
         else
           write(t,' ,resulttype = <nil>');
         writeln(t,', pos = (',fileinfo.line,',',fileinfo.column,')',
-                  ', loc = ',tcgloc2str[location.loc],
+                  // ', loc = ',tcgloc2str[location.loc],
+                  ', expectloc = ',tcgloc2str[expectloc],
                   ', intregs = ',registers32,
                   ', fpuregs = ',registersfpu);
       end;
@@ -980,7 +981,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.63  2003-08-10 17:25:23  peter
+  Revision 1.64  2003-09-03 11:18:37  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.63  2003/08/10 17:25:23  peter
     * fixed some reported bugs
 
   Revision 1.62  2003/05/26 21:17:17  peter

compiler/options.pas

@@ -370,6 +370,7 @@ var
   j,l  : longint;
   d    : DirStr;
   e    : ExtStr;
+  s    : string;
   forceasm : tasm;
 begin
   if opt='' then
@@ -483,6 +484,26 @@ begin
                            include(initmoduleswitches,cs_fp_emulation);
                        end;
 {$endif cpufpemu}
+{$ifdef arm}
+                   'f' :
+                     begin
+                       s:=upper(copy(more,j+1,length(more)-j));
+                       if s='SOFT' then
+                         initfputype:=fpu_soft
+                       else if s='FPA' then
+                         initfputype:=fpu_fpa
+                       else if s='FPA10' then
+                         initfputype:=fpu_fpa10
+                       else if s='FPA11' then
+                         initfputype:=fpu_fpa11
+                       else if s='VFP' then
+                         initfputype:=fpu_vfp
+                       else
+                         IllegalPara(opt);
+                       break;
+                     end;
+{$endif arm}
+
                     'h' :
                        begin
                          val(copy(more,j+1,length(more)-j),heapsize,code);
@@ -1700,6 +1721,12 @@ begin
   def_symbol('CPUVIS');
   def_symbol('CPU32');
 {$endif}
+{$ifdef arm}
+  def_symbol('CPUARM');
+  def_symbol('CPU32');
+  def_symbol('FPC_HAS_TYPE_DOUBLE');
+  def_symbol('FPC_HAS_TYPE_SINGLE');
+{$endif arm}
 
 { get default messagefile }
 {$ifdef Delphi}
@@ -1925,7 +1952,14 @@ finalization
 end.
 {
   $Log$
-  Revision 1.99  2003-05-13 19:14:41  peter
+  Revision 1.100  2003-09-03 11:18:37  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.99  2003/05/13 19:14:41  peter
     * failn removed
     * inherited result code check moven to pexpr
 

compiler/parser.pas

@@ -281,6 +281,7 @@ implementation
           oldaktoutputformat : tasm;
           oldaktspecificoptprocessor,
           oldaktoptprocessor : tprocessors;
+          oldaktfputype      : tfputype;
           oldaktasmmode      : tasmmode;
           oldaktinterfacetype: tinterfacetypes;
           oldaktmodeswitches : tmodeswitches;
@@ -355,6 +356,7 @@ implementation
             oldaktmoduleswitches:=aktmoduleswitches;
             oldaktalignment:=aktalignment;
             oldaktpackenum:=aktpackenum;
+            oldaktfputype:=aktfputype;
             oldaktmaxfpuregisters:=aktmaxfpuregisters;
             oldaktoutputformat:=aktoutputformat;
             oldaktoptprocessor:=aktoptprocessor;
@@ -409,6 +411,7 @@ implementation
          aktsetalloc:=initsetalloc;
          {$ENDIF}
          aktalignment:=initalignment;
+         aktfputype:=initfputype;
          aktpackenum:=initpackenum;
          aktoutputformat:=initoutputformat;
          set_target_asm(aktoutputformat);
@@ -542,6 +545,7 @@ implementation
                  set_target_asm(aktoutputformat);
                  aktoptprocessor:=oldaktoptprocessor;
                  aktspecificoptprocessor:=oldaktspecificoptprocessor;
+                 aktfputype:=oldaktfputype;
                  aktasmmode:=oldaktasmmode;
                  aktinterfacetype:=oldaktinterfacetype;
                  aktfilepos:=oldaktfilepos;
@@ -619,7 +623,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.55  2003-06-13 21:19:30  peter
+  Revision 1.56  2003-09-03 11:18:37  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.55  2003/06/13 21:19:30  peter
     * current_procdef removed, use current_procinfo.procdef instead
 
   Revision 1.54  2003/06/12 16:41:51  peter

compiler/pdecsub.pas

@@ -181,6 +181,7 @@ implementation
                   end;
                 vs:=tvarsym.create('$self',vsp,tt);
                 include(vs.varoptions,vo_is_self);
+                include(vs.varoptions,vo_regable);
                 { Insert as hidden parameter }
                 pd.parast.insert(vs);
                 pd.insertpara(vs.vartype,vs,nil,true);
@@ -2167,7 +2168,14 @@ const
 end.
 {
   $Log$
-  Revision 1.129  2003-07-02 22:18:04  peter
+  Revision 1.130  2003-09-03 11:18:37  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.129  2003/07/02 22:18:04  peter
     * paraloc splitted in callerparaloc,calleeparaloc
     * sparc calling convention updates
 

compiler/powerpc/cpubase.pas

@@ -384,7 +384,6 @@ uses
       toptype=(top_none,top_reg,top_ref,top_const,top_symbol,top_bool);
 
       toper=record
-        ot  : longint;
         case typ : toptype of
          top_none   : ();
          top_reg    : (reg:tregister);
@@ -861,7 +860,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.64  2003-08-17 16:59:20  jonas
+  Revision 1.65  2003-09-03 11:18:37  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.64  2003/08/17 16:59:20  jonas
     * fixed regvars so they work with newra (at least for ppc)
     * fixed some volatile register bugs
     + -dnotranslation option for -dnewra, which causes the registers not to

compiler/powerpc/cpuinfo.pas

@@ -46,6 +46,13 @@ Type
        ppc604
       );
 
+   tfputype =
+     (no_fpuprocessor,
+      fpu_soft,
+      fpu_standard
+     );
+
+
 Const
    {# Size of native extended floating point type }
    extended_size = 8;
@@ -67,7 +74,14 @@ Implementation
 end.
 {
   $Log$
-  Revision 1.13  2003-04-26 20:15:22  florian
+  Revision 1.14  2003-09-03 11:18:37  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.13  2003/04/26 20:15:22  florian
     * fixed setjmp record size
 
   Revision 1.12  2002/09/07 20:57:08  carl

compiler/pp.pas

@@ -112,6 +112,12 @@ program pp;
      {$endif CPUDEFINED}
      {$define CPUDEFINED}
    {$endif SPARC}
+   {$ifdef ARM}
+     {$ifdef CPUDEFINED}
+        {$fatal ONLY one of the switches for the CPU type must be defined}
+     {$endif CPUDEFINED}
+     {$define CPUDEFINED}
+   {$endif ARM}
    {$ifndef CPUDEFINED}
      {$fatal A CPU type switch must be defined}
    {$endif CPUDEFINED}
@@ -190,7 +196,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.24  2003-07-07 19:59:41  peter
+  Revision 1.25  2003-09-03 11:18:37  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.24  2003/07/07 19:59:41  peter
     * Fix halt() call
 
   Revision 1.23  2003/07/06 15:31:21  daniel

compiler/psub.pas

@@ -726,9 +726,15 @@ implementation
         if assigned(aktlocaldata) and
            (not aktlocaldata.empty) then
          begin
-           aktproccode.concat(Tai_section.Create(sec_data));
-           aktproccode.concatlist(aktlocaldata);
-           aktproccode.concat(Tai_section.Create(sec_code));
+           { because of the limited constant size of the arm, all data access is done pc relative }
+           if target_info.cpu=cpu_arm then
+             aktproccode.concatlist(aktlocaldata)
+           else
+             begin
+               aktproccode.concat(Tai_section.Create(sec_data));
+               aktproccode.concatlist(aktlocaldata);
+               aktproccode.concat(Tai_section.Create(sec_code));
+             end;
         end;
 
         { add the procedure to the codesegment }
@@ -1306,7 +1312,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.138  2003-08-20 17:48:49  peter
+  Revision 1.139  2003-09-03 11:18:37  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.138  2003/08/20 17:48:49  peter
     * fixed stackalloc to not allocate localst.datasize twice
     * order of stackalloc code fixed for implicit init/final
 

compiler/psystem.pas

@@ -273,6 +273,10 @@ implementation
         ordpointertype:=u32bittype;
         defaultordconsttype:=s32bittype;
 {$endif}
+{$ifdef arm}
+        ordpointertype:=u32bittype;
+        defaultordconsttype:=s32bittype;
+{$endif arm}
       end;
 
 
@@ -344,6 +348,14 @@ implementation
         s80floattype.setdef(tfloatdef.create(s80real));
         s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64)));
 {$endif}
+{$ifdef arm}
+        ordpointertype:=u32bittype;
+        defaultordconsttype:=s32bittype;
+        s32floattype.setdef(tfloatdef.create(s32real));
+        s64floattype.setdef(tfloatdef.create(s64real));
+        s80floattype.setdef(tfloatdef.create(s80real));
+        s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64)));
+{$endif arm}
         { some other definitions }
         voidpointertype.setdef(tpointerdef.create(voidtype));
         charpointertype.setdef(tpointerdef.create(cchartype));
@@ -492,7 +504,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.53  2003-08-10 17:25:23  peter
+  Revision 1.54  2003-09-03 11:18:37  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.53  2003/08/10 17:25:23  peter
     * fixed some reported bugs
 
   Revision 1.52  2003/05/26 21:17:18  peter

compiler/rgobj.pas

@@ -2445,7 +2445,10 @@ unit rgobj;
         ref.index.enum:=R_INTREGISTER;
       {$ifdef i386}
         ref.segment.enum:=R_INTREGISTER;
-      {$endif}
+      {$endif i386}
+      {$ifdef arm}
+        ref.signindex:=1;
+      {$endif arm}
       end;
 
     procedure reference_reset_old(var ref : treference);
@@ -2489,7 +2492,6 @@ unit rgobj;
    end;
 
 
-
 {****************************************************************************
                                   TLocation
 ****************************************************************************}
@@ -2512,6 +2514,9 @@ unit rgobj;
             {$ifdef i386}
               l.reference.segment.enum:=R_INTREGISTER;
             {$endif}
+            {$ifdef arm}
+              l.reference.signindex:=1;
+            {$endif arm}
             end;
         end;
       end;
@@ -2565,7 +2570,14 @@ end.
 
 {
   $Log$
-  Revision 1.67  2003-08-23 10:46:21  daniel
+  Revision 1.68  2003-09-03 11:18:37  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.67  2003/08/23 10:46:21  daniel
     * Register allocator bugfix for h2pas
 
   Revision 1.66  2003/08/17 16:59:20  jonas

compiler/scanner.pas

@@ -2720,8 +2720,12 @@ exit_label:
            end;
          repeat
            case c of
+{$ifndef arm}
+             // the { ... } is used in ARM assembler to define register sets,  so we can't used
+             // it as comment, either (* ... *), /* ... */ or // ... should be used instead
              '{' :
                skipcomment;
+{$endif arm}
              '/' :
                begin
                   readchar;
@@ -2808,7 +2812,14 @@ exit_label:
 end.
 {
   $Log$
-  Revision 1.60  2003-08-10 17:25:23  peter
+  Revision 1.61  2003-09-03 11:18:37  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.60  2003/08/10 17:25:23  peter
     * fixed some reported bugs
 
   Revision 1.59  2003/05/25 10:26:43  peter

compiler/sparc/ncpumat.pas

@@ -2,7 +2,7 @@
     $Id$
     Copyright (c) 1998-2002 by Florian Klaempfl
 
-    Generate PowerPC assembler for math nodes
+    Generate SPARC assembler for math nodes
 
     This program is free software; you can redistribute it and/or modify
     it under the terms of the GNU General Public License as published by
@@ -353,7 +353,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.12  2003-07-06 22:09:32  peter
+  Revision 1.13  2003-09-03 11:18:37  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.12  2003/07/06 22:09:32  peter
     * shr and div fixed
 
   Revision 1.11  2003/06/12 16:43:07  peter

compiler/symdef.pas

@@ -739,6 +739,9 @@ interface
 {$ifdef vis}
        pbestrealtype : ^ttype = @s64floattype;
 {$endif vis}
+{$ifdef ARM}
+       pbestrealtype : ^ttype = @s64floattype;
+{$endif ARM}
 
     function mangledname_prefix(typeprefix:string;st:tsymtable):string;
 
@@ -5838,7 +5841,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.158  2003-08-11 21:18:20  peter
+  Revision 1.159  2003-09-03 11:18:37  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.158  2003/08/11 21:18:20  peter
     * start of sparc support for newra
 
   Revision 1.157  2003/07/08 15:20:56  peter

compiler/symsym.pas

@@ -1,4 +1,4 @@
- {
+{
     $Id$
     Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller
 
@@ -2669,7 +2669,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.113  2003-08-20 20:29:06  daniel
+  Revision 1.114  2003-09-03 11:18:37  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.113  2003/08/20 20:29:06  daniel
     * Some more R_NO changes
     * Preventive code to loadref added
 

compiler/systems/i_linux.pas

@@ -420,7 +420,7 @@ unit i_linux;
             name         : 'Linux for ARM';
             shortname    : 'linux';
             flags        : [];
-            cpu          : cpu_SPARC;
+            cpu          : cpu_arm;
             unit_env     : 'LINUXUNITS';
             extradefines : 'UNIX;HASUNIX';
             sourceext    : '.pp';
@@ -454,7 +454,7 @@ unit i_linux;
             ar           : ar_gnu_ar;
             res          : res_none;
             script       : script_unix;
-            endian       : endian_big;
+            endian       : endian_little;
             alignment    :
               (
                 procalign       : 4;
@@ -522,7 +522,14 @@ initialization
 end.
 {
   $Log$
-  Revision 1.10  2003-07-21 11:52:57  florian
+  Revision 1.11  2003-09-03 11:18:37  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.10  2003/07/21 11:52:57  florian
     * very basic stuff for the arm
 
   Revision 1.9  2003/07/06 17:58:22  peter

compiler/x86/cpubase.pas

@@ -57,13 +57,13 @@ uses
       TAsmOp={$i i386op.inc}
 {$endif x86_64}
 
-      {# This should define the array of instructions as string }
+      { This should define the array of instructions as string }
       op2strtable=array[tasmop] of string[11];
 
     const
-      {# First value of opcode enumeration }
+      { First value of opcode enumeration }
       firstop = low(tasmop);
-      {# Last value of opcode enumeration  }
+      { Last value of opcode enumeration  }
       lastop  = high(tasmop);
 
 {*****************************************************************************
@@ -723,7 +723,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.13  2003-08-20 07:48:04  daniel
+  Revision 1.14  2003-09-03 11:18:37  florian
+    * fixed arm concatcopy
+    + arm support in the common compiler sources added
+    * moved some generic cg code around
+    + tfputype added
+    * ...
+
+  Revision 1.13  2003/08/20 07:48:04  daniel
     * Made internal assembler use new register coding
 
   Revision 1.12  2003/08/17 16:59:20  jonas