freepascal.compiler/compiler/i386/n386obj.pas

{
    $Id$
    Copyright (c) 1998-2002 by Kovacs Attila Zoltan

    Generate i386 assembly wrapper code interface implementor objects

    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 n386obj;

{$i fpcdefs.inc}

interface


implementation

uses
  systems,
  verbose,globals,globtype,
  aasmbase,aasmtai,
  symconst,symdef,
  fmodule,
  nobj,
  cpuinfo,cpubase,
  cga,cgobj;

   type
     ti386classheader=class(tclassheader)
     protected
       procedure cgintfwrapper(asmlist: TAAsmoutput; procdef: tprocdef; const labelname: string; ioffset: longint);override;
     end;

{
possible calling conventions:
              default stdcall cdecl pascal register saveregisters
default(0):      OK     OK    OK(1)  OK       OK          OK
virtual(2):      OK     OK    OK(3)  OK       OK          OK(4)

(0):
    set self parameter to correct value
    jmp mangledname

(1): The code is the following
     set self parameter to correct value
     call mangledname
     set self parameter to interface value

(2): The wrapper code use %eax to reach the virtual method address
     set self to correct value
     move self,%eax
     mov  0(%eax),%eax ; load vmt
     jmp  vmtoffs(%eax) ; method offs

(3): The wrapper code use %eax to reach the virtual method address
     set self to correct value
     move self,%eax
     mov  0(%eax),%eax ; load vmt
     jmp  vmtoffs(%eax) ; method offs
     set self parameter to interface value


(4): Virtual use eax to reach the method address so the following code be generated:
     set self to correct value
     push %ebx ; allocate space for function address
     push %eax
     mov  self,%eax
     mov  0(%eax),%eax ; load vmt
     mov  vmtoffs(%eax),eax ; method offs
     mov  %eax,4(%esp)
     pop  %eax
     ret  0; jmp the address

}

function getselfoffsetfromsp(procdef: tprocdef): longint;
begin
  { framepointer is pushed for nested procs }
  if procdef.parast.symtablelevel>normal_function_level then
    getselfoffsetfromsp:=2*POINTER_SIZE
  else
    getselfoffsetfromsp:=POINTER_SIZE;
end;


procedure ti386classheader.cgintfwrapper(asmlist: TAAsmoutput; procdef: tprocdef; const labelname: string; ioffset: longint);

  procedure getselftoeax(offs: longint);
  var
    href : treference;
  begin
    { mov offset(%esp),%eax }
    if (procdef.proccalloption<>pocall_register) then
      begin
        reference_reset_base(href,NR_ESP,getselfoffsetfromsp(procdef)+offs);
        cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,href,NR_EAX);
      end;
  end;

  procedure loadvmttoeax;
  var
    href : treference;
  begin
    { mov  0(%eax),%eax ; load vmt}
    reference_reset_base(href,NR_EAX,0);
    cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,href,NR_EAX);
  end;

  procedure op_oneaxmethodaddr(op: TAsmOp);
  var
    href : treference;
  begin
    if (procdef.extnumber=-1) then
      Internalerror(200006139);
    { call/jmp  vmtoffs(%eax) ; method offs }
    reference_reset_base(href,NR_EAX,procdef._class.vmtmethodoffset(procdef.extnumber));
    emit_ref(op,S_L,href);
  end;

  procedure loadmethodoffstoeax;
  var
    href : treference;
  begin
    if (procdef.extnumber=-1) then
      Internalerror(200006139);
    { mov vmtoffs(%eax),%eax ; method offs }
    reference_reset_base(href,NR_EAX,procdef._class.vmtmethodoffset(procdef.extnumber));
    cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,href,NR_EAX);
  end;

var
  oldexprasmlist: TAAsmoutput;
  lab : tasmsymbol;
  make_global : boolean;
  href : treference;
begin
  if procdef.proctypeoption<>potype_none then
    Internalerror(200006137);
  if not assigned(procdef._class) or
     (procdef.procoptions*[po_classmethod, po_staticmethod,
       po_methodpointer, po_interrupt, po_iocheck]<>[]) then
    Internalerror(200006138);
  if procdef.owner.symtabletype<>objectsymtable then
    Internalerror(200109191);

  oldexprasmlist:=exprasmlist;
  exprasmlist:=asmlist;

  make_global:=false;
  if (not current_module.is_unit) or
     (cs_create_smart in aktmoduleswitches) or
     (procdef.owner.defowner.owner.symtabletype=globalsymtable) then
    make_global:=true;

  if make_global then
   exprasmList.concat(Tai_symbol.Createname_global(labelname,0))
  else
   exprasmList.concat(Tai_symbol.Createname(labelname,0));

  { set param1 interface to self  }
  adjustselfvalue(procdef,ioffset);

  { case 1 or 2 }
  if (procdef.proccalloption in clearstack_pocalls) then
    begin
      if po_virtualmethod in procdef.procoptions then
        begin { case 2 }
          getselftoeax(0);
          loadvmttoeax;
          op_oneaxmethodaddr(A_CALL);
        end
      else { case 1 }
        cg.a_call_name(exprasmlist,procdef.mangledname);
      { restore param1 value self to interface }
      adjustselfvalue(procdef,-ioffset);
    end
  { case 3 }
  else if (procdef.proccalloption=pocall_register) or
          ([po_virtualmethod,po_saveregisters]*procdef.procoptions=[po_virtualmethod,po_saveregisters]) then
    begin
      emit_reg(A_PUSH,S_L,NR_EBX); { allocate space for address}
      emit_reg(A_PUSH,S_L,NR_EAX);
      getselftoeax(8);
      loadvmttoeax;
      loadmethodoffstoeax;
      { mov %eax,4(%esp) }
      reference_reset_base(href,NR_ESP,4);
      emit_reg_ref(A_MOV,S_L,NR_EAX,href);
      { pop  %eax }
      emit_reg(A_POP,S_L,NR_EAX);
      { ret  ; jump to the address }
      emit_none(A_RET,S_L);
    end
  { case 4 }
  else if po_virtualmethod in procdef.procoptions then
    begin
      getselftoeax(0);
      loadvmttoeax;
      op_oneaxmethodaddr(A_JMP);
    end
  { case 0 }
  else
    begin
      lab:=objectlibrary.newasmsymbol(procdef.mangledname);
      emit_sym(A_JMP,S_NO,lab);
    end;
  exprasmlist:=oldexprasmlist;
end;


initialization
  cclassheader:=ti386classheader;
end.
{
  $Log$
  Revision 1.28  2003-12-17 21:59:59  peter
    * register call fix

  Revision 1.27  2003/10/10 17:48:14  peter
    * old trgobj moved to x86/rgcpu and renamed to trgx86fpu
    * tregisteralloctor renamed to trgobj
    * removed rgobj from a lot of units
    * moved location_* and reference_* to cgobj
    * first things for mmx register allocation

  Revision 1.26  2003/10/01 20:34:49  peter
    * procinfo unit contains tprocinfo
    * cginfo renamed to cgbase
    * moved cgmessage to verbose
    * fixed ppc and sparc compiles

  Revision 1.25  2003/09/25 21:30:11  peter
    * parameter fixes

  Revision 1.24  2003/09/25 14:59:06  peter
    * fix intf wrapper code

  Revision 1.23  2003/09/23 17:56:06  peter
    * locals and paras are allocated in the code generation
    * tvarsym.localloc contains the location of para/local when
      generating code for the current procedure

  Revision 1.22  2003/09/07 22:09:35  peter
    * preparations for different default calling conventions
    * various RA fixes

  Revision 1.21  2003/09/03 15:55:01  peter
    * NEWRA branch merged

  Revision 1.20.2.1  2003/08/29 17:29:00  peter
    * next batch of updates

  Revision 1.20  2003/06/03 21:11:09  peter
    * cg.a_load_* get a from and to size specifier
    * makeregsize only accepts newregister
    * i386 uses generic tcgnotnode,tcgunaryminus

  Revision 1.19  2003/05/15 18:58:54  peter
    * removed selfpointer_offset, vmtpointer_offset
    * tvarsym.adjusted_address
    * address in localsymtable is now in the real direction
    * removed some obsolete globals

  Revision 1.18  2003/04/22 14:33:38  peter
    * removed some notes/hints

  Revision 1.17  2003/01/13 14:54:34  daniel
    * Further work to convert codegenerator register convention;
      internalerror bug fixed.

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

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

  Revision 1.14  2002/08/11 13:24:17  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.13  2002/08/09 07:33:04  florian
    * a couple of interface related fixes

  Revision 1.12  2002/07/16 15:34:21  florian
    * exit is now a syssym instead of a keyword

  Revision 1.11  2002/07/01 18:46:33  peter
    * internal linker
    * reorganized aasm layer

  Revision 1.10  2002/05/18 13:34:25  peter
    * readded missing revisions

  Revision 1.9  2002/05/16 19:46:52  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.7  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.6  2002/04/02 17:11:36  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.5  2002/03/31 20:26:39  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 i386/rgcpu.pas)
    * temp allocation is now handled by a class (+tgobj.pas, -i386\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 i386) 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
}