cgcpu.pas 66 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. This unit implements the code generator for the PowerPC
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit cgcpu;
  18. {$I fpcdefs.inc}
  19. interface
  20. uses
  21. globtype, symtype, symdef, symsym,
  22. cgbase, cgobj,cgppc,
  23. aasmbase, aasmcpu, aasmtai,aasmdata,
  24. cpubase, cpuinfo, cgutils, rgcpu,
  25. parabase;
  26. type
  27. tcgppc = class(tcgppcgen)
  28. procedure init_register_allocators; override;
  29. procedure done_register_allocators; override;
  30. procedure a_call_name(list: TAsmList; const s: string; weak: boolean); override;
  31. procedure a_call_reg(list: TAsmList; reg: tregister); override;
  32. procedure a_op_const_reg(list: TAsmList; Op: TOpCG; size: TCGSize; a:
  33. aint; reg: TRegister); override;
  34. procedure a_op_reg_reg(list: TAsmList; Op: TOpCG; size: TCGSize; src,
  35. dst: TRegister); override;
  36. procedure a_op_const_reg_reg(list: TAsmList; op: TOpCg;
  37. size: tcgsize; a: aint; src, dst: tregister); override;
  38. procedure a_op_reg_reg_reg(list: TAsmList; op: TOpCg;
  39. size: tcgsize; src1, src2, dst: tregister); override;
  40. { move instructions }
  41. procedure a_load_const_reg(list: TAsmList; size: tcgsize; a: aint; reg:
  42. tregister); override;
  43. { loads the memory pointed to by ref into register reg }
  44. procedure a_load_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const
  45. Ref: treference; reg: tregister); override;
  46. procedure a_load_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1,
  47. reg2: tregister); override;
  48. { comparison operations }
  49. procedure a_cmp_const_reg_label(list: TAsmList; size: tcgsize; cmp_op:
  50. topcmp; a: aint; reg: tregister;
  51. l: tasmlabel); override;
  52. procedure a_cmp_reg_reg_label(list: TAsmList; size: tcgsize; cmp_op:
  53. topcmp; reg1, reg2: tregister; l: tasmlabel); override;
  54. procedure a_jmp_name(list: TAsmList; const s: string); override;
  55. procedure a_jmp_always(list: TAsmList; l: tasmlabel); override;
  56. { need to override this for ppc64 to avoid calling CG methods which allocate
  57. registers during creation of the interface wrappers to subtract ioffset from
  58. the self pointer. But register allocation does not take place for them (which
  59. would probably be the generic fix) so we need to have a specialized method
  60. that uses the R11 scratch register in these cases.
  61. At the same time this allows > 32 bit offsets as well.
  62. }
  63. procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: aint);override;
  64. procedure g_profilecode(list: TAsmList); override;
  65. procedure g_proc_entry(list: TAsmList; localsize: longint; nostackframe:
  66. boolean); override;
  67. procedure g_proc_exit(list: TAsmList; parasize: longint; nostackframe:
  68. boolean); override;
  69. procedure g_save_registers(list: TAsmList); override;
  70. procedure g_restore_registers(list: TAsmList); override;
  71. procedure a_loadaddr_ref_reg(list: TAsmList; const ref: treference; r:
  72. tregister); override;
  73. procedure g_concatcopy(list: TAsmList; const source, dest: treference;
  74. len: aint); override;
  75. private
  76. procedure maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister);
  77. { returns whether a reference can be used immediately in a powerpc }
  78. { instruction }
  79. function issimpleref(const ref: treference): boolean;
  80. { contains the common code of a_load_reg_ref and a_load_ref_reg }
  81. procedure a_load_store(list: TAsmList; op: tasmop; reg: tregister;
  82. ref: treference); override;
  83. { returns the lowest numbered FP register in use, and the number of used FP registers
  84. for the current procedure }
  85. procedure calcFirstUsedFPR(out firstfpr : TSuperRegister; out fprcount : aint);
  86. { returns the lowest numbered GP register in use, and the number of used GP registers
  87. for the current procedure }
  88. procedure calcFirstUsedGPR(out firstgpr : TSuperRegister; out gprcount : aint);
  89. { generates code to call a method with the given string name. The boolean options
  90. control code generation. If prependDot is true, a single dot character is prepended to
  91. the string, if addNOP is true a single NOP instruction is added after the call, and
  92. if includeCall is true, the method is marked as having a call, not if false. This
  93. option is particularly useful to prevent generation of a larger stack frame for the
  94. register save and restore helper functions. }
  95. procedure a_call_name_direct(list: TAsmList; opc: tasmop; s: string; weak: boolean; prependDot : boolean;
  96. addNOP : boolean; includeCall : boolean = true);
  97. procedure a_jmp_name_direct(list : TAsmList; opc: tasmop; s : string; prependDot : boolean);
  98. { emits code to store the given value a into the TOC (if not already in there), and load it from there
  99. as well }
  100. procedure loadConstantPIC(list : TAsmList; size : TCGSize; a : aint; reg : TRegister);
  101. procedure profilecode_savepara(para : tparavarsym; list : TAsmList);
  102. procedure profilecode_restorepara(para : tparavarsym; list : TAsmList);
  103. end;
  104. procedure create_codegen;
  105. const
  106. TShiftOpCG2AsmOpConst : array[boolean, OP_SAR..OP_SHR] of TAsmOp = (
  107. (A_SRAWI, A_SLWI, A_SRWI), (A_SRADI, A_SLDI, A_SRDI)
  108. );
  109. implementation
  110. uses
  111. sysutils, cclasses,
  112. globals, verbose, systems, cutils,
  113. symconst, fmodule,
  114. rgobj, tgobj, cpupi, procinfo, paramgr, cpupara;
  115. function is_signed_cgsize(const size : TCgSize) : Boolean;
  116. begin
  117. case size of
  118. OS_S8,OS_S16,OS_S32,OS_S64 : result := true;
  119. OS_8,OS_16,OS_32,OS_64 : result := false;
  120. else
  121. internalerror(2006050701);
  122. end;
  123. end;
  124. { finds positive and negative powers of two of the given value, returning the
  125. power and whether it's a negative power or not in addition to the actual result
  126. of the function }
  127. function ispowerof2(value : aInt; out power : byte; out neg : boolean) : boolean;
  128. var
  129. i : longint;
  130. hl : aInt;
  131. begin
  132. result := false;
  133. neg := false;
  134. { also try to find negative power of two's by negating if the
  135. value is negative. low(aInt) is special because it can not be
  136. negated. Simply return the appropriate values for it }
  137. if (value < 0) then begin
  138. neg := true;
  139. if (value = low(aInt)) then begin
  140. power := sizeof(aInt)*8-1;
  141. result := true;
  142. exit;
  143. end;
  144. value := -value;
  145. end;
  146. if ((value and (value-1)) <> 0) then begin
  147. result := false;
  148. exit;
  149. end;
  150. hl := 1;
  151. for i := 0 to (sizeof(aInt)*8-1) do begin
  152. if (hl = value) then begin
  153. result := true;
  154. power := i;
  155. exit;
  156. end;
  157. hl := hl shl 1;
  158. end;
  159. end;
  160. { returns the number of instruction required to load the given integer into a register.
  161. This is basically a stripped down version of a_load_const_reg, increasing a counter
  162. instead of emitting instructions. }
  163. function getInstructionLength(a : aint) : longint;
  164. function get32bitlength(a : longint; var length : longint) : boolean; inline;
  165. var
  166. is_half_signed : byte;
  167. begin
  168. { if the lower 16 bits are zero, do a single LIS }
  169. if (smallint(a) = 0) and ((a shr 16) <> 0) then begin
  170. inc(length);
  171. get32bitlength := longint(a) < 0;
  172. end else begin
  173. is_half_signed := ord(smallint(lo(a)) < 0);
  174. inc(length);
  175. if smallint(hi(a) + is_half_signed) <> 0 then
  176. inc(length);
  177. get32bitlength := (smallint(a) < 0) or (a < 0);
  178. end;
  179. end;
  180. var
  181. extendssign : boolean;
  182. begin
  183. result := 0;
  184. if (lo(a) = 0) and (hi(a) <> 0) then begin
  185. get32bitlength(hi(a), result);
  186. inc(result);
  187. end else begin
  188. extendssign := get32bitlength(lo(a), result);
  189. if (extendssign) and (hi(a) = 0) then
  190. inc(result)
  191. else if (not
  192. ((extendssign and (longint(hi(a)) = -1)) or
  193. ((not extendssign) and (hi(a)=0)))
  194. ) then begin
  195. get32bitlength(hi(a), result);
  196. inc(result);
  197. end;
  198. end;
  199. end;
  200. procedure tcgppc.init_register_allocators;
  201. begin
  202. inherited init_register_allocators;
  203. if (target_info.system <> system_powerpc64_darwin) then
  204. // r13 is tls, do not use, r2 is not available
  205. rg[R_INTREGISTER] := trgintcpu.create(R_INTREGISTER, R_SUBWHOLE,
  206. [{$ifdef user0} RS_R0, {$endif} RS_R3, RS_R4, RS_R5, RS_R6, RS_R7, RS_R8,
  207. RS_R9, RS_R10, RS_R11, RS_R12, RS_R31, RS_R30, RS_R29,
  208. RS_R28, RS_R27, RS_R26, RS_R25, RS_R24, RS_R23, RS_R22,
  209. RS_R21, RS_R20, RS_R19, RS_R18, RS_R17, RS_R16, RS_R15,
  210. RS_R14], first_int_imreg, [])
  211. else
  212. { special for darwin/ppc64: r2 available volatile, r13 = tls }
  213. rg[R_INTREGISTER] := trgintcpu.create(R_INTREGISTER, R_SUBWHOLE,
  214. [{$ifdef user0} RS_R0, {$endif} RS_R2, RS_R3, RS_R4, RS_R5, RS_R6, RS_R7, RS_R8,
  215. RS_R9, RS_R10, RS_R11, RS_R12, RS_R31, RS_R30, RS_R29,
  216. RS_R28, RS_R27, RS_R26, RS_R25, RS_R24, RS_R23, RS_R22,
  217. RS_R21, RS_R20, RS_R19, RS_R18, RS_R17, RS_R16, RS_R15,
  218. RS_R14], first_int_imreg, []);
  219. rg[R_FPUREGISTER] := trgcpu.create(R_FPUREGISTER, R_SUBNONE,
  220. [RS_F0, RS_F1, RS_F2, RS_F3, RS_F4, RS_F5, RS_F6, RS_F7, RS_F8, RS_F9,
  221. RS_F10, RS_F11, RS_F12, RS_F13, RS_F31, RS_F30, RS_F29, RS_F28, RS_F27,
  222. RS_F26, RS_F25, RS_F24, RS_F23, RS_F22, RS_F21, RS_F20, RS_F19, RS_F18,
  223. RS_F17, RS_F16, RS_F15, RS_F14], first_fpu_imreg, []);
  224. { TODO: FIX ME}
  225. rg[R_MMREGISTER] := trgcpu.create(R_MMREGISTER, R_SUBNONE,
  226. [RS_M0, RS_M1, RS_M2], first_mm_imreg, []);
  227. end;
  228. procedure tcgppc.done_register_allocators;
  229. begin
  230. rg[R_INTREGISTER].free;
  231. rg[R_FPUREGISTER].free;
  232. rg[R_MMREGISTER].free;
  233. inherited done_register_allocators;
  234. end;
  235. { calling a procedure by name }
  236. procedure tcgppc.a_call_name(list: TAsmList; const s: string; weak: boolean);
  237. begin
  238. if (target_info.system <> system_powerpc64_darwin) then
  239. a_call_name_direct(list, A_BL, s, weak, target_info.system=system_powerpc64_aix, true)
  240. else
  241. begin
  242. list.concat(taicpu.op_sym(A_BL,get_darwin_call_stub(s,weak)));
  243. include(current_procinfo.flags,pi_do_call);
  244. end;
  245. end;
  246. procedure tcgppc.a_call_name_direct(list: TAsmList; opc: tasmop; s: string; weak: boolean; prependDot : boolean; addNOP : boolean; includeCall : boolean);
  247. begin
  248. if (prependDot) then
  249. s := '.' + s;
  250. if not(weak) then
  251. list.concat(taicpu.op_sym(opc, current_asmdata.RefAsmSymbol(s,AT_FUNCTION)))
  252. else
  253. list.concat(taicpu.op_sym(opc, current_asmdata.WeakRefAsmSymbol(s,AT_FUNCTION)));
  254. if (addNOP) then
  255. list.concat(taicpu.op_none(A_NOP));
  256. if (includeCall) and
  257. assigned(current_procinfo) then
  258. include(current_procinfo.flags, pi_do_call);
  259. end;
  260. { calling a procedure by address }
  261. procedure tcgppc.a_call_reg(list: TAsmList; reg: tregister);
  262. var
  263. tmpref: treference;
  264. tempreg : TRegister;
  265. begin
  266. if (target_info.abi<>abi_powerpc_sysv) then
  267. inherited a_call_reg(list,reg)
  268. else
  269. begin
  270. if (not (cs_opt_size in current_settings.optimizerswitches)) then
  271. begin
  272. tempreg := getintregister(list, OS_INT);
  273. { load actual function entry (reg contains the reference to the function descriptor)
  274. into tempreg }
  275. reference_reset_base(tmpref, reg, 0, ctempposinvalid, sizeof(pint), []);
  276. a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, tempreg);
  277. { move actual function pointer to CTR register }
  278. list.concat(taicpu.op_reg(A_MTCTR, tempreg));
  279. { load new TOC pointer from function descriptor into RTOC register }
  280. reference_reset_base(tmpref, reg, tcgsize2size[OS_ADDR], ctempposinvalid, 8, []);
  281. a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, NR_RTOC);
  282. { load new environment pointer from function descriptor into R11 register }
  283. reference_reset_base(tmpref, reg, 2*tcgsize2size[OS_ADDR], ctempposinvalid, 8, []);
  284. a_reg_alloc(list, NR_R11);
  285. a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, NR_R11);
  286. { call function }
  287. list.concat(taicpu.op_none(A_BCTRL));
  288. a_reg_dealloc(list, NR_R11);
  289. end
  290. else
  291. begin
  292. { call ptrgl helper routine which expects the pointer to the function descriptor
  293. in R11 }
  294. a_reg_alloc(list, NR_R11);
  295. a_load_reg_reg(list, OS_ADDR, OS_ADDR, reg, NR_R11);
  296. a_call_name_direct(list, A_BL, '.ptrgl', false, false, false);
  297. a_reg_dealloc(list, NR_R11);
  298. end;
  299. { we need to load the old RTOC from stackframe because we changed it}
  300. reference_reset_base(tmpref, NR_STACK_POINTER_REG, get_rtoc_offset, ctempposinvalid, 8, []);
  301. a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, NR_RTOC);
  302. end;
  303. include(current_procinfo.flags, pi_do_call);
  304. end;
  305. {********************** load instructions ********************}
  306. procedure tcgppc.a_load_const_reg(list: TAsmList; size: TCGSize; a: aint;
  307. reg: TRegister);
  308. { loads a 32 bit constant into the given register, using an optimal instruction sequence.
  309. This is either LIS, LI or LI+ADDIS.
  310. Returns true if during these operations the upper 32 bits were filled with 1 bits (e.g.
  311. sign extension was performed) }
  312. function load32bitconstant(list : TAsmList; size : TCGSize; a : longint;
  313. reg : TRegister) : boolean;
  314. var
  315. is_half_signed : byte;
  316. begin
  317. { if the lower 16 bits are zero, do a single LIS }
  318. if (smallint(a) = 0) and ((a shr 16) <> 0) then begin
  319. list.concat(taicpu.op_reg_const(A_LIS, reg, smallint(hi(a))));
  320. load32bitconstant := longint(a) < 0;
  321. end else begin
  322. is_half_signed := ord(smallint(lo(a)) < 0);
  323. list.concat(taicpu.op_reg_const(A_LI, reg, smallint(a and $ffff)));
  324. if smallint(hi(a) + is_half_signed) <> 0 then begin
  325. list.concat(taicpu.op_reg_reg_const(A_ADDIS, reg, reg, smallint(hi(a) + is_half_signed)));
  326. end;
  327. load32bitconstant := (smallint(a) < 0) or (a < 0);
  328. end;
  329. end;
  330. { loads a 32 bit constant into R0, using an optimal instruction sequence.
  331. This is either LIS, LI or LI+ORIS.
  332. Returns true if during these operations the upper 32 bits were filled with 1 bits (e.g.
  333. sign extension was performed) }
  334. function load32bitconstantR0(list : TAsmList; size : TCGSize; a : longint) : boolean;
  335. begin
  336. { if it's a value we can load with a single LI, do it }
  337. if (a >= low(smallint)) and (a <= high(smallint)) then begin
  338. list.concat(taicpu.op_reg_const(A_LI, NR_R0, smallint(a)));
  339. end else begin
  340. { if the lower 16 bits are zero, do a single LIS }
  341. list.concat(taicpu.op_reg_const(A_LIS, NR_R0, smallint(a shr 16)));
  342. if (smallint(a) <> 0) then begin
  343. list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(a)));
  344. end;
  345. end;
  346. load32bitconstantR0 := a < 0;
  347. end;
  348. { emits the code to load a constant by emitting various instructions into the output
  349. code}
  350. procedure loadConstantNormal(list: TAsmList; size : TCgSize; a: aint; reg: TRegister);
  351. var
  352. extendssign : boolean;
  353. instr : taicpu;
  354. begin
  355. if (lo(a) = 0) and (hi(a) <> 0) then begin
  356. { load only upper 32 bits, and shift }
  357. load32bitconstant(list, size, longint(hi(a)), reg);
  358. list.concat(taicpu.op_reg_reg_const(A_SLDI, reg, reg, 32));
  359. end else begin
  360. { load lower 32 bits }
  361. extendssign := load32bitconstant(list, size, longint(lo(a)), reg);
  362. if (extendssign) and (hi(a) = 0) then
  363. { if upper 32 bits are zero, but loading the lower 32 bit resulted in automatic
  364. sign extension, clear those bits }
  365. list.concat(taicpu.op_reg_reg_const_const(A_RLDICL, reg, reg, 0, 32))
  366. else if (not
  367. ((extendssign and (longint(hi(a)) = -1)) or
  368. ((not extendssign) and (hi(a)=0)))
  369. ) then begin
  370. { only load the upper 32 bits, if the automatic sign extension is not okay,
  371. that is, _not_ if
  372. - loading the lower 32 bits resulted in -1 in the upper 32 bits, and the upper
  373. 32 bits should contain -1
  374. - loading the lower 32 bits resulted in 0 in the upper 32 bits, and the upper
  375. 32 bits should contain 0 }
  376. a_reg_alloc(list, NR_R0);
  377. load32bitconstantR0(list, size, longint(hi(a)));
  378. { combine both registers }
  379. list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, reg, NR_R0, 32, 0));
  380. a_reg_dealloc(list, NR_R0);
  381. end;
  382. end;
  383. end;
  384. {$IFDEF EXTDEBUG}
  385. var
  386. astring : string;
  387. {$ENDIF EXTDEBUG}
  388. begin
  389. {$IFDEF EXTDEBUG}
  390. astring := 'a_load_const_reg ' + inttostr(hi(a)) + ' ' + inttostr(lo(a)) + ' ' + inttostr(ord(size)) + ' ' + inttostr(tcgsize2size[size]) + ' ' + hexstr(a, 16);
  391. list.concat(tai_comment.create(strpnew(astring)));
  392. {$ENDIF EXTDEBUG}
  393. if not (size in [OS_8, OS_S8, OS_16, OS_S16, OS_32, OS_S32, OS_64, OS_S64]) then
  394. internalerror(2002090902);
  395. { if PIC or basic optimizations are enabled, and the number of instructions which would be
  396. required to load the value is greater than 2, store (and later load) the value from there }
  397. // if (((cs_opt_peephole in current_settings.optimizerswitches) or (cs_create_pic in current_settings.moduleswitches)) and
  398. // (getInstructionLength(a) > 2)) then
  399. // loadConstantPIC(list, size, a, reg)
  400. // else
  401. loadConstantNormal(list, size, a, reg);
  402. end;
  403. procedure tcgppc.a_load_ref_reg(list: TAsmList; fromsize, tosize: tcgsize;
  404. const ref: treference; reg: tregister);
  405. const
  406. LoadInstr: array[OS_8..OS_S64, boolean, boolean] of TAsmOp =
  407. { indexed? updating? }
  408. (((A_LBZ, A_LBZU), (A_LBZX, A_LBZUX)),
  409. ((A_LHZ, A_LHZU), (A_LHZX, A_LHZUX)),
  410. ((A_LWZ, A_LWZU), (A_LWZX, A_LWZUX)),
  411. ((A_LD, A_LDU), (A_LDX, A_LDUX)),
  412. { 128bit stuff too }
  413. ((A_NONE, A_NONE), (A_NONE, A_NONE)),
  414. { there's no load-byte-with-sign-extend :( }
  415. ((A_LBZ, A_LBZU), (A_LBZX, A_LBZUX)),
  416. ((A_LHA, A_LHAU), (A_LHAX, A_LHAUX)),
  417. { there's no load-word-arithmetic-indexed with update, simulate it in code :( }
  418. ((A_LWA, A_NOP), (A_LWAX, A_LWAUX)),
  419. ((A_LD, A_LDU), (A_LDX, A_LDUX))
  420. );
  421. var
  422. op: tasmop;
  423. ref2: treference;
  424. tmpreg: tregister;
  425. begin
  426. if target_info.system=system_powerpc64_aix then
  427. g_load_check_simple(list,ref,65536);
  428. {$IFDEF EXTDEBUG}
  429. list.concat(tai_comment.create(strpnew('a_load_ref_reg ' + ref2string(ref))));
  430. {$ENDIF EXTDEBUG}
  431. if not (fromsize in [OS_8, OS_S8, OS_16, OS_S16, OS_32, OS_S32, OS_64, OS_S64]) then
  432. internalerror(2002090904);
  433. { the caller is expected to have adjusted the reference already
  434. in this case }
  435. if (TCGSize2Size[fromsize] >= TCGSize2Size[tosize]) then
  436. fromsize := tosize;
  437. ref2 := ref;
  438. fixref(list, ref2);
  439. op := loadinstr[fromsize, ref2.index <> NR_NO, false];
  440. { there is no LWAU instruction, simulate using ADDI and LWA }
  441. if (op = A_NOP) then begin
  442. list.concat(taicpu.op_reg_reg_const(A_ADDI, reg, reg, ref2.offset));
  443. ref2.offset := 0;
  444. op := A_LWA;
  445. end;
  446. a_load_store(list, op, reg, ref2);
  447. { sign extend shortint if necessary (because there is
  448. no load instruction to sign extend an 8 bit value automatically)
  449. and mask out extra sign bits when loading from a smaller
  450. signed to a larger unsigned type (where it matters) }
  451. if (fromsize = OS_S8) then begin
  452. a_load_reg_reg(list, OS_8, OS_S8, reg, reg);
  453. a_load_reg_reg(list, OS_S8, tosize, reg, reg);
  454. end else if (fromsize = OS_S16) and (tosize = OS_32) then
  455. a_load_reg_reg(list, fromsize, tosize, reg, reg);
  456. end;
  457. procedure tcgppc.a_load_reg_reg(list: TAsmList; fromsize, tosize: tcgsize;
  458. reg1, reg2: tregister);
  459. var
  460. instr: TAiCpu;
  461. bytesize : byte;
  462. begin
  463. {$ifdef extdebug}
  464. list.concat(tai_comment.create(strpnew('a_load_reg_reg from : ' + cgsize2string(fromsize) + ' to ' + cgsize2string(tosize))));
  465. {$endif}
  466. if (tcgsize2size[fromsize] > tcgsize2size[tosize]) or
  467. ((tcgsize2size[fromsize] = tcgsize2size[tosize]) and (fromsize <> tosize)) or
  468. { do we need to mask out the sign when loading from smaller signed to larger unsigned type? }
  469. ( is_signed_cgsize(fromsize) and (not is_signed_cgsize(tosize)) and
  470. (tcgsize2size[fromsize] < tcgsize2size[tosize]) and (tcgsize2size[tosize] <> sizeof(pint)) ) then begin
  471. case tosize of
  472. OS_S8:
  473. instr := taicpu.op_reg_reg(A_EXTSB,reg2,reg1);
  474. OS_S16:
  475. instr := taicpu.op_reg_reg(A_EXTSH,reg2,reg1);
  476. OS_S32:
  477. instr := taicpu.op_reg_reg(A_EXTSW,reg2,reg1);
  478. OS_8, OS_16, OS_32:
  479. instr := taicpu.op_reg_reg_const_const(A_RLDICL, reg2, reg1, 0, (8-tcgsize2size[tosize])*8);
  480. OS_S64, OS_64:
  481. instr := taicpu.op_reg_reg(A_MR, reg2, reg1);
  482. else
  483. internalerror(2013113007);
  484. end;
  485. end else
  486. instr := taicpu.op_reg_reg(A_MR, reg2, reg1);
  487. list.concat(instr);
  488. rg[R_INTREGISTER].add_move_instruction(instr);
  489. end;
  490. procedure tcgppc.a_op_const_reg(list: TAsmList; Op: TOpCG; size: TCGSize; a:
  491. aint; reg: TRegister);
  492. begin
  493. a_op_const_reg_reg(list, op, size, a, reg, reg);
  494. end;
  495. procedure tcgppc.a_op_reg_reg(list: TAsmList; Op: TOpCG; size: TCGSize; src,
  496. dst: TRegister);
  497. begin
  498. a_op_reg_reg_reg(list, op, size, src, dst, dst);
  499. end;
  500. procedure tcgppc.a_op_const_reg_reg(list: TAsmList; op: TOpCg;
  501. size: tcgsize; a: aint; src, dst: tregister);
  502. var
  503. useReg : boolean;
  504. procedure do_lo_hi(loOp, hiOp : TAsmOp);
  505. begin
  506. { Optimization for logical ops (excluding AND), trying to do this as efficiently
  507. as possible by only generating code for the affected halfwords. Note that all
  508. the instructions handled here must have "X op 0 = X" for every halfword. }
  509. usereg := false;
  510. if (aword(a) > high(dword)) then begin
  511. usereg := true;
  512. end else begin
  513. if (word(a) <> 0) then begin
  514. list.concat(taicpu.op_reg_reg_const(loOp, dst, src, word(a)));
  515. if (word(a shr 16) <> 0) then
  516. list.concat(taicpu.op_reg_reg_const(hiOp, dst, dst, word(a shr 16)));
  517. end else if (word(a shr 16) <> 0) then
  518. list.concat(taicpu.op_reg_reg_const(hiOp, dst, src, word(a shr 16)));
  519. end;
  520. end;
  521. procedure do_lo_hi_and;
  522. begin
  523. { optimization logical and with immediate: only use "andi." for 16 bit
  524. ands, otherwise use register method. Doing this for 32 bit constants
  525. would not give any advantage to the register method (via useReg := true),
  526. requiring a scratch register and three instructions. }
  527. usereg := false;
  528. if (aword(a) > high(word)) then
  529. usereg := true
  530. else
  531. list.concat(taicpu.op_reg_reg_const(A_ANDI_, dst, src, word(a)));
  532. end;
  533. procedure do_constant_div(list : TAsmList; size : TCgSize; a : aint; src, dst : TRegister;
  534. signed : boolean);
  535. const
  536. negops : array[boolean] of tasmop = (A_NEG, A_NEGO);
  537. var
  538. magic : int64;
  539. u_magic : qword;
  540. u_shift : byte;
  541. u_add : boolean;
  542. power : byte;
  543. isNegPower : boolean;
  544. divreg : tregister;
  545. begin
  546. if (a = 0) then begin
  547. internalerror(2005061701);
  548. end else if (a = 1) then begin
  549. a_load_reg_reg(list, OS_INT, OS_INT, src, dst);
  550. end else if (a = -1) and (signed) then begin
  551. { note: only in the signed case possible..., may overflow }
  552. list.concat(taicpu.op_reg_reg(negops[cs_check_overflow in current_settings.localswitches], dst, src));
  553. end else if (ispowerof2(a, power, isNegPower)) then begin
  554. if (signed) then begin
  555. { From "The PowerPC Compiler Writer's Guide", pg. 52ff }
  556. a_op_const_reg_reg(list, OP_SAR, OS_INT, power,
  557. src, dst);
  558. list.concat(taicpu.op_reg_reg(A_ADDZE, dst, dst));
  559. if (isNegPower) then
  560. list.concat(taicpu.op_reg_reg(A_NEG, dst, dst));
  561. end else begin
  562. a_op_const_reg_reg(list, OP_SHR, OS_INT, power, src, dst)
  563. end;
  564. end else begin
  565. { replace division by multiplication, both implementations }
  566. { from "The PowerPC Compiler Writer's Guide" pg. 53ff }
  567. divreg := getintregister(list, OS_INT);
  568. if (signed) then begin
  569. calc_divconst_magic_signed(sizeof(aInt)*8, a, magic, u_shift);
  570. { load magic value }
  571. a_load_const_reg(list, OS_INT, magic, divreg);
  572. { multiply }
  573. list.concat(taicpu.op_reg_reg_reg(A_MULHD, dst, src, divreg));
  574. { add/subtract numerator }
  575. if (a > 0) and (magic < 0) then begin
  576. a_op_reg_reg_reg(list, OP_ADD, OS_INT, src, dst, dst);
  577. end else if (a < 0) and (magic > 0) then begin
  578. a_op_reg_reg_reg(list, OP_SUB, OS_INT, src, dst, dst);
  579. end;
  580. { shift shift places to the right (arithmetic) }
  581. a_op_const_reg_reg(list, OP_SAR, OS_INT, u_shift, dst, dst);
  582. { extract and add sign bit }
  583. if (a >= 0) then begin
  584. a_op_const_reg_reg(list, OP_SHR, OS_INT, 63, src, divreg);
  585. end else begin
  586. a_op_const_reg_reg(list, OP_SHR, OS_INT, 63, dst, divreg);
  587. end;
  588. a_op_reg_reg_reg(list, OP_ADD, OS_INT, dst, divreg, dst);
  589. end else begin
  590. calc_divconst_magic_unsigned(sizeof(aWord)*8, a, u_magic, u_add, u_shift);
  591. { load magic in divreg }
  592. a_load_const_reg(list, OS_INT, aint(u_magic), divreg);
  593. list.concat(taicpu.op_reg_reg_reg(A_MULHDU, dst, src, divreg));
  594. if (u_add) then begin
  595. a_op_reg_reg_reg(list, OP_SUB, OS_INT, dst, src, divreg);
  596. a_op_const_reg_reg(list, OP_SHR, OS_INT, 1, divreg, divreg);
  597. a_op_reg_reg_reg(list, OP_ADD, OS_INT, divreg, dst, divreg);
  598. a_op_const_reg_reg(list, OP_SHR, OS_INT, u_shift-1, divreg, dst);
  599. end else begin
  600. a_op_const_reg_reg(list, OP_SHR, OS_INT, u_shift, dst, dst);
  601. end;
  602. end;
  603. end;
  604. end;
  605. var
  606. scratchreg: tregister;
  607. shift : byte;
  608. shiftmask : longint;
  609. isneg : boolean;
  610. begin
  611. { subtraction is the same as addition with negative constant }
  612. if op = OP_SUB then begin
  613. a_op_const_reg_reg(list, OP_ADD, size, -a, src, dst);
  614. exit;
  615. end;
  616. {$IFDEF EXTDEBUG}
  617. list.concat(tai_comment.create(strpnew('a_op_const_reg_reg ' + cgop2string(op))));
  618. {$ENDIF EXTDEBUG}
  619. { This case includes some peephole optimizations for the various operations,
  620. (e.g. AND, OR, XOR, ..) - can't this be done at some higher level,
  621. independent of architecture? }
  622. { assume that we do not need a scratch register for the operation }
  623. useReg := false;
  624. case (op) of
  625. OP_DIV, OP_IDIV:
  626. if (cs_opt_level1 in current_settings.optimizerswitches) then
  627. do_constant_div(list, size, a, src, dst, op = OP_IDIV)
  628. else
  629. usereg := true;
  630. OP_IMUL, OP_MUL:
  631. { idea: factorize constant multiplicands and use adds/shifts with few factors;
  632. however, even a 64 bit multiply is already quite fast on PPC64 }
  633. if (a = 0) then
  634. a_load_const_reg(list, size, 0, dst)
  635. else if (a = -1) then
  636. list.concat(taicpu.op_reg_reg(A_NEG, dst, dst))
  637. else if (a = 1) then
  638. a_load_reg_reg(list, OS_INT, OS_INT, src, dst)
  639. else if ispowerof2(a, shift, isneg) then begin
  640. list.concat(taicpu.op_reg_reg_const(A_SLDI, dst, src, shift));
  641. if (isneg) then
  642. list.concat(taicpu.op_reg_reg(A_NEG, dst, dst));
  643. end else if (a >= low(smallint)) and (a <= high(smallint)) then
  644. list.concat(taicpu.op_reg_reg_const(A_MULLI, dst, src,
  645. smallint(a)))
  646. else
  647. usereg := true;
  648. OP_ADD:
  649. if (a = 0) then
  650. a_load_reg_reg(list, size, size, src, dst)
  651. else if (a >= low(smallint)) and (a <= high(smallint)) then
  652. list.concat(taicpu.op_reg_reg_const(A_ADDI, dst, src, smallint(a)))
  653. else
  654. useReg := true;
  655. OP_OR:
  656. if (a = 0) then
  657. a_load_reg_reg(list, size, size, src, dst)
  658. else if (a = -1) then
  659. a_load_const_reg(list, size, -1, dst)
  660. else
  661. do_lo_hi(A_ORI, A_ORIS);
  662. OP_AND:
  663. if (a = 0) then
  664. a_load_const_reg(list, size, 0, dst)
  665. else if (a = -1) then
  666. a_load_reg_reg(list, size, size, src, dst)
  667. else
  668. do_lo_hi_and;
  669. OP_XOR:
  670. if (a = 0) then
  671. a_load_reg_reg(list, size, size, src, dst)
  672. else if (a = -1) then
  673. list.concat(taicpu.op_reg_reg(A_NOT, dst, src))
  674. else
  675. do_lo_hi(A_XORI, A_XORIS);
  676. OP_ROL:
  677. begin
  678. if (size in [OS_64, OS_S64]) then begin
  679. list.concat(taicpu.op_reg_reg_const_const(A_RLDICL, dst, src, a and 63, 0));
  680. end else if (size in [OS_32, OS_S32]) then begin
  681. list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM, dst, src, a and 31, 0, 31));
  682. end else begin
  683. internalerror(2008091303);
  684. end;
  685. end;
  686. OP_ROR:
  687. begin
  688. if (size in [OS_64, OS_S64]) then begin
  689. list.concat(taicpu.op_reg_reg_const_const(A_RLDICL, dst, src, ((64 - a) and 63), 0));
  690. end else if (size in [OS_32, OS_S32]) then begin
  691. list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM, dst, src, (32 - a) and 31, 0, 31));
  692. end else begin
  693. internalerror(2008091304);
  694. end;
  695. end;
  696. OP_SHL, OP_SHR, OP_SAR:
  697. begin
  698. if (size in [OS_64, OS_S64]) then
  699. shift := 6
  700. else
  701. shift := 5;
  702. shiftmask := (1 shl shift)-1;
  703. if (a and shiftmask) <> 0 then begin
  704. list.concat(taicpu.op_reg_reg_const(
  705. TShiftOpCG2AsmOpConst[size in [OS_64, OS_S64], op], dst, src, a and shiftmask));
  706. end else
  707. a_load_reg_reg(list, size, size, src, dst);
  708. if ((a shr shift) <> 0) then
  709. internalError(68991);
  710. end
  711. else
  712. internalerror(200109091);
  713. end;
  714. { if all else failed, load the constant in a register and then
  715. perform the operation }
  716. if (useReg) then begin
  717. scratchreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
  718. a_load_const_reg(list, size, a, scratchreg);
  719. a_op_reg_reg_reg(list, op, size, scratchreg, src, dst);
  720. end else
  721. maybeadjustresult(list, op, size, dst);
  722. end;
  723. procedure tcgppc.a_op_reg_reg_reg(list: TAsmList; op: TOpCg;
  724. size: tcgsize; src1, src2, dst: tregister);
  725. const
  726. op_reg_reg_opcg2asmop32: array[TOpCG] of tasmop =
  727. (A_NONE, A_MR, A_ADD, A_AND, A_DIVWU, A_DIVW, A_MULLW, A_MULLW, A_NEG, A_NOT, A_OR,
  728. A_SRAW, A_SLW, A_SRW, A_SUB, A_XOR, A_NONE, A_NONE);
  729. op_reg_reg_opcg2asmop64: array[TOpCG] of tasmop =
  730. (A_NONE, A_MR, A_ADD, A_AND, A_DIVDU, A_DIVD, A_MULLD, A_MULLD, A_NEG, A_NOT, A_OR,
  731. A_SRAD, A_SLD, A_SRD, A_SUB, A_XOR, A_NONE, A_NONE);
  732. var
  733. tmpreg : TRegister;
  734. begin
  735. case op of
  736. OP_NEG, OP_NOT:
  737. begin
  738. list.concat(taicpu.op_reg_reg(op_reg_reg_opcg2asmop64[op], dst, src1));
  739. if (op = OP_NOT) and not (size in [OS_64, OS_S64]) then
  740. { zero/sign extend result again, fromsize is not important here }
  741. a_load_reg_reg(list, OS_S64, size, dst, dst)
  742. end;
  743. OP_ROL:
  744. begin
  745. if (size in [OS_64, OS_S64]) then begin
  746. list.concat(taicpu.op_reg_reg_reg_const(A_RLDCL, dst, src2, src1, 0));
  747. end else if (size in [OS_32, OS_S32]) then begin
  748. list.concat(taicpu.op_reg_reg_reg_const_const(A_RLWNM, dst, src2, src1, 0, 31));
  749. end else begin
  750. internalerror(2008091301);
  751. end;
  752. end;
  753. OP_ROR:
  754. begin
  755. tmpreg := getintregister(list, OS_INT);
  756. list.concat(taicpu.op_reg_reg(A_NEG, tmpreg, src1));
  757. if (size in [OS_64, OS_S64]) then begin
  758. list.concat(taicpu.op_reg_reg_reg_const(A_RLDCL, dst, src2, tmpreg, 0));
  759. end else if (size in [OS_32, OS_S32]) then begin
  760. list.concat(taicpu.op_reg_reg_reg_const_const(A_RLWNM, dst, src2, tmpreg, 0, 31));
  761. end else begin
  762. internalerror(2008091302);
  763. end;
  764. end;
  765. else
  766. if (size in [OS_64, OS_S64]) then begin
  767. list.concat(taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop64[op], dst, src2,
  768. src1));
  769. end else begin
  770. list.concat(taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop32[op], dst, src2,
  771. src1));
  772. maybeadjustresult(list, op, size, dst);
  773. end;
  774. end;
  775. end;
  776. {*************** compare instructructions ****************}
  777. procedure tcgppc.a_cmp_const_reg_label(list: TAsmList; size: tcgsize;
  778. cmp_op: topcmp; a: aint; reg: tregister; l: tasmlabel);
  779. const
  780. { unsigned useconst 32bit-op }
  781. cmpop_table : array[boolean, boolean, boolean] of TAsmOp = (
  782. ((A_CMPD, A_CMPW), (A_CMPDI, A_CMPWI)),
  783. ((A_CMPLD, A_CMPLW), (A_CMPLDI, A_CMPLWI))
  784. );
  785. var
  786. tmpreg : TRegister;
  787. signed, useconst : boolean;
  788. opsize : TCgSize;
  789. op : TAsmOp;
  790. begin
  791. {$IFDEF EXTDEBUG}
  792. list.concat(tai_comment.create(strpnew('a_cmp_const_reg_label ' + cgsize2string(size) + ' ' + booltostr(cmp_op in [OC_GT, OC_LT, OC_GTE, OC_LTE]) + ' ' + inttostr(a) )));
  793. {$ENDIF EXTDEBUG}
  794. signed := cmp_op in [OC_GT, OC_LT, OC_GTE, OC_LTE];
  795. { in the following case, we generate more efficient code when
  796. signed is true }
  797. if (cmp_op in [OC_EQ, OC_NE]) and
  798. (aword(a) > $FFFF) then
  799. signed := true;
  800. opsize := size;
  801. { do we need to change the operand size because ppc64 only supports 32 and
  802. 64 bit compares? }
  803. if (not (size in [OS_32, OS_S32, OS_64, OS_S64])) then begin
  804. if (signed) then
  805. opsize := OS_S32
  806. else
  807. opsize := OS_32;
  808. a_load_reg_reg(list, size, opsize, reg, reg);
  809. end;
  810. { can we use immediate compares? }
  811. useconst := (signed and ( (a >= low(smallint)) and (a <= high(smallint)))) or
  812. ((not signed) and (aword(a) <= $FFFF));
  813. op := cmpop_table[not signed, useconst, opsize in [OS_32, OS_S32]];
  814. if (useconst) then begin
  815. list.concat(taicpu.op_reg_reg_const(op, NR_CR0, reg, a));
  816. end else begin
  817. tmpreg := getintregister(list, OS_INT);
  818. a_load_const_reg(list, opsize, a, tmpreg);
  819. list.concat(taicpu.op_reg_reg_reg(op, NR_CR0, reg, tmpreg));
  820. end;
  821. a_jmp(list, A_BC, TOpCmp2AsmCond[cmp_op], 0, l);
  822. end;
  823. procedure tcgppc.a_cmp_reg_reg_label(list: TAsmList; size: tcgsize;
  824. cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel);
  825. var
  826. op: tasmop;
  827. begin
  828. {$IFDEF extdebug}
  829. list.concat(tai_comment.create(strpnew('a_cmp_reg_reg_label, size ' + cgsize2string(size) + ' op ' + inttostr(ord(cmp_op)))));
  830. {$ENDIF extdebug}
  831. {$note Commented out below check because of compiler weirdness}
  832. {
  833. if (not (size in [OS_32, OS_S32, OS_64, OS_S64])) then
  834. internalerror(200606041);
  835. }
  836. if cmp_op in [OC_GT, OC_LT, OC_GTE, OC_LTE] then
  837. if (size in [OS_64, OS_S64]) then
  838. op := A_CMPD
  839. else
  840. op := A_CMPW
  841. else
  842. if (size in [OS_64, OS_S64]) then
  843. op := A_CMPLD
  844. else
  845. op := A_CMPLW;
  846. list.concat(taicpu.op_reg_reg_reg(op, NR_CR0, reg2, reg1));
  847. a_jmp(list, A_BC, TOpCmp2AsmCond[cmp_op], 0, l);
  848. end;
  849. procedure tcgppc.a_jmp_name_direct(list : TAsmList; opc: tasmop; s : string; prependDot : boolean);
  850. var
  851. p: taicpu;
  852. begin
  853. if (prependDot) then
  854. s := '.' + s;
  855. p := taicpu.op_sym(opc, current_asmdata.RefAsmSymbol(s,AT_FUNCTION));
  856. p.is_jmp := true;
  857. list.concat(p)
  858. end;
  859. procedure tcgppc.a_jmp_name(list: TAsmList; const s: string);
  860. var
  861. p: taicpu;
  862. begin
  863. if (target_info.system = system_powerpc64_darwin) then
  864. begin
  865. p := taicpu.op_sym(A_B,get_darwin_call_stub(s,false));
  866. p.is_jmp := true;
  867. list.concat(p)
  868. end
  869. else
  870. a_jmp_name_direct(list, A_B, s, true);
  871. end;
  872. procedure tcgppc.a_jmp_always(list: TAsmList; l: tasmlabel);
  873. begin
  874. a_jmp(list, A_B, C_None, 0, l);
  875. end;
  876. { *********** entry/exit code and address loading ************ }
  877. procedure tcgppc.g_save_registers(list: TAsmList);
  878. begin
  879. { this work is done in g_proc_entry; additionally it is not safe
  880. to use it because it is called at some weird time }
  881. end;
  882. procedure tcgppc.g_restore_registers(list: TAsmList);
  883. begin
  884. { this work is done in g_proc_exit; mainly because it is not safe to
  885. put the register restore code here because it is called at some weird time }
  886. end;
  887. procedure tcgppc.calcFirstUsedFPR(out firstfpr : TSuperRegister; out fprcount : aint);
  888. var
  889. reg : TSuperRegister;
  890. begin
  891. fprcount := 0;
  892. firstfpr := RS_F31;
  893. if not (po_assembler in current_procinfo.procdef.procoptions) then
  894. for reg := RS_F14 to RS_F31 do
  895. if reg in rg[R_FPUREGISTER].used_in_proc then begin
  896. fprcount := ord(RS_F31)-ord(reg)+1;
  897. firstfpr := reg;
  898. break;
  899. end;
  900. end;
  901. procedure tcgppc.calcFirstUsedGPR(out firstgpr : TSuperRegister; out gprcount : aint);
  902. var
  903. reg : TSuperRegister;
  904. begin
  905. gprcount := 0;
  906. firstgpr := RS_R31;
  907. if not (po_assembler in current_procinfo.procdef.procoptions) then
  908. for reg := RS_R14 to RS_R31 do
  909. if reg in rg[R_INTREGISTER].used_in_proc then begin
  910. gprcount := ord(RS_R31)-ord(reg)+1;
  911. firstgpr := reg;
  912. break;
  913. end;
  914. end;
  915. procedure tcgppc.profilecode_savepara(para : tparavarsym; list : TAsmList);
  916. begin
  917. case (para.paraloc[calleeside].location^.loc) of
  918. LOC_REGISTER, LOC_CREGISTER:
  919. a_load_reg_ref(list, OS_INT, para.paraloc[calleeside].Location^.size,
  920. para.paraloc[calleeside].Location^.register, para.localloc.reference);
  921. LOC_FPUREGISTER, LOC_CFPUREGISTER:
  922. a_loadfpu_reg_ref(list, para.paraloc[calleeside].Location^.size,
  923. para.paraloc[calleeside].Location^.size,
  924. para.paraloc[calleeside].Location^.register, para.localloc.reference);
  925. LOC_MMREGISTER, LOC_CMMREGISTER:
  926. { not supported }
  927. internalerror(2006041801);
  928. end;
  929. end;
  930. procedure tcgppc.profilecode_restorepara(para : tparavarsym; list : TAsmList);
  931. begin
  932. case (para.paraloc[calleeside].Location^.loc) of
  933. LOC_REGISTER, LOC_CREGISTER:
  934. a_load_ref_reg(list, para.paraloc[calleeside].Location^.size, OS_INT,
  935. para.localloc.reference, para.paraloc[calleeside].Location^.register);
  936. LOC_FPUREGISTER, LOC_CFPUREGISTER:
  937. a_loadfpu_ref_reg(list, para.paraloc[calleeside].Location^.size,
  938. para.paraloc[calleeside].Location^.size,
  939. para.localloc.reference, para.paraloc[calleeside].Location^.register);
  940. LOC_MMREGISTER, LOC_CMMREGISTER:
  941. { not supported }
  942. internalerror(2006041802);
  943. end;
  944. end;
  945. procedure tcgppc.g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: aint);
  946. var
  947. hsym : tsym;
  948. href : treference;
  949. paraloc : Pcgparalocation;
  950. begin
  951. if ((ioffset >= low(smallint)) and (ioffset < high(smallint))) then begin
  952. { the original method can handle this }
  953. inherited g_adjust_self_value(list, procdef, ioffset);
  954. exit;
  955. end;
  956. { calculate the parameter info for the procdef }
  957. procdef.init_paraloc_info(callerside);
  958. hsym:=tsym(procdef.parast.Find('self'));
  959. if not(assigned(hsym) and
  960. (hsym.typ=paravarsym)) then
  961. internalerror(2010103101);
  962. paraloc:=tparavarsym(hsym).paraloc[callerside].location;
  963. while paraloc<>nil do
  964. with paraloc^ do begin
  965. case loc of
  966. LOC_REGISTER:
  967. begin
  968. a_load_const_reg(list, size, ioffset, NR_R11);
  969. a_op_reg_reg(list, OP_SUB, size, NR_R11, register);
  970. end else
  971. internalerror(2010103102);
  972. end;
  973. paraloc:=next;
  974. end;
  975. end;
  976. procedure tcgppc.g_profilecode(list: TAsmList);
  977. begin
  978. current_procinfo.procdef.paras.ForEachCall(TObjectListCallback(@profilecode_savepara), list);
  979. a_call_name_direct(list, A_BL, '_mcount', false, false, true);
  980. current_procinfo.procdef.paras.ForEachCall(TObjectListCallback(@profilecode_restorepara), list);
  981. end;
  982. { Generates the entry code of a procedure/function.
  983. This procedure may be called before, as well as after g_return_from_proc
  984. is called. localsize is the sum of the size necessary for local variables
  985. and the maximum possible combined size of ALL the parameters of a procedure
  986. called by the current one
  987. IMPORTANT: registers are not to be allocated through the register
  988. allocator here, because the register colouring has already occurred !!
  989. }
  990. procedure tcgppc.g_proc_entry(list: TAsmList; localsize: longint;
  991. nostackframe: boolean);
  992. var
  993. firstregfpu, firstreggpr: TSuperRegister;
  994. needslinkreg: boolean;
  995. fprcount, gprcount : aint;
  996. { Save standard registers, both FPR and GPR; does not support VMX/Altivec }
  997. procedure save_standard_registers;
  998. var
  999. regcount : TSuperRegister;
  1000. href : TReference;
  1001. mayNeedLRStore : boolean;
  1002. opc : tasmop;
  1003. begin
  1004. { there are two ways to do this: manually, by generating a few "std" instructions,
  1005. or via the restore helper functions. The latter are selected by the -Og switch,
  1006. i.e. "optimize for size" }
  1007. if (cs_opt_size in current_settings.optimizerswitches) and
  1008. (target_info.system <> system_powerpc64_darwin) then begin
  1009. mayNeedLRStore := false;
  1010. if target_info.system=system_powerpc64_aix then
  1011. opc:=A_BLA
  1012. else
  1013. opc:=A_BL;
  1014. if ((fprcount > 0) and (gprcount > 0)) then begin
  1015. a_op_const_reg_reg(list, OP_SUB, OS_INT, 8 * fprcount, NR_R1, NR_R12);
  1016. a_call_name_direct(list, opc, '_savegpr1_' + intToStr(32-gprcount), false, false, false, false);
  1017. a_call_name_direct(list, opc, '_savefpr_' + intToStr(32-fprcount), false, false, false, false);
  1018. end else if (gprcount > 0) then
  1019. a_call_name_direct(list, opc, '_savegpr0_' + intToStr(32-gprcount), false, false, false, false)
  1020. else if (fprcount > 0) then
  1021. a_call_name_direct(list, opc, '_savefpr_' + intToStr(32-fprcount), false, false, false, false)
  1022. else
  1023. mayNeedLRStore := true;
  1024. end else begin
  1025. { save registers, FPU first, then GPR }
  1026. reference_reset_base(href, NR_STACK_POINTER_REG, -8, ctempposinvalid, 8, []);
  1027. if (fprcount > 0) then
  1028. for regcount := RS_F31 downto firstregfpu do begin
  1029. a_loadfpu_reg_ref(list, OS_FLOAT, OS_FLOAT, newreg(R_FPUREGISTER,
  1030. regcount, R_SUBNONE), href);
  1031. dec(href.offset, tcgsize2size[OS_FLOAT]);
  1032. end;
  1033. if (gprcount > 0) then
  1034. for regcount := RS_R31 downto firstreggpr do begin
  1035. a_load_reg_ref(list, OS_INT, OS_INT, newreg(R_INTREGISTER, regcount,
  1036. R_SUBNONE), href);
  1037. dec(href.offset, sizeof(pint));
  1038. end;
  1039. { VMX registers not supported by FPC atm }
  1040. { in this branch we always need to store LR ourselves}
  1041. mayNeedLRStore := true;
  1042. end;
  1043. { we may need to store R0 (=LR) ourselves }
  1044. if ((cs_profile in init_settings.moduleswitches) or (mayNeedLRStore)) and (needslinkreg) then begin
  1045. reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_SYSV, ctempposinvalid, 8, []);
  1046. list.concat(taicpu.op_reg_ref(A_STD, NR_R0, href));
  1047. end;
  1048. end;
  1049. var
  1050. href: treference;
  1051. lab: tasmlabel;
  1052. procmangledname: TSymStr;
  1053. begin
  1054. { In ELFv2 the function is required to initialise the TOC register itself
  1055. if necessary. Additionally, it has to mark the end of this TOC
  1056. initialisation code with a .localfunc directive, which will be used as
  1057. local entry code by the linker (when it knows the TOC value is the same
  1058. for the caller and callee). It must load the TOC in a PIC-way, which it
  1059. can do easily because R12 is guaranteed to hold the address of this function
  1060. on entry. }
  1061. if (target_info.abi=abi_powerpc_elfv2) and
  1062. (pi_needs_got in current_procinfo.flags) and
  1063. not nostackframe then
  1064. begin
  1065. current_asmdata.getlabel(lab,alt_addr);
  1066. getcpuregister(list,NR_R12);
  1067. getcpuregister(list,NR_R2);
  1068. cg.a_label(list,lab);
  1069. reference_reset_symbol(href,current_asmdata.RefAsmSymbol('.TOC.',AT_DATA),0,sizeof(PInt),[]);
  1070. href.relsymbol:=lab;
  1071. href.refaddr:=addr_higha;
  1072. list.concat(taicpu.op_reg_reg_ref(a_addis,NR_R2,NR_R12,href));
  1073. href.refaddr:=addr_low;
  1074. list.concat(taicpu.op_reg_reg_ref(a_addi,NR_R2,NR_R2,href));
  1075. procmangledname:=current_procinfo.procdef.mangledname;
  1076. list.concat(tai_symbolpair.create(spk_localentry,procmangledname,procmangledname));
  1077. end;
  1078. calcFirstUsedFPR(firstregfpu, fprcount);
  1079. calcFirstUsedGPR(firstreggpr, gprcount);
  1080. { calculate real stack frame size }
  1081. localsize := tcpuprocinfo(current_procinfo).calc_stackframe_size(
  1082. gprcount, fprcount);
  1083. { determine whether we need to save the link register }
  1084. needslinkreg :=
  1085. not(nostackframe) and
  1086. (save_lr_in_prologue or
  1087. ((cs_opt_size in current_settings.optimizerswitches) and
  1088. ((fprcount > 0) or
  1089. (gprcount > 0))));
  1090. a_reg_alloc(list, NR_STACK_POINTER_REG);
  1091. a_reg_alloc(list, NR_R0);
  1092. { move link register to r0 }
  1093. if (needslinkreg) then
  1094. list.concat(taicpu.op_reg(A_MFLR, NR_R0));
  1095. save_standard_registers;
  1096. { save old stack frame pointer }
  1097. if (tcpuprocinfo(current_procinfo).needs_frame_pointer) then
  1098. list.concat(taicpu.op_reg_reg(A_MR, NR_OLD_STACK_POINTER_REG, NR_STACK_POINTER_REG));
  1099. { create stack frame }
  1100. if (not nostackframe) and (localsize > 0) and
  1101. tcpuprocinfo(current_procinfo).needstackframe then begin
  1102. if (localsize <= high(smallint)) then begin
  1103. reference_reset_base(href, NR_STACK_POINTER_REG, -localsize, ctempposinvalid, 8, []);
  1104. a_load_store(list, A_STDU, NR_STACK_POINTER_REG, href);
  1105. end else begin
  1106. reference_reset_base(href, NR_NO, -localsize, ctempposinvalid, 8, []);
  1107. { Use R0 for loading the constant (which is definitely > 32k when entering
  1108. this branch).
  1109. Inlined at this position because it must not use temp registers because
  1110. register allocations have already been done }
  1111. { Code template:
  1112. lis r0,ofs@highest
  1113. ori r0,r0,ofs@higher
  1114. sldi r0,r0,32
  1115. oris r0,r0,ofs@h
  1116. ori r0,r0,ofs@l
  1117. }
  1118. list.concat(taicpu.op_reg_const(A_LIS, NR_R0, word(href.offset shr 48)));
  1119. list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(href.offset shr 32)));
  1120. list.concat(taicpu.op_reg_reg_const(A_SLDI, NR_R0, NR_R0, 32));
  1121. list.concat(taicpu.op_reg_reg_const(A_ORIS, NR_R0, NR_R0, word(href.offset shr 16)));
  1122. list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(href.offset)));
  1123. list.concat(taicpu.op_reg_reg_reg(A_STDUX, NR_R1, NR_R1, NR_R0));
  1124. end;
  1125. end;
  1126. { save current RTOC for restoration after calls if necessary }
  1127. if (pi_do_call in current_procinfo.flags) and
  1128. (target_info.abi in abis_ppc_toc) and
  1129. not nostackframe then
  1130. begin
  1131. reference_reset_base(href,NR_STACK_POINTER_REG,get_rtoc_offset,ctempposinvalid,target_info.stackalign,[]);
  1132. a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_RTOC,href);
  1133. end;
  1134. { CR register not used by FPC atm }
  1135. { keep R1 allocated??? }
  1136. a_reg_dealloc(list, NR_R0);
  1137. end;
  1138. { Generates the exit code for a method.
  1139. This procedure may be called before, as well as after g_stackframe_entry
  1140. is called.
  1141. IMPORTANT: registers are not to be allocated through the register
  1142. allocator here, because the register colouring has already occurred !!
  1143. }
  1144. procedure tcgppc.g_proc_exit(list: TAsmList; parasize: longint; nostackframe:
  1145. boolean);
  1146. var
  1147. firstregfpu, firstreggpr: TSuperRegister;
  1148. needslinkreg : boolean;
  1149. fprcount, gprcount: aint;
  1150. { Restore standard registers, both FPR and GPR; does not support VMX/Altivec }
  1151. procedure restore_standard_registers;
  1152. var
  1153. { flag indicating whether we need to manually add the exit code (e.g. blr instruction)
  1154. or not }
  1155. needsExitCode : Boolean;
  1156. href : treference;
  1157. regcount : TSuperRegister;
  1158. callopc,
  1159. jmpopc: tasmop;
  1160. begin
  1161. { there are two ways to do this: manually, by generating a few "ld" instructions,
  1162. or via the restore helper functions. The latter are selected by the -Og switch,
  1163. i.e. "optimize for size" }
  1164. if (cs_opt_size in current_settings.optimizerswitches) then begin
  1165. if target_info.system=system_powerpc64_aix then begin
  1166. callopc:=A_BLA;
  1167. jmpopc:=A_BA;
  1168. end
  1169. else begin
  1170. callopc:=A_BL;
  1171. jmpopc:=A_B;
  1172. end;
  1173. needsExitCode := false;
  1174. if ((fprcount > 0) and (gprcount > 0)) then begin
  1175. a_op_const_reg_reg(list, OP_SUB, OS_INT, 8 * fprcount, NR_R1, NR_R12);
  1176. a_call_name_direct(list, callopc, '_restgpr1_' + intToStr(32-gprcount), false, false, false, false);
  1177. a_jmp_name_direct(list, jmpopc, '_restfpr_' + intToStr(32-fprcount), false);
  1178. end else if (gprcount > 0) then
  1179. a_jmp_name_direct(list, jmpopc, '_restgpr0_' + intToStr(32-gprcount), false)
  1180. else if (fprcount > 0) then
  1181. a_jmp_name_direct(list, jmpopc, '_restfpr_' + intToStr(32-fprcount), false)
  1182. else
  1183. needsExitCode := true;
  1184. end else begin
  1185. needsExitCode := true;
  1186. { restore registers, FPU first, GPR next }
  1187. reference_reset_base(href, NR_STACK_POINTER_REG, -tcgsize2size[OS_FLOAT], ctempposinvalid, 8, []);
  1188. if (fprcount > 0) then
  1189. for regcount := RS_F31 downto firstregfpu do begin
  1190. a_loadfpu_ref_reg(list, OS_FLOAT, OS_FLOAT, href, newreg(R_FPUREGISTER, regcount,
  1191. R_SUBNONE));
  1192. dec(href.offset, tcgsize2size[OS_FLOAT]);
  1193. end;
  1194. if (gprcount > 0) then
  1195. for regcount := RS_R31 downto firstreggpr do begin
  1196. a_load_ref_reg(list, OS_INT, OS_INT, href, newreg(R_INTREGISTER, regcount,
  1197. R_SUBNONE));
  1198. dec(href.offset, sizeof(pint));
  1199. end;
  1200. { VMX not supported by FPC atm }
  1201. end;
  1202. if (needsExitCode) then begin
  1203. { restore LR (if needed) }
  1204. if (needslinkreg) then begin
  1205. reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_SYSV, ctempposinvalid, 8, []);
  1206. list.concat(taicpu.op_reg_ref(A_LD, NR_R0, href));
  1207. list.concat(taicpu.op_reg(A_MTLR, NR_R0));
  1208. end;
  1209. { generate return instruction }
  1210. list.concat(taicpu.op_none(A_BLR));
  1211. end;
  1212. end;
  1213. var
  1214. href: treference;
  1215. localsize : aint;
  1216. begin
  1217. calcFirstUsedFPR(firstregfpu, fprcount);
  1218. calcFirstUsedGPR(firstreggpr, gprcount);
  1219. { determine whether we need to restore the link register }
  1220. needslinkreg :=
  1221. not(nostackframe) and
  1222. (((not (po_assembler in current_procinfo.procdef.procoptions)) and
  1223. ((pi_do_call in current_procinfo.flags) or (cs_profile in init_settings.moduleswitches))) or
  1224. ((cs_opt_size in current_settings.optimizerswitches) and ((fprcount > 0) or (gprcount > 0))) or
  1225. ([cs_lineinfo, cs_debuginfo] * current_settings.moduleswitches <> []));
  1226. { calculate stack frame }
  1227. localsize := tcpuprocinfo(current_procinfo).calc_stackframe_size(
  1228. gprcount, fprcount);
  1229. { CR register not supported }
  1230. { restore stack pointer }
  1231. if (not nostackframe) and (localsize > 0) and
  1232. tcpuprocinfo(current_procinfo).needstackframe then begin
  1233. if (localsize <= high(smallint)) then begin
  1234. list.concat(taicpu.op_reg_reg_const(A_ADDI, NR_STACK_POINTER_REG, NR_STACK_POINTER_REG, localsize));
  1235. end else begin
  1236. reference_reset_base(href, NR_NO, localsize, ctempposinvalid, 8, []);
  1237. { use R0 for loading the constant (which is definitely > 32k when entering
  1238. this branch)
  1239. Inlined because it must not use temp registers because register allocations
  1240. have already been done
  1241. }
  1242. { Code template:
  1243. lis r0,ofs@highest
  1244. ori r0,ofs@higher
  1245. sldi r0,r0,32
  1246. oris r0,r0,ofs@h
  1247. ori r0,r0,ofs@l
  1248. }
  1249. list.concat(taicpu.op_reg_const(A_LIS, NR_R0, word(href.offset shr 48)));
  1250. list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(href.offset shr 32)));
  1251. list.concat(taicpu.op_reg_reg_const(A_SLDI, NR_R0, NR_R0, 32));
  1252. list.concat(taicpu.op_reg_reg_const(A_ORIS, NR_R0, NR_R0, word(href.offset shr 16)));
  1253. list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(href.offset)));
  1254. list.concat(taicpu.op_reg_reg_reg(A_ADD, NR_R1, NR_R1, NR_R0));
  1255. end;
  1256. end;
  1257. restore_standard_registers;
  1258. end;
  1259. procedure tcgppc.a_loadaddr_ref_reg(list: TAsmList; const ref: treference; r:
  1260. tregister);
  1261. var
  1262. ref2, tmpref: treference;
  1263. { register used to construct address }
  1264. tempreg : TRegister;
  1265. begin
  1266. if (target_info.system in [system_powerpc64_darwin,system_powerpc64_aix]) then
  1267. begin
  1268. inherited a_loadaddr_ref_reg(list,ref,r);
  1269. exit;
  1270. end;
  1271. ref2 := ref;
  1272. fixref(list, ref2);
  1273. { load a symbol }
  1274. if (assigned(ref2.symbol) or (hasLargeOffset(ref2))) then begin
  1275. { add the symbol's value to the base of the reference, and if the }
  1276. { reference doesn't have a base, create one }
  1277. reference_reset(tmpref, ref2.alignment, ref2.volatility);
  1278. tmpref.offset := ref2.offset;
  1279. tmpref.symbol := ref2.symbol;
  1280. tmpref.relsymbol := ref2.relsymbol;
  1281. { load 64 bit reference into r. If the reference already has a base register,
  1282. first load the 64 bit value into a temp register, then add it to the result
  1283. register rD }
  1284. if (ref2.base <> NR_NO) then begin
  1285. { already have a base register, so allocate a new one }
  1286. tempreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
  1287. end else begin
  1288. tempreg := r;
  1289. end;
  1290. { code for loading a reference from a symbol into a register rD }
  1291. (*
  1292. lis rX,SYM@highest
  1293. ori rX,SYM@higher
  1294. sldi rX,rX,32
  1295. oris rX,rX,SYM@h
  1296. ori rX,rX,SYM@l
  1297. *)
  1298. {$IFDEF EXTDEBUG}
  1299. list.concat(tai_comment.create(strpnew('loadaddr_ref_reg ')));
  1300. {$ENDIF EXTDEBUG}
  1301. if (assigned(tmpref.symbol)) then begin
  1302. tmpref.refaddr := addr_highest;
  1303. list.concat(taicpu.op_reg_ref(A_LIS, tempreg, tmpref));
  1304. tmpref.refaddr := addr_higher;
  1305. list.concat(taicpu.op_reg_reg_ref(A_ORI, tempreg, tempreg, tmpref));
  1306. list.concat(taicpu.op_reg_reg_const(A_SLDI, tempreg, tempreg, 32));
  1307. tmpref.refaddr := addr_high;
  1308. list.concat(taicpu.op_reg_reg_ref(A_ORIS, tempreg, tempreg, tmpref));
  1309. tmpref.refaddr := addr_low;
  1310. list.concat(taicpu.op_reg_reg_ref(A_ORI, tempreg, tempreg, tmpref));
  1311. end else
  1312. a_load_const_reg(list, OS_ADDR, tmpref.offset, tempreg);
  1313. { if there's already a base register, add the temp register contents to
  1314. the base register }
  1315. if (ref2.base <> NR_NO) then begin
  1316. list.concat(taicpu.op_reg_reg_reg(A_ADD, r, tempreg, ref2.base));
  1317. end;
  1318. end else if (ref2.offset <> 0) then begin
  1319. { no symbol, but offset <> 0 }
  1320. if (ref2.base <> NR_NO) then begin
  1321. a_op_const_reg_reg(list, OP_ADD, OS_64, ref2.offset, ref2.base, r)
  1322. { FixRef makes sure that "(ref.index <> R_NO) and (ref.offset <> 0)" never
  1323. occurs, so now only ref.offset has to be loaded }
  1324. end else begin
  1325. a_load_const_reg(list, OS_64, ref2.offset, r);
  1326. end;
  1327. end else if (ref2.index <> NR_NO) then begin
  1328. list.concat(taicpu.op_reg_reg_reg(A_ADD, r, ref2.base, ref2.index))
  1329. end else if (ref2.base <> NR_NO) and
  1330. (r <> ref2.base) then begin
  1331. a_load_reg_reg(list, OS_ADDR, OS_ADDR, ref2.base, r)
  1332. end else begin
  1333. list.concat(taicpu.op_reg_const(A_LI, r, 0));
  1334. end;
  1335. end;
  1336. { ************* concatcopy ************ }
  1337. procedure tcgppc.g_concatcopy(list: TAsmList; const source, dest: treference;
  1338. len: aint);
  1339. var
  1340. countreg, tempreg:TRegister;
  1341. src, dst: TReference;
  1342. lab: tasmlabel;
  1343. count, count2, step: longint;
  1344. size: tcgsize;
  1345. begin
  1346. {$IFDEF extdebug}
  1347. list.concat(tai_comment.create(strpnew('g_concatcopy1 ' + inttostr(len) + ' bytes left ')));
  1348. {$ENDIF extdebug}
  1349. { if the references are equal, exit, there is no need to copy anything }
  1350. if references_equal(source, dest) or
  1351. (len=0) then
  1352. exit;
  1353. { make sure short loads are handled as optimally as possible;
  1354. note that the data here never overlaps, so we can do a forward
  1355. copy at all times.
  1356. NOTE: maybe use some scratch registers to pair load/store instructions
  1357. }
  1358. if (len <= 8) then begin
  1359. src := source; dst := dest;
  1360. {$IFDEF extdebug}
  1361. list.concat(tai_comment.create(strpnew('g_concatcopy3 ' + inttostr(src.offset) + ' ' + inttostr(dst.offset))));
  1362. {$ENDIF extdebug}
  1363. while (len <> 0) do begin
  1364. if (len = 8) then begin
  1365. a_load_ref_ref(list, OS_64, OS_64, src, dst);
  1366. dec(len, 8);
  1367. end else if (len >= 4) then begin
  1368. a_load_ref_ref(list, OS_32, OS_32, src, dst);
  1369. inc(src.offset, 4); inc(dst.offset, 4);
  1370. dec(len, 4);
  1371. end else if (len >= 2) then begin
  1372. a_load_ref_ref(list, OS_16, OS_16, src, dst);
  1373. inc(src.offset, 2); inc(dst.offset, 2);
  1374. dec(len, 2);
  1375. end else begin
  1376. a_load_ref_ref(list, OS_8, OS_8, src, dst);
  1377. inc(src.offset, 1); inc(dst.offset, 1);
  1378. dec(len, 1);
  1379. end;
  1380. end;
  1381. exit;
  1382. end;
  1383. {$IFDEF extdebug}
  1384. list.concat(tai_comment.create(strpnew('g_concatcopy2 ' + inttostr(len) + ' bytes left ')));
  1385. {$ENDIF extdebug}
  1386. if not(source.alignment in [1,2]) and
  1387. not(dest.alignment in [1,2]) then
  1388. begin
  1389. count:=len div 8;
  1390. step:=8;
  1391. size:=OS_64;
  1392. end
  1393. else
  1394. begin
  1395. count:=len div 4;
  1396. step:=4;
  1397. size:=OS_32;
  1398. end;
  1399. tempreg:=getintregister(list,size);
  1400. reference_reset(src,source.alignment,source.volatility);
  1401. reference_reset(dst,dest.alignment,dest.volatility);
  1402. { load the address of source into src.base }
  1403. if (count > 4) or
  1404. not issimpleref(source) or
  1405. ((source.index <> NR_NO) and
  1406. ((source.offset + len) > high(smallint))) then begin
  1407. src.base := getaddressregister(list);
  1408. a_loadaddr_ref_reg(list, source, src.base);
  1409. end else begin
  1410. src := source;
  1411. end;
  1412. { load the address of dest into dst.base }
  1413. if (count > 4) or
  1414. not issimpleref(dest) or
  1415. ((dest.index <> NR_NO) and
  1416. ((dest.offset + len) > high(smallint))) then begin
  1417. dst.base := getaddressregister(list);
  1418. a_loadaddr_ref_reg(list, dest, dst.base);
  1419. end else begin
  1420. dst := dest;
  1421. end;
  1422. { generate a loop }
  1423. if count > 4 then begin
  1424. { the offsets are zero after the a_loadaddress_ref_reg and just
  1425. have to be set to step. I put an Inc there so debugging may be
  1426. easier (should offset be different from zero here, it will be
  1427. easy to notice in the generated assembler }
  1428. inc(dst.offset, step);
  1429. inc(src.offset, step);
  1430. list.concat(taicpu.op_reg_reg_const(A_SUBI, src.base, src.base, step));
  1431. list.concat(taicpu.op_reg_reg_const(A_SUBI, dst.base, dst.base, step));
  1432. countreg := getintregister(list, OS_INT);
  1433. a_load_const_reg(list, OS_INT, count, countreg);
  1434. current_asmdata.getjumplabel(lab);
  1435. a_label(list, lab);
  1436. list.concat(taicpu.op_reg_reg_const(A_SUBIC_, countreg, countreg, 1));
  1437. if (size=OS_64) then
  1438. begin
  1439. list.concat(taicpu.op_reg_ref(A_LDU, tempreg, src));
  1440. list.concat(taicpu.op_reg_ref(A_STDU, tempreg, dst));
  1441. end
  1442. else
  1443. begin
  1444. list.concat(taicpu.op_reg_ref(A_LWZU, tempreg, src));
  1445. list.concat(taicpu.op_reg_ref(A_STWU, tempreg, dst));
  1446. end;
  1447. a_jmp(list, A_BC, C_NE, 0, lab);
  1448. a_reg_sync(list,src.base);
  1449. a_reg_sync(list,dst.base);
  1450. a_reg_sync(list,countreg);
  1451. len := len mod step;
  1452. count := 0;
  1453. end;
  1454. { unrolled loop }
  1455. if count > 0 then begin
  1456. for count2 := 1 to count do begin
  1457. a_load_ref_reg(list, size, size, src, tempreg);
  1458. a_load_reg_ref(list, size, size, tempreg, dst);
  1459. inc(src.offset, step);
  1460. inc(dst.offset, step);
  1461. end;
  1462. len := len mod step;
  1463. end;
  1464. if (len and 4) <> 0 then begin
  1465. a_load_ref_reg(list, OS_32, OS_32, src, tempreg);
  1466. a_load_reg_ref(list, OS_32, OS_32, tempreg, dst);
  1467. inc(src.offset, 4);
  1468. inc(dst.offset, 4);
  1469. end;
  1470. { copy the leftovers }
  1471. if (len and 2) <> 0 then begin
  1472. a_load_ref_reg(list, OS_16, OS_16, src, tempreg);
  1473. a_load_reg_ref(list, OS_16, OS_16, tempreg, dst);
  1474. inc(src.offset, 2);
  1475. inc(dst.offset, 2);
  1476. end;
  1477. if (len and 1) <> 0 then begin
  1478. a_load_ref_reg(list, OS_8, OS_8, src, tempreg);
  1479. a_load_reg_ref(list, OS_8, OS_8, tempreg, dst);
  1480. end;
  1481. end;
  1482. {***************** This is private property, keep out! :) *****************}
  1483. procedure tcgppc.maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister);
  1484. const
  1485. overflowops = [OP_MUL,OP_SHL,OP_ADD,OP_SUB,OP_NOT,OP_NEG];
  1486. begin
  1487. {$IFDEF EXTDEBUG}
  1488. list.concat(tai_comment.create(strpnew('maybeadjustresult op = ' + cgop2string(op) + ' size = ' + cgsize2string(size))));
  1489. {$ENDIF EXTDEBUG}
  1490. if (op in overflowops) and (size in [OS_8, OS_S8, OS_16, OS_S16, OS_32, OS_S32]) then
  1491. a_load_reg_reg(list, OS_64, size, dst, dst);
  1492. end;
  1493. function tcgppc.issimpleref(const ref: treference): boolean;
  1494. begin
  1495. if (ref.base = NR_NO) and
  1496. (ref.index <> NR_NO) then
  1497. internalerror(200208101);
  1498. result :=
  1499. not (assigned(ref.symbol)) and
  1500. (((ref.index = NR_NO) and
  1501. (ref.offset >= low(smallint)) and
  1502. (ref.offset <= high(smallint))) or
  1503. ((ref.index <> NR_NO) and
  1504. (ref.offset = 0)));
  1505. end;
  1506. procedure tcgppc.a_load_store(list: TAsmList; op: tasmop; reg: tregister;
  1507. ref: treference);
  1508. procedure maybefixup64bitoffset;
  1509. var
  1510. tmpreg: tregister;
  1511. begin
  1512. { for some instructions we need to check that the offset is divisible by at
  1513. least four. If not, add the bytes which are "off" to the base register and
  1514. adjust the offset accordingly }
  1515. case op of
  1516. A_LD, A_LDU, A_STD, A_STDU, A_LWA :
  1517. if ((ref.offset mod 4) <> 0) then begin
  1518. tmpreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
  1519. if (ref.base <> NR_NO) then begin
  1520. a_op_const_reg_reg(list, OP_ADD, OS_ADDR, ref.offset mod 4, ref.base, tmpreg);
  1521. ref.base := tmpreg;
  1522. end else begin
  1523. list.concat(taicpu.op_reg_const(A_LI, tmpreg, ref.offset mod 4));
  1524. ref.base := tmpreg;
  1525. end;
  1526. ref.offset := (ref.offset div 4) * 4;
  1527. end;
  1528. end;
  1529. end;
  1530. var
  1531. tmpreg, tmpreg2: tregister;
  1532. tmpref: treference;
  1533. largeOffset: Boolean;
  1534. begin
  1535. if (target_info.system = system_powerpc64_darwin) then
  1536. begin
  1537. { darwin/ppc64 works with 32 bit relocatable symbol addresses }
  1538. maybefixup64bitoffset;
  1539. inherited a_load_store(list,op,reg,ref);
  1540. exit
  1541. end;
  1542. { at this point there must not be a combination of values in the ref treference
  1543. which is not possible to directly map to instructions of the PowerPC architecture }
  1544. if (ref.index <> NR_NO) and ((ref.offset <> 0) or (assigned(ref.symbol))) then
  1545. internalerror(200310131);
  1546. { if this is a PIC'ed address, handle it and exit }
  1547. if (ref.refaddr in [addr_pic,addr_pic_no_got]) then begin
  1548. if (ref.offset <> 0) then
  1549. internalerror(2006010501);
  1550. if (ref.index <> NR_NO) then
  1551. internalerror(2006010502);
  1552. if (not assigned(ref.symbol)) then
  1553. internalerror(200601050);
  1554. list.concat(taicpu.op_reg_ref(op, reg, ref));
  1555. exit;
  1556. end;
  1557. maybefixup64bitoffset;
  1558. {$IFDEF EXTDEBUG}
  1559. list.concat(tai_comment.create(strpnew('a_load_store1 ' + BoolToStr(ref.refaddr = addr_pic))));
  1560. {$ENDIF EXTDEBUG}
  1561. { if we have to load/store from a symbol or large addresses, use a temporary register
  1562. containing the address }
  1563. if (assigned(ref.symbol) or (hasLargeOffset(ref))) then begin
  1564. tmpreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
  1565. if (hasLargeOffset(ref) and (ref.base = NR_NO)) then begin
  1566. ref.base := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
  1567. a_load_const_reg(list, OS_ADDR, ref.offset, ref.base);
  1568. ref.offset := 0;
  1569. end;
  1570. reference_reset(tmpref, ref.alignment, ref.volatility);
  1571. tmpref.symbol := ref.symbol;
  1572. tmpref.relsymbol := ref.relsymbol;
  1573. tmpref.offset := ref.offset;
  1574. if (ref.base <> NR_NO) then begin
  1575. { As long as the TOC isn't working we try to achieve highest speed (in this
  1576. case by allowing instructions execute in parallel) as possible at the cost
  1577. of using another temporary register. So the code template when there is
  1578. a base register and an offset is the following:
  1579. lis rT1, SYM+offs@highest
  1580. ori rT1, rT1, SYM+offs@higher
  1581. lis rT2, SYM+offs@hi
  1582. ori rT2, SYM+offs@lo
  1583. rldimi rT2, rT1, 32
  1584. <op>X reg, base, rT2
  1585. }
  1586. tmpreg2 := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
  1587. if (assigned(tmpref.symbol)) then begin
  1588. tmpref.refaddr := addr_highest;
  1589. list.concat(taicpu.op_reg_ref(A_LIS, tmpreg, tmpref));
  1590. tmpref.refaddr := addr_higher;
  1591. list.concat(taicpu.op_reg_reg_ref(A_ORI, tmpreg, tmpreg, tmpref));
  1592. tmpref.refaddr := addr_high;
  1593. list.concat(taicpu.op_reg_ref(A_LIS, tmpreg2, tmpref));
  1594. tmpref.refaddr := addr_low;
  1595. list.concat(taicpu.op_reg_reg_ref(A_ORI, tmpreg2, tmpreg2, tmpref));
  1596. list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, tmpreg2, tmpreg, 32, 0));
  1597. end else
  1598. a_load_const_reg(list, OS_ADDR, tmpref.offset, tmpreg2);
  1599. reference_reset(tmpref, ref.alignment, ref.volatility);
  1600. tmpref.base := ref.base;
  1601. tmpref.index := tmpreg2;
  1602. case op of
  1603. { the code generator doesn't generate update instructions anyway, so
  1604. error out on those instructions }
  1605. A_LBZ : op := A_LBZX;
  1606. A_LHZ : op := A_LHZX;
  1607. A_LWZ : op := A_LWZX;
  1608. A_LD : op := A_LDX;
  1609. A_LHA : op := A_LHAX;
  1610. A_LWA : op := A_LWAX;
  1611. A_LFS : op := A_LFSX;
  1612. A_LFD : op := A_LFDX;
  1613. A_STB : op := A_STBX;
  1614. A_STH : op := A_STHX;
  1615. A_STW : op := A_STWX;
  1616. A_STD : op := A_STDX;
  1617. A_STFS : op := A_STFSX;
  1618. A_STFD : op := A_STFDX;
  1619. else
  1620. { unknown load/store opcode }
  1621. internalerror(2005101302);
  1622. end;
  1623. list.concat(taicpu.op_reg_ref(op, reg, tmpref));
  1624. end else begin
  1625. { when accessing value from a reference without a base register, use the
  1626. following code template:
  1627. lis rT,SYM+offs@highesta
  1628. ori rT,SYM+offs@highera
  1629. sldi rT,rT,32
  1630. oris rT,rT,SYM+offs@ha
  1631. ld rD,SYM+offs@l(rT)
  1632. }
  1633. tmpref.refaddr := addr_highesta;
  1634. list.concat(taicpu.op_reg_ref(A_LIS, tmpreg, tmpref));
  1635. tmpref.refaddr := addr_highera;
  1636. list.concat(taicpu.op_reg_reg_ref(A_ORI, tmpreg, tmpreg, tmpref));
  1637. list.concat(taicpu.op_reg_reg_const(A_SLDI, tmpreg, tmpreg, 32));
  1638. tmpref.refaddr := addr_higha;
  1639. list.concat(taicpu.op_reg_reg_ref(A_ORIS, tmpreg, tmpreg, tmpref));
  1640. tmpref.base := tmpreg;
  1641. tmpref.refaddr := addr_low;
  1642. list.concat(taicpu.op_reg_ref(op, reg, tmpref));
  1643. end;
  1644. end else begin
  1645. list.concat(taicpu.op_reg_ref(op, reg, ref));
  1646. end;
  1647. end;
  1648. procedure tcgppc.loadConstantPIC(list : TAsmList; size : TCGSize; a : aint; reg : TRegister);
  1649. var
  1650. l: tasmsymbol;
  1651. ref: treference;
  1652. symname : string;
  1653. begin
  1654. maybe_new_object_file(current_asmdata.asmlists[al_picdata]);
  1655. symname := '_$' + current_asmdata.name^ + '$toc$' + hexstr(a, sizeof(a)*2);
  1656. l:=current_asmdata.getasmsymbol(symname);
  1657. if not(assigned(l)) then begin
  1658. l:=current_asmdata.DefineAsmSymbol(symname,AB_GLOBAL, AT_METADATA, voidpointertype);
  1659. new_section(current_asmdata.asmlists[al_picdata],sec_toc, '.toc', 8);
  1660. current_asmdata.asmlists[al_picdata].concat(tai_symbol.create_global(l,0));
  1661. current_asmdata.asmlists[al_picdata].concat(tai_directive.create(asd_toc_entry, symname + '[TC], ' + inttostr(a)));
  1662. end;
  1663. reference_reset_symbol(ref,l,0,8,[]);
  1664. ref.base := NR_R2;
  1665. ref.refaddr := addr_no;
  1666. {$IFDEF EXTDEBUG}
  1667. list.concat(tai_comment.create(strpnew('loading value from TOC reference for ' + symname)));
  1668. {$ENDIF EXTDEBUG}
  1669. a_load_ref_reg(list, OS_INT, OS_INT, ref, reg);
  1670. end;
  1671. procedure create_codegen;
  1672. begin
  1673. cg := tcgppc.create;
  1674. cg128:=tcg128.create;
  1675. end;
  1676. end.