1 {
2     Copyright (c) 1998-2010 by Florian Klaempfl and Jonas Maebe
3     Member of the Free Pascal development team
4 
5     This unit contains routines to create a pass-through high-level code
6     generator. This is used by most regular code generators.
7 
8     This program is free software; you can redistribute it and/or modify
9     it under the terms of the GNU General Public License as published by
10     the Free Software Foundation; either version 2 of the License, or
11     (at your option) any later version.
12 
13     This program is distributed in the hope that it will be useful,
14     but WITHOUT ANY WARRANTY; without even the implied warranty of
15     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16     GNU General Public License for more details.
17 
18     You should have received a copy of the GNU General Public License
19     along with this program; if not, write to the Free Software
20     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
21 
22  ****************************************************************************
23 }
24 
25 unit hlcgcpu;
26 
27 {$i fpcdefs.inc}
28 
29 interface
30 
31   uses
32     aasmdata,
33     symdef,
34     hlcgx86;
35 
36   type
37     thlcgcpu = class(thlcgx86)
38      procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
39     end;
40 
41   procedure create_hlcodegen;
42 
43 implementation
44 
45   uses
46     globtype,globals,verbose,
47     fmodule,systems,
48     aasmbase,aasmtai,aasmcpu,
49     symconst,
50     hlcgobj,
51     cgbase,cgutils,cgobj,cpubase,cgcpu,cpupi;
52 
53   procedure thlcgcpu.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
54     var
55       make_global : boolean;
56       href : treference;
57       sym : tasmsymbol;
58       r : treference;
59     begin
potype_procedurenull60       if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
61         Internalerror(200006137);
62       if not assigned(procdef.struct) or
63          (procdef.procoptions*[po_classmethod, po_staticmethod,
64            po_methodpointer, po_interrupt, po_iocheck]<>[]) then
65         Internalerror(200006138);
66       if procdef.owner.symtabletype<>ObjectSymtable then
67         Internalerror(200109191);
68 
69       make_global:=false;
70       if (not current_module.is_unit) or create_smartlink or
71          (procdef.owner.defowner.owner.symtabletype=globalsymtable) then
72         make_global:=true;
73 
74       if make_global then
0null75         List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0,procdef))
76       else
77         List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0,procdef));
78 
79       { set param1 interface to self  }
80       g_adjust_self_value(list,procdef,ioffset);
81 
82       if (po_virtualmethod in procdef.procoptions) and
83           not is_objectpascal_helper(procdef.struct) then
84         begin
85           if (procdef.extnumber=$ffff) then
86             Internalerror(200006139);
87           { load vmt from first paramter }
88           { win64 uses a different abi }
89           if x86_64_use_ms_abi(procdef.proccalloption) then
90             reference_reset_base(href,voidpointertype,NR_RCX,0,ctempposinvalid,sizeof(pint),[])
91           else
92             reference_reset_base(href,voidpointertype,NR_RDI,0,ctempposinvalid,sizeof(pint),[]);
93           cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_RAX);
94           { jmp *vmtoffs(%eax) ; method offs }
95           reference_reset_base(href,voidpointertype,NR_RAX,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),ctempposinvalid,sizeof(pint),[]);
96           list.concat(taicpu.op_ref(A_JMP,S_Q,href));
97         end
98       else
99         begin
100           sym:=current_asmdata.RefAsmSymbol(procdef.mangledname,AT_FUNCTION);
reference_reset_symbolnull101           reference_reset_symbol(r,sym,0,sizeof(pint),[]);
102           if (cs_create_pic in current_settings.moduleswitches) and
103              { darwin/x86_64's assembler doesn't want @PLT after call symbols }
104              not(target_info.system in systems_darwin) then
105             r.refaddr:=addr_pic
106           else
107             r.refaddr:=addr_full;
108 
109           list.concat(taicpu.op_ref(A_JMP,S_NO,r));
110         end;
111 
112       List.concat(Tai_symbol_end.Createname(labelname));
113     end;
114 
115 
116   procedure create_hlcodegen;
117     begin
118       hlcg:=thlcgcpu.create;
119       create_codegen;
120     end;
121 
122 begin
123   chlcgobj:=thlcgcpu;
124 end.
125