Merged revisions 10597,10625,10870-10871 via svnmerge from

svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
r10597 | peter | 2008-04-02 09:05:31 +0100 (Wed, 02 Apr 2008) | 2 lines

  * fix parameter allocation for left to right calling conventions

........
r10625 | florian | 2008-04-10 20:47:49 +0100 (Thu, 10 Apr 2008) | 2 lines

* fix by Jan Bruns for #11042: improves reading of references on arm

........
r10870 | florian | 2008-05-02 22:15:10 +0100 (Fri, 02 May 2008) | 2 lines

+ allow dyn. arrays to be published, resolves #10493

........
r10871 | florian | 2008-05-02 22:25:04 +0100 (Fri, 02 May 2008) | 3 lines

* updated version and copyright
* removed Alt-X shortcut, non working and makes no sense, resolves #6529

........

git-svn-id: branches/fixes_2_2@11685 -

.gitattributes

@@ -7988,6 +7988,7 @@ tests/webtbs/tw1044.pp svneol=native#text/plain
 tests/webtbs/tw10454.pp svneol=native#text/plain
 tests/webtbs/tw1046.pp svneol=native#text/plain
 tests/webtbs/tw10489.pp svneol=native#text/plain
+tests/webtbs/tw10493.pp svneol=native#text/plain
 tests/webtbs/tw10495.pp svneol=native#text/plain
 tests/webtbs/tw1050.pp svneol=native#text/plain
 tests/webtbs/tw10519.pp svneol=native#text/plain
@@ -8024,6 +8025,7 @@ tests/webtbs/tw11006.pp svneol=native#text/plain
 tests/webtbs/tw1103.pp svneol=native#text/plain
 tests/webtbs/tw11033.pp svneol=native#text/plain
 tests/webtbs/tw1104.pp svneol=native#text/plain
+tests/webtbs/tw11042.pp svneol=native#text/plain
 tests/webtbs/tw11053.pp svneol=native#text/plain
 tests/webtbs/tw1111.pp svneol=native#text/plain
 tests/webtbs/tw11139.pp svneol=native#text/plain

compiler/arm/raarmgas.pas

@@ -128,96 +128,352 @@ Unit raarmgas;
         { typecasting? }
         if (actasmtoken=AS_LPAREN) and
            SearchType(tempstr,typesize) then
-         begin
-           oper.hastype:=true;
-           Consume(AS_LPAREN);
-           BuildOperand(oper);
-           Consume(AS_RPAREN);
-           if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
-             oper.SetSize(typesize,true);
-         end
+          begin
+            oper.hastype:=true;
+            Consume(AS_LPAREN);
+            BuildOperand(oper);
+            Consume(AS_RPAREN);
+            if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
+              oper.SetSize(typesize,true);
+          end
         else
-         if not oper.SetupVar(tempstr,false) then
-          Message1(sym_e_unknown_id,tempstr);
+          if not oper.SetupVar(tempstr,false) then
+            Message1(sym_e_unknown_id,tempstr);
         { record.field ? }
         if actasmtoken=AS_DOT then
-         begin
-           BuildRecordOffsetSize(tempstr,l,k,mangledname,false);
-           if (mangledname<>'') then
-             Message(asmr_e_invalid_reference_syntax);
-           inc(oper.opr.ref.offset,l);
-         end;
+          begin
+            BuildRecordOffsetSize(tempstr,l,k,mangledname,false);
+            if (mangledname<>'') then
+              Message(asmr_e_invalid_reference_syntax);
+            inc(oper.opr.ref.offset,l);
+          end;
       end;
 
 
     Procedure tarmattreader.BuildReference(oper : tarmoperand);
 
-      procedure Consume_RBracket;
+      procedure do_error;
         begin
-          if actasmtoken<>AS_RBRACKET then
-           Begin
-             Message(asmr_e_invalid_reference_syntax);
-             RecoverConsume(true);
-           end
-          else
-           begin
-             Consume(AS_RBRACKET);
-             if not (actasmtoken in [AS_COMMA,AS_SEPARATOR,AS_END]) then
-              Begin
-                Message(asmr_e_invalid_reference_syntax);
-                RecoverConsume(true);
-              end;
-           end;
+          Message(asmr_e_invalid_reference_syntax);
+          RecoverConsume(false);
         end;
 
 
-      procedure read_index;
+      procedure test_end(require_rbracket : boolean);
         begin
-          Consume(AS_COMMA);
-          if actasmtoken=AS_REGISTER then
-            Begin
-              oper.opr.ref.index:=actasmregister;
-              Consume(AS_REGISTER);
-            end
-          else if actasmtoken=AS_HASH then
+          if require_rbracket then begin
+            if not(actasmtoken=AS_RBRACKET) then 
+              begin 
+                do_error; 
+                exit; 
+              end
+            else 
+              Consume(AS_RBRACKET);
+            if (actasmtoken=AS_NOT) then 
+              begin
+                oper.opr.ref.addressmode:=AM_PREINDEXED;
+                Consume(AS_NOT);
+              end;
+          end;
+          if not(actasmtoken in [AS_SEPARATOR,AS_end]) then 
+            do_error
+          else 
             begin
-              Consume(AS_HASH);
-              inc(oper.opr.ref.offset,BuildConstExpression(false,true));
+{$IFDEF debugasmreader}
+              writeln('TEST_end_FINAL_OK. Created the following ref:');
+              writeln('oper.opr.ref.shiftimm=',oper.opr.ref.shiftimm);
+              writeln('oper.opr.ref.shiftmode=',ord(oper.opr.ref.shiftmode));
+              writeln('oper.opr.ref.index=',ord(oper.opr.ref.index));
+              writeln('oper.opr.ref.base=',ord(oper.opr.ref.base));
+              writeln('oper.opr.ref.signindex=',ord(oper.opr.ref.signindex));
+              writeln('oper.opr.ref.addressmode=',ord(oper.opr.ref.addressmode));
+              writeln;
+{$endIF debugasmreader}
             end;
         end;
 
 
-      begin
-        Consume(AS_LBRACKET);
-        if actasmtoken=AS_REGISTER then
-          begin
-            oper.opr.ref.base:=actasmregister;
-            Consume(AS_REGISTER);
-            { can either be a register or a right parenthesis }
-            { (reg)        }
-            if actasmtoken=AS_RBRACKET then
-             Begin
-               Consume_RBracket;
-               oper.opr.ref.addressmode:=AM_POSTINDEXED;
-               if actasmtoken=AS_COMMA then
-                 read_index;
-               exit;
-             end;
-            if actasmtoken=AS_COMMA then
+      function is_shifter_ref_operation(var a : tshiftmode) : boolean;
+        begin
+          a := SM_NONE;
+          if      (actasmpattern='LSL') then 
+            a := SM_LSL
+          else if (actasmpattern='LSR') then 
+            a := SM_LSR
+          else if (actasmpattern='ASR') then 
+            a := SM_ASR
+          else if (actasmpattern='ROR') then 
+            a := SM_ROR
+          else if (actasmpattern='RRX') then 
+            a := SM_RRX;
+          is_shifter_ref_operation := not(a=SM_NONE);
+        end;
+
+
+      procedure read_index_shift(require_rbracket : boolean);
+        begin
+          case actasmtoken of
+            AS_COMMA : 
+              begin
+                Consume(AS_COMMA);
+                if not(actasmtoken=AS_ID) then 
+                  do_error;
+                if is_shifter_ref_operation(oper.opr.ref.shiftmode) then 
+                  begin
+                    Consume(AS_ID);
+                    if not(oper.opr.ref.shiftmode=SM_RRX) then 
+                      begin
+                        if not(actasmtoken=AS_HASH) then 
+                          do_error;
+                        Consume(AS_HASH);
+                        oper.opr.ref.shiftimm := BuildConstExpression(false,true);
+                        if (oper.opr.ref.shiftimm<0) or (oper.opr.ref.shiftimm>32) then 
+                          do_error;
+                        test_end(require_rbracket);
+                      end;
+                   end 
+                 else 
+                   begin 
+                     do_error; 
+                     exit; 
+                   end;
+              end;
+            AS_RBRACKET : 
+              if require_rbracket then 
+                test_end(require_rbracket)
+              else 
+                begin 
+                  do_error; 
+                  exit; 
+                end;
+            AS_SEPARATOR,AS_END : 
+              if not require_rbracket then 
+                test_end(false)
+               else 
+                 do_error; 
+            else 
               begin
-                read_index;
-                Consume_RBracket;
+                do_error; 
+                exit;
               end;
-            if actasmtoken=AS_NOT then
+          end;
+        end;
+
+
+      procedure read_index(require_rbracket : boolean);
+        var 
+          i : longint; 
+          w : word; 
+          recname : string; 
+          o_int,s_int : aint;
+        begin
+          case actasmtoken of
+            AS_REGISTER : 
               begin
-                consume(AS_NOT);
+                oper.opr.ref.index:=actasmregister;  
+                Consume(AS_REGISTER);
+                read_index_shift(require_rbracket);
+                exit;
+              end;
+            AS_PLUS,AS_MINUS : 
+              begin
+                if actasmtoken=AS_PLUS then 
+                  begin
+                    Consume(AS_PLUS);
+                  end 
+                else 
+                  begin
+                    oper.opr.ref.signindex := -1;
+                    Consume(AS_MINUS);
+                  end;
+                if actasmtoken=AS_REGISTER then 
+                  begin
+                    oper.opr.ref.index:=actasmregister;   
+                    Consume(AS_REGISTER);
+                    read_index_shift(require_rbracket);
+                    exit;
+                  end 
+                else 
+                  begin
+                    do_error; 
+                    exit;
+                  end;
+                test_end(require_rbracket);
+                exit;
+              end;
+            AS_HASH : // constant
+              begin
+                Consume(AS_HASH);
+                o_int := BuildConstExpression(false,true);
+                if (o_int>4095) or (o_int<-4095) then 
+                  begin
+                    Message(asmr_e_constant_out_of_bounds);
+                    RecoverConsume(false);
+                    exit;
+                  end 
+                else 
+                  begin
+                    inc(oper.opr.ref.offset,o_int);
+                    test_end(require_rbracket);
+                    exit;
+                  end;
+              end;
+            AS_ID :
+              begin
+                recname := actasmpattern;
+                Consume(AS_ID);
+                BuildRecordOffsetSize(recname,o_int,s_int,recname,false);
+                if (o_int>4095)or(o_int<-4095) then 
+                  begin
+                    Message(asmr_e_constant_out_of_bounds);
+                    RecoverConsume(false);
+                    exit;
+                  end 
+                else 
+                  begin
+                    inc(oper.opr.ref.offset,o_int);
+                    test_end(require_rbracket);
+                    exit;
+                  end;
+              end;
+            AS_AT: 
+              begin
+                do_error;
+                exit;
+              end;
+            AS_DOT : // local label
+              begin
+                oper.opr.ref.signindex := BuildConstExpression(true,false);
+                test_end(require_rbracket);
+                exit;
+              end;
+            AS_RBRACKET :
+              begin
+                if require_rbracket then 
+                  begin
+                    test_end(require_rbracket);
+                    exit;
+                  end 
+                else 
+                  begin
+                    do_error; // unexpected rbracket
+                    exit;
+                  end;
+              end;
+            AS_SEPARATOR,AS_end : 
+              begin
+                if not require_rbracket then 
+                  begin
+                    test_end(false);
+                    exit;
+                  end 
+                else 
+                  begin
+                    do_error; 
+                    exit;
+                  end;
+              end;
+            else 
+              begin
+                // unexpected token
+                do_error; 
+                exit;
+              end;
+          end; // case
+        end;
+
+
+      procedure try_prepostindexed;
+        begin
+          Consume(AS_RBRACKET);
+          case actasmtoken of
+            AS_COMMA : 
+              begin // post-indexed
+                Consume(AS_COMMA);
+                oper.opr.ref.addressmode:=AM_POSTINDEXED;
+                read_index(false);
+                exit;
+              end;
+            AS_NOT : 
+              begin   // pre-indexed
+                Consume(AS_NOT);
                 oper.opr.ref.addressmode:=AM_PREINDEXED;
+                test_end(false);
+                exit;
               end;
-          end {end case }
-        else
+            else 
+              begin
+                test_end(false);
+                exit;
+              end;
+          end; // case
+        end;
+ 
+      var 
+        lab : TASMLABEL;
+      begin 
+        Consume(AS_LBRACKET);
+        oper.opr.ref.addressmode:=AM_OFFSET; // assume "neither PRE nor POST inc"
+        if actasmtoken=AS_REGISTER then
+          begin
+            oper.opr.ref.base:=actasmregister;
+            Consume(AS_REGISTER);
+            case actasmtoken of
+              AS_RBRACKET : 
+                begin 
+                  try_prepostindexed; 
+                  exit; 
+                end;
+              AS_COMMA : 
+                begin 
+                  Consume(AS_COMMA); 
+                  read_index(true); 
+                  exit; 
+                end;
+              else 
+                begin
+                  Message(asmr_e_invalid_reference_syntax);
+                  RecoverConsume(false);
+                end;
+            end;
+          end
+        else 
+{
+  if base isn't a register, r15=PC is implied base, so it must be a local label.
+  pascal constants don't make sense, because implied r15
+  record offsets probably don't make sense, too (a record offset of code?)
+
+  TODO: However, we could make the Stackpointer implied.
+
+}
+
           Begin
-            Message(asmr_e_invalid_reference_syntax);
-            RecoverConsume(false);
+            case actasmtoken of
+              AS_ID : 
+                begin
+                  if is_locallabel(actasmpattern) then 
+                    begin
+                      CreateLocalLabel(actasmpattern,lab,false);
+                      oper.opr.ref.symbol := lab;
+                      Consume(AS_ID);
+                      test_end(true);
+                      exit;
+                    end 
+                  else 
+                    begin
+                      // TODO: Stackpointer implied, 
+                      Message(asmr_e_invalid_reference_syntax);
+                      RecoverConsume(false);
+                      exit;
+                    end;
+                end;
+              else 
+                begin // elsecase
+                  Message(asmr_e_invalid_reference_syntax);
+                  RecoverConsume(false);
+                  exit;
+                end;
+            end;
           end;
       end;
 
@@ -373,7 +629,7 @@ Unit raarmgas;
                 Begin
                   ReadSym(oper);
                   case actasmtoken of
-                    AS_END,
+                    AS_end,
                     AS_SEPARATOR,
                     AS_COMMA: ;
                     AS_LPAREN:
@@ -529,7 +785,7 @@ Unit raarmgas;
               { save the type of register used. }
               tempreg:=actasmregister;
               Consume(AS_REGISTER);
-              if (actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) then
+              if (actasmtoken in [AS_end,AS_SEPARATOR,AS_COMMA]) then
                 Begin
                   if not (oper.opr.typ in [OPR_NONE,OPR_REGISTER]) then
                     Message(asmr_e_invalid_operand_type);
@@ -578,7 +834,7 @@ Unit raarmgas;
               oper.opr.typ:=OPR_REGSET;
               oper.opr.regset:=registerset;
             end;
-          AS_END,
+          AS_end,
           AS_SEPARATOR,
           AS_COMMA: ;
         else
@@ -617,7 +873,7 @@ Unit raarmgas;
         operandnum:=1;
         Consume(AS_OPCODE);
         { Zero operand opcode ?  }
-        if actasmtoken in [AS_SEPARATOR,AS_END] then
+        if actasmtoken in [AS_SEPARATOR,AS_end] then
          begin
            operandnum:=0;
            exit;
@@ -645,7 +901,7 @@ Unit raarmgas;
                   end;
               end;
             AS_SEPARATOR,
-            AS_END : { End of asm operands for this opcode  }
+            AS_end : { End of asm operands for this opcode  }
               begin
                 break;
               end;

compiler/i386/cpupara.pas

@@ -390,7 +390,12 @@ unit cpupara;
           That means for pushes the para with the
           highest offset (see para3) needs to be pushed first
         }
-        for i:=0 to paras.count-1 do
+        if p.proccalloption in pushleftright_pocalls then
+          i:=paras.count-1
+        else
+          i:=0;
+        while ((p.proccalloption in pushleftright_pocalls) and (i>=0)) or
+              (not(p.proccalloption in pushleftright_pocalls) and (i<=paras.count-1)) do
           begin
             hp:=tparavarsym(paras[i]);
             pushaddr:=push_addr_param(hp.varspez,hp.vardef,p.proccalloption);
@@ -478,6 +483,10 @@ unit cpupara;
                     dec(paralen,l);
                   end;
               end;
+            if p.proccalloption in pushleftright_pocalls then
+              dec(i)
+            else
+              inc(i);
           end;
       end;
 

compiler/symdef.pas

@@ -303,6 +303,7 @@ interface
           { returns the label of the range check string }
           function needs_inittable : boolean;override;
           property elementdef : tdef read _elementdef write setelementdef;
+          function is_publishable : boolean;override;
        end;
 
        torddef = class(tstoreddef)
@@ -2402,6 +2403,11 @@ implementation
       end;
 
 
+    function tarraydef.is_publishable : boolean;
+      begin
+        Result:=ado_IsDynamicArray in arrayoptions;
+      end;
+
 {***************************************************************************
                               tabstractrecorddef
 ***************************************************************************}

installer/install.pas

@@ -201,6 +201,7 @@ program install;
 
      tapp = object(tapplication)
          procedure initmenubar;virtual;
+         procedure initstatusline;virtual;
          procedure handleevent(var event : tevent);virtual;
          procedure do_installdialog;
          procedure readcfg(const fn:string);
@@ -1807,6 +1808,22 @@ end;
     end;
 
 
+  procedure tapp.initstatusline;
+    var
+       R: TRect;
+    begin
+      GetExtent(R);
+      R.A.Y := R.B.Y - 1;
+      R.B.X := R.B.X - 12;
+      New(StatusLine,
+        Init(R,
+          NewStatusDef(0, $EFFF,nil,nil
+          )
+        )
+      );
+    end;
+
+
   procedure tapp.handleevent(var event : tevent);
     begin
        inherited handleevent(event);

tests/webtbs/tw10493.pp

@@ -0,0 +1,16 @@
+{$mode objfpc}
+program test;
+
+type
+  TStringArray = array of String;
+
+  TBug = class
+  private
+    fSA: TStringArray;
+  published
+    property SA: TStringArray read fSA write fSA;
+  end;
+
+begin
+
+end.

tests/webtbs/tw11042.pp

@@ -0,0 +1,39 @@
+{ %cpu=arm }
+{ %norun }
+
+TYPE
+  ttest = record
+    a : shortstring;
+    b : dword;
+  end;
+VAR
+  q : ttest;
+begin
+  asm
+    ldr r0,[r1,r2,lsl #3]
+    ldr r0,[r1]
+    ldr r0,[r1, r2]
+    ldr r0,[r1, -r2]
+    ldr r0,[r1, r2, lsl #23]
+    ldr	r0,[r1, -r2, lsl #23]
+    ldr	r0,[r1, #4095]
+    ldr	r0,[r1, #-4095]
+    ldr	r0,[r1, r2]!
+    ldr	r0,[r1, -r2]!
+    ldr	r0,[r1, r2, lsl #23]!
+    ldr	r0,[r1, -r2, lsl #23]!
+    ldr	r0,[r1, #4095]!
+    ldr	r0,[r1, #-4095]!
+    ldr	r0,[r1], r2
+    ldr	r0,[r1], -r2
+    ldr	r0,[r1], r2, lsl #23
+    ldr	r0,[r1], -r2, lsl #23
+    ldr	r0,[r1], #4095
+    ldr r0,[r1], #-4095
+
+    ldr r0,[r1,q.b]
+
+.Ltest:
+    ldr r0,[.Ltest]
+  end;
+end.