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 high-level code generator support shared by
6     ppc32 and ppc64
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 unit hlcgppc;
25 
26 {$i fpcdefs.inc}
27 
28 interface
29 
30 uses
31   globtype,globals,
32   aasmdata,
33   symtype,symdef,
34   cgbase,cgutils,hlcgobj,hlcg2ll;
35 
36 type
37   thlcgppcgen = class(thlcg2ll)
38    protected
39     procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tdef; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); override;
40    public
41     procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
42     procedure a_jmp_external_name(list: TAsmList; const externalname: TSymStr); override;
43     procedure gen_load_para_value(list: TAsmList); override;
44   end;
45 
46 implementation
47 
48   uses
49     verbose,
50     systems,fmodule,
51     symconst,
52     aasmbase,aasmtai,aasmcpu,
53     cpubase,
54     procinfo,cpupi,cgobj,cgppc,
55     defutil;
56 
57 { thlcgppc }
58 
59   procedure thlcgppcgen.a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tdef; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister);
60     var
61       fromsreg, tosreg: tsubsetregister;
62       restbits: byte;
63     begin
64       { the code below is only valid for big endian }
65       if target_info.endian=endian_little then
66         begin
67          inherited;
68          exit
69         end;
70       restbits:=(sref.bitlen-(loadbitsize-sref.startbit));
71       if is_signed(subsetsize) then
72         begin
73          { sign extend }
74          a_op_const_reg(list,OP_SHL,osuinttype,AIntBits-loadbitsize+sref.startbit,valuereg);
75          a_op_const_reg(list,OP_SAR,osuinttype,AIntBits-sref.bitlen,valuereg);
76         end
77       else
78         begin
79           a_op_const_reg(list,OP_SHL,osuinttype,restbits,valuereg);
80           { mask other bits }
81           if (sref.bitlen<>AIntBits) then
82             a_op_const_reg(list,OP_AND,osuinttype,(aword(1) shl sref.bitlen)-1,valuereg);
83         end;
84       { use subsetreg routine, it may have been overridden with an optimized version }
85       fromsreg.subsetreg:=extra_value_reg;
86       fromsreg.subsetregsize:=OS_INT;
87       { subsetregs always count bits from right to left }
88       fromsreg.startbit:=loadbitsize-restbits;
89       fromsreg.bitlen:=restbits;
90 
91       tosreg.subsetreg:=valuereg;
92       tosreg.subsetregsize:=OS_INT;
93       tosreg.startbit:=0;
94       tosreg.bitlen:=restbits;
95 
96       a_load_subsetreg_subsetreg(list,subsetsize,subsetsize,fromsreg,tosreg);
97     end;
98 
99 
100   procedure thlcgppcgen.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
101 
102       procedure loadvmttor11;
103       var
104         href : treference;
105       begin
106         reference_reset_base(href,voidpointertype,NR_R3,0,ctempposinvalid,sizeof(pint),[]);
107         cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R11);
108       end;
109 
110 
111       procedure op_onr11methodaddr;
112       var
113         href : treference;
114       begin
115         if (procdef.extnumber=$ffff) then
116           Internalerror(200006139);
117         { call/jmp  vmtoffs(%eax) ; method offs }
118         reference_reset_base(href,voidpointertype,NR_R11,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),ctempposinvalid,sizeof(pint),[]);
119         if tcgppcgen(cg).hasLargeOffset(href) then
120           begin
121 {$ifdef cpu64bitaddr}
122             if (longint(href.offset) <> href.offset) then
123               { add support for offsets > 32 bit }
124               internalerror(200510201);
125 {$endif cpu64bitaddr}
126             list.concat(taicpu.op_reg_reg_const(A_ADDIS,NR_R11,NR_R11,
127               smallint((href.offset shr 16)+ord(smallint(href.offset and $ffff) < 0))));
128             href.offset := smallint(href.offset and $ffff);
129           end;
130         { use R12 for dispatch because most ABIs don't care and ELFv2
131           requires it }
132         cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R12);
133         if (target_info.system in systems_aix) or
134            ((target_info.system = system_powerpc64_linux) and
135             (target_info.abi=abi_powerpc_sysv)) then
136           begin
137             reference_reset_base(href, voidpointertype, NR_R12, 0, ctempposinvalid, sizeof(pint),[]);
138             cg.a_load_ref_reg(list, OS_ADDR, OS_ADDR, href, NR_R12);
139           end;
140         list.concat(taicpu.op_reg(A_MTCTR,NR_R12));
141         list.concat(taicpu.op_none(A_BCTR));
142         if (target_info.system in ([system_powerpc64_linux]+systems_aix)) then
143           list.concat(taicpu.op_none(A_NOP));
144       end;
145 
146 
147     var
148       make_global : boolean;
149     begin
potype_procedurenull150       if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
151         Internalerror(200006137);
152       if not assigned(procdef.struct) or
153          (procdef.procoptions*[po_classmethod, po_staticmethod,
154            po_methodpointer, po_interrupt, po_iocheck]<>[]) then
155         Internalerror(200006138);
156       if procdef.owner.symtabletype<>ObjectSymtable then
157         Internalerror(200109191);
158 
159       make_global:=false;
160       if (not current_module.is_unit) or
161           create_smartlink or
162          (procdef.owner.defowner.owner.symtabletype=globalsymtable) then
163         make_global:=true;
164 
165       if make_global then
0null166         List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0,procdef))
167       else
168         List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0,procdef));
169 
170       { set param1 interface to self  }
171       g_adjust_self_value(list,procdef,ioffset);
172 
173       { case 4 }
174       if (po_virtualmethod in procdef.procoptions) and
175           not is_objectpascal_helper(procdef.struct) then
176         begin
177           loadvmttor11;
178           op_onr11methodaddr;
179         end
180       { case 0 }
181       else
182         case target_info.system of
183           system_powerpc_darwin,
184           system_powerpc64_darwin:
185             list.concat(taicpu.op_sym(A_B,tcgppcgen(cg).get_darwin_call_stub(procdef.mangledname,false)));
186           else if use_dotted_functions then
187             {$note ts:todo add GOT change?? - think not needed :) }
188             list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol('.' + procdef.mangledname,AT_FUNCTION)))
elsenull189           else
190             list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(procdef.mangledname,AT_FUNCTION)))
191         end;
192       List.concat(Tai_symbol_end.Createname(labelname));
193     end;
194 
195 
196   procedure thlcgppcgen.a_jmp_external_name(list: TAsmList; const externalname: TSymStr);
197     var
198       href : treference;
199     begin
200       if not(target_info.system in ([system_powerpc64_linux]+systems_aix)) then begin
201         inherited;
202         exit;
203       end;
204 
205       { for ppc64/linux and aix emit correct code which sets up a stack frame
206         and then calls the external method normally to ensure that the GOT/TOC
207         will be loaded correctly if required.
208 
209       The resulting code sequence looks as follows:
210 
211       mflr r0
212       stw/d r0, 16(r1)
213       stw/du r1, -112(r1)
214       bl <external_method>
215       nop
216       addi r1, r1, 112
217       lwz/d r0, 16(r1)
218       mtlr r0
219       blr
220 
221       }
222       list.concat(taicpu.op_reg(A_MFLR, NR_R0));
223       if target_info.abi=abi_powerpc_sysv then
224         reference_reset_base(href, voidstackpointertype, NR_STACK_POINTER_REG, LA_LR_SYSV, ctempposinvalid, 8, [])
225       else
226         reference_reset_base(href, voidstackpointertype, NR_STACK_POINTER_REG, LA_LR_AIX, ctempposinvalid, 8, []);
227       cg.a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_R0,href);
228       reference_reset_base(href, voidstackpointertype, NR_STACK_POINTER_REG, -MINIMUM_STACKFRAME_SIZE, ctempposinvalid, 8, []);
229       list.concat(taicpu.op_reg_ref({$ifdef cpu64bitaddr}A_STDU{$else}A_STWU{$endif}, NR_STACK_POINTER_REG, href));
230 
231       cg.a_call_name(list,externalname,false);
232 
233       list.concat(taicpu.op_reg_reg_const(A_ADDI, NR_STACK_POINTER_REG, NR_STACK_POINTER_REG, MINIMUM_STACKFRAME_SIZE));
234 
235 
236       if target_info.abi=abi_powerpc_sysv then
237         reference_reset_base(href, voidstackpointertype, NR_STACK_POINTER_REG, LA_LR_SYSV, ctempposinvalid, 8, [])
238       else
239         reference_reset_base(href, voidstackpointertype, NR_STACK_POINTER_REG, LA_LR_AIX, ctempposinvalid, 8, []);
240       cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R0);
241       list.concat(taicpu.op_reg(A_MTLR, NR_R0));
242       list.concat(taicpu.op_none(A_BLR));
243     end;
244 
245 
246   procedure thlcgppcgen.gen_load_para_value(list: TAsmList);
247     begin
248       { get the register that contains the stack pointer before the procedure
249         entry, which is used to access the parameters in their original
250         callee-side location }
251       if (tcpuprocinfo(current_procinfo).needs_frame_pointer) then
252         getcpuregister(list,NR_OLD_STACK_POINTER_REG);
253       inherited;
254       { free it again }
255       if (tcpuprocinfo(current_procinfo).needs_frame_pointer) then
256         ungetcpuregister(list,NR_OLD_STACK_POINTER_REG);
257     end;
258 
259 end.
260 
261