* set operand size information when accessing fields in assembly

(mantis #29096)

git-svn-id: trunk@32567 -

.gitattributes

@@ -14884,6 +14884,7 @@ tests/webtbs/tw29053b.pp svneol=native#text/pascal
 tests/webtbs/tw29064.pp svneol=native#text/plain
 tests/webtbs/tw2908.pp svneol=native#text/plain
 tests/webtbs/tw29086.pp -text svneol=native#text/plain
+tests/webtbs/tw29096.pp svneol=native#text/plain
 tests/webtbs/tw2911.pp svneol=native#text/plain
 tests/webtbs/tw2912.pp svneol=native#text/plain
 tests/webtbs/tw2913.pp svneol=native#text/plain

compiler/rautils.pas

@@ -739,15 +739,60 @@ Function TOperand.SetupVar(const s:string;GetOffset : boolean): Boolean;
   end;
 
 
+  procedure setvarsize(sym: tabstractvarsym);
+  var
+    harrdef: tarraydef;
+    l: asizeint;
+  begin
+    case sym.vardef.typ of
+      orddef,
+      enumdef,
+      pointerdef,
+      procvardef,
+      floatdef :
+        SetSize(sym.getsize,false);
+      arraydef :
+        begin
+          { for arrays try to get the element size, take care of
+            multiple indexes }
+          harrdef:=tarraydef(sym.vardef);
+
+          { calc array size }
+          if is_special_array(harrdef) then
+             l := -1
+           else
+             l := harrdef.size;
+
+          case opr.typ of
+            OPR_REFERENCE: opr.varsize := l;
+                OPR_LOCAL: opr.localvarsize := l;
+          end;
+
+
+          while assigned(harrdef.elementdef) and
+                (harrdef.elementdef.typ=arraydef) do
+           harrdef:=tarraydef(harrdef.elementdef);
+          if not is_packed_array(harrdef) then
+            SetSize(harrdef.elesize,false)
+           else
+               if (harrdef.elepackedbitsize mod 8) = 0 then
+                 SetSize(harrdef.elepackedbitsize div 8,false);
+        end;
+      recorddef:
+        case opr.typ of
+          OPR_REFERENCE: opr.varsize := sym.getsize;
+              OPR_LOCAL: opr.localvarsize := sym.getsize;
+        end;
+    end;
+  end;
+
 { search and sets up the correct fields in the Instr record }
 { for the NON-constant identifier passed to the routine.    }
 { if not found returns FALSE.                               }
 var
   sym : tsym;
   srsymtable : TSymtable;
-  harrdef : tarraydef;
   indexreg : tregister;
-  l : aint;
   plist : ppropaccesslistitem;
 Begin
   SetupVar:=false;
@@ -784,6 +829,7 @@ Begin
           setconst(tfieldvarsym(sym).fieldoffset div 8)
         else
           Message(asmr_e_packed_element);
+        setvarsize(tabstractvarsym(sym));
         hasvar:=true;
         SetupVar:=true;
       end;
@@ -838,46 +884,7 @@ Begin
                 SetSize(sizeof(pint),false);
             end;
         end;
-        case tabstractvarsym(sym).vardef.typ of
+        setvarsize(tabstractvarsym(sym));
-          orddef,
-          enumdef,
-          pointerdef,
-          procvardef,
-          floatdef :
-            SetSize(tabstractvarsym(sym).getsize,false);
-          arraydef :
-            begin
-              { for arrays try to get the element size, take care of
-                multiple indexes }
-              harrdef:=tarraydef(tabstractvarsym(sym).vardef);
-
-              { calc array size }
-              if is_special_array(harrdef) then
-                 l := -1
-               else
-                 l := harrdef.size;
-
-              case opr.typ of
-                OPR_REFERENCE: opr.varsize := l;
-                    OPR_LOCAL: opr.localvarsize := l;
-              end;
-
-
-              while assigned(harrdef.elementdef) and
-                    (harrdef.elementdef.typ=arraydef) do
-               harrdef:=tarraydef(harrdef.elementdef);
-              if not is_packed_array(harrdef) then
-                SetSize(harrdef.elesize,false)
-               else
-                   if (harrdef.elepackedbitsize mod 8) = 0 then
-                     SetSize(harrdef.elepackedbitsize div 8,false);
-            end;
-          recorddef:
-            case opr.typ of
-              OPR_REFERENCE: opr.varsize := tabstractvarsym(sym).getsize;
-                  OPR_LOCAL: opr.localvarsize := tabstractvarsym(sym).getsize;
-            end;
-        end;
         hasvar:=true;
         SetupVar:=true;
         Exit;

tests/webtbs/tw29096.pp

@@ -0,0 +1,129 @@
+{ %cpu=i386 }
+
+program asm_bug;
+{$IFDEF FPC}
+{$mode delphi}
+{$OPTIMIZATION SIZE}
+{$OPTIMIZATION STACKFRAME}
+{$OPTIMIZATION REGVAR}
+{$CODEALIGN VARMIN=1}
+{$CODEALIGN VARMAX=1}
+{$CODEALIGN CONSTMIN=1}
+{$CODEALIGN CONSTMAX=1}
+{$ENDIF}
+
+{$ALIGN 1}
+{$APPTYPE CONSOLE}
+
+{$IFDEF XXX}
+             o  study of explicit/impicit operand size def
+{$ENDIF}
+
+type
+
+obj1t = object  //__ fpc.exe eat "packed object" delphi 2007 does not eat _
+b0 :byte;
+b1 :byte;
+b2 :byte;
+b3 :byte;
+procedure proc0();  register;
+procedure proc1();  register;
+procedure proc2();  register;
+procedure proc3();  register;
+procedure pascal(); register;
+end;
+
+var
+
+obj1 :obj1t;
+error: boolean;
+
+
+procedure obj1t.proc0(); //___ it is seems to good but the last mov scrabble 3 byte after obj1 (with fpc.exe) _
+ASM   //___________ proc1 __
+  mov [eax].b0 , 0  //___ affable pascal like syntax but the "byte ptr" info not present (with DCC32(delphi) present)
+  mov [eax].b1 , 1
+  mov [eax].b2 , 2
+  mov [eax].b3 , 3
+end; //___________ proc1 __
+
+procedure obj1t.proc1();
+ASM   //___________ proc1 __
+  mov [eax].b3 , 3  //___ reverse order to detect scrabbling _
+  mov [eax].b2 , 2
+  mov [eax].b1 , 1
+  mov [eax].b0 , 0 //____ clear all four byte value with fpc __
+end; //___________ proc1 __
+
+procedure obj1t.proc2();
+ASM   //___________ proc1 __
+  mov [eax.b3] , 3     //___ this syntax preferable maybe _
+  mov [eax.b2] , 2
+  mov [eax.b1] , 1
+  mov [eax.b0] , 0
+end; //___________ proc1 __
+
+procedure obj1t.proc3(); //___ naturally this proc work well _
+ASM   //___________ proc1 __
+  mov byte ptr [eax.b3] , 3     //___  _
+  mov byte ptr [eax.b2] , 2
+  mov byte ptr [eax.b1] , 1
+  mov byte ptr [eax.b0] , 0
+end; //___________ proc1 __
+
+
+procedure obj1t.pascal();
+begin //___________ pascal __
+ b3:= 3;
+ b2:= 2;
+ b1:= 1;
+ b0:= 0;
+end; //___________ pascal __
+
+type
+str31 = string[31];
+procedure wr_obj(e :str31);
+begin //___________ wr_obj __
+ with obj1 do writeln(b0:3,b1:3,b2:3,b3:3, '    must be:[0 1 2 3] ',e);  //___
+ if (obj1.b0<>0) or
+    (obj1.b1<>1) or
+    (obj1.b2<>2) or
+    (obj1.b3<>3) then
+   error:=true;
+end; //___________ wr_obj __
+
+var
+a1,a2   :ptruint;
+
+var
+c0,c1,c2,c3     :byte;  //___ the test with internal assemlber not fair because of 16-byte aligment of global variables _
+
+begin  //____ m a i n _
+  a1:= ptruint(@obj1.b0);
+  a2:= ptruint(@obj1.b1);
+  if ((a2-a1) <> 1) then begin writeln('obj1 not packed:'); halt(1); end;
+
+  obj1.proc0();  wr_obj('fwd');
+  obj1.proc1();  wr_obj('bwd');
+  obj1.proc2();  wr_obj('bwd');
+  obj1.proc3();  wr_obj('byte ptr');
+  obj1.pascal(); wr_obj('pascal');
+
+ASM
+  lea  eax , c1
+  sub  eax , offset c0
+  mov  a1  , eax
+  mov [c3] , 3 //___ there is "byte ptr" info present  _
+  mov [c2] , 2
+  mov [c1] , 1
+  mov [c0] , 0
+end;
+   writeln(c0:3,c1:3,c2:3,c3:3, '    must be:[0 1 2 3] glo');  //___
+   if (c0<>0) or
+      (c1<>1) or
+      (c2<>2) or
+      (c3<>3) then
+     error:=true;
+   if error then
+     halt(1);
+end.