Browse Source

* varspez in calls to push_addr_param

peter 22 years ago
parent
commit
76a53a375d

+ 5 - 2
compiler/globals.pas

@@ -975,7 +975,7 @@ implementation
      {$ifdef hasunix}
      {$ifdef hasunix}
        {$IFDEF VER1_0}
        {$IFDEF VER1_0}
         FStat (F,Info);
         FStat (F,Info);
-        L:=Info.st_Mtime;
+        L:=Info.Mtime;
        {$ELSE}
        {$ELSE}
         FPFStat (F,Info);
         FPFStat (F,Info);
 	L:=Info.st_Mtime;
 	L:=Info.st_Mtime;
@@ -1679,7 +1679,10 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.100  2003-09-15 20:11:06  marco
+  Revision 1.101  2003-09-16 16:17:01  peter
+    * varspez in calls to push_addr_param
+
+  Revision 1.100  2003/09/15 20:11:06  marco
    * fixed
    * fixed
 
 
   Revision 1.99  2003/09/14 20:26:18  marco
   Revision 1.99  2003/09/14 20:26:18  marco

+ 36 - 13
compiler/i386/cpupara.pas

@@ -43,7 +43,7 @@ unit cpupara;
        }
        }
        ti386paramanager = class(tparamanager)
        ti386paramanager = class(tparamanager)
           function ret_in_param(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 push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
           function get_volatile_registers_int(calloption : tproccalloption):tsuperregisterset;override;
           function get_volatile_registers_int(calloption : tproccalloption):tsuperregisterset;override;
           function get_volatile_registers_fpu(calloption : tproccalloption):tsuperregisterset;override;
           function get_volatile_registers_fpu(calloption : tproccalloption):tsuperregisterset;override;
           function getintparaloc(calloption : tproccalloption; nr : longint) : tparalocation;override;
           function getintparaloc(calloption : tproccalloption; nr : longint) : tparalocation;override;
@@ -73,11 +73,13 @@ unit cpupara;
         case target_info.system of
         case target_info.system of
           system_i386_win32 :
           system_i386_win32 :
             begin
             begin
-              { Win32 returns small records in the FUNCTION_RETURN_REG }
               case def.deftype of
               case def.deftype of
                 recorddef :
                 recorddef :
                   begin
                   begin
-                    if (calloption in [pocall_stdcall,pocall_cdecl,pocall_cppdecl]) and (def.size<=8) then
+                    { Win32 GCC returns small records in the FUNCTION_RETURN_REG.
+                      For stdcall we follow delphi instead of GCC }
+                    if (calloption in [pocall_cdecl,pocall_cppdecl]) and
+                       (def.size<=8) then
                      begin
                      begin
                        result:=false;
                        result:=false;
                        exit;
                        exit;
@@ -90,7 +92,7 @@ unit cpupara;
       end;
       end;
 
 
 
 
-    function ti386paramanager.push_addr_param(def : tdef;calloption : tproccalloption) : boolean;
+    function ti386paramanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
       begin
       begin
         case target_info.system of
         case target_info.system of
           system_i386_win32 :
           system_i386_win32 :
@@ -98,17 +100,23 @@ unit cpupara;
               case def.deftype of
               case def.deftype of
                 recorddef :
                 recorddef :
                   begin
                   begin
-                    { This is not true for the WinAPI expects (PFV)
-                     if (calloption=pocall_stdcall) and (def.size<=8) then
+                    { Win32 passes small records on the stack for call by
+                      value }
+                    if (calloption in [pocall_stdcall,pocall_cdecl,pocall_cppdecl]) and
+                       (varspez=vs_value) and
+                       (def.size<=8) then
                      begin
                      begin
                        result:=false;
                        result:=false;
                        exit;
                        exit;
-                     end; }
+                     end;
                   end;
                   end;
                 arraydef :
                 arraydef :
                   begin
                   begin
-                    if (tarraydef(def).highrange>=tarraydef(def).lowrange) and
-                       (calloption in [pocall_cdecl,pocall_cppdecl]) then
+                    { Win32 passes arrays on the stack for call by
+                      value }
+                    if (calloption in [pocall_stdcall,pocall_cdecl,pocall_cppdecl]) and
+                       (varspez=vs_value) and
+                       (tarraydef(def).highrange>=tarraydef(def).lowrange) then
                      begin
                      begin
                        result:=true;
                        result:=true;
                        exit;
                        exit;
@@ -117,7 +125,17 @@ unit cpupara;
               end;
               end;
             end;
             end;
         end;
         end;
-        result:=inherited push_addr_param(def,calloption);
+        if calloption=pocall_register then
+          begin
+            case def.deftype of
+              floatdef :
+                begin
+                  result:=true;
+                  exit;
+                end;
+            end;
+          end;
+        result:=inherited push_addr_param(varspez,def,calloption);
       end;
       end;
 
 
 
 
@@ -255,7 +273,7 @@ unit cpupara;
         hp:=tparaitem(p.para.first);
         hp:=tparaitem(p.para.first);
         while assigned(hp) do
         while assigned(hp) do
           begin
           begin
-            if hp.paratyp in [vs_var,vs_out] then
+            if push_addr_param(hp.paratyp,hp.paratype.def,p.proccalloption) then
               paraloc.size:=OS_ADDR
               paraloc.size:=OS_ADDR
             else
             else
               paraloc.size:=def_cgsize(hp.paratype.def);
               paraloc.size:=def_cgsize(hp.paratype.def);
@@ -294,7 +312,9 @@ unit cpupara;
 
 
     procedure ti386paramanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee);
     procedure ti386paramanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee);
       begin
       begin
-        if p.proccalloption=pocall_register then
+        if (p.proccalloption=pocall_register) or
+           ((pocall_default=pocall_register) and
+            (p.proccalloption in [pocall_compilerproc,pocall_internproc])) then
           create_register_paraloc_info(p,side)
           create_register_paraloc_info(p,side)
         else
         else
           create_stdcall_paraloc_info(p,side);
           create_stdcall_paraloc_info(p,side);
@@ -321,7 +341,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.28  2003-09-10 08:31:47  marco
+  Revision 1.29  2003-09-16 16:17:01  peter
+    * varspez in calls to push_addr_param
+
+  Revision 1.28  2003/09/10 08:31:47  marco
    * Patch from Peter for paraloc
    * Patch from Peter for paraloc
 
 
   Revision 1.27  2003/09/09 21:03:17  peter
   Revision 1.27  2003/09/09 21:03:17  peter

+ 5 - 2
compiler/ncal.pas

@@ -690,7 +690,7 @@ type
                 (paraitem.paratype.def.deftype<>formaldef) then
                 (paraitem.paratype.def.deftype<>formaldef) then
                begin
                begin
                   { Process open parameters }
                   { Process open parameters }
-                  if paramanager.push_high_param(paraitem.paratype.def,aktcallnode.procdefinition.proccalloption) then
+                  if paramanager.push_high_param(paraitem.paratyp,paraitem.paratype.def,aktcallnode.procdefinition.proccalloption) then
                    begin
                    begin
                      { insert type conv but hold the ranges of the array }
                      { insert type conv but hold the ranges of the array }
                      oldtype:=left.resulttype;
                      oldtype:=left.resulttype;
@@ -2514,7 +2514,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.179  2003-09-07 22:09:35  peter
+  Revision 1.180  2003-09-16 16:17:01  peter
+    * varspez in calls to push_addr_param
+
+  Revision 1.179  2003/09/07 22:09:35  peter
     * preparations for different default calling conventions
     * preparations for different default calling conventions
     * various RA fixes
     * various RA fixes
 
 

+ 28 - 10
compiler/ncgcal.pas

@@ -138,14 +138,14 @@ implementation
          { handle varargs first, because defcoll is not valid }
          { handle varargs first, because defcoll is not valid }
          if (nf_varargs_para in flags) then
          if (nf_varargs_para in flags) then
            begin
            begin
-             if paramanager.push_addr_param(left.resulttype.def,calloption) then
+             if paramanager.push_addr_param(vs_value,left.resulttype.def,calloption) then
                begin
                begin
                  inc(pushedparasize,POINTER_SIZE);
                  inc(pushedparasize,POINTER_SIZE);
                  cg.a_paramaddr_ref(exprasmlist,left.location.reference,tempparaloc);
                  cg.a_paramaddr_ref(exprasmlist,left.location.reference,tempparaloc);
                  location_release(exprasmlist,left.location);
                  location_release(exprasmlist,left.location);
                end
                end
              else
              else
-               push_value_para(exprasmlist,left,calloption,para_offset,para_alignment,tempparaloc);
+               push_value_para(exprasmlist,left,vs_value,calloption,para_offset,para_alignment,tempparaloc);
            end
            end
          { hidden parameters }
          { hidden parameters }
          else if paraitem.is_hidden then
          else if paraitem.is_hidden then
@@ -154,7 +154,7 @@ implementation
                by address for implicit hidden parameters }
                by address for implicit hidden parameters }
              if (vo_is_funcret in tvarsym(paraitem.parasym).varoptions) or
              if (vo_is_funcret in tvarsym(paraitem.parasym).varoptions) or
                 (not(left.resulttype.def.deftype in [pointerdef,classrefdef]) and
                 (not(left.resulttype.def.deftype in [pointerdef,classrefdef]) and
-                 paramanager.push_addr_param(paraitem.paratype.def,calloption)) then
+                 paramanager.push_addr_param(paraitem.paratyp,paraitem.paratype.def,calloption)) then
                begin
                begin
                   if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
                   if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
                     internalerror(200305071);
                     internalerror(200305071);
@@ -174,7 +174,7 @@ implementation
                end
                end
              else
              else
                begin
                begin
-                  push_value_para(exprasmlist,left,calloption,
+                  push_value_para(exprasmlist,left,paraitem.paratyp,calloption,
                     para_offset,para_alignment,tempparaloc);
                     para_offset,para_alignment,tempparaloc);
                end;
                end;
            end
            end
@@ -224,8 +224,14 @@ implementation
                    location_release(exprasmlist,left.location);
                    location_release(exprasmlist,left.location);
                 end;
                 end;
            end
            end
+(*
          { handle call by reference parameter }
          { handle call by reference parameter }
-         else if (paraitem.paratyp in [vs_var,vs_out]) then
+         else if (paraitem.paratyp in [vs_var,vs_out]) or
+                 { win32 stdcall const parameters are also
+                   call by reference, Delphi compatible }
+                 (paraitem.paratyp=vs_const) and
+                 (calloption=pocall_stdcall) and
+                 (target_info.target=target_i386_win32) then
            begin
            begin
               if (left.location.loc<>LOC_REFERENCE) then
               if (left.location.loc<>LOC_REFERENCE) then
                begin
                begin
@@ -253,16 +259,26 @@ implementation
                 cg.a_paramaddr_ref(exprasmlist,left.location.reference,tempparaloc);
                 cg.a_paramaddr_ref(exprasmlist,left.location.reference,tempparaloc);
               location_release(exprasmlist,left.location);
               location_release(exprasmlist,left.location);
            end
            end
+*)
          else
          else
-           begin
               { don't push a node that already generated a pointer type
               { don't push a node that already generated a pointer type
                 by address for implicit hidden parameters }
                 by address for implicit hidden parameters }
               if (not(
               if (not(
                       paraitem.is_hidden and
                       paraitem.is_hidden and
                       (left.resulttype.def.deftype in [pointerdef,classrefdef])
                       (left.resulttype.def.deftype in [pointerdef,classrefdef])
                      ) and
                      ) and
-                  paramanager.push_addr_param(paraitem.paratype.def,calloption)) then
+                  paramanager.push_addr_param(paraitem.paratyp,paraitem.paratype.def,calloption)) then
                 begin
                 begin
+                   { Check for passing a constant to var,out parameter }
+                   if (paraitem.paratyp in [vs_var,vs_out]) and
+                      (left.location.loc<>LOC_REFERENCE) then
+                    begin
+                      { passing self to a var parameter is allowed in
+                        TP and delphi }
+                      if not((left.location.loc=LOC_CREFERENCE) and
+                             is_self_node(left)) then
+                       internalerror(200106041);
+                    end;
                    if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
                    if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
                     begin
                     begin
                       { allow passing nil to a procvardef (methodpointer) }
                       { allow passing nil to a procvardef (methodpointer) }
@@ -297,10 +313,9 @@ implementation
                 end
                 end
               else
               else
                 begin
                 begin
-                   push_value_para(exprasmlist,left,calloption,
+                   push_value_para(exprasmlist,left,paraitem.paratyp,calloption,
                      para_offset,para_alignment,tempparaloc);
                      para_offset,para_alignment,tempparaloc);
                 end;
                 end;
-           end;
          truelabel:=otlabel;
          truelabel:=otlabel;
          falselabel:=oflabel;
          falselabel:=oflabel;
 
 
@@ -1299,7 +1314,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.114  2003-09-14 19:17:39  peter
+  Revision 1.115  2003-09-16 16:17:01  peter
+    * varspez in calls to push_addr_param
+
+  Revision 1.114  2003/09/14 19:17:39  peter
     * don't use a_call_ref because it can use a parameter register
     * don't use a_call_ref because it can use a parameter register
       as temp
       as temp
 
 

+ 6 - 6
compiler/ncgld.pas

@@ -223,10 +223,7 @@ implementation
                     when we need to load the self pointer for objects }
                     when we need to load the self pointer for objects }
                   if (symtabletype in [parasymtable,inlineparasymtable]) and
                   if (symtabletype in [parasymtable,inlineparasymtable]) and
                      not(nf_load_self_pointer in flags) and
                      not(nf_load_self_pointer in flags) and
-                     (
-                      (tvarsym(symtableentry).varspez in [vs_var,vs_out]) or
-                      paramanager.push_addr_param(tvarsym(symtableentry).vartype.def,tprocdef(symtable.defowner).proccalloption)
-                     ) then
+                     paramanager.push_addr_param(tvarsym(symtableentry).varspez,tvarsym(symtableentry).vartype.def,tprocdef(symtable.defowner).proccalloption) then
                     begin
                     begin
                       if hregister=NR_NO then
                       if hregister=NR_NO then
                         hregister:=rg.getaddressregister(exprasmlist);
                         hregister:=rg.getaddressregister(exprasmlist);
@@ -811,7 +808,7 @@ implementation
                      end
                      end
                     else
                     else
                       if vtype in [vtInt64,vtQword,vtExtended] then
                       if vtype in [vtInt64,vtQword,vtExtended] then
-                        push_value_para(exprasmlist,hp.left,pocall_cdecl,0,4,paraloc)
+                        push_value_para(exprasmlist,hp.left,vs_value,pocall_cdecl,0,4,paraloc)
                     else
                     else
                       begin
                       begin
                         cg.a_param_loc(exprasmlist,hp.left.location,paraloc);
                         cg.a_param_loc(exprasmlist,hp.left.location,paraloc);
@@ -888,7 +885,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.81  2003-09-14 12:57:10  peter
+  Revision 1.82  2003-09-16 16:17:01  peter
+    * varspez in calls to push_addr_param
+
+  Revision 1.81  2003/09/14 12:57:10  peter
     * save destroyed registers when calling threadvar helper
     * save destroyed registers when calling threadvar helper
 
 
   Revision 1.80  2003/09/10 08:31:47  marco
   Revision 1.80  2003/09/10 08:31:47  marco

+ 18 - 9
compiler/ncgutil.pas

@@ -31,7 +31,7 @@ interface
       globtype,
       globtype,
       cpubase,
       cpubase,
       aasmbase,aasmtai,aasmcpu,
       aasmbase,aasmtai,aasmcpu,
-      cginfo,symbase,symdef,symtype,
+      cginfo,symconst,symbase,symdef,symtype,
 {$ifndef cpu64bit}
 {$ifndef cpu64bit}
       cg64f32,
       cg64f32,
 {$endif cpu64bit}
 {$endif cpu64bit}
@@ -50,8 +50,11 @@ interface
 
 
     function  maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
     function  maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
 
 
-    procedure push_value_para(list:taasmoutput;p:tnode;calloption:tproccalloption;
-                              para_offset:longint;alignment : longint;
+    procedure push_value_para(list:taasmoutput;p:tnode;
+                              varspez:tvarspez;
+                              calloption:tproccalloption;
+                              para_offset:longint;
+                              alignment:longint;
                               const locpara : tparalocation);
                               const locpara : tparalocation);
 
 
     procedure gen_load_return_value(list:TAAsmoutput; var uses_acc,uses_acchi,uses_fpu : boolean);
     procedure gen_load_return_value(list:TAAsmoutput; var uses_acc,uses_acchi,uses_fpu : boolean);
@@ -100,7 +103,7 @@ implementation
 {$endif}
 {$endif}
     cutils,cclasses,
     cutils,cclasses,
     globals,systems,verbose,
     globals,systems,verbose,
-    symconst,symsym,symtable,defutil,
+    symsym,symtable,defutil,
     paramgr,fmodule,
     paramgr,fmodule,
     cgbase,regvars,
     cgbase,regvars,
 {$ifdef GDB}
 {$ifdef GDB}
@@ -661,8 +664,11 @@ implementation
                                 Push Value Para
                                 Push Value Para
 *****************************************************************************}
 *****************************************************************************}
 
 
-    procedure push_value_para(list:taasmoutput;p:tnode;calloption:tproccalloption;
-                              para_offset:longint;alignment : longint;
+    procedure push_value_para(list:taasmoutput;p:tnode;
+                              varspez:tvarspez;
+                              calloption:tproccalloption;
+                              para_offset:longint;
+                              alignment:longint;
                               const locpara : tparalocation);
                               const locpara : tparalocation);
       var
       var
         href : treference;
         href : treference;
@@ -759,7 +765,7 @@ implementation
         else
         else
          begin
          begin
            { copy the value on the stack or use normal parameter push? }
            { copy the value on the stack or use normal parameter push? }
-           if paramanager.copy_value_on_stack(p.resulttype.def,calloption) then
+           if paramanager.copy_value_on_stack(varspez,p.resulttype.def,calloption) then
             begin
             begin
 {$ifdef i386}
 {$ifdef i386}
               if not (p.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
               if not (p.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
@@ -856,7 +862,7 @@ implementation
         list:=taasmoutput(arg);
         list:=taasmoutput(arg);
         if (tsym(p).typ=varsym) and
         if (tsym(p).typ=varsym) and
            (tvarsym(p).varspez=vs_value) and
            (tvarsym(p).varspez=vs_value) and
-           (paramanager.push_addr_param(tvarsym(p).vartype.def,current_procinfo.procdef.proccalloption)) then
+           (paramanager.push_addr_param(tvarsym(p).varspez,tvarsym(p).vartype.def,current_procinfo.procdef.proccalloption)) then
          begin
          begin
            loadref := (tvarsym(p).reg=NR_NO);
            loadref := (tvarsym(p).reg=NR_NO);
            if (loadref) then
            if (loadref) then
@@ -1767,7 +1773,10 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.144  2003-09-14 21:33:37  peter
+  Revision 1.145  2003-09-16 16:17:01  peter
+    * varspez in calls to push_addr_param
+
+  Revision 1.144  2003/09/14 21:33:37  peter
     * location_force_reg gives IE when size=OS_NO
     * location_force_reg gives IE when size=OS_NO
 
 
   Revision 1.143  2003/09/14 19:18:10  peter
   Revision 1.143  2003/09/14 19:18:10  peter

+ 5 - 2
compiler/ninl.pas

@@ -1406,7 +1406,7 @@ implementation
               in_sizeof_x:
               in_sizeof_x:
                 begin
                 begin
                   set_varstate(left,false);
                   set_varstate(left,false);
-                  if paramanager.push_high_param(left.resulttype.def,current_procinfo.procdef.proccalloption) then
+                  if paramanager.push_high_param(vs_value,left.resulttype.def,current_procinfo.procdef.proccalloption) then
                    begin
                    begin
                      hightree:=load_high_value_node(tvarsym(tloadnode(left).symtableentry));
                      hightree:=load_high_value_node(tvarsym(tloadnode(left).symtableentry));
                      if assigned(hightree) then
                      if assigned(hightree) then
@@ -2363,7 +2363,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.115  2003-09-06 16:47:24  florian
+  Revision 1.116  2003-09-16 16:17:01  peter
+    * varspez in calls to push_addr_param
+
+  Revision 1.115  2003/09/06 16:47:24  florian
     + support of NaN and Inf in the compiler as values of real constants
     + support of NaN and Inf in the compiler as values of real constants
 
 
   Revision 1.114  2003/06/13 21:19:30  peter
   Revision 1.114  2003/06/13 21:19:30  peter

+ 5 - 7
compiler/nld.pas

@@ -486,13 +486,8 @@ implementation
                 if (tvarsym(symtableentry).varspez=vs_const) then
                 if (tvarsym(symtableentry).varspez=vs_const) then
                   expectloc:=LOC_CREFERENCE;
                   expectloc:=LOC_CREFERENCE;
                 { we need a register for call by reference parameters }
                 { we need a register for call by reference parameters }
-                if (tvarsym(symtableentry).varspez in [vs_var,vs_out]) or
-                   ((tvarsym(symtableentry).varspez=vs_const) and
-                    paramanager.push_addr_param(tvarsym(symtableentry).vartype.def,pocall_default)) or
-                    { call by value open arrays are also indirect addressed }
-                    is_open_array(tvarsym(symtableentry).vartype.def) then
+                if paramanager.push_addr_param(tvarsym(symtableentry).varspez,tvarsym(symtableentry).vartype.def,pocall_default) then
                   registers32:=1;
                   registers32:=1;
-
                 if ([vo_is_thread_var,vo_is_dll_var]*tvarsym(symtableentry).varoptions)<>[] then
                 if ([vo_is_thread_var,vo_is_dll_var]*tvarsym(symtableentry).varoptions)<>[] then
                   registers32:=1;
                   registers32:=1;
                 { call to get address of threadvar }
                 { call to get address of threadvar }
@@ -1287,7 +1282,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.104  2003-09-07 22:09:35  peter
+  Revision 1.105  2003-09-16 16:17:01  peter
+    * varspez in calls to push_addr_param
+
+  Revision 1.104  2003/09/07 22:09:35  peter
     * preparations for different default calling conventions
     * preparations for different default calling conventions
     * various RA fixes
     * various RA fixes
 
 

+ 39 - 26
compiler/paramgr.pas

@@ -44,18 +44,18 @@ unit paramgr;
           }
           }
           function ret_in_param(def : tdef;calloption : tproccalloption) : boolean;virtual;
           function ret_in_param(def : tdef;calloption : tproccalloption) : boolean;virtual;
 
 
-          function push_high_param(def : tdef;calloption : tproccalloption) : boolean;virtual;
+          function push_high_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;virtual;
 
 
           { Returns true if a parameter is too large to copy and only
           { Returns true if a parameter is too large to copy and only
             the address is pushed
             the address is pushed
           }
           }
-          function push_addr_param(def : tdef;calloption : tproccalloption) : boolean;virtual;
+          function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;virtual;
           { return the size of a push }
           { return the size of a push }
           function push_size(varspez:tvarspez;def : tdef;calloption : tproccalloption) : longint;
           function push_size(varspez:tvarspez;def : tdef;calloption : tproccalloption) : longint;
           { Returns true if a parameter needs to be copied on the stack, this
           { Returns true if a parameter needs to be copied on the stack, this
             is required for cdecl procedures
             is required for cdecl procedures
           }
           }
-          function copy_value_on_stack(def : tdef;calloption : tproccalloption) : boolean;virtual;
+          function copy_value_on_stack(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;virtual;
           {# Returns a structure giving the information on
           {# Returns a structure giving the information on
             the storage of the parameter (which must be
             the storage of the parameter (which must be
             an integer parameter). This is only used when calling
             an integer parameter). This is only used when calling
@@ -130,7 +130,7 @@ implementation
       end;
       end;
 
 
 
 
-    function tparamanager.push_high_param(def : tdef;calloption : tproccalloption) : boolean;
+    function tparamanager.push_high_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
       begin
       begin
          push_high_param:=not(calloption in [pocall_cdecl,pocall_cppdecl]) and
          push_high_param:=not(calloption in [pocall_cdecl,pocall_cppdecl]) and
                           (
                           (
@@ -142,52 +142,62 @@ implementation
 
 
 
 
     { true if a parameter is too large to copy and only the address is pushed }
     { true if a parameter is too large to copy and only the address is pushed }
-    function tparamanager.push_addr_param(def : tdef;calloption : tproccalloption) : boolean;
+    function tparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
       begin
       begin
-        push_addr_param:=false;
+        result:=false;
+        { var,out always require address }
+        if varspez in [vs_var,vs_out] then
+          begin
+            result:=true;
+            exit;
+          end;
+        { Only vs_const, vs_value here }
         case def.deftype of
         case def.deftype of
           variantdef,
           variantdef,
           formaldef :
           formaldef :
-            push_addr_param:=true;
+            result:=true;
           recorddef :
           recorddef :
-            push_addr_param:=not(calloption in [pocall_cdecl,pocall_cppdecl]) and (def.size>pointer_size);
+            result:=not(calloption in [pocall_cdecl,pocall_cppdecl]) and (def.size>pointer_size);
           arraydef :
           arraydef :
             begin
             begin
               if (calloption in [pocall_cdecl,pocall_cppdecl]) then
               if (calloption in [pocall_cdecl,pocall_cppdecl]) then
                begin
                begin
                  { array of const values are pushed on the stack }
                  { array of const values are pushed on the stack }
-                 push_addr_param:=not is_array_of_const(def);
+                 result:=not is_array_of_const(def);
                end
                end
               else
               else
                begin
                begin
-                 push_addr_param:=(
-                                   (tarraydef(def).highrange>=tarraydef(def).lowrange) and
-                                   (def.size>pointer_size)
-                                  ) or
-                                  is_open_array(def) or
-                                  is_array_of_const(def) or
-                                  is_array_constructor(def);
+                 result:=(
+                          (tarraydef(def).highrange>=tarraydef(def).lowrange) and
+                          (def.size>pointer_size)
+                         ) or
+                         is_open_array(def) or
+                         is_array_of_const(def) or
+                         is_array_constructor(def);
                end;
                end;
             end;
             end;
           objectdef :
           objectdef :
-            push_addr_param:=is_object(def);
+            result:=is_object(def);
           stringdef :
           stringdef :
-            push_addr_param:=not(calloption in [pocall_cdecl,pocall_cppdecl]) and (tstringdef(def).string_typ in [st_shortstring,st_longstring]);
+            result:=not(calloption in [pocall_cdecl,pocall_cppdecl]) and (tstringdef(def).string_typ in [st_shortstring,st_longstring]);
           procvardef :
           procvardef :
-            push_addr_param:=not(calloption in [pocall_cdecl,pocall_cppdecl]) and (po_methodpointer in tprocvardef(def).procoptions);
+            result:=not(calloption in [pocall_cdecl,pocall_cppdecl]) and (po_methodpointer in tprocvardef(def).procoptions);
           setdef :
           setdef :
-            push_addr_param:=not(calloption in [pocall_cdecl,pocall_cppdecl]) and (tsetdef(def).settype<>smallset);
+            result:=not(calloption in [pocall_cdecl,pocall_cppdecl]) and (tsetdef(def).settype<>smallset);
         end;
         end;
       end;
       end;
 
 
 
 
     { true if a parameter is too large to push and needs a concatcopy to get the value on the stack }
     { 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;
+    function tparamanager.copy_value_on_stack(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
       begin
       begin
         copy_value_on_stack:=false;
         copy_value_on_stack:=false;
-        { this is only for cdecl procedures }
-        if not(calloption in [pocall_cdecl,pocall_cppdecl]) then
-         exit;
+        { this is only for cdecl procedures with vs_const,vs_value }
+        if not(
+               (calloption in [pocall_cdecl,pocall_cppdecl]) and
+               (varspez in [vs_value,vs_const])
+              ) then
+          exit;
         case def.deftype of
         case def.deftype of
           variantdef,
           variantdef,
           formaldef :
           formaldef :
@@ -220,7 +230,7 @@ implementation
           vs_value,
           vs_value,
           vs_const :
           vs_const :
             begin
             begin
-                if push_addr_param(def,calloption) then
+                if push_addr_param(varspez,def,calloption) then
                   push_size:=pointer_size
                   push_size:=pointer_size
                 else
                 else
                   begin
                   begin
@@ -353,7 +363,10 @@ end.
 
 
 {
 {
    $Log$
    $Log$
-   Revision 1.54  2003-09-10 08:31:47  marco
+   Revision 1.55  2003-09-16 16:17:01  peter
+     * varspez in calls to push_addr_param
+
+   Revision 1.54  2003/09/10 08:31:47  marco
     * Patch from Peter for paraloc
     * Patch from Peter for paraloc
 
 
    Revision 1.53  2003/09/07 22:09:35  peter
    Revision 1.53  2003/09/07 22:09:35  peter

+ 26 - 8
compiler/pdecsub.pas

@@ -255,7 +255,7 @@ implementation
         while assigned(currpara) do
         while assigned(currpara) do
          begin
          begin
            { needs high parameter ? }
            { needs high parameter ? }
-           if paramanager.push_high_param(currpara.paratype.def,pd.proccalloption) then
+           if paramanager.push_high_param(currpara.paratyp,currpara.paratype.def,pd.proccalloption) then
             begin
             begin
               if assigned(currpara.parasym) then
               if assigned(currpara.parasym) then
                begin
                begin
@@ -273,7 +273,7 @@ implementation
               { Give a warning that cdecl routines does not include high()
               { Give a warning that cdecl routines does not include high()
                 support }
                 support }
               if (pd.proccalloption in [pocall_cdecl,pocall_cppdecl]) and
               if (pd.proccalloption in [pocall_cdecl,pocall_cppdecl]) and
-                 paramanager.push_high_param(currpara.paratype.def,pocall_default) then
+                 paramanager.push_high_param(currpara.paratyp,currpara.paratype.def,pocall_default) then
                begin
                begin
                  if is_open_string(currpara.paratype.def) then
                  if is_open_string(currpara.paratype.def) then
                     Message(parser_w_cdecl_no_openstring);
                     Message(parser_w_cdecl_no_openstring);
@@ -302,7 +302,7 @@ implementation
              array of const and open array do not need this, the local copy routine
              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 }
              will patch the pushed value to point to the local copy }
            if (varspez=vs_value) and
            if (varspez=vs_value) and
-              paramanager.push_addr_param(vartype.def,pd.proccalloption) and
+              paramanager.push_addr_param(varspez,vartype.def,pd.proccalloption) and
               not(is_array_of_const(vartype.def) or
               not(is_array_of_const(vartype.def) or
                   is_open_array(vartype.def)) then
                   is_open_array(vartype.def)) then
             pd.parast.symsearch.rename(name,'val'+name);
             pd.parast.symsearch.rename(name,'val'+name);
@@ -488,7 +488,7 @@ implementation
              if not is_procvar then
              if not is_procvar then
               begin
               begin
                 if (varspez in [vs_var,vs_const,vs_out]) and
                 if (varspez in [vs_var,vs_const,vs_out]) and
-                   paramanager.push_addr_param(tt.def,pd.proccalloption) then
+                   paramanager.push_addr_param(varspez,tt.def,pd.proccalloption) then
                   include(vs.varoptions,vo_regable);
                   include(vs.varoptions,vo_regable);
               end;
               end;
              pd.concatpara(nil,tt,vs,tdefaultvalue,false);
              pd.concatpara(nil,tt,vs,tdefaultvalue,false);
@@ -1775,7 +1775,11 @@ const
 {$ifdef i386}
 {$ifdef i386}
         { Move first 3 register parameters in localst }
         { Move first 3 register parameters in localst }
         if (pd.deftype=procdef) and
         if (pd.deftype=procdef) and
-           (pd.proccalloption=pocall_register) and
+           (
+            (pd.proccalloption=pocall_register) or
+            ((pocall_default=pocall_register) and
+             (pd.proccalloption in [pocall_compilerproc,pocall_internproc]))
+           ) and
            not(po_assembler in pd.procoptions) and
            not(po_assembler in pd.procoptions) and
            assigned(pd.para.first) then
            assigned(pd.para.first) then
           begin
           begin
@@ -1930,6 +1934,7 @@ const
       var
       var
         hd    : tprocdef;
         hd    : tprocdef;
         ad,fd : tsym;
         ad,fd : tsym;
+        s1,s2 : stringid;
         i     : cardinal;
         i     : cardinal;
         forwardfound : boolean;
         forwardfound : boolean;
         po_comp : tprocoptions;
         po_comp : tprocoptions;
@@ -2074,10 +2079,20 @@ const
                         { stop when one of the two lists is at the end }
                         { stop when one of the two lists is at the end }
                         if not assigned(ad) or not assigned(fd) then
                         if not assigned(ad) or not assigned(fd) then
                          break;
                          break;
-                        if (ad.name<>fd.name) then
+                        { retrieve names, remove reg for register parameters }
+                        s1:=ad.name;
+                        s2:=fd.name;
+{$ifdef i386}
+                        if copy(s1,1,3)='reg' then
+                          delete(s1,1,3);
+                        if copy(s2,1,3)='reg' then
+                          delete(s2,1,3);
+{$endif i386}
+                        { compare names }
+                        if (s1<>s2) then
                          begin
                          begin
                            MessagePos3(pd.fileinfo,parser_e_header_different_var_names,
                            MessagePos3(pd.fileinfo,parser_e_header_different_var_names,
-                                       aprocsym.name,ad.name,fd.name);
+                                       aprocsym.name,s1,s2);
                            break;
                            break;
                          end;
                          end;
                         ad:=tsym(ad.indexnext);
                         ad:=tsym(ad.indexnext);
@@ -2190,7 +2205,10 @@ const
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.133  2003-09-09 21:03:17  peter
+  Revision 1.134  2003-09-16 16:17:01  peter
+    * varspez in calls to push_addr_param
+
+  Revision 1.133  2003/09/09 21:03:17  peter
     * basics for x86 register calling
     * basics for x86 register calling
 
 
   Revision 1.132  2003/09/09 15:54:10  peter
   Revision 1.132  2003/09/09 15:54:10  peter

+ 9 - 1
compiler/pstatmnt.pas

@@ -1130,6 +1130,11 @@ implementation
          include(current_procinfo.flags,pi_is_assembler);
          include(current_procinfo.flags,pi_is_assembler);
          p:=_asm_statement;
          p:=_asm_statement;
 
 
+         { assembler routines use stdcall instead of register }
+         if (po_assembler in current_procinfo.procdef.procoptions) and
+            (current_procinfo.procdef.proccalloption=pocall_register) then
+           current_procinfo.procdef.proccalloption:=pocall_stdcall;
+
 {$ifndef sparc}
 {$ifndef sparc}
          { set the framepointer to esp for assembler functions when the
          { set the framepointer to esp for assembler functions when the
            following conditions are met:
            following conditions are met:
@@ -1181,7 +1186,10 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.108  2003-09-07 22:09:35  peter
+  Revision 1.109  2003-09-16 16:17:01  peter
+    * varspez in calls to push_addr_param
+
+  Revision 1.108  2003/09/07 22:09:35  peter
     * preparations for different default calling conventions
     * preparations for different default calling conventions
     * various RA fixes
     * various RA fixes
 
 

+ 6 - 7
compiler/rautils.pas

@@ -838,9 +838,7 @@ Begin
                   opr.ref.offsetfixup:=0;
                   opr.ref.offsetfixup:=0;
                   opr.ref.options:=ref_none;
                   opr.ref.options:=ref_none;
                 end;
                 end;
-              if (tvarsym(sym).varspez=vs_var) or
-                 ((tvarsym(sym).varspez=vs_const) and
-                  paramanager.push_addr_param(tvarsym(sym).vartype.def,current_procinfo.procdef.proccalloption)) then
+              if paramanager.push_addr_param(tvarsym(sym).varspez,tvarsym(sym).vartype.def,current_procinfo.procdef.proccalloption) then
                 SetSize(pointer_size,false);
                 SetSize(pointer_size,false);
             end;
             end;
           localsymtable :
           localsymtable :
@@ -876,9 +874,7 @@ Begin
                       opr.ref.options:=ref_none;
                       opr.ref.options:=ref_none;
                     end;
                     end;
                 end;
                 end;
-              if (tvarsym(sym).varspez in [vs_var,vs_out]) or
-                 ((tvarsym(sym).varspez=vs_const) and
-                  paramanager.push_addr_param(tvarsym(sym).vartype.def,current_procinfo.procdef.proccalloption)) then
+              if paramanager.push_addr_param(tvarsym(sym).varspez,tvarsym(sym).vartype.def,current_procinfo.procdef.proccalloption) then
                 SetSize(pointer_size,false);
                 SetSize(pointer_size,false);
             end;
             end;
         end;
         end;
@@ -1555,7 +1551,10 @@ end;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.65  2003-09-03 15:55:01  peter
+  Revision 1.66  2003-09-16 16:17:01  peter
+    * varspez in calls to push_addr_param
+
+  Revision 1.65  2003/09/03 15:55:01  peter
     * NEWRA branch merged
     * NEWRA branch merged
 
 
   Revision 1.64.2.1  2003/08/27 19:55:54  peter
   Revision 1.64.2.1  2003/08/27 19:55:54  peter

+ 7 - 10
compiler/regvars.pas

@@ -194,9 +194,7 @@ implementation
                       { unused                                }
                       { unused                                }
 
 
                       { call by reference/const ? }
                       { call by reference/const ? }
-                      if (regvarinfo^.regvars[i].varspez in [vs_var,vs_out]) or
-                         ((regvarinfo^.regvars[i].varspez=vs_const) and
-                           paramanager.push_addr_param(regvarinfo^.regvars[i].vartype.def,current_procinfo.procdef.proccalloption)) then
+                      if paramanager.push_addr_param(regvarinfo^.regvars[i].varspez,regvarinfo^.regvars[i].vartype.def,current_procinfo.procdef.proccalloption) then
                         siz:=OS_32
                         siz:=OS_32
                       else
                       else
                        if (regvarinfo^.regvars[i].vartype.def.deftype in [orddef,enumdef]) and
                        if (regvarinfo^.regvars[i].vartype.def.deftype in [orddef,enumdef]) and
@@ -364,9 +362,7 @@ implementation
             begin
             begin
               asml.concat(tai_regalloc.alloc(reg));
               asml.concat(tai_regalloc.alloc(reg));
               reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address);
               reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address);
-              if (vsym.varspez in [vs_var,vs_out]) or
-                 ((vsym.varspez=vs_const) and
-                   paramanager.push_addr_param(vsym.vartype.def,current_procinfo.procdef.proccalloption)) then
+              if paramanager.push_addr_param(vsym.varspez,vsym.vartype.def,current_procinfo.procdef.proccalloption) then
                 opsize := OS_ADDR
                 opsize := OS_ADDR
               else
               else
                 opsize := def_cgsize(vsym.vartype.def);
                 opsize := def_cgsize(vsym.vartype.def);
@@ -382,9 +378,7 @@ implementation
             begin
             begin
               asml.concat(tai_regalloc.alloc(reg));
               asml.concat(tai_regalloc.alloc(reg));
               reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address);
               reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address);
-              if (vsym.varspez in [vs_var,vs_out]) or
-                 ((vsym.varspez=vs_const) and
-                   paramanager.push_addr_param(vsym.vartype.def,current_procinfo.procdef.proccalloption)) then
+              if paramanager.push_addr_param(vsym.varspez,vsym.vartype.def,current_procinfo.procdef.proccalloption) then
                 opsize := OS_ADDR
                 opsize := OS_ADDR
               else
               else
                 opsize := def_cgsize(vsym.vartype.def);
                 opsize := def_cgsize(vsym.vartype.def);
@@ -610,7 +604,10 @@ end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.64  2003-09-07 22:09:35  peter
+  Revision 1.65  2003-09-16 16:17:01  peter
+    * varspez in calls to push_addr_param
+
+  Revision 1.64  2003/09/07 22:09:35  peter
     * preparations for different default calling conventions
     * preparations for different default calling conventions
     * various RA fixes
     * various RA fixes
 
 

+ 5 - 2
compiler/rgobj.pas

@@ -195,7 +195,7 @@ unit rgobj;
           t_times: longint;
           t_times: longint;
 
 
           constructor create(Acpu_registers:byte;const Ausable:string);
           constructor create(Acpu_registers:byte;const Ausable:string);
-          destructor destroy;virtual;
+          destructor destroy;override;
 
 
           {# Allocate a general purpose register
           {# Allocate a general purpose register
 
 
@@ -2225,7 +2225,10 @@ end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.75  2003-09-12 19:07:42  daniel
+  Revision 1.76  2003-09-16 16:17:01  peter
+    * varspez in calls to push_addr_param
+
+  Revision 1.75  2003/09/12 19:07:42  daniel
     * Fixed fast spilling functionality by re-adding the code that initializes
     * Fixed fast spilling functionality by re-adding the code that initializes
       precoloured nodes to degree 255. I would like to play hangman on the one
       precoloured nodes to degree 255. I would like to play hangman on the one
       who removed that code.
       who removed that code.

+ 8 - 10
compiler/symsym.pas

@@ -1851,15 +1851,10 @@ implementation
          end
          end
        else if (owner.symtabletype in [parasymtable,inlineparasymtable]) then
        else if (owner.symtabletype in [parasymtable,inlineparasymtable]) then
          begin
          begin
-            case varspez of
-               vs_out,
-               vs_var   : st := 'v'+st;
-               vs_value,
-               vs_const : if paramanager.push_addr_param(vartype.def,tprocdef(owner.defowner).proccalloption) then
-                            st := 'v'+st { should be 'i' but 'i' doesn't work }
-                          else
-                            st := 'p'+st;
-              end;
+            if paramanager.push_addr_param(varspez,vartype.def,tprocdef(owner.defowner).proccalloption) then
+              st := 'v'+st { should be 'i' but 'i' doesn't work }
+            else
+              st := 'p'+st;
             stabstring := strpnew('"'+name+':'+st+'",'+
             stabstring := strpnew('"'+name+':'+st+'",'+
                   tostr(N_tsym)+',0,'+tostr(fileinfo.line)+','+
                   tostr(N_tsym)+',0,'+tostr(fileinfo.line)+','+
                   tostr(adjusted_address));
                   tostr(adjusted_address));
@@ -2662,7 +2657,10 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.117  2003-09-14 13:20:12  peter
+  Revision 1.118  2003-09-16 16:17:01  peter
+    * varspez in calls to push_addr_param
+
+  Revision 1.117  2003/09/14 13:20:12  peter
     * fix previous commit, also include objectsymtable
     * fix previous commit, also include objectsymtable
 
 
   Revision 1.116  2003/09/14 12:58:00  peter
   Revision 1.116  2003/09/14 12:58:00  peter