* fixed pushing of records>8 bytes with stdcall

  * simplified hightree loading

compiler/i386/cpupara.pas

@@ -42,6 +42,7 @@ unit cpupara;
        ti386paramanager = class(tparamanager)
           function ret_in_acc(def : tdef;calloption : tproccalloption) : boolean;override;
           function ret_in_param(def : tdef;calloption : tproccalloption) : boolean;override;
+          function push_addr_param(def : tdef;calloption : tproccalloption) : boolean;override;
           function getintparaloc(nr : longint) : tparalocation;override;
           procedure create_param_loc_info(p : tabstractprocdef);override;
           function getselflocation(p : tabstractprocdef) : tparalocation;override;
@@ -76,6 +77,16 @@ unit cpupara;
           result:=inherited ret_in_param(def,calloption);
       end;
 
+    function ti386paramanager.push_addr_param(def : tdef;calloption : tproccalloption) : boolean;
+      begin
+        if ((target_info.system=system_i386_win32) and
+            (calloption=pocall_stdcall) and
+            (def.deftype=recorddef) and (def.size<=8)) then
+         result:=false
+        else
+         result:=inherited push_addr_param(def,calloption);
+      end;
+
     function ti386paramanager.getintparaloc(nr : longint) : tparalocation;
       begin
       end;
@@ -100,7 +111,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.5  2002-11-18 17:32:00  peter
+  Revision 1.6  2002-12-17 22:19:33  peter
+    * fixed pushing of records>8 bytes with stdcall
+    * simplified hightree loading
+
+  Revision 1.5  2002/11/18 17:32:00  peter
     * pass proccalloption to ret_in_xxx and push_xxx functions
 
   Revision 1.4  2002/11/15 01:58:56  peter

compiler/ncgmem.pas

@@ -567,9 +567,7 @@ implementation
             is_array_of_const(left.resulttype.def) then
           begin
             { Get high value }
-            srsym:=searchsymonlyin(tloadnode(left).symtable,
-              'high'+tvarsym(tloadnode(left).symtableentry).name);
-            hightree:=cloadnode.create(tvarsym(srsym),tloadnode(left).symtable);
+            hightree:=load_high_value(tvarsym(tloadnode(left).symtableentry));
             firstpass(hightree);
             secondpass(hightree);
             { generate compares }
@@ -921,7 +919,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.37  2002-12-08 13:39:03  carl
+  Revision 1.38  2002-12-17 22:19:33  peter
+    * fixed pushing of records>8 bytes with stdcall
+    * simplified hightree loading
+
+  Revision 1.37  2002/12/08 13:39:03  carl
     + some documentation added
 
   Revision 1.36  2002/12/07 14:14:19  carl

compiler/ninl.pas

@@ -1096,7 +1096,8 @@ implementation
       var
          vl,vl2    : TConstExprInt;
          vr        : bestreal;
-         hp,p1     : tnode;
+         hightree,
+         hp        : tnode;
          srsym     : tsym;
          isreal    : boolean;
          checkrange : boolean;
@@ -1370,7 +1371,22 @@ implementation
               in_sizeof_x:
                 begin
                   set_varstate(left,false);
-                  resulttype:=s32bittype;
+                  if paramanager.push_high_param(left.resulttype.def,aktprocdef.proccalloption) then
+                   begin
+                     hightree:=load_high_value(tvarsym(tloadnode(left).symtableentry));
+                     if assigned(hightree) then
+                      begin
+                        hp:=caddnode.create(addn,hightree,
+                                         cordconstnode.create(1,s32bittype,false));
+                        if (left.resulttype.def.deftype=arraydef) and
+                           (tarraydef(left.resulttype.def).elesize<>1) then
+                          hp:=caddnode.create(muln,hp,cordconstnode.create(tarraydef(
+                            left.resulttype.def).elesize,s32bittype,true));
+                        result:=hp;
+                      end;
+                   end
+                  else
+                   resulttype:=s32bittype;
                 end;
 
               in_typeof_x:
@@ -1519,15 +1535,13 @@ implementation
                         if is_open_array(left.resulttype.def) or
                            is_array_of_const(left.resulttype.def) then
                          begin
-                           srsym:=searchsymonlyin(tloadnode(left).symtable,'high'+tvarsym(tloadnode(left).symtableentry).name);
-                           if not assigned(srsym) then
+                           hightree:=load_high_value(tvarsym(tloadnode(left).symtableentry));
+                           if assigned(hightree) then
                             begin
-                              CGMessage(cg_e_illegal_expression);
-                              goto myexit;
+                              hp:=caddnode.create(addn,hightree,
+                                                  cordconstnode.create(1,s32bittype,false));
+                              result:=hp;
                             end;
-                           hp:=caddnode.create(addn,cloadnode.create(srsym,tloadnode(left).symtable),
-                                                    cordconstnode.create(1,s32bittype,false));
-                           result:=hp;
                            goto myexit;
                          end
                         else
@@ -1576,7 +1590,6 @@ implementation
                    { is now nil                                                }
                    left.free;
                    left := nil;
-                   resulttypepass(result);
                    goto myexit;
                 end;
 
@@ -1685,6 +1698,7 @@ implementation
                 begin
                   result := handle_read_write;
                 end;
+
               in_settextbuf_file_x :
                 begin
                   resulttype:=voidtype;
@@ -1759,13 +1773,9 @@ implementation
                         else
                          begin
                            if is_open_array(left.resulttype.def) or
-                             is_array_of_const(left.resulttype.def) then
+                              is_array_of_const(left.resulttype.def) then
                             begin
-                              srsym:=searchsymonlyin(tloadnode(left).symtable,'high'+tvarsym(tloadnode(left).symtableentry).name);
-                              if assigned(srsym) then
-                                result:=cloadnode.create(srsym,tloadnode(left).symtable)
-                              else
-                                CGMessage(cg_e_illegal_expression);
+                              result:=load_high_value(tvarsym(tloadnode(left).symtableentry));
                             end
                            else
                             if is_dynamic_array(left.resulttype.def) then
@@ -1786,32 +1796,19 @@ implementation
                                left.resulttype.def).highrange,tarraydef(left.resulttype.def).rangetype,true);
                             end;
                          end;
-                         if assigned(result) then
-                           resulttypepass(result);
                       end;
                     stringdef:
                       begin
                         if inlinenumber=in_low_x then
                          begin
-                           hp:=cordconstnode.create(0,u8bittype,false);
-                           resulttypepass(hp);
-                           result:=hp;
+                           result:=cordconstnode.create(0,u8bittype,false);
                          end
                         else
                          begin
                            if is_open_string(left.resulttype.def) then
-                            begin
-                              srsym:=searchsymonlyin(tloadnode(left).symtable,'high'+tvarsym(tloadnode(left).symtableentry).name);
-                              hp:=cloadnode.create(srsym,tloadnode(left).symtable);
-                              resulttypepass(hp);
-                              result:=hp;
-                            end
+                            result:=load_high_value(tvarsym(tloadnode(left).symtableentry))
                            else
-                            begin
-                              hp:=cordconstnode.create(tstringdef(left.resulttype.def).len,u8bittype,true);
-                              resulttypepass(hp);
-                              result:=hp;
-                            end;
+                            result:=cordconstnode.create(tstringdef(left.resulttype.def).len,u8bittype,true);
                          end;
                      end;
                     else
@@ -1951,6 +1948,14 @@ implementation
                     end
                   else
                     CGMessage(type_e_mismatch);
+
+                  { We've checked the whole statement for correctness, now we
+                    can remove it if assertions are off }
+                  if not(cs_do_assertion in aktlocalswitches) then
+                   begin
+                     { we need a valid node, so insert a nothingn }
+                     result:=cnothingnode.create;
+                   end;
                 end;
 
                else
@@ -1972,7 +1977,6 @@ implementation
 
     function tinlinenode.pass_1 : tnode;
       var
-         srsym   : tsym;
          hp,hpp  : tnode;
          shiftconst: longint;
 
@@ -2018,26 +2022,12 @@ implementation
               include(result.flags,nf_explizit);
               firstpass(result);
             end;
+
           in_sizeof_x:
             begin
-              if paramanager.push_high_param(left.resulttype.def,aktprocdef.proccalloption) then
-               begin
-                 srsym:=searchsymonlyin(tloadnode(left).symtable,'high'+tvarsym(tloadnode(left).symtableentry).name);
-                 hp:=caddnode.create(addn,cloadnode.create(srsym,tloadnode(left).symtable),
-                                  cordconstnode.create(1,s32bittype,false));
-                 if (left.resulttype.def.deftype=arraydef) and
-                    (tarraydef(left.resulttype.def).elesize<>1) then
-                   hp:=caddnode.create(muln,hp,cordconstnode.create(tarraydef(
-                     left.resulttype.def).elesize,s32bittype,true));
-                 firstpass(hp);
-                 result:=hp;
-               end
-              else
-               begin
-                 if registers32<1 then
-                    registers32:=1;
-                 location.loc:=LOC_REGISTER;
-               end;
+              if registers32<1 then
+                 registers32:=1;
+              location.loc:=LOC_REGISTER;
             end;
 
           in_typeof_x:
@@ -2260,22 +2250,11 @@ implementation
 
          in_assert_x_y :
             begin
-              { We've checked the whole statement for correctness, now we
-                can remove it if assertions are off }
-              if not(cs_do_assertion in aktlocalswitches) then
-               begin
-                 { we need a valid node, so insert a nothingn }
-                 result:=cnothingnode.create;
-                 firstpass(result);
-              end
-              else
-               begin
-                 registers32:=left.registers32;
-                 registersfpu:=left.registersfpu;
+              registers32:=left.registers32;
+              registersfpu:=left.registersfpu;
 {$ifdef SUPPORT_MMX}
-                 registersmmx:=left.registersmmx;
+              registersmmx:=left.registersmmx;
 {$endif SUPPORT_MMX}
-               end;
             end;
 
           else
@@ -2298,7 +2277,6 @@ implementation
      function tinlinenode.first_pi : tnode;
       begin
         result := crealconstnode.create(pi,pbestrealtype^);
-        firstpass(result);
       end;
 
 
@@ -2308,10 +2286,6 @@ implementation
         { on entry left node contains the parameter }
         first_arctan_real := ccallnode.createintern('fpc_arctan_real',
                 ccallparanode.create(left,nil));
-        { now left is nil, nothing left, so no second pass
-          required.
-        }
-        firstpass(result);
         left := nil;
       end;
 
@@ -2321,10 +2295,6 @@ implementation
         { on entry left node contains the parameter }
         first_abs_real := ccallnode.createintern('fpc_abs_real',
                 ccallparanode.create(left,nil));
-        { now left is nil, nothing left, so no second pass
-          required.
-        }
-        firstpass(result);
         left := nil;
       end;
 
@@ -2334,10 +2304,6 @@ implementation
         { on entry left node contains the parameter }
         first_sqr_real := ccallnode.createintern('fpc_sqr_real',
                 ccallparanode.create(left,nil));
-        { now left is nil, nothing left, so no second pass
-          required.
-        }
-        firstpass(result);
         left := nil;
       end;
 
@@ -2347,10 +2313,6 @@ implementation
         { on entry left node contains the parameter }
         first_sqrt_real := ccallnode.createintern('fpc_sqrt_real',
                 ccallparanode.create(left,nil));
-        { now left is nil, nothing left, so no second pass
-          required.
-        }
-        firstpass(result);
         left := nil;
       end;
 
@@ -2360,10 +2322,6 @@ implementation
         { on entry left node contains the parameter }
         first_ln_real := ccallnode.createintern('fpc_ln_real',
                 ccallparanode.create(left,nil));
-        { now left is nil, nothing left, so no second pass
-          required.
-        }
-        firstpass(result);
         left := nil;
       end;
 
@@ -2373,10 +2331,6 @@ implementation
         { on entry left node contains the parameter }
         first_cos_real := ccallnode.createintern('fpc_cos_real',
                 ccallparanode.create(left,nil));
-        { now left is nil, nothing left, so no second pass
-          required.
-        }
-        firstpass(result);
         left := nil;
       end;
 
@@ -2386,10 +2340,6 @@ implementation
         { on entry left node contains the parameter }
         first_sin_real := ccallnode.createintern('fpc_sin_real',
                 ccallparanode.create(left,nil));
-        { now left is nil, nothing left, so no second pass
-          required.
-        }
-        firstpass(result);
         left := nil;
       end;
 
@@ -2399,7 +2349,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.102  2002-12-15 21:30:12  florian
+  Revision 1.103  2002-12-17 22:19:33  peter
+    * fixed pushing of records>8 bytes with stdcall
+    * simplified hightree loading
+
+  Revision 1.102  2002/12/15 21:30:12  florian
     * tcallnode.paraitem introduced, all references to defcoll removed
 
   Revision 1.101  2002/11/27 20:04:39  peter

compiler/nld.pas

@@ -147,7 +147,9 @@ interface
        crttinode : trttinodeclass;
 
 
-      procedure load_procvar_from_calln(var p1:tnode);
+    procedure load_procvar_from_calln(var p1:tnode);
+    function load_high_value(vs:tvarsym):tnode;
+
 
 implementation
 
@@ -189,6 +191,27 @@ implementation
         end;
 
 
+    function load_high_value(vs:tvarsym):tnode;
+      var
+        srsym : tsym;
+        srsymtable : tsymtable;
+      begin
+        srsymtable:=vs.owner;
+        if vo_is_local_copy in vs.varoptions then
+         begin
+           { next symtable is always the para symtable }
+           srsymtable:=srsymtable.next;
+           if not(srsymtable.symtabletype in [parasymtable,inlineparasymtable]) then
+             internalerror(200212171);
+         end;
+        srsym:=searchsymonlyin(srsymtable,'high'+vs.name);
+        if assigned(srsym) then
+          result:=cloadnode.create(srsym,srsymtable)
+        else
+          CGMessage(cg_e_illegal_expression);
+      end;
+
+
 {*****************************************************************************
                              TLOADNODE
 *****************************************************************************}
@@ -695,8 +718,8 @@ implementation
 
         { check if the assignment may cause a range check error }
         { if its not explicit, and only if the values are       }
-        { ordinals, enumdef and floatdef                        }                           
-        if (right.nodetype = typeconvn) and 
+        { ordinals, enumdef and floatdef                        }
+        if (right.nodetype = typeconvn) and
            not (nf_explizit in ttypeconvnode(right).flags) then
          begin
             if assigned(left.resulttype.def) and
@@ -711,7 +734,7 @@ implementation
                   end;
               end;
          end;
-         
+
 
         { call helpers for interface }
         if is_interfacecom(left.resulttype.def) then
@@ -1074,13 +1097,14 @@ implementation
               exit;
             end;
          end;
-        { C Arguments are pushed on the stack and
-          are not accesible after the push }
-        if not(nf_cargs in flags) then
-         location.loc:=LOC_CREFERENCE
-        else
-         location.loc:=LOC_INVALID;
+        { Calculate registers }
+        location.loc:=LOC_CREFERENCE;
         calcregisters(self,0,0,0);
+        { C Arguments are pushed on the stack and
+          are not accesible after the push. This must be done
+          after calcregisters, because that needs a valid location }
+        if (nf_cargs in flags) then
+          location.loc:=LOC_INVALID;
       end;
 
 
@@ -1244,7 +1268,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.71  2002-12-07 14:27:07  carl
+  Revision 1.72  2002-12-17 22:19:33  peter
+    * fixed pushing of records>8 bytes with stdcall
+    * simplified hightree loading
+
+  Revision 1.71  2002/12/07 14:27:07  carl
     * 3% memory optimization
     * changed some types
     + added type checking with different size for call node and for

compiler/paramgr.pas

@@ -193,7 +193,7 @@ unit paramgr;
       end;
 
 
-    { true if a parameter is too large to copy and only the address is pushed }
+    { true if a parameter is too large to push and needs a concatcopy to get the value on the stack }
     function tparamanager.copy_value_on_stack(def : tdef;calloption : tproccalloption) : boolean;
       begin
         copy_value_on_stack:=false;
@@ -414,7 +414,11 @@ end.
 
 {
    $Log$
-   Revision 1.27  2002-12-06 16:56:58  peter
+   Revision 1.28  2002-12-17 22:19:33  peter
+     * fixed pushing of records>8 bytes with stdcall
+     * simplified hightree loading
+
+   Revision 1.27  2002/12/06 16:56:58  peter
      * only compile cs_fp_emulation support when cpufpuemu is defined
      * define cpufpuemu for m68k only
 

compiler/pass_1.pas

@@ -162,6 +162,9 @@ implementation
                  if assigned(hp) then
                   begin
                     p.free;
+                    { run firstpass }
+                    firstpass(hp);
+                    { switch to new node }
                     p:=hp;
                   end;
                  if codegenerror then
@@ -205,7 +208,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.28  2002-09-05 19:28:30  peter
+  Revision 1.29  2002-12-17 22:19:33  peter
+    * fixed pushing of records>8 bytes with stdcall
+    * simplified hightree loading
+
+  Revision 1.28  2002/09/05 19:28:30  peter
     * removed repetitive pass counting
     * display heapsize also for extdebug
 

compiler/pdecsub.pas

@@ -86,12 +86,22 @@ implementation
        ;
 
 
-    procedure resetvaluepara(p:tnamedindexitem;arg:pointer);
+    procedure checkvaluepara(p:tnamedindexitem;arg:pointer);
       begin
-        if tsym(p).typ=varsym then
-         with tvarsym(p) do
-          if copy(name,1,3)='val' then
-           aktprocdef.parast.symsearch.rename(name,copy(name,4,length(name)));
+        if tsym(p).typ<>varsym then
+         exit;
+        with tvarsym(p) do
+         begin
+           { do we need a local copy? Then rename the varsym, do this after the
+             insert so the dup id checking is done correctly.
+             array of const and open array do not need this, the local copy routine
+             will patch the pushed value to point to the local copy }
+           if (varspez=vs_value) and
+              paramanager.push_addr_param(vartype.def,aktprocdef.proccalloption) and
+              not(is_array_of_const(vartype.def) or
+                  is_open_array(vartype.def)) then
+            aktprocdef.parast.symsearch.rename(name,'val'+name);
+         end;
       end;
 
 
@@ -353,13 +363,6 @@ implementation
                         paramanager.push_addr_param(tt.def,aktprocdef.proccalloption) then
                        include(vs.varoptions,vo_regable);
 
-                     { do we need a local copy? Then rename the varsym, do this after the
-                       insert so the dup id checking is done correctly }
-                     if (varspez=vs_value) and
-                        paramanager.push_addr_param(tt.def,aktprocdef.proccalloption) and
-                        not(is_open_array(tt.def) or is_array_of_const(tt.def)) then
-                       currparast.rename(vs.name,'val'+vs.name);
-
                      { also need to push a high value? }
                      if inserthigh then
                       begin
@@ -1548,9 +1551,13 @@ const
 
     procedure handle_calling_convention(sym:tprocsym;def:tabstractprocdef);
       begin
-      { set the default calling convention }
+        { set the default calling convention }
         if def.proccalloption=pocall_none then
           def.proccalloption:=aktdefproccall;
+        { generate symbol names for local copies }
+        if (def.deftype=procdef) then
+          tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}checkvaluepara,nil);
+        { handle proccall specific settings }
         case def.proccalloption of
           pocall_cdecl :
             begin
@@ -1569,8 +1576,6 @@ const
                   end;
                  if not assigned(tprocdef(def).parast) then
                   internalerror(200110234);
-                 { do not copy on local !! }
-                 tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}resetvaluepara,nil);
                  { check C cdecl para types }
                  tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}checkparatype,nil);
                  { Adjust alignment to match cdecl or stdcall }
@@ -1591,8 +1596,6 @@ const
                   tprocdef(def).setmangledname(target_info.Cprefix+tprocdef(def).cplusplusmangledname);
                  if not assigned(tprocdef(def).parast) then
                   internalerror(200110235);
-                 { do not copy on local !! }
-                 tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}resetvaluepara,nil);
                  { check C cdecl para types }
                  tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}checkparatype,nil);
                  { Adjust alignment to match cdecl or stdcall }
@@ -1652,8 +1655,6 @@ const
                begin
                  if not assigned(tprocdef(def).parast) then
                   internalerror(200110236);
-                 { do not copy on local !! }
-                 tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}resetvaluepara,nil);
                  { Adjust positions of args for cdecl or stdcall }
                  tprocdef(def).parast.dataalignment:=std_param_align;
                end;
@@ -1730,6 +1731,7 @@ const
       end;
 
 
+
     procedure parse_proc_directives(var pdflags:word);
       {
         Parse the procedure directives. It does not matter if procedure directives
@@ -2078,7 +2080,11 @@ const
 end.
 {
   $Log$
-  Revision 1.89  2002-12-15 21:07:30  peter
+  Revision 1.90  2002-12-17 22:19:33  peter
+    * fixed pushing of records>8 bytes with stdcall
+    * simplified hightree loading
+
+  Revision 1.89  2002/12/15 21:07:30  peter
     * don't allow external in object declarations
 
   Revision 1.88  2002/12/15 19:34:31  florian