+ call support

compiler/sparc/ncgcall.pas

@@ -0,0 +1,1587 @@
+{*****************************************************************************}
+{ File                   : ncgcall.pas                                        }
+{ Author                 : Mazen NEIFER                                       }
+{ Project                : Free Pascal Compiler (FPC)                         }
+{ Creation date          : 2002\26\26                                         }
+{ Last modification date : 2002\07\01                                         }
+{ Licence                : GPL                                                }
+{ Bug report             : [email protected]                        }
+{*****************************************************************************}
+{
+    $Id$
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    Generate SPARC assembler for in call nodes
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published bymethodpointer
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************}
+UNIT ncgcall;
+{$INCLUDE fpcdefs.inc}{$MACRO ON}
+INTERFACE
+{$DEFINE R_ESI:=R_I0}
+{$DEFINE R_EDI:=R_O0}
+{$DEFINE R_CS:=R_PSR}
+{$DEFINE R_ST:=R_PSR}
+{$DEFINE A_LEA:=A_NONE}
+{$DEFINE A_FSTP:=A_NONE}
+USES
+  symdef,node,ncal;
+TYPE
+  tSPARCcallparanode=CLASS(tcallparanode)
+    PROCEDURE secondcallparan(defcoll : TParaItem;
+    push_from_left_to_right,inlined,is_cdecl : boolean;
+    para_alignment,para_offset : longint);override;
+  end;
+  tSPARCcallnode = class(tcallnode)
+    PROCEDURE pass_2;override;
+  end;
+  tSPARCprocinlinenode = class(tprocinlinenode)
+    PROCEDURE pass_2;override;
+  end;
+IMPLEMENTATION
+USES
+  globtype,systems,
+  cutils,verbose,globals,
+  symconst,symbase,symsym,symtable,types,
+{$ifdef GDB}
+  {$ifdef delphi}
+      sysutils,
+  {$else}
+      strings,
+  {$endif}
+      gdb,
+{$endif GDB}
+      cginfo,cgbase,pass_2,
+      cpubase,aasm,tainst,
+      nmem,nld,ncnv,
+      ncgutil,cga,cgobj,tgobj,regvars,rgobj,rgcpu,cg64f32,cgcpu;
+
+{*****************************************************************************
+                             TSPARCCALLPARANODE
+*****************************************************************************}
+
+    PROCEDURE tSPARCcallparanode.secondcallparan(defcoll : TParaItem;
+                push_from_left_to_right,inlined,is_cdecl : boolean;para_alignment,para_offset : longint);
+
+      PROCEDURE maybe_push_high;
+        begin
+           { open array ? }
+           { defcoll.data can be nil for read/write }
+           if assigned(defcoll.paratype.def) and
+              assigned(hightree) then
+            begin
+              secondpass(hightree);
+              { this is a longint anyway ! }
+              push_value_para(hightree,inlined,false,para_offset,4);
+            end;
+        end;
+
+      var
+         otlabel,oflabel : tasmlabel;
+         { temporary variables: }
+         tempdeftype : tdeftype;
+         tmpreg : tregister;
+         href   : treference;
+
+      begin
+         { set default para_alignment to target_info.stackalignment }
+         if para_alignment=0 then
+          para_alignment:=aktalignment.paraalign;
+
+         { push from left to right if specified }
+         if push_from_left_to_right and assigned(right) then
+          begin
+            if (nf_varargs_para in flags) then
+              tcallparanode(right).secondcallparan(defcoll,push_from_left_to_right,
+                                                   inlined,is_cdecl,para_alignment,para_offset)
+            else
+              tcallparanode(right).secondcallparan(TParaItem(defcoll.next),push_from_left_to_right,
+                                                   inlined,is_cdecl,para_alignment,para_offset);
+          end;
+
+         otlabel:=truelabel;
+         oflabel:=falselabel;
+         getlabel(truelabel);
+         getlabel(falselabel);
+         secondpass(left);
+         { handle varargs first, because defcoll is not valid }
+         if (nf_varargs_para in flags) then
+           begin
+             if push_addr_param(left.resulttype.def) then
+               begin
+                 inc(pushedparasize,4);
+                 cg.a_paramaddr_ref(exprasmlist,left.location.reference,-1);
+                 location_release(exprasmlist,left.location);
+               end
+             else
+               push_value_para(left,inlined,is_cdecl,para_offset,para_alignment);
+           end
+         { filter array constructor with c styled args }
+         else if is_array_constructor(left.resulttype.def) and (nf_cargs in left.flags) then
+           begin
+             { nothing, everything is already pushed }
+           end
+         { in codegen.handleread.. defcoll.data is set to nil }
+         else if assigned(defcoll.paratype.def) and
+                 (defcoll.paratype.def.deftype=formaldef) then
+           begin
+              { allow passing of a constant to a const formaldef }
+              if (defcoll.paratyp=vs_const) and
+                 (left.location.loc=LOC_CONSTANT) then
+                location_force_mem(exprasmlist,left.location);
+
+              { allow @var }
+              inc(pushedparasize,4);
+              if (left.nodetype=addrn) and
+                 (not(nf_procvarload in left.flags)) then
+                begin
+                  if inlined then
+                    begin
+                       reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
+                       cg.a_load_loc_ref(exprasmlist,left.location,href);
+                    end
+                  else
+                    cg.a_param_loc(exprasmlist,left.location,-1);
+                  location_release(exprasmlist,left.location);
+                end
+              else
+                begin
+                   if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
+                     CGMessage(type_e_mismatch)
+                   else
+                     begin
+                       if inlined then
+                         begin
+                           tmpreg:=cg.get_scratch_reg_address(exprasmlist);
+                           cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
+                           reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
+                           cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
+                           cg.free_scratch_reg(exprasmlist,tmpreg);
+                         end
+                       else
+                         cg.a_paramaddr_ref(exprasmlist,left.location.reference,-1);
+                       location_release(exprasmlist,left.location);
+                     end;
+                end;
+           end
+         { handle call by reference parameter }
+         else if (defcoll.paratyp in [vs_var,vs_out]) then
+           begin
+              { get temp for constants }
+              if left.location.loc=LOC_CONSTANT then
+               begin
+                 tg.gettempofsizereference(exprasmlist,left.resulttype.def.size,href);
+                 cg.a_load_loc_ref(exprasmlist,left.location,href);
+                 location_reset(left.location,LOC_REFERENCE,def_cgsize(left.resulttype.def));
+                 left.location.reference:=href;
+               end;
+
+              if (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
+                        (left.nodetype=selfn)) then
+                  internalerror(200106041);
+               end;
+              maybe_push_high;
+              if (defcoll.paratyp=vs_out) and
+                 assigned(defcoll.paratype.def) and
+                 not is_class(defcoll.paratype.def) and
+                 defcoll.paratype.def.needs_inittable then
+                cg.g_finalize(exprasmlist,defcoll.paratype.def,left.location.reference,false);
+              inc(pushedparasize,4);
+              if inlined then
+                begin
+                   tmpreg:=cg.get_scratch_reg_address(exprasmlist);
+                   cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
+                   reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
+                   cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
+                   cg.free_scratch_reg(exprasmlist,tmpreg);
+                end
+              else
+                cg.a_paramaddr_ref(exprasmlist,left.location.reference,-1);
+              location_release(exprasmlist,left.location);
+           end
+         else
+           begin
+              tempdeftype:=resulttype.def.deftype;
+              if tempdeftype=filedef then
+               CGMessage(cg_e_file_must_call_by_reference);
+              { open array must always push the address, this is needed to
+                also push addr of small open arrays and with cdecl functions (PFV) }
+              if (
+                  assigned(defcoll.paratype.def) and
+                  (is_open_array(defcoll.paratype.def) or
+                   is_array_of_const(defcoll.paratype.def))
+                 ) or
+                 (
+                  push_addr_param(resulttype.def) and
+                  not is_cdecl
+                 ) then
+                begin
+                   if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
+                    begin
+                      { allow passing nil to a procvardef (methodpointer) }
+                      if (left.nodetype=typeconvn) and
+                         (left.resulttype.def.deftype=procvardef) and
+                         (ttypeconvnode(left).left.nodetype=niln) then
+                       begin
+                         tg.gettempofsizereference(exprasmlist,tcgsize2size[left.location.size],href);
+                         cg.a_load_loc_ref(exprasmlist,left.location,href);
+                         location_reset(left.location,LOC_REFERENCE,left.location.size);
+                         left.location.reference:=href;
+                       end
+                      else
+                       internalerror(200204011);
+                    end;
+
+                   maybe_push_high;
+                   inc(pushedparasize,4);
+                   if inlined then
+                     begin
+                        tmpreg:=cg.get_scratch_reg_address(exprasmlist);
+                        cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
+                        reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
+                        cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
+                        cg.free_scratch_reg(exprasmlist,tmpreg);
+                     end
+                   else
+                     cg.a_paramaddr_ref(exprasmlist,left.location.reference,-1);
+                   location_release(exprasmlist,left.location);
+                end
+              else
+                begin
+                   push_value_para(left,inlined,is_cdecl,
+                     para_offset,para_alignment);
+                end;
+           end;
+         truelabel:=otlabel;
+         falselabel:=oflabel;
+         { push from right to left }
+         if not push_from_left_to_right and assigned(right) then
+          begin
+            if (nf_varargs_para in flags) then
+              tcallparanode(right).secondcallparan(defcoll,push_from_left_to_right,
+                                                   inlined,is_cdecl,para_alignment,para_offset)
+            else
+              tcallparanode(right).secondcallparan(TParaItem(defcoll.next),push_from_left_to_right,
+                                                   inlined,is_cdecl,para_alignment,para_offset);
+          end;
+      end;
+
+
+{*****************************************************************************
+                             TI386CALLNODE
+*****************************************************************************}
+
+    PROCEDURE tSPARCcallnode.pass_2;
+      var
+         regs_to_push : tregisterset;
+         unusedstate: pointer;
+         pushed : tpushedsaved;
+         funcretref,refcountedtemp : treference;
+         tmpreg : tregister;
+         hregister : tregister;
+         oldpushedparasize : longint;
+         { true if ESI must be loaded again after the subroutine }
+         loadesi : boolean;
+         { true if a virtual method must be called directly }
+         no_virtual_call : boolean;
+         { true if we produce a con- or destrutor in a call }
+         is_con_or_destructor : boolean;
+         { true if a constructor is called again }
+         extended_new : boolean;
+         { adress returned from an I/O-error }
+         iolabel : tasmlabel;
+         { lexlevel count }
+         i : longint;
+         { help reference pointer }
+         href : treference;
+         hrefvmt : treference;
+         hp : tnode;
+         pp : tbinarynode;
+         params : tnode;
+         inlined : boolean;
+         inlinecode : tprocinlinenode;
+         store_parast_fixup,
+         para_alignment,
+         para_offset : longint;
+         cgsize : tcgsize;
+         { instruction for alignement correction }
+{        corr : paicpu;}
+         { we must pop this size also after !! }
+{        must_pop : boolean; }
+         pop_size : longint;
+{$ifdef OPTALIGN}
+         pop_esp : boolean;
+         push_size : longint;
+{$endif OPTALIGN}
+         pop_allowed : boolean;
+         release_tmpreg : boolean;
+         constructorfailed : tasmlabel;
+
+      label
+         dont_call;
+
+      begin
+         extended_new:=false;
+         iolabel:=nil;
+         inlinecode:=nil;
+         inlined:=false;
+         loadesi:=true;
+         no_virtual_call:=false;
+         rg.saveunusedstate(unusedstate);
+
+         { if we allocate the temp. location for ansi- or widestrings }
+         { already here, we avoid later a push/pop                    }
+         if is_widestring(resulttype.def) then
+           begin
+             tg.gettempwidestringreference(exprasmlist,refcountedtemp);
+             cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp);
+           end
+         else if is_ansistring(resulttype.def) then
+           begin
+             tg.gettempansistringreference(exprasmlist,refcountedtemp);
+             cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp);
+           end;
+
+         if (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_stdcall]) then
+          para_alignment:=4
+         else
+          para_alignment:=aktalignment.paraalign;
+
+         if not assigned(procdefinition) then
+          exit;
+
+         { Deciding whether we may still need the parameters happens next (JM) }
+         if assigned(left) then
+           params:=left.getcopy
+         else params := nil;
+
+         if (procdefinition.proccalloption=pocall_inline) then
+           begin
+              inlined:=true;
+              inlinecode:=tprocinlinenode(right);
+              right:=nil;
+              { set it to the same lexical level as the local symtable, becuase
+                the para's are stored there }
+              tprocdef(procdefinition).parast.symtablelevel:=aktprocdef.localst.symtablelevel;
+              if assigned(params) then
+                inlinecode.para_offset:=tg.gettempofsizepersistant(exprasmlist,inlinecode.para_size);
+              store_parast_fixup:=tprocdef(procdefinition).parast.address_fixup;
+              tprocdef(procdefinition).parast.address_fixup:=inlinecode.para_offset;
+{$ifdef extdebug}
+             Comment(V_debug,
+               'inlined parasymtable is at offset '
+               +tostr(tprocdef(procdefinition).parast.address_fixup));
+             exprasmList.concat(Tai_asm_comment.Create(
+               strpnew('inlined parasymtable is at offset '
+               +tostr(tprocdef(procdefinition).parast.address_fixup))));
+{$endif extdebug}
+           end;
+         { only if no proc var }
+         if inlined or
+            not(assigned(right)) then
+           is_con_or_destructor:=(procdefinition.proctypeoption in [potype_constructor,potype_destructor]);
+         { proc variables destroy all registers }
+         if (inlined or
+            (right=nil)) and
+            { virtual methods too }
+            not(po_virtualmethod in procdefinition.procoptions) then
+           begin
+              if (cs_check_io in aktlocalswitches) and
+                 (po_iocheck in procdefinition.procoptions) and
+                 not(po_iocheck in aktprocdef.procoptions) then
+                begin
+                   getaddrlabel(iolabel);
+                   cg.a_label(exprasmlist,iolabel);
+                end
+              else
+                iolabel:=nil;
+
+              { save all used registers }
+              regs_to_push := tprocdef(procdefinition).usedregisters;
+              rg.saveusedregisters(exprasmlist,pushed,regs_to_push);
+
+              { give used registers through }
+              rg.usedinproc:=rg.usedinproc + tprocdef(procdefinition).usedregisters;
+           end
+         else
+           begin
+              regs_to_push := all_registers;
+              rg.saveusedregisters(exprasmlist,pushed,regs_to_push);
+              rg.usedinproc:=all_registers;
+              { no IO check for methods and PROCEDURE variables }
+              iolabel:=nil;
+           end;
+
+         { generate the code for the parameter and push them }
+         oldpushedparasize:=pushedparasize;
+         pushedparasize:=0;
+         pop_size:=0;
+         { no inc esp for inlined PROCEDURE
+           and for objects constructors PM }
+         if inlined or
+            ((procdefinition.proctypeoption=potype_constructor) and
+            { quick'n'dirty check if it is a class or an object }
+             (resulttype.def.deftype=orddef)) then
+           pop_allowed:=false
+         else
+           pop_allowed:=true;
+         if pop_allowed then
+          begin
+          { Old pushedsize aligned on 4 ? }
+            i:=oldpushedparasize and 3;
+            if i>0 then
+             inc(pop_size,4-i);
+          { This parasize aligned on 4 ? }
+            i:=procdefinition.para_size(para_alignment) and 3;
+            if i>0 then
+             inc(pop_size,4-i);
+          { insert the opcode and update pushedparasize }
+          { never push 4 or more !! }
+            pop_size:=pop_size mod 4;
+            if pop_size>0 then
+             begin
+               inc(pushedparasize,pop_size);
+               emit_const_reg(A_SUB,S_L,pop_size,Stack_Pointer_Reg);
+{$ifdef GDB}
+               if (cs_debuginfo in aktmoduleswitches) and
+                  (exprasmList.first=exprasmList.last) then
+                 exprasmList.concat(Tai_force_line.Create);
+{$endif GDB}
+             end;
+          end;
+{$ifdef OPTALIGN}
+         if pop_allowed and (cs_align in aktglobalswitches) then
+           begin
+              pop_esp:=true;
+              push_size:=procdefinition.para_size(para_alignment);
+              { !!!! here we have to take care of return type, self
+                and nested PROCEDUREs
+              }
+              inc(push_size,12);
+              emit_reg_reg(A_MOV,S_L,Stack_Pointer,R_EDI);
+              if (push_size mod 8)=0 then
+                emit_const_reg(A_AND,S_L,$fffffff8,Stack_Pointer)
+              else
+                begin
+                   emit_const_reg(A_SUB,S_L,push_size,Stack_Pointer);
+                   emit_const_reg(A_AND,S_L,$fffffff8,Stack_Pointer);
+                   emit_const_reg(A_SUB,S_L,push_size,Stack_Pointer);
+                end;
+              emit_reg(A_SAVE,S_L,R_EDI);
+           end
+         else
+           pop_esp:=false;
+{$endif OPTALIGN}
+
+         { Push parameters }
+         if assigned(params) then
+           begin
+              { be found elsewhere }
+              if inlined then
+                para_offset:=tprocdef(procdefinition).parast.address_fixup+
+                  tprocdef(procdefinition).parast.datasize
+              else
+                para_offset:=0;
+              if not(inlined) and
+                 assigned(right) then
+                tcallparanode(params).secondcallparan(TParaItem(tabstractprocdef(right.resulttype.def).Para.first),
+                  (po_leftright in procdefinition.procoptions),inlined,
+                  (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl]),
+                  para_alignment,para_offset)
+              else
+                tcallparanode(params).secondcallparan(TParaItem(procdefinition.Para.first),
+                  (po_leftright in procdefinition.procoptions),inlined,
+                  (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl]),
+                  para_alignment,para_offset);
+           end;
+
+         { Allocate return value for inlined routines }
+         if inlined then
+           inlinecode.retoffset:=tg.gettempofsizepersistant(exprasmlist,Align(resulttype.def.size,aktalignment.paraalign));
+
+         { Allocate return value when returned in argument }
+         if ret_in_param(resulttype.def) then
+           begin
+             if assigned(funcretrefnode) then
+              begin
+                secondpass(funcretrefnode);
+                if codegenerror then
+                 exit;
+                if (funcretrefnode.location.loc<>LOC_REFERENCE) then
+                 internalerror(200204246);
+                funcretref:=funcretrefnode.location.reference;
+              end
+             else
+              begin
+                if inlined then
+                 begin
+                   reference_reset(funcretref);
+                   funcretref.offset:=tg.gettempofsizepersistant(exprasmlist,resulttype.def.size);
+                   funcretref.base:=procinfo^.framepointer;
+{$ifdef extdebug}
+                   Comment(V_debug,'function return value is at offset '
+                                   +tostr(funcretref.offset));
+                   exprasmlist.concat(tai_asm_comment.create(
+                                       strpnew('function return value is at offset '
+                                               +tostr(funcretref.offset))));
+{$endif extdebug}
+                 end
+                else
+                 tg.gettempofsizereference(exprasmlist,resulttype.def.size,funcretref);
+              end;
+
+             { This must not be counted for C code
+               complex return address is removed from stack
+               by function itself !   }
+{$ifdef OLD_C_STACK}
+             inc(pushedparasize,4); { lets try without it PM }
+{$endif not OLD_C_STACK}
+             if inlined then
+               begin
+                  hregister:=cg.get_scratch_reg_address(exprasmlist);
+                  cg.a_loadaddr_ref_reg(exprasmlist,funcretref,hregister);
+                  reference_reset_base(href,procinfo^.framepointer,inlinecode.retoffset);
+                  cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,href);
+                  cg.free_scratch_reg(exprasmlist,hregister);
+               end
+             else
+               cg.a_paramaddr_ref(exprasmlist,funcretref,-1);
+           end;
+
+         { PROCEDURE variable or normal function call ? }
+         if inlined or
+            (right=nil) then
+           begin
+              { Normal function call }
+
+              { overloaded operator has no symtable }
+              { push self }
+              if assigned(symtableproc) and
+                (symtableproc.symtabletype=withsymtable) then
+                begin
+                   { dirty trick to avoid the secondcall below }
+                   methodpointer:=ccallparanode.create(nil,nil);
+                   location_reset(methodpointer.location,LOC_REGISTER,OS_ADDR);
+                   rg.getexplicitregisterint(exprasmlist,R_ESI);
+                   methodpointer.location.register:=R_ESI;
+                   { ARGHHH this is wrong !!!
+                     if we can init from base class for a child
+                     class that the wrong VMT will be
+                     transfered to constructor !! }
+                   methodpointer.resulttype:=
+                     twithnode(twithsymtable(symtableproc).withnode).left.resulttype;
+                   { make a reference }
+                   href:=twithnode(twithsymtable(symtableproc).withnode).withreference;
+                   if ((not(nf_islocal in twithnode(twithsymtable(symtableproc).withnode).flags)) and
+                       (not twithsymtable(symtableproc).direct_with)) or
+                      is_class_or_interface(methodpointer.resulttype.def) then
+                     cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,self_pointer_reg)
+                   else
+                     cg.a_loadaddr_ref_reg(exprasmlist,href,self_pointer_reg);
+                end;
+
+              { push self }
+              if assigned(symtableproc) and
+                ((symtableproc.symtabletype=objectsymtable) or
+                (symtableproc.symtabletype=withsymtable)) then
+                begin
+                   if assigned(methodpointer) then
+                     begin
+                        {
+                        if methodpointer^.resulttype.def=classrefdef then
+                          begin
+                              two possibilities:
+                               1. constructor
+                               2. class method
+
+                          end
+                        else }
+                          begin
+                             case methodpointer.nodetype of
+                               typen:
+                                 begin
+                                    { direct call to inherited method }
+                                    if (po_abstractmethod in procdefinition.procoptions) then
+                                      begin
+                                         CGMessage(cg_e_cant_call_abstract_method);
+                                         goto dont_call;
+                                      end;
+                                    { generate no virtual call }
+                                    no_virtual_call:=true;
+
+                                    if (sp_static in symtableprocentry.symoptions) then
+                                      begin
+                                         { well lets put the VMT address directly into ESI }
+                                         { it is kind of dirty but that is the simplest    }
+                                         { way to accept virtual static functions (PM)     }
+                                         loadesi:=true;
+                                         { if no VMT just use $0 bug0214 PM }
+                                         rg.getexplicitregisterint(exprasmlist,R_ESI);
+                                         if not(oo_has_vmt in tobjectdef(methodpointer.resulttype.def).objectoptions) then
+                                           cg.a_load_const_reg(exprasmlist,OS_ADDR,0,self_pointer_reg)
+                                         else
+                                           begin
+                                             reference_reset_symbol(href,newasmsymbol(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
+                                             cg.a_loadaddr_ref_reg(exprasmlist,href,self_pointer_reg);
+                                           end;
+                                         { emit_reg(A_SAVE,S_L,R_ESI);
+                                           this is done below !! }
+                                      end
+                                    else
+                                      { this is a member call, so ESI isn't modfied }
+                                      loadesi:=false;
+
+                                    { a class destructor needs a flag }
+                                    if is_class(tobjectdef(methodpointer.resulttype.def)) and
+                                       (procdefinition.proctypeoption=potype_destructor) then
+                                      begin
+                                        cg.a_param_const(exprasmlist,OS_ADDR,0,2);
+                                        cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,1);
+                                      end;
+
+                                    if not(is_con_or_destructor and
+                                           is_class(methodpointer.resulttype.def) and
+                                           (procdefinition.proctypeoption in [potype_constructor,potype_destructor])
+                                          ) then
+                                      cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,1);
+                                    { if an inherited con- or destructor should be  }
+                                    { called in a con- or destructor then a warning }
+                                    { will be made                                  }
+                                    { con- and destructors need a pointer to the vmt }
+                                    if is_con_or_destructor and
+                                      is_object(methodpointer.resulttype.def) and
+                                      assigned(aktprocdef) then
+                                      begin
+                                         if not(aktprocdef.proctypeoption in
+                                                [potype_constructor,potype_destructor]) then
+                                          CGMessage(cg_w_member_cd_call_from_method);
+                                      end;
+                                    { class destructors get there flag above }
+                                    { constructor flags ?                    }
+                                    if is_con_or_destructor and
+                                      not(
+                                        is_class(methodpointer.resulttype.def) and
+                                        assigned(aktprocdef) and
+                                        (aktprocdef.proctypeoption=potype_destructor)) then
+                                      begin
+                                         { a constructor needs also a flag }
+                                         if is_class(methodpointer.resulttype.def) then
+                                           cg.a_param_const(exprasmlist,OS_ADDR,0,2);
+                                         cg.a_param_const(exprasmlist,OS_ADDR,0,1);
+                                      end;
+                                 end;
+                               hnewn:
+                                 begin
+                                    { extended syntax of new }
+                                    { ESI must be zero }
+                                    rg.getexplicitregisterint(exprasmlist,R_ESI);
+                                    cg.a_load_const_reg(exprasmlist,OS_ADDR,0,self_pointer_reg);
+                                    cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,2);
+                                    { insert the vmt }
+                                    reference_reset_symbol(href,newasmsymbol(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
+                                    cg.a_paramaddr_ref(exprasmlist,href,1);
+                                    extended_new:=true;
+                                 end;
+                               hdisposen:
+                                 begin
+                                    secondpass(methodpointer);
+
+                                    { destructor with extended syntax called from dispose }
+                                    { hdisposen always deliver LOC_REFERENCE          }
+                                    rg.getexplicitregisterint(exprasmlist,R_ESI);
+                                    emit_ref_reg(A_LEA,S_L,methodpointer.location.reference,R_ESI);
+                                    reference_release(exprasmlist,methodpointer.location.reference);
+                                    cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,2);
+                                    reference_reset_symbol(href,newasmsymbol(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
+                                    cg.a_paramaddr_ref(exprasmlist,href,1);
+                                 end;
+                               else
+                                 begin
+                                    { call to an instance member }
+                                    if (symtableproc.symtabletype<>withsymtable) then
+                                      begin
+                                         secondpass(methodpointer);
+                                         rg.getexplicitregisterint(exprasmlist,R_ESI);
+                                         case methodpointer.location.loc of
+                                            LOC_CREGISTER,
+                                            LOC_REGISTER:
+                                              begin
+                                                 cg.a_load_reg_reg(exprasmlist,OS_ADDR,methodpointer.location.register,R_ESI);
+                                                 rg.ungetregisterint(exprasmlist,methodpointer.location.register);
+                                              end;
+                                            else
+                                              begin
+                                                 if (methodpointer.resulttype.def.deftype=classrefdef) or
+                                                    is_class_or_interface(methodpointer.resulttype.def) then
+                                                   cg.a_load_ref_reg(exprasmlist,OS_ADDR,methodpointer.location.reference,R_ESI)
+                                                 else
+                                                   cg.a_loadaddr_ref_reg(exprasmlist,methodpointer.location.reference,R_ESI);
+                                                 reference_release(exprasmlist,methodpointer.location.reference);
+                                              end;
+                                         end;
+                                      end;
+                                    { when calling a class method, we have to load ESI with the VMT !
+                                      But, not for a class method via self }
+                                    if not(po_containsself in procdefinition.procoptions) then
+                                      begin
+                                        if (po_classmethod in procdefinition.procoptions) and
+                                           not(methodpointer.resulttype.def.deftype=classrefdef) then
+                                          begin
+                                             { class method needs current VMT }
+                                             rg.getexplicitregisterint(exprasmlist,R_ESI);
+                                             reference_reset_base(href,R_ESI,tprocdef(procdefinition)._class.vmt_offset);
+                                             cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,self_pointer_reg);
+                                          end;
+
+                                        { direct call to destructor: remove data }
+                                        if (procdefinition.proctypeoption=potype_destructor) and
+                                           is_class(methodpointer.resulttype.def) then
+                                          cg.a_param_const(exprasmlist,OS_INT,1,1);
+
+                                        { direct call to class constructor, don't allocate memory }
+                                        if (procdefinition.proctypeoption=potype_constructor) and
+                                           is_class(methodpointer.resulttype.def) then
+                                          begin
+                                             cg.a_param_const(exprasmlist,OS_INT,0,2);
+                                             cg.a_param_const(exprasmlist,OS_INT,0,1);
+                                          end
+                                        else
+                                          begin
+                                             { constructor call via classreference => allocate memory }
+                                             if (procdefinition.proctypeoption=potype_constructor) and
+                                                (methodpointer.resulttype.def.deftype=classrefdef) and
+                                                is_class(tclassrefdef(methodpointer.resulttype.def).pointertype.def) then
+                                               cg.a_param_const(exprasmlist,OS_INT,1,1);
+                                             cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,1);
+                                          end;
+                                      end;
+
+                                    if is_con_or_destructor then
+                                      begin
+                                         { classes don't get a VMT pointer pushed }
+                                         if is_object(methodpointer.resulttype.def) then
+                                           begin
+                                              if (procdefinition.proctypeoption=potype_constructor) then
+                                                begin
+                                                  { it's no bad idea, to insert the VMT }
+                                                  reference_reset_symbol(href,newasmsymbol(
+                                                     tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
+                                                  cg.a_paramaddr_ref(exprasmlist,href,1);
+                                                end
+                                              { destructors haven't to dispose the instance, if this is }
+                                              { a direct call                                           }
+                                              else
+                                                cg.a_param_const(exprasmlist,OS_INT,0,1);
+                                           end;
+                                      end;
+                                 end;
+                             end;
+                          end;
+                     end
+                   else
+                     begin
+                        if (po_classmethod in procdefinition.procoptions) and
+                          not(
+                            assigned(aktprocdef) and
+                            (po_classmethod in aktprocdef.procoptions)
+                          ) then
+                          begin
+                             { class method needs current VMT }
+                             rg.getexplicitregisterint(exprasmlist,R_ESI);
+                             reference_reset_base(href,R_ESI,tprocdef(procdefinition)._class.vmt_offset);
+                             cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,R_ESI);
+                          end
+                        else
+                          begin
+                             { member call, ESI isn't modified }
+                             loadesi:=false;
+                          end;
+                        { direct call to destructor: don't remove data! }
+                        if is_class(procinfo^._class) then
+                          begin
+                             if (procdefinition.proctypeoption=potype_destructor) then
+                               begin
+                                  cg.a_param_const(exprasmlist,OS_INT,0,2);
+                                  cg.a_param_reg(exprasmlist,OS_ADDR,R_ESI,1);
+                               end
+                             else if (procdefinition.proctypeoption=potype_constructor) then
+                               begin
+                                  cg.a_param_const(exprasmlist,OS_INT,0,2);
+                                  cg.a_param_const(exprasmlist,OS_INT,0,1);
+                               end
+                             else
+                               cg.a_param_reg(exprasmlist,OS_ADDR,R_ESI,1);
+                          end
+                        else if is_object(procinfo^._class) then
+                          begin
+                             cg.a_param_reg(exprasmlist,OS_ADDR,R_ESI,1);
+                             if is_con_or_destructor then
+                               begin
+                                  if (procdefinition.proctypeoption=potype_constructor) then
+                                    begin
+                                      { it's no bad idea, to insert the VMT }
+                                      reference_reset_symbol(href,newasmsymbol(procinfo^._class.vmt_mangledname),0);
+                                      cg.a_paramaddr_ref(exprasmlist,href,1);
+                                    end
+                                  { destructors haven't to dispose the instance, if this is }
+                                  { a direct call                                           }
+                                  else
+                                    cg.a_param_const(exprasmlist,OS_INT,0,1);
+                               end;
+                          end
+                        else
+                          Internalerror(200006165);
+                     end;
+                end;
+
+                { call to BeforeDestruction? }
+                if (procdefinition.proctypeoption=potype_destructor) and
+                   assigned(methodpointer) and
+                   (methodpointer.nodetype<>typen) and
+                   is_class(tobjectdef(methodpointer.resulttype.def)) and
+                   (inlined or
+                   (right=nil)) then
+                  begin
+                     cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,1);
+                     reference_reset_base(href,self_pointer_reg,0);
+                     tmpreg:=cg.get_scratch_reg_address(exprasmlist);
+                     cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,tmpreg);
+                     reference_reset_base(href,tmpreg,72);
+                     cg.a_call_ref(exprasmlist,href);
+                     cg.free_scratch_reg(exprasmlist,tmpreg);
+                  end;
+
+              { push base pointer ?}
+              { never when inlining, since if necessary, the base pointer }
+              { can/will be gottten from the current PROCEDURE's symtable }
+              { (JM)                                                      }
+              if not inlined then
+                if (lexlevel>=normal_function_level) and assigned(tprocdef(procdefinition).parast) and
+                  ((tprocdef(procdefinition).parast.symtablelevel)>normal_function_level) then
+                  begin
+                     { if we call a nested function in a method, we must      }
+                     { push also SELF!                                    }
+                     { THAT'S NOT TRUE, we have to load ESI via frame pointer }
+                     { access                                              }
+                     {
+                       begin
+                          loadesi:=false;
+                          emit_reg(A_SAVE,S_L,R_ESI);
+                       end;
+                     }
+                     if lexlevel=(tprocdef(procdefinition).parast.symtablelevel) then
+                       begin
+                          reference_reset_base(href,procinfo^.framepointer,procinfo^.framepointer_offset);
+                          cg.a_param_ref(exprasmlist,OS_ADDR,href,-1);
+                       end
+                       { this is only true if the difference is one !!
+                         but it cannot be more !! }
+                     else if (lexlevel=(tprocdef(procdefinition).parast.symtablelevel)-1) then
+                       begin
+                          cg.a_param_reg(exprasmlist,OS_ADDR,procinfo^.framepointer,-1);
+                       end
+                     else if (lexlevel>(tprocdef(procdefinition).parast.symtablelevel)) then
+                       begin
+                          hregister:=rg.getregisterint(exprasmlist);
+                          reference_reset_base(href,procinfo^.framepointer,procinfo^.framepointer_offset);
+                          cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
+                          for i:=(tprocdef(procdefinition).parast.symtablelevel) to lexlevel-1 do
+                            begin
+                               {we should get the correct frame_pointer_offset at each level
+                               how can we do this !!! }
+                               reference_reset_base(href,hregister,procinfo^.framepointer_offset);
+                               cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
+                            end;
+                          cg.a_param_reg(exprasmlist,OS_ADDR,hregister,-1);
+                          rg.ungetregisterint(exprasmlist,hregister);
+                       end
+                     else
+                       internalerror(25000);
+                  end;
+
+              rg.saveregvars(exprasmlist,regs_to_push);
+
+              if (po_virtualmethod in procdefinition.procoptions) and
+                 not(no_virtual_call) then
+                begin
+                   { static functions contain the vmt_address in ESI }
+                   { also class methods                       }
+                   { Here it is quite tricky because it also depends }
+                   { on the methodpointer                        PM }
+                   release_tmpreg:=false;
+                   rg.getexplicitregisterint(exprasmlist,R_ESI);
+                   if assigned(aktprocdef) then
+                     begin
+                       if (((sp_static in aktprocdef.procsym.symoptions) or
+                        (po_classmethod in aktprocdef.procoptions)) and
+                        ((methodpointer=nil) or (methodpointer.nodetype=typen)))
+                        or
+                        (po_staticmethod in procdefinition.procoptions) or
+                        ((procdefinition.proctypeoption=potype_constructor) and
+                        { esi contains the vmt if we call a constructor via a class ref }
+                         assigned(methodpointer) and
+                         (methodpointer.resulttype.def.deftype=classrefdef)
+                        ) or
+                        { is_interface(tprocdef(procdefinition)._class) or }
+                        { ESI is loaded earlier }
+                        (po_classmethod in procdefinition.procoptions) then
+                         begin
+                            reference_reset_base(href,R_ESI,0);
+                         end
+                       else
+                         begin
+                            { this is one point where we need vmt_offset (PM) }
+                            reference_reset_base(href,R_ESI,tprocdef(procdefinition)._class.vmt_offset);
+                            tmpreg:=cg.get_scratch_reg_address(exprasmlist);
+                            cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,tmpreg);
+                            reference_reset_base(href,tmpreg,0);
+                            release_tmpreg:=true;
+                         end;
+                     end
+                   else
+                     { aktprocdef should be assigned, also in main program }
+                     internalerror(12345);
+
+                   if tprocdef(procdefinition).extnumber=-1 then
+                     internalerror(44584);
+
+                   href.offset:=tprocdef(procdefinition)._class.vmtmethodoffset(tprocdef(procdefinition).extnumber);
+                   if not(is_interface(tprocdef(procdefinition)._class)) and
+                      not(is_cppclass(tprocdef(procdefinition)._class)) then
+                     begin
+                        if (cs_check_object in aktlocalswitches) then
+                          begin
+                             reference_reset_symbol(hrefvmt,newasmsymbol(tprocdef(procdefinition)._class.vmt_mangledname),0);
+                             cg.a_paramaddr_ref(exprasmlist,hrefvmt,2);
+                             cg.a_param_reg(exprasmlist,OS_ADDR,href.base,1);
+                             cg.a_call_name(exprasmlist,'FPC_CHECK_OBJECT_EXT');
+                          end
+                        else if (cs_check_range in aktlocalswitches) then
+                          begin
+                             cg.a_param_reg(exprasmlist,OS_ADDR,href.base,1);
+                             cg.a_call_name(exprasmlist,'FPC_CHECK_OBJECT');
+                          end;
+                     end;
+                   cg.a_call_ref(exprasmlist,href);
+                   if release_tmpreg then
+                     cg.free_scratch_reg(exprasmlist,tmpreg);
+                end
+              else if not inlined then
+                begin
+                  { We can call interrupts from within the smae code
+                    by just pushing the flags and CS PM }
+                  if (po_interrupt in procdefinition.procoptions) then
+                    begin
+                        emit_none(A_SAVE{F},S_L);
+                        emit_reg(A_SAVE,S_L,R_CS);
+                    end;
+                  cg.a_call_name(exprasmlist,tprocdef(procdefinition).mangledname);
+                end
+              else { inlined proc }
+                { inlined code is in inlinecode }
+                begin
+                   { process the inlinecode }
+                   secondpass(inlinecode);
+                   { free the args }
+                   if tprocdef(procdefinition).parast.datasize>0 then
+                     tg.ungetpersistanttemp(exprasmlist,tprocdef(procdefinition).parast.address_fixup);
+                end;
+           end
+         else
+           { now PROCEDURE variable case }
+           begin
+              secondpass(right);
+              if (po_interrupt in procdefinition.procoptions) then
+                begin
+                    emit_none(A_SAVE{F},S_L);
+                    emit_reg(A_SAVE,S_L,R_CS);
+                end;
+              { PROCEDURE of object? }
+              if (po_methodpointer in procdefinition.procoptions) then
+                begin
+                   { method pointer can't be in a register }
+                   hregister:=R_NO;
+
+                   { do some hacking if we call a method pointer }
+                   { which is a class member                 }
+                   { else ESI is overwritten !             }
+                   if (right.location.reference.base=R_ESI) or
+                      (right.location.reference.index=R_ESI) then
+                     begin
+                        reference_release(exprasmlist,right.location.reference);
+                        hregister:=cg.get_scratch_reg_address(exprasmlist);
+                        cg.a_load_ref_reg(exprasmlist,OS_ADDR,right.location.reference,hregister);
+                     end;
+
+                   { load self, but not if it's already explicitly pushed }
+                   if not(po_containsself in procdefinition.procoptions) then
+                     begin
+                       { load ESI }
+                       href:=right.location.reference;
+                       inc(href.offset,4);
+                       rg.getexplicitregisterint(exprasmlist,R_ESI);
+                       cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,self_pointer_reg);
+                       { push self pointer }
+                       cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,-1);
+                     end;
+
+                   rg.saveregvars(exprasmlist,ALL_REGISTERS);
+                   if hregister<>R_NO then
+                     reference_reset_base(href,hregister,0)
+                   else
+                     href:=right.location.reference;
+                   cg.a_call_ref(exprasmlist,href);
+
+                   if hregister<>R_NO then
+                     cg.free_scratch_reg(exprasmlist,hregister);
+                   reference_release(exprasmlist,right.location.reference);
+                end
+              else
+                begin
+                   rg.saveregvars(exprasmlist,ALL_REGISTERS);
+                   case right.location.loc of
+                      LOC_REGISTER,LOC_CREGISTER:
+                        reference_reset_base(href,right.location.register,0);
+                      LOC_REFERENCE,LOC_CREFERENCE :
+                        href:=right.location.reference;
+                      else
+                        internalerror(200203311);
+                   end;
+                   cg.a_call_ref(exprasmlist,href);
+                   location_release(exprasmlist,right.location);
+                end;
+           end;
+
+           { this was only for normal functions
+             displaced here so we also get
+             it to work for procvars PM }
+           if (not inlined) and (po_clearstack in procdefinition.procoptions) then
+             begin
+                { we also add the pop_size which is included in pushedparasize }
+                pop_size:=0;
+                { better than an add on all processors }
+                if pushedparasize=4 then
+                  begin
+                    rg.getexplicitregisterint(exprasmlist,R_EDI);
+                    emit_reg(A_RESTORE,S_L,R_EDI);
+                    rg.ungetregisterint(exprasmlist,R_EDI);
+                  end
+                { the pentium has two pipes and pop reg is pairable }
+                { but the registers must be different!        }
+                else if (pushedparasize=8) and
+                  not(cs_littlesize in aktglobalswitches) and
+                  (aktoptprocessor=ClassP5) and
+                  (procinfo^._class=nil) then
+                    begin
+                       rg.getexplicitregisterint(exprasmlist,R_EDI);
+                       emit_reg(A_RESTORE,S_L,R_EDI);
+                       rg.ungetregisterint(exprasmlist,R_EDI);
+                       exprasmList.concat(Tairegalloc.Alloc(R_ESI));
+                       emit_reg(A_RESTORE,S_L,R_ESI);
+                       exprasmList.concat(Tairegalloc.DeAlloc(R_ESI));
+                    end
+                else if pushedparasize<>0 then
+                  emit_const_reg(A_ADD,S_L,pushedparasize,Stack_Pointer_Reg);
+             end;
+{$ifdef OPTALIGN}
+         if pop_esp then
+           emit_reg(A_RESTORE,S_L,Stack_Pointer);
+{$endif OPTALIGN}
+      dont_call:
+         pushedparasize:=oldpushedparasize;
+         rg.restoreunusedstate(unusedstate);
+{$ifdef TEMPREGDEBUG}
+         testregisters32;
+{$endif TEMPREGDEBUG}
+
+         { a constructor could be a function with boolean result }
+         { if calling constructor called fail we
+           must jump directly to quickexitlabel  PM
+           but only if it is a call of an inherited constructor }
+         if (inlined or
+             (right=nil)) and
+            (procdefinition.proctypeoption=potype_constructor) and
+            assigned(methodpointer) and
+            (methodpointer.nodetype=typen) and
+            (aktprocdef.proctypeoption=potype_constructor) then
+           begin
+             emitjmp(C_Z,faillabel);
+           end;
+
+         { call to AfterConstruction? }
+         if is_class(resulttype.def) and
+           (inlined or
+           (right=nil)) and
+           (procdefinition.proctypeoption=potype_constructor) and
+           assigned(methodpointer) and
+           (methodpointer.nodetype<>typen) then
+           begin
+              getlabel(constructorfailed);
+              emitjmp(C_Z,constructorfailed);
+              cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,1);
+              reference_reset_base(href,self_pointer_reg,0);
+              tmpreg:=cg.get_scratch_reg_address(exprasmlist);
+              cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,tmpreg);
+              reference_reset_base(href,tmpreg,68);
+              cg.a_call_ref(exprasmlist,href);
+              cg.free_scratch_reg(exprasmlist,tmpreg);
+              exprasmList.concat(Tairegalloc.Alloc(accumulator));
+              cg.a_label(exprasmlist,constructorfailed);
+              cg.a_load_reg_reg(exprasmlist,OS_ADDR,self_pointer_reg,accumulator);
+           end;
+
+         { handle function results }
+         if (not is_void(resulttype.def)) then
+          begin
+            { structured results are easy to handle.... }
+            { needed also when result_no_used !! }
+            if ret_in_param(resulttype.def) then
+             begin
+               location_reset(location,LOC_CREFERENCE,def_cgsize(resulttype.def));
+               location.reference.symbol:=nil;
+               location.reference:=funcretref;
+             end
+            else
+            { ansi/widestrings must be registered, so we can dispose them }
+             if is_ansistring(resulttype.def) or
+                is_widestring(resulttype.def) then
+              begin
+                location_reset(location,LOC_CREFERENCE,OS_ADDR);
+                location.reference:=refcountedtemp;
+                cg.a_reg_alloc(exprasmlist,accumulator);
+                cg.a_load_reg_ref(exprasmlist,OS_ADDR,accumulator,location.reference);
+                cg.a_reg_dealloc(exprasmlist,accumulator);
+              end
+            else
+            { we have only to handle the result if it is used }
+             if (nf_return_value_used in flags) then
+              begin
+                case resulttype.def.deftype of
+                  enumdef,
+                  orddef :
+                    begin
+                      cgsize:=def_cgsize(resulttype.def);
+                      { an object constructor is a function with boolean result }
+                      if (inlined or (right=nil)) and
+                         (procdefinition.proctypeoption=potype_constructor) then
+                       begin
+                         if extended_new then
+                          cgsize:=OS_INT
+                         else
+                          begin
+                            cgsize:=OS_NO;
+                            { this fails if popsize > 0 PM }
+                            location_reset(location,LOC_FLAGS,OS_NO);
+                            location.resflags:=F_NE;
+                          end;
+                       end;
+
+                      if cgsize<>OS_NO then
+                       begin
+                         location_reset(location,LOC_REGISTER,cgsize);
+                         cg.a_reg_alloc(exprasmlist,accumulator);
+                         if cgsize in [OS_64,OS_S64] then
+                          begin
+                            cg.a_reg_alloc(exprasmlist,accumulatorhigh);
+                            if accumulatorhigh in rg.unusedregsint then
+                              begin
+                                 location.registerhigh:=rg.getexplicitregisterint(exprasmlist,accumulatorhigh);
+                                 location.registerlow:=rg.getexplicitregisterint(exprasmlist,accumulator);
+                              end
+                            else
+                              begin
+                                 location.registerhigh:=rg.getexplicitregisterint(exprasmlist,accumulatorhigh);
+                                 location.registerlow:=rg.getexplicitregisterint(exprasmlist,accumulator);
+                              end;
+                            tcg64f32(cg).a_load64_reg_reg(exprasmlist,accumulator,accumulatorhigh,
+                                location.registerlow,location.registerhigh);
+                          end
+                         else
+                          begin
+                            location.register:=rg.getexplicitregisterint(exprasmlist,accumulator);
+                            hregister:=rg.makeregsize(accumulator,cgsize);
+                            location.register:=rg.makeregsize(location.register,cgsize);
+                            cg.a_load_reg_reg(exprasmlist,cgsize,hregister,location.register);
+                          end;
+                       end;
+                    end;
+                  floatdef :
+                    begin
+                      location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
+                      location.register:=R_ST;
+                      inc(trgcpu(rg).fpuvaroffset);
+                    end;
+                  else
+                    begin
+                      location_reset(location,LOC_REGISTER,OS_INT);
+                      location.register:=rg.getexplicitregisterint(exprasmlist,accumulator);
+                      cg.a_load_reg_reg(exprasmlist,OS_INT,accumulator,location.register);
+                    end;
+                end;
+             end;
+          end;
+
+         { perhaps i/o check ? }
+         if iolabel<>nil then
+           begin
+              reference_reset_symbol(href,iolabel,0);
+              cg.a_paramaddr_ref(exprasmlist,href,1);
+              cg.a_call_name(exprasmlist,'FPC_IOCHECK');
+           end;
+         if pop_size>0 then
+           emit_const_reg(A_ADD,S_L,pop_size,Stack_Pointer_Reg);
+
+         { restore registers }
+         rg.restoreusedregisters(exprasmlist,pushed);
+
+         { at last, restore instance pointer (SELF) }
+         if loadesi then
+           cg.g_maybe_loadself(exprasmlist);
+         pp:=tbinarynode(params);
+         while assigned(pp) do
+           begin
+              if assigned(pp.left) then
+                begin
+                  location_freetemp(exprasmlist,pp.left.location);
+                  { process also all nodes of an array of const }
+                  if pp.left.nodetype=arrayconstructorn then
+                    begin
+                      if assigned(tarrayconstructornode(pp.left).left) then
+                       begin
+                         hp:=pp.left;
+                         while assigned(hp) do
+                          begin
+                            location_freetemp(exprasmlist,tarrayconstructornode(hp).left.location);
+                            hp:=tarrayconstructornode(hp).right;
+                          end;
+                       end;
+                    end;
+                end;
+              pp:=tbinarynode(pp.right);
+           end;
+         if inlined then
+           begin
+             tg.ungetpersistanttemp(exprasmlist,inlinecode.retoffset);
+             tprocdef(procdefinition).parast.address_fixup:=store_parast_fixup;
+             right:=inlinecode;
+           end;
+         if assigned(params) then
+           params.free;
+
+         { from now on the result can be freed normally }
+         if inlined and ret_in_param(resulttype.def) then
+           tg.persistanttemptonormal(funcretref.offset);
+
+         { if return value is not used }
+         if (not(nf_return_value_used in flags)) and (not is_void(resulttype.def)) then
+           begin
+              if location.loc in [LOC_CREFERENCE,LOC_REFERENCE] then
+                begin
+                   { data which must be finalized ? }
+                   if (resulttype.def.needs_inittable) then
+                      cg.g_finalize(exprasmlist,resulttype.def,location.reference,false);
+                   { release unused temp }
+                   tg.ungetiftemp(exprasmlist,location.reference)
+                end
+              else if location.loc=LOC_FPUREGISTER then
+                begin
+                  { release FPU stack }
+                  emit_reg(A_FSTP,S_NO,R_ST);
+                  {
+                    dec(trgcpu(rg).fpuvaroffset);
+                    do NOT decrement as the increment before
+                    is not called for unused results PM }
+                end;
+           end;
+      end;
+
+
+
+{*****************************************************************************
+                             TI386PROCINLINENODE
+*****************************************************************************}
+
+
+    PROCEDURE tSPARCprocinlinenode.pass_2;
+       var st : tsymtable;
+           oldprocdef : tprocdef;
+           ps, i : longint;
+           tmpreg: tregister;
+           oldprocinfo : pprocinfo;
+           oldinlining_PROCEDURE,
+           nostackframe,make_global : boolean;
+           inlineentrycode,inlineexitcode : TAAsmoutput;
+           oldexitlabel,oldexit2label,oldquickexitlabel:tasmlabel;
+           oldregstate: pointer;
+{$ifdef GDB}
+           startlabel,endlabel : tasmlabel;
+           pp : pchar;
+           mangled_length  : longint;
+{$endif GDB}
+       begin
+          { deallocate the registers used for the current PROCEDURE's regvars }
+          if assigned(aktprocdef.regvarinfo) then
+            begin
+              with pregvarinfo(aktprocdef.regvarinfo)^ do
+                for i := 1 to maxvarregs do
+                  if assigned(regvars[i]) then
+                    store_regvar(exprasmlist,regvars[i].reg);
+              rg.saveStateForInline(oldregstate);
+              { make sure the register allocator knows what the regvars in the }
+              { inlined code block are (JM)                                    }
+              rg.resetusableregisters;
+              rg.clearregistercount;
+              rg.cleartempgen;
+              if assigned(inlineprocdef.regvarinfo) then
+                with pregvarinfo(inlineprocdef.regvarinfo)^ do
+                  for i := 1 to maxvarregs do
+                    if assigned(regvars[i]) then
+                      begin
+                        tmpreg:=rg.makeregsize(regvars[i].reg,OS_INT);
+                        rg.makeregvar(tmpreg);
+                      end;
+            end;
+          oldinlining_PROCEDURE:=inlining_PROCEDURE;
+          oldexitlabel:=aktexitlabel;
+          oldexit2label:=aktexit2label;
+          oldquickexitlabel:=quickexitlabel;
+          getlabel(aktexitlabel);
+          getlabel(aktexit2label);
+          { we're inlining a PROCEDURE }
+          inlining_PROCEDURE:=true;
+          { save old procinfo }
+          oldprocdef:=aktprocdef;
+          getmem(oldprocinfo,sizeof(tprocinfo));
+          move(procinfo^,oldprocinfo^,sizeof(tprocinfo));
+          { set new procinfo }
+          aktprocdef:=inlineprocdef;
+          procinfo^.return_offset:=retoffset;
+          procinfo^.para_offset:=para_offset;
+          procinfo^.no_fast_exit:=false;
+          { arg space has been filled by the parent secondcall }
+          st:=aktprocdef.localst;
+          { set it to the same lexical level }
+          st.symtablelevel:=oldprocdef.localst.symtablelevel;
+          if st.datasize>0 then
+            begin
+              st.address_fixup:=tg.gettempofsizepersistant(exprasmlist,st.datasize)+st.datasize;
+{$ifdef extdebug}
+              Comment(V_debug,'local symtable is at offset '+tostr(st.address_fixup));
+              exprasmList.concat(Tai_asm_comment.Create(strpnew(
+                'local symtable is at offset '+tostr(st.address_fixup))));
+{$endif extdebug}
+            end;
+          exprasmList.concat(Tai_Marker.Create(InlineStart));
+{$ifdef extdebug}
+          exprasmList.concat(Tai_asm_comment.Create(strpnew('Start of inlined proc')));
+{$endif extdebug}
+{$ifdef GDB}
+          if (cs_debuginfo in aktmoduleswitches) then
+            begin
+              getaddrlabel(startlabel);
+              getaddrlabel(endlabel);
+              cg.a_label(exprasmlist,startlabel);
+              inlineprocdef.localst.symtabletype:=inlinelocalsymtable;
+              inlineprocdef.parast.symtabletype:=inlineparasymtable;
+
+              { Here we must include the para and local symtable info }
+              inlineprocdef.concatstabto(withdebuglist);
+
+              { set it back for safety }
+              inlineprocdef.localst.symtabletype:=localsymtable;
+              inlineprocdef.parast.symtabletype:=parasymtable;
+
+              mangled_length:=length(oldprocdef.mangledname);
+              getmem(pp,mangled_length+50);
+              strpcopy(pp,'192,0,0,'+startlabel.name);
+              if (target_info.use_function_relative_addresses) then
+                begin
+                  strpcopy(strend(pp),'-');
+                  strpcopy(strend(pp),oldprocdef.mangledname);
+                end;
+              withdebugList.concat(Tai_stabn.Create(strnew(pp)));
+            end;
+{$endif GDB}
+          { takes care of local data initialization }
+          inlineentrycode:=TAAsmoutput.Create;
+          inlineexitcode:=TAAsmoutput.Create;
+          ps:=para_size;
+          make_global:=false; { to avoid warning }
+          genentrycode(inlineentrycode,make_global,0,ps,nostackframe,true);
+          if po_assembler in aktprocdef.procoptions then
+            inlineentrycode.insert(Tai_marker.Create(asmblockstart));
+          exprasmList.concatlist(inlineentrycode);
+          secondpass(inlinetree);
+          genexitcode(inlineexitcode,0,false,true);
+          if po_assembler in aktprocdef.procoptions then
+            inlineexitcode.concat(Tai_marker.Create(asmblockend));
+          exprasmList.concatlist(inlineexitcode);
+
+          inlineentrycode.free;
+          inlineexitcode.free;
+{$ifdef extdebug}
+          exprasmList.concat(Tai_asm_comment.Create(strpnew('End of inlined proc')));
+{$endif extdebug}
+          exprasmList.concat(Tai_Marker.Create(InlineEnd));
+
+          {we can free the local data now, reset also the fixup address }
+          if st.datasize>0 then
+            begin
+              tg.ungetpersistanttemp(exprasmlist,st.address_fixup-st.datasize);
+              st.address_fixup:=0;
+            end;
+          { restore procinfo }
+          move(oldprocinfo^,procinfo^,sizeof(tprocinfo));
+          freemem(oldprocinfo,sizeof(tprocinfo));
+{$ifdef GDB}
+          if (cs_debuginfo in aktmoduleswitches) then
+            begin
+              cg.a_label(exprasmlist,endlabel);
+              strpcopy(pp,'224,0,0,'+endlabel.name);
+             if (target_info.use_function_relative_addresses) then
+               begin
+                 strpcopy(strend(pp),'-');
+                 strpcopy(strend(pp),oldprocdef.mangledname);
+               end;
+              withdebugList.concat(Tai_stabn.Create(strnew(pp)));
+              freemem(pp,mangled_length+50);
+            end;
+{$endif GDB}
+          { restore }
+          aktprocdef:=oldprocdef;
+          aktexitlabel:=oldexitlabel;
+          aktexit2label:=oldexit2label;
+          quickexitlabel:=oldquickexitlabel;
+          inlining_PROCEDURE:=oldinlining_PROCEDURE;
+
+          { reallocate the registers used for the current PROCEDURE's regvars, }
+          { since they may have been used and then deallocated in the inlined  }
+          { PROCEDURE (JM)                                                     }
+          if assigned(aktprocdef.regvarinfo) then
+            begin
+              rg.restoreStateAfterInline(oldregstate);
+            end;
+       end;
+
+
+begin
+   ccallparanode:=tSPARCcallparanode;
+   ccallnode:=tSPARCcallnode;
+   cprocinlinenode:=tSPARCprocinlinenode;
+end.
+{
+  $Log$
+  Revision 1.3  2002-09-19 20:24:44  mazen
+  + call support
+
+  Revision 1.1  2002/08/22 08:30:50  mazen
+  first insertion 2002\08\22
+
+  Revision 1.54  2002/05/20 13:30:40  carl
+  * bugfix of hdisponen (base must be set, not index)
+  * more portability fixes
+
+  Revision 1.53  2002/05/18 13:34:23  peter
+    * readded missing revisions
+
+  Revision 1.52  2002/05/16 19:46:51  carl
+  + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
+  + try to fix temp allocation (still in ifdef)
+  + generic constructor calls
+  + start of tassembler / tmodulebase class cleanup
+
+  Revision 1.50  2002/05/13 19:54:38  peter
+    * removed n386ld and n386util units
+    * maybe_save/maybe_restore added instead of the old maybe_push
+
+  Revision 1.49  2002/05/12 16:53:17  peter
+    * moved entry and exitcode to ncgutil and cgobj
+    * foreach gets extra argument for passing local data to the
+      iterator function
+    * -CR checks also class typecasts at runtime by changing them
+      into as
+    * fixed compiler to cycle with the -CR option
+    * fixed stabs with elf writer, finally the global variables can
+      be watched
+    * removed a lot of routines from cga unit and replaced them by
+      calls to cgobj
+    * u32bit-s32bit updates for and,or,xor nodes. When one element is
+      u32bit then the other is typecasted also to u32bit without giving
+      a rangecheck warning/error.
+    * fixed pascal calling method with reversing also the high tree in
+      the parast, detected by tcalcst3 test
+
+  Revision 1.48  2002/04/25 20:16:40  peter
+    * moved more routines from cga/n386util
+
+  Revision 1.47  2002/04/21 19:02:07  peter
+    * removed newn and disposen nodes, the code is now directly
+      inlined from pexpr
+    * -an option that will write the secondpass nodes to the .s file, this
+      requires EXTDEBUG define to actually write the info
+    * fixed various internal errors and crashes due recent code changes
+
+  Revision 1.46  2002/04/21 15:34:25  carl
+  * changeregsize -> rg.makeregsize
+
+  Revision 1.45  2002/04/15 19:44:21  peter
+    * fixed stackcheck that would be called recursively when a stack
+      error was found
+    * generic changeregsize(reg,size) for SPARC register resizing
+    * removed some more routines from cga unit
+    * fixed returnvalue handling
+    * fixed default stacksize of linux and go32v2, 8kb was a bit small :-)
+
+  Revision 1.44  2002/04/04 19:06:10  peter
+    * removed unused units
+    * use tlocation.size in cg.a_*loc*() routines
+
+  Revision 1.43  2002/04/02 17:11:35  peter
+    * tlocation,treference update
+    * LOC_CONSTANT added for better constant handling
+    * secondadd splitted in multiple routines
+    * location_force_reg added for loading a location to a register
+      of a specified size
+    * secondassignment parses now first the right and then the left node
+      (this is compatible with Kylix). This saves a lot of push/pop especially
+      with string operations
+    * adapted some routines to use the new cg methods
+
+  Revision 1.42  2002/03/31 20:26:38  jonas
+    + a_loadfpu_* and a_loadmm_* methods in tcg
+    * register allocation is now handled by a class and is mostly processor
+      independent (+rgobj.pas and SPARC/rgcpu.pas)
+    * temp allocation is now handled by a class (+tgobj.pas, -SPARC\tgcpu.pas)
+    * some small improvements and fixes to the optimizer
+    * some register allocation fixes
+    * some fpuvaroffset fixes in the unary minus node
+    * push/popusedregisters is now called rg.save/restoreusedregisters and
+      (for SPARC) uses temps instead of push/pop's when using -Op3 (that code is
+      also better optimizable)
+    * fixed and optimized register saving/restoring for new/dispose nodes
+    * LOC_FPU locations now also require their "register" field to be set to
+      R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
+    - list field removed of the tnode class because it's not used currently
+      and can cause hard-to-find bugs
+
+  Revision 1.41  2002/03/04 19:10:13  peter
+    * removed compiler warnings
+
+}

compiler/sparc/radirect.pas

@@ -187,7 +187,7 @@ end;
                                            if (sym.typ=procsym) and ((pos('CALL',upper(s))>0) or
                                               (pos('LEA',upper(s))>0)) then
                                              begin
-                                                hs:=tprocsym(sym).defs^.def.mangledname;
+                                                hs:=tprocsym(sym).first_procdef.mangledname;
                                              end;
                                         end
                                       else
@@ -235,10 +235,10 @@ end;
                                                      { procs can be called or the address can be loaded }
                                                      if ((pos('CALL',upper(s))>0) or (pos('LEA',upper(s))>0)) then
                                                       begin
-                                                        if assigned(tprocsym(sym).defs^.def) then
+                                                        if assigned(tprocsym(sym).first_procdef) then
                                                           Message1(asmr_w_direct_global_is_overloaded_func,hs);
-                                                        Message2(asmr_h_direct_global_to_mangled,hs,tprocsym(sym).defs^.def.mangledname);
-                                                        hs:=tprocsym(sym).defs^.def.mangledname;
+                                                        Message2(asmr_h_direct_global_to_mangled,hs,tprocsym(sym).first_procdef.mangledname);
+                                                        hs:=tprocsym(sym).first_procdef.mangledname;
                                                       end;
                                                    end;
                                                  else
@@ -314,7 +314,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.1  2002-08-23 10:08:28  mazen
+  Revision 1.2  2002-09-19 20:24:47  mazen
+  + call support
+
+  Revision 1.1  2002/08/23 10:08:28  mazen
   *** empty log message ***
 
   Revision 1.2  2002/08/17 09:23:47  florian