freepascal.compiler/compiler/i386/n386cal.pas

{
    $Id$
    Copyright (c) 1998-2002 by Florian Klaempfl

    Generate i386 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 by
    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 n386cal;

{$i fpcdefs.inc}

interface

{ $define AnsiStrRef}

    uses
      globtype,
      symdef,
      node,ncal,ncgcal;

    type
       ti386callparanode = class(tcallparanode)
          procedure secondcallparan(push_from_left_to_right:boolean;calloption:tproccalloption;
                para_alignment,para_offset : longint);override;
       end;

       ti386callnode = class(tcgcallnode)
          procedure pass_2;override;
       end;


implementation

    uses
      systems,
      cutils,verbose,globals,
      symconst,symbase,symsym,symtable,defutil,
{$ifdef GDB}
  {$ifdef delphi}
      sysutils,
  {$else}
      strings,
  {$endif}
      gdb,
{$endif GDB}
      cginfo,cgbase,pass_2,
      cpubase,paramgr,
      aasmbase,aasmtai,aasmcpu,
      nmem,nld,ncnv,
      ncgutil,cga,cgobj,tgobj,regvars,rgobj,rgcpu,cg64f32,cgcpu,cpuinfo;

{*****************************************************************************
                             TI386CALLPARANODE
*****************************************************************************}

    procedure ti386callparanode.secondcallparan(push_from_left_to_right:boolean;calloption:tproccalloption;para_alignment,para_offset : longint);

      procedure maybe_push_high;
        begin
           { open array ? }
           { paraitem.data can be nil for read/write }
           if assigned(paraitem.paratype.def) and
              assigned(hightree) then
            begin
              secondpass(hightree);
              { this is a longint anyway ! }
              push_value_para(hightree,calloption,para_offset,4,paralocdummy);
            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(push_from_left_to_right,
                                                   calloption,para_alignment,para_offset)
            else
              tcallparanode(right).secondcallparan(push_from_left_to_right,
                                                   calloption,para_alignment,para_offset);
          end;

         otlabel:=truelabel;
         oflabel:=falselabel;
         objectlibrary.getlabel(truelabel);
         objectlibrary.getlabel(falselabel);
         secondpass(left);
         { handle varargs first, because paraitem is not valid }
         if (nf_varargs_para in flags) then
           begin
             if paramanager.push_addr_param(left.resulttype.def,calloption) then
               begin
                 inc(pushedparasize,4);
                 cg.a_paramaddr_ref(exprasmlist,left.location.reference,paralocdummy);
                 location_release(exprasmlist,left.location);
               end
             else
               push_value_para(left,calloption,para_offset,para_alignment,paralocdummy);
           end
         { filter array constructor with c styled args }
         else if is_array_of_const(left.resulttype.def) and (nf_cargs in left.flags) then
           begin
             { nothing, everything is already pushed }
           end
         { in codegen.handleread.. paraitem.data is set to nil }
         else if assigned(paraitem.paratype.def) and
                 (paraitem.paratype.def.deftype=formaldef) then
           begin
              { allow passing of a constant to a const formaldef }
              if (paraitem.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 calloption=pocall_inline 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,paralocdummy);
                  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 calloption=pocall_inline 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,paralocdummy);
                       location_release(exprasmlist,left.location);
                     end;
                end;
           end
         { handle call by reference parameter }
         else if (paraitem.paratyp in [vs_var,vs_out]) then
           begin
              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;
{$ifdef unused}
              if not push_from_left_to_right then
{$endif unused}
                maybe_push_high;
              if (paraitem.paratyp=vs_out) and
                 assigned(paraitem.paratype.def) and
                 not is_class(paraitem.paratype.def) and
                 paraitem.paratype.def.needs_inittable then
                cg.g_finalize(exprasmlist,paraitem.paratype.def,left.location.reference,false);
              inc(pushedparasize,4);
              if calloption=pocall_inline 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,paralocdummy);
              location_release(exprasmlist,left.location);
{$ifdef unused}
              if push_from_left_to_right then
                maybe_push_high;
{$endif unused}
           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(paraitem.paratype.def) and
                  (is_open_array(paraitem.paratype.def) or
                   is_array_of_const(paraitem.paratype.def))
                 ) or
                 (
                  paramanager.push_addr_param(resulttype.def,calloption)
                 ) 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.GetTemp(exprasmlist,tcgsize2size[left.location.size],tt_normal,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;

{$ifdef unused}
                   if not push_from_left_to_right then
{$endif unused}
                     maybe_push_high;
                   inc(pushedparasize,4);
                   if calloption=pocall_inline 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,paralocdummy);
                   location_release(exprasmlist,left.location);
{$ifdef unused}
                   if push_from_left_to_right then
                     maybe_push_high;
{$endif unused}
                end
              else
                begin
                   push_value_para(left,calloption,
                     para_offset,para_alignment,paralocdummy);
                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(push_from_left_to_right,
                                                   calloption,para_alignment,para_offset)
            else
              tcallparanode(right).secondcallparan(push_from_left_to_right,
                                                   calloption,para_alignment,para_offset);
          end;
      end;


{*****************************************************************************
                             TI386CALLNODE
*****************************************************************************}

    procedure ti386callnode.pass_2;
      var
         regs_to_push_int : Tsupregset;
         regs_to_push_other : tregisterset;
         unusedstate: pointer;
         pushed : tpushedsaved;
         pushed_int : tpushedsavedint;
         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;
         returnref,
         pararef : treference;
         r,r2,rsp:Tregister;

      label
         dont_call;

      begin
         rsp.enum:=R_INTREGISTER;
         rsp.number:=NR_ESP;
         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.GetTemp(exprasmlist,pointer_size,tt_widestring,refcountedtemp);
             cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp);
           end
         else if is_ansistring(resulttype.def) then
           begin
             tg.GetTemp(exprasmlist,pointer_size,tt_ansistring,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
               begin
                 inlinecode.para_size:=tprocdef(procdefinition).para_size(para_alignment);
                 tg.GetTemp(exprasmlist,inlinecode.para_size,tt_persistant,pararef);
                 inlinecode.para_offset:=pararef.offset;
               end;
              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_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
                   objectlibrary.getaddrlabel(iolabel);
                   cg.a_label(exprasmlist,iolabel);
                end
              else
                iolabel:=nil;

              { save all used registers and possible registers
                used for the return value }
              regs_to_push_int := tprocdef(procdefinition).usedintregisters;
              regs_to_push_other := tprocdef(procdefinition).usedotherregisters;
              if (not is_void(resulttype.def)) and
                 (not paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption)) then
               begin
                 include(regs_to_push_int,RS_ACCUMULATOR);
                 if resulttype.def.size>sizeof(aword) then
                   include(regs_to_push_int,RS_ACCUMULATORHIGH);
               end;
              rg.saveusedintregisters(exprasmlist,pushed_int,regs_to_push_int);
              rg.saveusedotherregisters(exprasmlist,pushed,regs_to_push_other);

              { give used registers through }
              rg.usedintinproc:=rg.usedintinproc + tprocdef(procdefinition).usedintregisters;
              rg.usedinproc:=rg.usedinproc + tprocdef(procdefinition).usedotherregisters;
           end
         else
           begin
              regs_to_push_int := all_intregisters;
              regs_to_push_other:=all_registers;
              rg.saveusedintregisters(exprasmlist,pushed_int,regs_to_push_int);
              rg.saveusedotherregisters(exprasmlist,pushed,regs_to_push_other);
              rg.usedintinproc:=all_intregisters;
              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,rsp);
{$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,rsp,R_EDI);
              if (push_size mod 8)=0 then
                emit_const_reg(A_AND,S_L,$fffffff8,rsp)
              else
                begin
                   emit_const_reg(A_SUB,S_L,push_size,rsp);
                   emit_const_reg(A_AND,S_L,$fffffff8,rsp);
                   emit_const_reg(A_SUB,S_L,push_size,rsp);
                end;
              r.enum:=R_INTREGISTER;
              r.number:=R_EDI;
              emit_reg(A_PUSH,S_L,r);
           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),procdefinition.proccalloption,
                  para_alignment,para_offset)
              else
                tcallparanode(params).secondcallparan(
                  { TParaItem(procdefinition.Para.first), }
                  (po_leftright in procdefinition.procoptions),procdefinition.proccalloption,
                  para_alignment,para_offset);
           end;

         { Allocate return value for inlined routines }
         if inlined and
            (resulttype.def.size>0) then
          begin
            tg.GetTemp(exprasmlist,Align(resulttype.def.size,aktalignment.paraalign),tt_persistant,returnref);
            inlinecode.retoffset:=returnref.offset;
          end;

         { Allocate return value when returned in argument }
         if paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption) 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
                   tg.GetTemp(exprasmlist,resulttype.def.size,tt_persistant,funcretref);
{$ifdef extdebug}
                   Comment(V_debug,'function return value is at offset '
                                   +tostr(funcretref.offset));
                   exprasmlist.concat(tai_comment.create(
                                       strpnew('function return value is at offset '
                                               +tostr(funcretref.offset))));
{$endif extdebug}
                 end
                else
                 tg.GetTemp(exprasmlist,resulttype.def.size,tt_normal,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,paralocdummy);
           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,NR_ESI);
                   methodpointer.location.register.enum:=R_INTREGISTER;
                   methodpointer.location.register.number:=NR_SELF_POINTER_REG;
                   { 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;
                   r.enum:=R_INTREGISTER;
                   r.number:=NR_SELF_POINTER_REG;
                   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,r)
                   else
                     cg.a_loadaddr_ref_reg(exprasmlist,href,r);
                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,NR_ESI);
                                         r.enum:=R_INTREGISTER;
                                         r.number:=NR_SELF_POINTER_REG;
                                         if not(oo_has_vmt in tobjectdef(methodpointer.resulttype.def).objectoptions) then
                                           cg.a_load_const_reg(exprasmlist,OS_ADDR,0,r)
                                         else
                                           begin
                                             reference_reset_symbol(href,objectlibrary.newasmsymbol(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
                                             cg.a_loadaddr_ref_reg(exprasmlist,href,r);
                                           end;
                                         { emit_reg(A_PUSH,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 }
                                    r.enum:=R_INTREGISTER;
                                    r.number:=NR_SELF_POINTER_REG;
                                    if is_class(tobjectdef(methodpointer.resulttype.def)) and
                                       (procdefinition.proctypeoption=potype_destructor) then
                                      begin
                                        cg.a_param_const(exprasmlist,OS_ADDR,0,paramanager.getintparaloc(2));
                                        cg.a_param_reg(exprasmlist,OS_ADDR,r,paramanager.getintparaloc(1));
                                      end;

                                    r.enum:=R_INTREGISTER;
                                    r.number:=NR_SELF_POINTER_REG;
                                    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,r,paramanager.getintparaloc(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,paramanager.getintparaloc(2));
                                         cg.a_param_const(exprasmlist,OS_ADDR,0,paramanager.getintparaloc(1));
                                      end;
                                 end;
                               hnewn:
                                 begin
                                    { extended syntax of new }
                                    { ESI must be zero }
                                    r.enum:=R_INTREGISTER;
                                    r.number:=NR_SELF_POINTER_REG;
                                    rg.getexplicitregisterint(exprasmlist,NR_ESI);
                                    cg.a_load_const_reg(exprasmlist,OS_ADDR,0,r);
                                    cg.a_param_reg(exprasmlist,OS_ADDR,r,paramanager.getintparaloc(2));
                                    { insert the vmt }
                                    reference_reset_symbol(href,objectlibrary.newasmsymbol(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
                                    cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(1));
                                    extended_new:=true;
                                 end;
                               hdisposen:
                                 begin
                                    secondpass(methodpointer);

                                    { destructor with extended syntax called from dispose }
                                    { hdisposen always deliver LOC_REFERENCE          }
                                    r.enum:=R_INTREGISTER;
                                    r.number:=NR_SELF_POINTER_REG;
                                    rg.getexplicitregisterint(exprasmlist,NR_ESI);
                                    emit_ref_reg(A_LEA,S_L,methodpointer.location.reference,r);
                                    reference_release(exprasmlist,methodpointer.location.reference);
                                    cg.a_param_reg(exprasmlist,OS_ADDR,r,paramanager.getintparaloc(2));
                                    reference_reset_symbol(href,objectlibrary.newasmsymbol(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
                                    cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(1));
                                 end;
                               else
                                 begin
                                    { call to an instance member }
                                    if (symtableproc.symtabletype<>withsymtable) then
                                      begin
                                         r.enum:=R_INTREGISTER;
                                         r.number:=NR_SELF_POINTER_REG;
                                         secondpass(methodpointer);
                                         rg.getexplicitregisterint(exprasmlist,NR_ESI);
                                         case methodpointer.location.loc of
                                            LOC_CREGISTER,
                                            LOC_REGISTER:
                                              begin
                                                 cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,methodpointer.location.register,r);
                                                 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)
                                                 else
                                                   cg.a_loadaddr_ref_reg(exprasmlist,methodpointer.location.reference,r);
                                                 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_staticmethod in procdefinition.procoptions) or
                                           ((po_classmethod in procdefinition.procoptions) and
                                            not(methodpointer.resulttype.def.deftype=classrefdef)) then
                                          begin
                                            r.enum:=R_INTREGISTER;
                                            r.number:=NR_SELF_POINTER_REG;
                                            rg.getexplicitregisterint(exprasmlist,NR_ESI);
                                            if not(oo_has_vmt in tprocdef(procdefinition)._class.objectoptions) then
                                              cg.a_load_const_reg(exprasmlist,OS_ADDR,0,r)
                                            else
                                              begin
                                                { class method and static methods needs current VMT }
                                                cg.g_maybe_testself(exprasmlist,r);
                                                reference_reset_base(href,r,tprocdef(procdefinition)._class.vmt_offset);
                                                cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,r);
                                                cg.g_maybe_testvmt(exprasmlist,r,tprocdef(procdefinition)._class);
                                              end;
                                          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,paramanager.getintparaloc(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,paramanager.getintparaloc(2));
                                             cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(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,paramanager.getintparaloc(1));
                                             r.enum:=R_INTREGISTER;
                                             r.number:=NR_SELF_POINTER_REG;
                                             cg.a_param_reg(exprasmlist,OS_ADDR,r,paramanager.getintparaloc(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,objectlibrary.newasmsymbol(
                                                     tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
                                                  cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(1));
                                                end
                                              { destructors haven't to dispose the instance, if this is }
                                              { a direct call                                           }
                                              else
                                                cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(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))
                           ) or
                           (
                            (po_staticmethod in procdefinition.procoptions) and
                             not(assigned(aktprocdef) and
                                 (po_staticmethod in aktprocdef.procoptions))
                           ) then
                          begin
                            r.enum:=R_INTREGISTER;
                            r.number:=NR_SELF_POINTER_REG;
                            rg.getexplicitregisterint(exprasmlist,NR_ESI);
                            if not(oo_has_vmt in tprocdef(procdefinition)._class.objectoptions) then
                             cg.a_load_const_reg(exprasmlist,OS_ADDR,0,r)
                            else
                             begin
                               { class method and static methods needs current VMT }
                               cg.g_maybe_testself(exprasmlist,r);
                               reference_reset_base(href,r,tprocdef(procdefinition)._class.vmt_offset);
                               cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,r);
                               cg.g_maybe_testvmt(exprasmlist,r,tprocdef(procdefinition)._class);
                             end;
                          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
                             r.enum:=R_INTREGISTER;
                             r.number:=NR_SELF_POINTER_REG;
                             if (procdefinition.proctypeoption=potype_destructor) then
                               begin
                                  cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(2));
                                  cg.a_param_reg(exprasmlist,OS_ADDR,r,paramanager.getintparaloc(1));
                               end
                             else if (procdefinition.proctypeoption=potype_constructor) then
                               begin
                                  cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(2));
                                  cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(1));
                               end
                             else
                               cg.a_param_reg(exprasmlist,OS_ADDR,r,paramanager.getintparaloc(1));
                          end
                        else if is_object(procinfo._class) then
                          begin
                             r.enum:=R_INTREGISTER;
                             r.number:=NR_SELF_POINTER_REG;
                             cg.a_param_reg(exprasmlist,OS_ADDR,r,paramanager.getintparaloc(1));
                             if is_con_or_destructor then
                               begin
                                  (*
                                  The constructor/destructor is called from the class
                                  itself, no need to push the VMT to create a new object
                                  if (procdefinition.proctypeoption=potype_constructor) then
                                    begin
                                      { it's no bad idea, to insert the VMT }
                                      reference_reset_symbol(href,objectlibrary.newasmsymbol(procinfo._class.vmt_mangledname),0);
                                      cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(1));
                                    end
                                  { destructors haven't to dispose the instance, if this is }
                                  { a direct call                                           }
                                  else
                                  *)
                                    cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(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
                     r.enum:=R_INTREGISTER;
                     r.number:=NR_SELF_POINTER_REG;
                     cg.a_param_reg(exprasmlist,OS_ADDR,r,paramanager.getintparaloc(1));
                     reference_reset_base(href,r,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_PUSH,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,paralocdummy);
                       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,paralocdummy);
                       end
                     else if (lexlevel>(tprocdef(procdefinition).parast.symtablelevel)) then
                       begin
                          hregister:=rg.getregisterint(exprasmlist,OS_ADDR);
                          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,paralocdummy);
                          rg.ungetregisterint(exprasmlist,hregister);
                       end
                     else
                       internalerror(25000);
                  end;

              rg.saveintregvars(exprasmlist,regs_to_push_int);

              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,NR_ESI);
                   r.enum:=R_INTREGISTER;
                   r.number:=NR_SELF_POINTER_REG;
                   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,0);
                         end
                       else
                         begin
                            cg.g_maybe_testself(exprasmlist,r);
                            { this is one point where we need vmt_offset (PM) }
                            reference_reset_base(href,r,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
                     cg.g_maybe_testvmt(exprasmlist,href.base,tprocdef(procdefinition)._class);
                   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_PUSHF,S_L);
                        r.enum:=R_INTREGISTER;
                        r.number:=NR_CS;
                        emit_reg(A_PUSH,S_L,r);
                    end;
                  cg.a_call_name(exprasmlist,tprocdef(procdefinition).mangledname);
                end
              else { inlined proc }
                { inlined code is in inlinecode }
                begin
                   { process the inlinecode }
                   secondpass(tnode(inlinecode));
                   { free the args }
                   if tprocdef(procdefinition).parast.datasize>0 then
                     tg.UnGetTemp(exprasmlist,pararef);
                end;
           end
         else
           { now procedure variable case }
           begin
              secondpass(right);
              if (po_interrupt in procdefinition.procoptions) then
                begin
                    emit_none(A_PUSHF,S_L);
                    r.enum:=R_INTREGISTER;
                    r.number:=NR_CS;
                    emit_reg(A_PUSH,S_L,r);
                end;
              { procedure of object? }
              if (po_methodpointer in procdefinition.procoptions) then
                begin
                   { method pointer can't be in a register }
                   hregister.enum:=R_INTREGISTER;
                   hregister.number:=NR_NO;

                   { do some hacking if we call a method pointer }
                   { which is a class member                 }
                   { else ESI is overwritten !             }
                   if (right.location.reference.base.number=NR_ESI) or
                      (right.location.reference.index.number=NR_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);
                       r.enum:=R_INTREGISTER;
                       r.number:=NR_SELF_POINTER_REG;
                       rg.getexplicitregisterint(exprasmlist,NR_ESI);
                       cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,r);
                       { push self pointer }
                       cg.a_param_reg(exprasmlist,OS_ADDR,r,paralocdummy);
                     end;

                   rg.saveintregvars(exprasmlist,ALL_INTREGISTERS);
                   rg.saveotherregvars(exprasmlist,ALL_REGISTERS);
                   if hregister.number<>NR_NO then
                     cg.a_call_reg(exprasmlist,hregister)
                   else
                     cg.a_call_ref(exprasmlist,right.location.reference);

                   if hregister.number<>NR_NO then
                     cg.free_scratch_reg(exprasmlist,hregister);
                   reference_release(exprasmlist,right.location.reference);
                   tg.Ungetiftemp(exprasmlist,right.location.reference);
                end
              else
                begin
                   rg.saveintregvars(exprasmlist,ALL_INTREGISTERS);
                   rg.saveotherregvars(exprasmlist,ALL_REGISTERS);
                   cg.a_call_loc(exprasmlist,right.location);
                   location_release(exprasmlist,right.location);
                   location_freetemp(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
                    r.enum:=R_INTREGISTER;
                    r.number:=NR_EDI;
                    rg.getexplicitregisterint(exprasmlist,NR_EDI);
                    emit_reg(A_POP,S_L,r);
                    rg.ungetregisterint(exprasmlist,r);
                  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,NR_EDI);
                       r.enum:=R_INTREGISTER;
                       r.number:=NR_EDI;
                       emit_reg(A_POP,S_L,r);
                       rg.ungetregisterint(exprasmlist,r);
                       r.number:=NR_ESI;
                       exprasmList.concat(tai_regalloc.Alloc(r));
                       emit_reg(A_POP,S_L,r);
                       exprasmList.concat(tai_regalloc.DeAlloc(r));
                    end
                else if pushedparasize<>0 then
                  emit_const_reg(A_ADD,S_L,pushedparasize,rsp);
             end;
{$ifdef OPTALIGN}
         if pop_esp then
           emit_reg(A_POP,S_L,rsp);
{$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);
{$ifdef TEST_GENERIC}
{ should be moved to generic version! }
             reference_reset_base(href, procinfo.framepointer,procinfo.selfpointer_offset);
             cg.a_load_ref_reg(exprasmlist, OS_ADDR, href, SELF_POINTER_REG);
{$endif}
           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
              r.enum:=R_INTREGISTER;
              r.number:=NR_ACCUMULATOR;
              r2.enum:=R_INTREGISTER;
              r2.number:=NR_SELF_POINTER_REG;
              objectlibrary.getlabel(constructorfailed);
              emitjmp(C_Z,constructorfailed);
              cg.a_param_reg(exprasmlist,OS_ADDR,r2,paramanager.getintparaloc(1));
              reference_reset_base(href,r2,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(tai_regalloc.Alloc(r));
              cg.a_label(exprasmlist,constructorfailed);
              cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,r2,r);
           end;

         { handle function results }
         if (not is_void(resulttype.def)) then
          handle_return_value(inlined,extended_new);

         { perhaps i/o check ? }
         if iolabel<>nil then
           begin
              reference_reset_symbol(href,iolabel,0);
              cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(1));
              cg.a_call_name(exprasmlist,'FPC_IOCHECK');
           end;
         if pop_size>0 then
           emit_const_reg(A_ADD,S_L,pop_size,rsp);

         { restore registers }
         rg.restoreusedotherregisters(exprasmlist,pushed);
         rg.restoreusedintregisters(exprasmlist,pushed_int);

         { 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
             if (resulttype.def.size>0) then
               tg.UnGetTemp(exprasmlist,returnref);
             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 paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption) then
           tg.ChangeTempType(exprasmlist,funcretref,tt_normal);

         { 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 }
                  r.enum:=R_ST;
                  emit_reg(A_FSTP,S_NO,r);
                  {
                    dec(trgcpu(rg).fpuvaroffset);
                    do NOT decrement as the increment before
                    is not called for unused results PM }
                end;
           end;
      end;

begin
   ccallparanode:=ti386callparanode;
   ccallnode:=ti386callnode;
end.
{
  $Log$
  Revision 1.84  2003-03-13 19:52:23  jonas
    * and more new register allocator fixes (in the i386 code generator this
      time). At least now the ppc cross compiler can compile the linux
      system unit again, but I haven't tested it.

  Revision 1.83  2003/03/06 11:35:50  daniel
    * Fixed internalerror 7843 issue

  Revision 1.82  2003/02/19 22:00:15  daniel
    * Code generator converted to new register notation
    - Horribily outdated todo.txt removed

  Revision 1.81  2003/01/30 21:46:57  peter
    * self fixes for static methods (merged)

  Revision 1.80  2003/01/13 18:37:44  daniel
    * Work on register conversion

  Revision 1.79  2003/01/08 18:43:57  daniel
   * Tregister changed into a record

  Revision 1.78  2002/12/15 21:30:12  florian
    * tcallnode.paraitem introduced, all references to defcoll removed

  Revision 1.77  2002/11/27 20:05:06  peter
    * cdecl array of const fixes

  Revision 1.76  2002/11/25 17:43:26  peter
    * splitted defbase in defutil,symutil,defcmp
    * merged isconvertable and is_equal into compare_defs(_ext)
    * made operator search faster by walking the list only once

  Revision 1.75  2002/11/18 17:32:00  peter
    * pass proccalloption to ret_in_xxx and push_xxx functions

  Revision 1.74  2002/11/15 01:58:57  peter
    * merged changes from 1.0.7 up to 04-11
      - -V option for generating bug report tracing
      - more tracing for option parsing
      - errors for cdecl and high()
      - win32 import stabs
      - win32 records<=8 are returned in eax:edx (turned off by default)
      - heaptrc update
      - more info for temp management in .s file with EXTDEBUG

  Revision 1.73  2002/10/05 12:43:29  carl
    * fixes for Delphi 6 compilation
     (warning : Some features do not work under Delphi)

  Revision 1.72  2002/09/17 18:54:03  jonas
    * a_load_reg_reg() now has two size parameters: source and dest. This
      allows some optimizations on architectures that don't encode the
      register size in the register name.

  Revision 1.71  2002/09/16 19:07:37  peter
    * push 0 instead of VMT when calling a constructor from a member

  Revision 1.70  2002/09/07 15:25:10  peter
    * old logs removed and tabs fixed

  Revision 1.69  2002/09/01 18:43:27  peter
    * include accumulator in regs_to_push list

  Revision 1.68  2002/09/01 12:13:00  peter
    * use a_call_reg
    * ungetiftemp for procvar of object temp

  Revision 1.67  2002/08/25 19:25:21  peter
    * sym.insert_in_data removed
    * symtable.insertvardata/insertconstdata added
    * removed insert_in_data call from symtable.insert, it needs to be
      called separatly. This allows to deref the address calculation
    * procedures now calculate the parast addresses after the procedure
      directives are parsed. This fixes the cdecl parast problem
    * push_addr_param has an extra argument that specifies if cdecl is used
      or not

  Revision 1.66  2002/08/23 16:14:49  peter
    * tempgen cleanup
    * tt_noreuse temp type added that will be used in genentrycode

  Revision 1.65  2002/08/18 20:06:30  peter
    * inlining is now also allowed in interface
    * renamed write/load to ppuwrite/ppuload
    * tnode storing in ppu
    * nld,ncon,nbas are already updated for storing in ppu

  Revision 1.64  2002/08/17 09:23:45  florian
    * first part of procinfo rewrite

  Revision 1.63  2002/08/12 15:08:42  carl
    + stab register indexes for powerpc (moved from gdb to cpubase)
    + tprocessor enumeration moved to cpuinfo
    + linker in target_info is now a class
    * many many updates for m68k (will soon start to compile)
    - removed some ifdef or correct them for correct cpu

  Revision 1.62  2002/08/11 14:32:30  peter
    * renamed current_library to objectlibrary

  Revision 1.61  2002/08/11 13:24:16  peter
    * saving of asmsymbols in ppu supported
    * asmsymbollist global is removed and moved into a new class
      tasmlibrarydata that will hold the info of a .a file which
      corresponds with a single module. Added librarydata to tmodule
      to keep the library info stored for the module. In the future the
      objectfiles will also be stored to the tasmlibrarydata class
    * all getlabel/newasmsymbol and friends are moved to the new class

  Revision 1.60  2002/07/20 11:58:01  florian
    * types.pas renamed to defbase.pas because D6 contains a types
      unit so this would conflicts if D6 programms are compiled
    + Willamette/SSE2 instructions to assembler added

  Revision 1.59  2002/07/11 14:41:33  florian
    * start of the new generic parameter handling

  Revision 1.58  2002/07/07 09:52:34  florian
    * powerpc target fixed, very simple units can be compiled
    * some basic stuff for better callparanode handling, far from being finished

  Revision 1.57  2002/07/06 20:27:26  carl
  + generic set handling

  Revision 1.56  2002/07/01 18:46:31  peter
    * internal linker
    * reorganized aasm layer

  Revision 1.55  2002/07/01 16:23:56  peter
    * cg64 patch
    * basics for currency
    * asnode updates for class and interface (not finished)

  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

}