* fixed procedure entry/exit code

  * started to fix reference handling

compiler/arm/aasmcpu.pas

@@ -42,6 +42,7 @@ uses
          oppostfix : TOpPostfix;
          roundingmode : troundingmode;
          procedure loadshifterop(opidx:longint;const so:tshifterop);
+         procedure loadregset(opidx:longint;const s:tsupregset);
          constructor op_none(op : tasmop);
 
          constructor op_reg(op : tasmop;_op1 : tregister);
@@ -50,6 +51,7 @@ uses
          constructor op_reg_reg(op : tasmop;_op1,_op2 : tregister);
          constructor op_reg_ref(op : tasmop;_op1 : tregister;const _op2 : treference);
          constructor op_reg_const(op:tasmop; _op1: tregister; _op2: longint);
+         constructor op_reg_regset(op:tasmop; _op1: tregister; _op2: tsupregset);
 
          constructor op_const_const(op : tasmop;_op1,_op2 : longint);
 
@@ -108,13 +110,30 @@ implementation
         with oper[opidx] do
           begin
             if typ<>top_shifterop then
-              new(shifterop);
+              begin
+                clearop(opidx);
+                new(shifterop);
+              end;
             shifterop^:=so;
             typ:=top_shifterop;
           end;
       end;
 
 
+    procedure taicpu.loadregset(opidx:longint;const s:tsupregset);
+      begin
+        if opidx>=ops then
+         ops:=opidx+1;
+        with oper[opidx] do
+         begin
+           if typ<>top_regset then
+             clearop(opidx);
+           regset:=s;
+           typ:=top_regset;
+         end;
+      end;
+
+
 {*****************************************************************************
                                  taicpu Constructors
 *****************************************************************************}
@@ -167,6 +186,17 @@ implementation
       end;
 
 
+    constructor taicpu.op_reg_regset(op:tasmop; _op1: tregister; _op2: tsupregset);
+      begin
+         inherited create(op);
+         if (_op1.enum = R_INTREGISTER) and (_op1.number = NR_NO) then
+           internalerror(2003031208);
+         ops:=2;
+         loadreg(0,_op1);
+         loadregset(1,_op2);
+      end;
+
+
     constructor taicpu.op_reg_ref(op : tasmop;_op1 : tregister;const _op2 : treference);
       begin
          inherited create(op);
@@ -693,7 +723,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.6  2003-08-28 00:05:29  florian
+  Revision 1.7  2003-08-29 21:36:28  florian
+    * fixed procedure entry/exit code
+    * started to fix reference handling
+
+  Revision 1.6  2003/08/28 00:05:29  florian
     * today's arm patches
 
   Revision 1.5  2003/08/27 00:27:56  florian

compiler/arm/agarmgas.pas

@@ -43,6 +43,10 @@ unit agarmgas;
     var
       gas_reg2str : reg2strtable;
 
+    const
+      gas_shiftmode2str : array[tshiftmode] of string[3] = (
+        '','lsl','lsr','asr','ror','rrx');
+
     function gas_regnum_search(const s:string):Tnewregister;
     function gas_regname(const r:Tnewregister):string;
 
@@ -77,50 +81,62 @@ unit agarmgas;
           );
 
     function getreferencestring(var ref : treference) : string;
-    var
-      s : string;
-    begin
-       with ref do
-        begin
-          inc(offset,offsetfixup);
-
-          if not assigned(symbol) then
-            s := '['
-          else
-            s:='['+symbol.name;
-
-          if offset<0 then
-           s:=s+tostr(offset)
-          else
-           if (offset>0) then
-            begin
-              if assigned(symbol) then
-               s:=s+'+'+tostr(offset)
-              else
-               s:=s+tostr(offset);
-            end;
+      var
+        s : string;
+        nobase,noindex : boolean;
+      begin
+         with ref do
+          begin
+            inc(offset,offsetfixup);
+
+            noindex:=(index.enum=R_NO) or ((index.enum=R_INTREGISTER) and (index.number=NR_NO));
+{$ifdef extdebug}
+            nobase:=(base.enum=R_NO) or ((base.enum=R_INTREGISTER) and (base.number=NR_NO));
+            //!!!! if nobase then
+            //!!!!   internalerror(200308292);
+
+            // !!! if (not(noindex) or (shiftmode<>SM_None)) and ((offset<>0) or (symbol<>nil)) then
+            // !!!   internalerror(200308293);
+{$endif extdebug}
+            if base.enum=R_INTREGISTER then
+              s:='['+gas_regname(base.number)
+            else
+              s:='['+gas_reg2str[base.enum];
+            if addressmode=AM_POSTINDEXED then
+              s:=s+']';
 
-           if (index.enum=R_NO) and (base.enum<>R_NO) then
-             begin
-                if offset=0 then
-                  begin
-                     if assigned(symbol) then
-                       s:=s+'+0'
-                     else
-                       s:=s+'0';
-                  end;
-                if base.enum=R_INTREGISTER then
-                  s:=s+'('+gas_regname(base.number)+')'
-                else
-                  s:=s+'('+gas_reg2str[base.enum]+')';
-             end
-           else if (index.enum<>R_NO) and (base.enum<>R_NO) and (offset=0) then
-             s:=s+std_reg2str[base.enum]+','+std_reg2str[index.enum]
-           else if ((index.enum<>R_NO) or (base.enum<>R_NO)) then
-             internalerror(19992);
-        end;
-      getreferencestring:=s;
-    end;
+            if not(noindex) then
+              begin
+                 if signindex<0 then
+                   s:=s+', -'
+                 else
+                   s:=s+', ';
+
+                 if index.enum=R_INTREGISTER then
+                   s:=s+gas_regname(index.number)
+                 else
+                   s:=s+gas_reg2str[index.enum];
+
+                 if shiftmode<>SM_None then
+                   s:=s+' ,'+gas_shiftmode2str[shiftmode]+' #'+tostr(shiftimm);
+              end
+            else
+              begin
+                { handle symbol and index }
+                if offset<>0 then
+                  s:=s+', #'+tostr(offset);
+                { !!!!!}
+              end;
+
+             case addressmode of
+               AM_OFFSET:
+                 s:=s+']';
+               AM_PREINDEXED:
+                 s:=s+']!';
+             end;
+          end;
+        getreferencestring:=s;
+      end;
 
 
     function getopstr_jmp(const o:toper) : string;
@@ -170,6 +186,8 @@ unit agarmgas;
     function getopstr(const o:toper) : string;
     var
       hs : string;
+      first : boolean;
+      r : tnewregister;
     begin
       case o.typ of
         top_reg:
@@ -194,6 +212,20 @@ unit agarmgas;
           end;
         top_const:
           getopstr:='#'+tostr(longint(o.val));
+        top_regset:
+          begin
+            getopstr:='{';
+            first:=true;
+            for r:=RS_R0 to RS_R15 do
+              if r in o.regset then
+                begin
+                  if not(first) then
+                    getopstr:=getopstr+',';
+                  getopstr:=getopstr+'r'+tostr(r-RS_R0);
+                  first:=false;
+                end;
+            getopstr:=getopstr+'}';
+          end;
         top_ref:
           getopstr:=getreferencestring(o.ref^);
         top_symbol:
@@ -225,9 +257,9 @@ unit agarmgas;
         sep: string[3];
     begin
       op:=taicpu(hp).opcode;
+{
       if is_calljmp(op) then
         begin
-{
           { direct BO/BI in op[0] and op[1] not supported, put them in condition! }
           case op of
              A_B,A_BA,A_BL,A_BLA:
@@ -240,12 +272,12 @@ unit agarmgas;
 
           if (taicpu(hp).oper[0].typ <> top_none) then
             s:=s+getopstr_jmp(taicpu(hp).oper[0]);
-}
         end
       else
+}
         { process operands }
         begin
-          s:=#9+std_op2str[op];
+          s:=#9+std_op2str[op]+cond2str[taicpu(hp).condition]+oppostfix2str[taicpu(hp).oppostfix];
           if taicpu(hp).ops<>0 then
             begin
             {
@@ -292,7 +324,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.5  2003-08-28 13:26:10  florian
+  Revision 1.6  2003-08-29 21:36:28  florian
+    * fixed procedure entry/exit code
+    * started to fix reference handling
+
+  Revision 1.5  2003/08/28 13:26:10  florian
     * another couple of arm fixes
 
   Revision 1.4  2003/08/28 00:05:29  florian

compiler/arm/cgcpu.pas

@@ -54,6 +54,7 @@ unit cgcpu;
           size: tcgsize; src1, src2, dst: tregister); override;
 
         { move instructions }
+        procedure handle_load_store(list:taasmoutput;op: tasmop;oppostfix : toppostfix;reg:tregister;ref: treference);
         procedure a_load_const_reg(list : taasmoutput; size: tcgsize; a : aword;reg : tregister);override;
         procedure a_load_reg_ref(list : taasmoutput; fromsize, tosize: tcgsize; reg : tregister;const ref : treference);override;
         procedure a_load_ref_reg(list : taasmoutput; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);override;
@@ -267,7 +268,7 @@ unit cgcpu;
          tmpreg : tregister;
          so : tshifterop;
        begin
-          if is_shifter_const(a,shift) and (op<>OP_MUL) then
+          if is_shifter_const(a,shift) and (not(op in [OP_IMUL,OP_MUL])) then
             case op of
               OP_NEG,OP_NOT,
               OP_DIV,OP_IDIV:
@@ -316,6 +317,7 @@ unit cgcpu;
        size: tcgsize; src1, src2, dst: tregister);
        var
          so : tshifterop;
+         tmpreg : tregister;
        begin
          case op of
            OP_NEG:
@@ -345,6 +347,23 @@ unit cgcpu;
                so.shiftertype:=SO_LSL;
                list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src1,so));
              end;
+           OP_IMUL,
+           OP_MUL:
+             begin
+               { the arm doesn't allow that rd and rm are the same }
+               if dst.number=src2.number then
+                 begin
+                   if src1.number<>src2.number then
+                     list.concat(taicpu.op_reg_reg_reg(A_MUL,dst,src1,src2))
+                   else
+                     begin
+                       writeln('Warning: Fix MUL');
+                       list.concat(taicpu.op_reg_reg_reg(A_MUL,dst,src2,src1));
+                     end;
+                 end
+               else
+                 list.concat(taicpu.op_reg_reg_reg(A_MUL,dst,src2,src1));
+             end;
            else
              list.concat(taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop[op],dst,src2,src1));
          end;
@@ -398,13 +417,128 @@ unit cgcpu;
        end;
 
 
+    procedure tcgarm.handle_load_store(list:taasmoutput;op: tasmop;oppostfix : toppostfix;reg:tregister;ref: treference);
+      var
+        tmpreg : tregister;
+        tmpref : treference;
+        instr : taicpu;
+      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;
+
+        { When need to use SETHI, do it first }
+        if assigned(ref.symbol) or
+           (ref.offset<-4095) or
+           (ref.offset>4095) then
+          begin
+{
+            tmpreg:=rg.getregisterint(list,OS_INT);
+            reference_reset(tmpref);
+            tmpref.symbol:=ref.symbol;
+            tmpref.offset:=ref.offset;
+            tmpref.symaddr:=refs_hi;
+            list.concat(taicpu.op_ref_reg(A_SETHI,tmpref,tmpreg));
+            { Load the low part is left }
+{$warning TODO Maybe not needed to load symbol}
+            tmpref.symaddr:=refs_lo;
+            list.concat(taicpu.op_reg_ref_reg(A_OR,tmpreg,tmpref,tmpreg));
+            { The offset and symbol are loaded, reset in reference }
+            ref.offset:=0;
+            ref.symbol:=nil;
+            { Only an index register or offset is allowed }
+            if tmpreg.number<>NR_NO then
+              begin
+                if (ref.index.number<>NR_NO) then
+                  begin
+                    list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.index,tmpreg));
+                    ref.index:=tmpreg;
+                  end
+                else
+                  begin
+                    if ref.base.number<>NR_NO then
+                      ref.index:=tmpreg
+                    else
+                      ref.base:=tmpreg;
+                  end;
+              end;
+}
+          end;
+{
+        if (ref.base.number<>NR_NO) then
+          begin
+            if (ref.index.number<>NR_NO) and
+               ((ref.offset<>0) or assigned(ref.symbol)) then
+              begin
+                if tmpreg.number=NR_NO then
+                  tmpreg:=rg.getregisterint(list,OS_INT);
+                if (ref.index.number<>NR_NO) then
+                  begin
+                    list.concat(taicpu.op_reg_reg_reg(A_ADD,ref.base,ref.index,tmpreg));
+                    ref.index.number:=NR_NO;
+                  end;
+              end;
+          end;
+}
+        instr:=taicpu.op_reg_ref(op,reg,ref);
+        instr.oppostfix:=oppostfix;
+        list.concat(instr);
+        if (tmpreg.number<>NR_NO) then
+          rg.ungetregisterint(list,tmpreg);
+      end;
+
+
      procedure tcgarm.a_load_reg_ref(list : taasmoutput; fromsize, tosize: tcgsize; reg : tregister;const ref : treference);
-       begin
+       var
+         oppostfix:toppostfix;
+       begin
+         case ToSize of
+           { signed integer registers }
+           OS_8,
+           OS_S8:
+             oppostfix:=PF_B;
+           OS_16,
+           OS_S16:
+             oppostfix:=PF_H;
+           OS_32,
+           OS_S32:
+             oppostfix:=PF_None;
+           else
+             InternalError(200308295);
+         end;
+         handle_load_store(list,A_STR,oppostfix,reg,ref);
        end;
 
 
      procedure tcgarm.a_load_ref_reg(list : taasmoutput; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);
-       begin
+       var
+         oppostfix:toppostfix;
+       begin
+         case ToSize of
+           { signed integer registers }
+           OS_8:
+             oppostfix:=PF_B;
+           OS_S8:
+             oppostfix:=PF_SB;
+           OS_16:
+             oppostfix:=PF_H;
+           OS_S16:
+             oppostfix:=PF_SH;
+           OS_32,
+           OS_S32:
+             oppostfix:=PF_None;
+           else
+             InternalError(200308291);
+         end;
+         handle_load_store(list,A_LDR,oppostfix,reg,ref);
        end;
 
 
@@ -522,12 +656,59 @@ unit cgcpu;
 
 
      procedure tcgarm.g_stackframe_entry(list : taasmoutput;localsize : longint);
+       var
+         rip,rsp,rfp : tregister;
+         instr : taicpu;
        begin
+         rsp.enum:=R_INTREGISTER;
+         rsp.number:=NR_STACK_POINTER_REG;
+         a_reg_alloc(list,rsp);
+
+         rfp.enum:=R_INTREGISTER;
+         rfp.number:=NR_FRAME_POINTER_REG;
+         a_reg_alloc(list,rfp);
+
+         rip.enum:=R_INTREGISTER;
+         rip.number:=NR_R12;
+         a_reg_alloc(list,rip);
+
+         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_R4]+[RS_R11,RS_R12,RS_R15]);
+         instr.oppostfix:=PF_FD;
+         list.concat(instr);
+
+         list.concat(taicpu.op_reg_reg_const(A_SUB,rfp,rip,4));
+         a_reg_alloc(list,rip);
+
+         { allocate necessary stack size }
+         list.concat(taicpu.op_reg_reg_const(A_SUB,rsp,rsp,4));
        end;
 
 
      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
+             r1.enum:=R_INTREGISTER;
+             r1.number:=NR_R15;
+             r2.enum:=R_INTREGISTER;
+             r2.number:=NR_R14;
+
+             list.concat(taicpu.op_reg_reg(A_MOV,r1,r2));
+           end
+         else
+           begin
+             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_R4]+[RS_R11,RS_R13,RS_R15]);
+             instr.oppostfix:=PF_EA;
+             list.concat(instr);
+           end;
        end;
 
 
@@ -617,7 +798,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.7  2003-08-28 13:26:10  florian
+  Revision 1.8  2003-08-29 21:36:28  florian
+    * fixed procedure entry/exit code
+    * started to fix reference handling
+
+  Revision 1.7  2003/08/28 13:26:10  florian
     * another couple of arm fixes
 
   Revision 1.6  2003/08/28 00:05:29  florian

compiler/arm/cpubase.pas

@@ -134,7 +134,7 @@ uses
       last_supreg = RS_R15;
 
       { registers which may be destroyed by calls }
-      VOLATILE_INTREGISTERS = [RS_R0..RS_R3];
+      VOLATILE_INTREGISTERS = [RS_R0..RS_R3,RS_R12..RS_R15];
       VOLATILE_FPUREGISTERS = [R_F0..R_F3];
 
       { Number of first and last imaginary register. }
@@ -201,7 +201,7 @@ uses
         { load/store }
         PF_B,PF_SB,PF_BT,PF_H,PF_SH,PF_T,
         { multiple load/store address modes }
-        PF_IA,PF_IB,PF_DA,PF_DB,PF_DF,PF_FA,PF_ED,PF_EA
+        PF_IA,PF_IB,PF_DA,PF_DB,PF_FD,PF_FA,PF_ED,PF_EA
       );
 
       TRoundingMode = (RM_None,RM_P,RM_M,RM_Z);
@@ -211,7 +211,7 @@ uses
         's',
         'd','e','p','ep',
         'b','sb','bt','h','sh','t',
-        'ia','ib','da','db','df','fa','ed','ea');
+        'ia','ib','da','db','fd','fa','ed','ea');
 
       roundingmode2str : array[TRoundingMode] of string[1] = ('',
         'p','m','z');
@@ -253,14 +253,15 @@ uses
       trefoptions=(ref_none,ref_parafixup,ref_localfixup,ref_selffixup);
 
       taddressmode = (AM_OFFSET,AM_PREINDEXED,AM_POSTINDEXED);
-      tshiftmode = (SM_LSL,SM_LSR,SM_ASR,SM_ROR,SM_RRX);
+      tshiftmode = (SM_None,SM_LSL,SM_LSR,SM_ASR,SM_ROR,SM_RRX);
 
       { reference record }
       preference = ^treference;
       treference = packed record
          base,
          index       : tregister;
-         scalefactor : byte;
+         shiftimm    : byte;
+         signindex   : shortint;
          offset      : longint;
          symbol      : tasmsymbol;
          offsetfixup : longint;
@@ -483,8 +484,8 @@ uses
                                  Constants
 *****************************************************************************}
 
-      firstsaveintreg = R_R4;
-      lastsaveintreg  = R_R10;
+      firstsaveintreg = RS_R4;
+      lastsaveintreg  = RS_R10;
       firstsavefpureg = R_F4;
       lastsavefpureg  = R_F7;
       firstsavemmreg  = R_S16;
@@ -690,7 +691,11 @@ uses
 end.
 {
   $Log$
-  Revision 1.8  2003-08-28 00:05:29  florian
+  Revision 1.9  2003-08-29 21:36:28  florian
+    * fixed procedure entry/exit code
+    * started to fix reference handling
+
+  Revision 1.8  2003/08/28 00:05:29  florian
     * today's arm patches
 
   Revision 1.7  2003/08/25 23:20:38  florian