cgcpu.pas 80 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223
  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. { passing parameters, per default the parameter is pushed }
  31. { nr gives the number of the parameter (enumerated from }
  32. { left to right), this allows to move the parameter to }
  33. { register, if the cpu supports register calling }
  34. { conventions }
  35. procedure a_param_ref(list: TAsmList; size: tcgsize; const r: treference;
  36. const paraloc: tcgpara); override;
  37. procedure a_call_name(list: TAsmList; const s: string); override;
  38. procedure a_call_reg(list: TAsmList; reg: tregister); override;
  39. procedure a_op_const_reg(list: TAsmList; Op: TOpCG; size: TCGSize; a:
  40. aint; reg: TRegister); override;
  41. procedure a_op_reg_reg(list: TAsmList; Op: TOpCG; size: TCGSize; src,
  42. dst: TRegister); override;
  43. procedure a_op_const_reg_reg(list: TAsmList; op: TOpCg;
  44. size: tcgsize; a: aint; src, dst: tregister); override;
  45. procedure a_op_reg_reg_reg(list: TAsmList; op: TOpCg;
  46. size: tcgsize; src1, src2, dst: tregister); override;
  47. { move instructions }
  48. procedure a_load_const_reg(list: TAsmList; size: tcgsize; a: aint; reg:
  49. tregister); override;
  50. { loads the memory pointed to by ref into register reg }
  51. procedure a_load_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const
  52. Ref: treference; reg: tregister); override;
  53. procedure a_load_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1,
  54. reg2: tregister); override;
  55. procedure a_load_subsetreg_reg(list : TAsmList; subsetsize, tosize: tcgsize; const sreg: tsubsetregister; destreg: tregister); override;
  56. procedure a_load_const_subsetreg(list: TAsmlist; subsetsize: tcgsize; a: aint; const sreg: tsubsetregister); override;
  57. { comparison operations }
  58. procedure a_cmp_const_reg_label(list: TAsmList; size: tcgsize; cmp_op:
  59. topcmp; a: aint; reg: tregister;
  60. l: tasmlabel); override;
  61. procedure a_cmp_reg_reg_label(list: TAsmList; size: tcgsize; cmp_op:
  62. topcmp; reg1, reg2: tregister; l: tasmlabel); override;
  63. procedure a_jmp_name(list: TAsmList; const s: string); override;
  64. procedure a_jmp_always(list: TAsmList; l: tasmlabel); override;
  65. procedure a_jmp_flags(list: TAsmList; const f: TResFlags; l: tasmlabel);
  66. override;
  67. procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags;
  68. reg: TRegister); override;
  69. procedure g_profilecode(list: TAsmList); override;
  70. procedure g_proc_entry(list: TAsmList; localsize: longint; nostackframe:
  71. boolean); override;
  72. procedure g_proc_exit(list: TAsmList; parasize: longint; nostackframe:
  73. boolean); override;
  74. procedure g_save_standard_registers(list: TAsmList); override;
  75. procedure g_restore_standard_registers(list: TAsmList); override;
  76. procedure a_loadaddr_ref_reg(list: TAsmList; const ref: treference; r:
  77. tregister); override;
  78. procedure g_concatcopy(list: TAsmList; const source, dest: treference;
  79. len: aint); override;
  80. procedure g_external_wrapper(list: TAsmList; pd: TProcDef; const externalname: string); override;
  81. private
  82. procedure a_load_regconst_subsetreg_intern(list : TAsmList; fromsize, subsetsize: tcgsize; fromreg: tregister; const sreg: tsubsetregister; slopt: tsubsetloadopt); override;
  83. procedure maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister);
  84. { Make sure ref is a valid reference for the PowerPC and sets the }
  85. { base to the value of the index if (base = R_NO). }
  86. { Returns true if the reference contained a base, index and an }
  87. { offset or symbol, in which case the base will have been changed }
  88. { to a tempreg (which has to be freed by the caller) containing }
  89. { the sum of part of the original reference }
  90. function fixref(list: TAsmList; var ref: treference): boolean; override;
  91. function load_got_symbol(list : TAsmList; symbol : string) : tregister;
  92. { returns whether a reference can be used immediately in a powerpc }
  93. { instruction }
  94. function issimpleref(const ref: treference): boolean;
  95. { contains the common code of a_load_reg_ref and a_load_ref_reg }
  96. procedure a_load_store(list: TAsmList; op: tasmop; reg: tregister;
  97. ref: treference); override;
  98. { returns the lowest numbered FP register in use, and the number of used FP registers
  99. for the current procedure }
  100. procedure calcFirstUsedFPR(out firstfpr : TSuperRegister; out fprcount : aint);
  101. { returns the lowest numbered GP register in use, and the number of used GP registers
  102. for the current procedure }
  103. procedure calcFirstUsedGPR(out firstgpr : TSuperRegister; out gprcount : aint);
  104. { generates code to call a method with the given string name. The boolean options
  105. control code generation. If prependDot is true, a single dot character is prepended to
  106. the string, if addNOP is true a single NOP instruction is added after the call, and
  107. if includeCall is true, the method is marked as having a call, not if false. This
  108. option is particularly useful to prevent generation of a larger stack frame for the
  109. register save and restore helper functions. }
  110. procedure a_call_name_direct(list: TAsmList; s: string; prependDot : boolean;
  111. addNOP : boolean; includeCall : boolean = true);
  112. procedure a_jmp_name_direct(list : TAsmList; s : string; prependDot : boolean);
  113. { emits code to store the given value a into the TOC (if not already in there), and load it from there
  114. as well }
  115. procedure loadConstantPIC(list : TAsmList; size : TCGSize; a : aint; reg : TRegister);
  116. procedure profilecode_savepara(para : tparavarsym; list : TAsmList);
  117. procedure profilecode_restorepara(para : tparavarsym; list : TAsmList);
  118. end;
  119. const
  120. TShiftOpCG2AsmOpConst : array[boolean, OP_SAR..OP_SHR] of TAsmOp = (
  121. (A_SRAWI, A_SLWI, A_SRWI), (A_SRADI, A_SLDI, A_SRDI)
  122. );
  123. implementation
  124. uses
  125. sysutils, cclasses,
  126. globals, verbose, systems, cutils,
  127. symconst, fmodule,
  128. rgobj, tgobj, cpupi, procinfo, paramgr, cpupara;
  129. function ref2string(const ref : treference) : string;
  130. begin
  131. result := 'base : ' + inttostr(ord(ref.base)) + ' index : ' + inttostr(ord(ref.index)) + ' refaddr : ' + inttostr(ord(ref.refaddr)) + ' offset : ' + inttostr(ref.offset) + ' symbol : ';
  132. if (assigned(ref.symbol)) then
  133. result := result + ref.symbol.name;
  134. end;
  135. function cgsize2string(const size : TCgSize) : string;
  136. const
  137. cgsize_strings : array[TCgSize] of string[8] = (
  138. 'OS_NO', 'OS_8', 'OS_16', 'OS_32', 'OS_64', 'OS_128', 'OS_S8', 'OS_S16', 'OS_S32',
  139. 'OS_S64', 'OS_S128', 'OS_F32', 'OS_F64', 'OS_F80', 'OS_C64', 'OS_F128',
  140. 'OS_M8', 'OS_M16', 'OS_M32', 'OS_M64', 'OS_M128', 'OS_MS8', 'OS_MS16', 'OS_MS32',
  141. 'OS_MS64', 'OS_MS128');
  142. begin
  143. result := cgsize_strings[size];
  144. end;
  145. function cgop2string(const op : TOpCg) : String;
  146. const
  147. opcg_strings : array[TOpCg] of string[6] = (
  148. 'None', 'Move', 'Add', 'And', 'Div', 'IDiv', 'IMul', 'Mul',
  149. 'Neg', 'Not', 'Or', 'Sar', 'Shl', 'Shr', 'Sub', 'Xor'
  150. );
  151. begin
  152. result := opcg_strings[op];
  153. end;
  154. function is_signed_cgsize(const size : TCgSize) : Boolean;
  155. begin
  156. case size of
  157. OS_S8,OS_S16,OS_S32,OS_S64 : result := true;
  158. OS_8,OS_16,OS_32,OS_64 : result := false;
  159. else
  160. internalerror(2006050701);
  161. end;
  162. end;
  163. {$ifopt r+}
  164. {$r-}
  165. {$define rangeon}
  166. {$endif}
  167. {$ifopt q+}
  168. {$q-}
  169. {$define overflowon}
  170. {$endif}
  171. { helper function which calculate "magic" values for replacement of unsigned
  172. division by constant operation by multiplication. See the PowerPC compiler
  173. developer manual for more information }
  174. procedure getmagic_unsignedN(const N : byte; const d : aWord;
  175. out magic_m : aWord; out magic_add : boolean; out magic_shift : byte);
  176. var
  177. p : aInt;
  178. nc, delta, q1, r1, q2, r2, two_N_minus_1 : aWord;
  179. begin
  180. assert(d > 0);
  181. two_N_minus_1 := aWord(1) shl (N-1);
  182. magic_add := false;
  183. nc := - 1 - (-d) mod d;
  184. p := N-1; { initialize p }
  185. q1 := two_N_minus_1 div nc; { initialize q1 = 2p/nc }
  186. r1 := two_N_minus_1 - q1*nc; { initialize r1 = rem(2p,nc) }
  187. q2 := (two_N_minus_1-1) div d; { initialize q2 = (2p-1)/d }
  188. r2 := (two_N_minus_1-1) - q2*d; { initialize r2 = rem((2p-1),d) }
  189. repeat
  190. inc(p);
  191. if (r1 >= (nc - r1)) then begin
  192. q1 := 2 * q1 + 1; { update q1 }
  193. r1 := 2*r1 - nc; { update r1 }
  194. end else begin
  195. q1 := 2*q1; { update q1 }
  196. r1 := 2*r1; { update r1 }
  197. end;
  198. if ((r2 + 1) >= (d - r2)) then begin
  199. if (q2 >= (two_N_minus_1-1)) then
  200. magic_add := true;
  201. q2 := 2*q2 + 1; { update q2 }
  202. r2 := 2*r2 + 1 - d; { update r2 }
  203. end else begin
  204. if (q2 >= two_N_minus_1) then
  205. magic_add := true;
  206. q2 := 2*q2; { update q2 }
  207. r2 := 2*r2 + 1; { update r2 }
  208. end;
  209. delta := d - 1 - r2;
  210. until not ((p < (2*N)) and ((q1 < delta) or ((q1 = delta) and (r1 = 0))));
  211. magic_m := q2 + 1; { resulting magic number }
  212. magic_shift := p - N; { resulting shift }
  213. end;
  214. { helper function which calculate "magic" values for replacement of signed
  215. division by constant operation by multiplication. See the PowerPC compiler
  216. developer manual for more information }
  217. procedure getmagic_signedN(const N : byte; const d : aInt;
  218. out magic_m : aInt; out magic_s : aInt);
  219. var
  220. p : aInt;
  221. ad, anc, delta, q1, r1, q2, r2, t : aWord;
  222. two_N_minus_1 : aWord;
  223. begin
  224. assert((d < -1) or (d > 1));
  225. two_N_minus_1 := aWord(1) shl (N-1);
  226. ad := abs(d);
  227. t := two_N_minus_1 + (aWord(d) shr (N-1));
  228. anc := t - 1 - t mod ad; { absolute value of nc }
  229. p := (N-1); { initialize p }
  230. q1 := two_N_minus_1 div anc; { initialize q1 = 2p/abs(nc) }
  231. r1 := two_N_minus_1 - q1*anc; { initialize r1 = rem(2p,abs(nc)) }
  232. q2 := two_N_minus_1 div ad; { initialize q2 = 2p/abs(d) }
  233. r2 := two_N_minus_1 - q2*ad; { initialize r2 = rem(2p,abs(d)) }
  234. repeat
  235. inc(p);
  236. q1 := 2*q1; { update q1 = 2p/abs(nc) }
  237. r1 := 2*r1; { update r1 = rem(2p/abs(nc)) }
  238. if (r1 >= anc) then begin { must be unsigned comparison }
  239. inc(q1);
  240. dec(r1, anc);
  241. end;
  242. q2 := 2*q2; { update q2 = 2p/abs(d) }
  243. r2 := 2*r2; { update r2 = rem(2p/abs(d)) }
  244. if (r2 >= ad) then begin { must be unsigned comparison }
  245. inc(q2);
  246. dec(r2, ad);
  247. end;
  248. delta := ad - r2;
  249. until not ((q1 < delta) or ((q1 = delta) and (r1 = 0)));
  250. magic_m := q2 + 1;
  251. if (d < 0) then begin
  252. magic_m := -magic_m; { resulting magic number }
  253. end;
  254. magic_s := p - N; { resulting shift }
  255. end;
  256. {$ifdef rangeon}
  257. {$r+}
  258. {$undef rangeon}
  259. {$endif}
  260. {$ifdef overflowon}
  261. {$q+}
  262. {$undef overflowon}
  263. {$endif}
  264. { finds positive and negative powers of two of the given value, returning the
  265. power and whether it's a negative power or not in addition to the actual result
  266. of the function }
  267. function ispowerof2(value : aInt; out power : byte; out neg : boolean) : boolean;
  268. var
  269. i : longint;
  270. hl : aInt;
  271. begin
  272. neg := false;
  273. { also try to find negative power of two's by negating if the
  274. value is negative. low(aInt) is special because it can not be
  275. negated. Simply return the appropriate values for it }
  276. if (value < 0) then begin
  277. neg := true;
  278. if (value = low(aInt)) then begin
  279. power := sizeof(aInt)*8-1;
  280. result := true;
  281. exit;
  282. end;
  283. value := -value;
  284. end;
  285. if ((value and (value-1)) <> 0) then begin
  286. result := false;
  287. exit;
  288. end;
  289. hl := 1;
  290. for i := 0 to (sizeof(aInt)*8-1) do begin
  291. if (hl = value) then begin
  292. result := true;
  293. power := i;
  294. exit;
  295. end;
  296. hl := hl shl 1;
  297. end;
  298. end;
  299. { returns the number of instruction required to load the given integer into a register.
  300. This is basically a stripped down version of a_load_const_reg, increasing a counter
  301. instead of emitting instructions. }
  302. function getInstructionLength(a : aint) : longint;
  303. function get32bitlength(a : longint; var length : longint) : boolean; inline;
  304. var
  305. is_half_signed : byte;
  306. begin
  307. { if the lower 16 bits are zero, do a single LIS }
  308. if (smallint(a) = 0) and ((a shr 16) <> 0) then begin
  309. inc(length);
  310. get32bitlength := longint(a) < 0;
  311. end else begin
  312. is_half_signed := ord(smallint(lo(a)) < 0);
  313. inc(length);
  314. if smallint(hi(a) + is_half_signed) <> 0 then
  315. inc(length);
  316. get32bitlength := (smallint(a) < 0) or (a < 0);
  317. end;
  318. end;
  319. var
  320. extendssign : boolean;
  321. begin
  322. result := 0;
  323. if (lo(a) = 0) and (hi(a) <> 0) then begin
  324. get32bitlength(hi(a), result);
  325. inc(result);
  326. end else begin
  327. extendssign := get32bitlength(lo(a), result);
  328. if (extendssign) and (hi(a) = 0) then
  329. inc(result)
  330. else if (not
  331. ((extendssign and (longint(hi(a)) = -1)) or
  332. ((not extendssign) and (hi(a)=0)))
  333. ) then begin
  334. get32bitlength(hi(a), result);
  335. inc(result);
  336. end;
  337. end;
  338. end;
  339. procedure tcgppc.init_register_allocators;
  340. begin
  341. inherited init_register_allocators;
  342. if (target_info.system <> system_powerpc64_darwin) then
  343. // r13 is tls, do not use, r2 is not available
  344. rg[R_INTREGISTER] := trgintcpu.create(R_INTREGISTER, R_SUBWHOLE,
  345. [{$ifdef user0} RS_R0, {$endif} RS_R3, RS_R4, RS_R5, RS_R6, RS_R7, RS_R8,
  346. RS_R9, RS_R10, RS_R11, RS_R12, RS_R31, RS_R30, RS_R29,
  347. RS_R28, RS_R27, RS_R26, RS_R25, RS_R24, RS_R23, RS_R22,
  348. RS_R21, RS_R20, RS_R19, RS_R18, RS_R17, RS_R16, RS_R15,
  349. RS_R14], first_int_imreg, [])
  350. else
  351. { special for darwin/ppc64: r2 available volatile, r13 = tls }
  352. rg[R_INTREGISTER] := trgintcpu.create(R_INTREGISTER, R_SUBWHOLE,
  353. [{$ifdef user0} RS_R0, {$endif} RS_R2, RS_R3, RS_R4, RS_R5, RS_R6, RS_R7, RS_R8,
  354. RS_R9, RS_R10, RS_R11, RS_R12, RS_R31, RS_R30, RS_R29,
  355. RS_R28, RS_R27, RS_R26, RS_R25, RS_R24, RS_R23, RS_R22,
  356. RS_R21, RS_R20, RS_R19, RS_R18, RS_R17, RS_R16, RS_R15,
  357. RS_R14], first_int_imreg, []);
  358. rg[R_FPUREGISTER] := trgcpu.create(R_FPUREGISTER, R_SUBNONE,
  359. [RS_F0, RS_F1, RS_F2, RS_F3, RS_F4, RS_F5, RS_F6, RS_F7, RS_F8, RS_F9,
  360. RS_F10, RS_F11, RS_F12, RS_F13, RS_F31, RS_F30, RS_F29, RS_F28, RS_F27,
  361. RS_F26, RS_F25, RS_F24, RS_F23, RS_F22, RS_F21, RS_F20, RS_F19, RS_F18,
  362. RS_F17, RS_F16, RS_F15, RS_F14], first_fpu_imreg, []);
  363. {$WARNING FIX ME}
  364. rg[R_MMREGISTER] := trgcpu.create(R_MMREGISTER, R_SUBNONE,
  365. [RS_M0, RS_M1, RS_M2], first_mm_imreg, []);
  366. end;
  367. procedure tcgppc.done_register_allocators;
  368. begin
  369. rg[R_INTREGISTER].free;
  370. rg[R_FPUREGISTER].free;
  371. rg[R_MMREGISTER].free;
  372. inherited done_register_allocators;
  373. end;
  374. procedure tcgppc.a_param_ref(list: TAsmList; size: tcgsize; const r:
  375. treference; const paraloc: tcgpara);
  376. var
  377. tmpref, ref: treference;
  378. location: pcgparalocation;
  379. sizeleft: aint;
  380. adjusttail : boolean;
  381. begin
  382. location := paraloc.location;
  383. tmpref := r;
  384. sizeleft := paraloc.intsize;
  385. adjusttail := false;
  386. while assigned(location) do begin
  387. case location^.loc of
  388. LOC_REGISTER, LOC_CREGISTER:
  389. begin
  390. if not(size in [OS_NO,OS_128,OS_S128]) then
  391. a_load_ref_reg(list, size, location^.size, tmpref,
  392. location^.register)
  393. else begin
  394. { load non-integral sized memory location into register. This
  395. memory location be 1-sizeleft byte sized.
  396. Always assume that this memory area is properly aligned, eg. start
  397. loading the larger quantities for "odd" quantities first }
  398. case sizeleft of
  399. 1,2,4,8 :
  400. a_load_ref_reg(list, int_cgsize(sizeleft), location^.size, tmpref,
  401. location^.register);
  402. 3 : begin
  403. a_reg_alloc(list, NR_R12);
  404. a_load_ref_reg(list, OS_16, location^.size, tmpref,
  405. NR_R12);
  406. inc(tmpref.offset, tcgsize2size[OS_16]);
  407. a_load_ref_reg(list, OS_8, location^.size, tmpref,
  408. location^.register);
  409. list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, location^.register, NR_R12, 8, 40));
  410. a_reg_dealloc(list, NR_R12);
  411. end;
  412. 5 : begin
  413. a_reg_alloc(list, NR_R12);
  414. a_load_ref_reg(list, OS_32, location^.size, tmpref, NR_R12);
  415. inc(tmpref.offset, tcgsize2size[OS_32]);
  416. a_load_ref_reg(list, OS_8, location^.size, tmpref, location^.register);
  417. list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, location^.register, NR_R12, 8, 24));
  418. a_reg_dealloc(list, NR_R12);
  419. end;
  420. 6 : begin
  421. a_reg_alloc(list, NR_R12);
  422. a_load_ref_reg(list, OS_32, location^.size, tmpref, NR_R12);
  423. inc(tmpref.offset, tcgsize2size[OS_32]);
  424. a_load_ref_reg(list, OS_16, location^.size, tmpref, location^.register);
  425. list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, location^.register, NR_R12, 16, 16));
  426. a_reg_dealloc(list, NR_R12);
  427. end;
  428. 7 : begin
  429. a_reg_alloc(list, NR_R12);
  430. a_reg_alloc(list, NR_R0);
  431. a_load_ref_reg(list, OS_32, location^.size, tmpref, NR_R12);
  432. inc(tmpref.offset, tcgsize2size[OS_32]);
  433. a_load_ref_reg(list, OS_16, location^.size, tmpref, NR_R0);
  434. inc(tmpref.offset, tcgsize2size[OS_16]);
  435. a_load_ref_reg(list, OS_8, location^.size, tmpref, location^.register);
  436. list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, NR_R0, NR_R12, 16, 16));
  437. list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, location^.register, NR_R0, 8, 8));
  438. a_reg_dealloc(list, NR_R0);
  439. a_reg_dealloc(list, NR_R12);
  440. end;
  441. else begin
  442. { still > 8 bytes to load, so load data single register now }
  443. a_load_ref_reg(list, location^.size, location^.size, tmpref,
  444. location^.register);
  445. { the block is > 8 bytes, so we have to store any bytes not
  446. a multiple of the register size beginning with the MSB }
  447. adjusttail := true;
  448. end;
  449. end;
  450. if (adjusttail) and (sizeleft < tcgsize2size[OS_INT]) then
  451. a_op_const_reg(list, OP_SHL, OS_INT,
  452. (tcgsize2size[OS_INT] - sizeleft) * tcgsize2size[OS_INT],
  453. location^.register);
  454. end;
  455. end;
  456. LOC_REFERENCE:
  457. begin
  458. reference_reset_base(ref, location^.reference.index,
  459. location^.reference.offset);
  460. g_concatcopy(list, tmpref, ref, sizeleft);
  461. if assigned(location^.next) then
  462. internalerror(2005010710);
  463. end;
  464. LOC_FPUREGISTER, LOC_CFPUREGISTER:
  465. case location^.size of
  466. OS_F32, OS_F64:
  467. a_loadfpu_ref_reg(list, location^.size, location^.size, tmpref, location^.register);
  468. else
  469. internalerror(2002072801);
  470. end;
  471. LOC_VOID:
  472. { nothing to do }
  473. ;
  474. else
  475. internalerror(2002081103);
  476. end;
  477. inc(tmpref.offset, tcgsize2size[location^.size]);
  478. dec(sizeleft, tcgsize2size[location^.size]);
  479. location := location^.next;
  480. end;
  481. end;
  482. { calling a procedure by name }
  483. procedure tcgppc.a_call_name(list: TAsmList; const s: string);
  484. begin
  485. if (target_info.system <> system_powerpc64_darwin) then
  486. a_call_name_direct(list, s, false, true)
  487. else
  488. begin
  489. list.concat(taicpu.op_sym(A_BL,get_darwin_call_stub(s)));
  490. include(current_procinfo.flags,pi_do_call);
  491. end;
  492. end;
  493. procedure tcgppc.a_call_name_direct(list: TAsmList; s: string; prependDot : boolean; addNOP : boolean; includeCall : boolean);
  494. begin
  495. if (prependDot) then
  496. s := '.' + s;
  497. list.concat(taicpu.op_sym(A_BL, current_asmdata.RefAsmSymbol(s)));
  498. if (addNOP) then
  499. list.concat(taicpu.op_none(A_NOP));
  500. if (includeCall) then
  501. include(current_procinfo.flags, pi_do_call);
  502. end;
  503. { calling a procedure by address }
  504. procedure tcgppc.a_call_reg(list: TAsmList; reg: tregister);
  505. var
  506. tmpref: treference;
  507. tempreg : TRegister;
  508. begin
  509. if (target_info.system = system_powerpc64_darwin) then
  510. inherited a_call_reg(list,reg)
  511. else if (not (cs_opt_size in current_settings.optimizerswitches)) then begin
  512. tempreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT);
  513. { load actual function entry (reg contains the reference to the function descriptor)
  514. into tempreg }
  515. reference_reset_base(tmpref, reg, 0);
  516. a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, tempreg);
  517. { save TOC pointer in stackframe }
  518. reference_reset_base(tmpref, NR_STACK_POINTER_REG, LA_RTOC_ELF);
  519. a_load_reg_ref(list, OS_ADDR, OS_ADDR, NR_RTOC, tmpref);
  520. { move actual function pointer to CTR register }
  521. list.concat(taicpu.op_reg(A_MTCTR, tempreg));
  522. { load new TOC pointer from function descriptor into RTOC register }
  523. reference_reset_base(tmpref, reg, tcgsize2size[OS_ADDR]);
  524. a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, NR_RTOC);
  525. { load new environment pointer from function descriptor into R11 register }
  526. reference_reset_base(tmpref, reg, 2*tcgsize2size[OS_ADDR]);
  527. a_reg_alloc(list, NR_R11);
  528. a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, NR_R11);
  529. { call function }
  530. list.concat(taicpu.op_none(A_BCTRL));
  531. a_reg_dealloc(list, NR_R11);
  532. end else begin
  533. { call ptrgl helper routine which expects the pointer to the function descriptor
  534. in R11 }
  535. a_reg_alloc(list, NR_R11);
  536. a_load_reg_reg(list, OS_ADDR, OS_ADDR, reg, NR_R11);
  537. a_call_name_direct(list, '.ptrgl', false, false);
  538. a_reg_dealloc(list, NR_R11);
  539. end;
  540. { we need to load the old RTOC from stackframe because we changed it}
  541. reference_reset_base(tmpref, NR_STACK_POINTER_REG, LA_RTOC_ELF);
  542. a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, NR_RTOC);
  543. include(current_procinfo.flags, pi_do_call);
  544. end;
  545. {********************** load instructions ********************}
  546. procedure tcgppc.a_load_const_reg(list: TAsmList; size: TCGSize; a: aint;
  547. reg: TRegister);
  548. { loads a 32 bit constant into the given register, using an optimal instruction sequence.
  549. This is either LIS, LI or LI+ADDIS.
  550. Returns true if during these operations the upper 32 bits were filled with 1 bits (e.g.
  551. sign extension was performed) }
  552. function load32bitconstant(list : TAsmList; size : TCGSize; a : longint;
  553. reg : TRegister) : boolean;
  554. var
  555. is_half_signed : byte;
  556. begin
  557. { if the lower 16 bits are zero, do a single LIS }
  558. if (smallint(a) = 0) and ((a shr 16) <> 0) then begin
  559. list.concat(taicpu.op_reg_const(A_LIS, reg, smallint(hi(a))));
  560. load32bitconstant := longint(a) < 0;
  561. end else begin
  562. is_half_signed := ord(smallint(lo(a)) < 0);
  563. list.concat(taicpu.op_reg_const(A_LI, reg, smallint(a and $ffff)));
  564. if smallint(hi(a) + is_half_signed) <> 0 then begin
  565. list.concat(taicpu.op_reg_reg_const(A_ADDIS, reg, reg, smallint(hi(a) + is_half_signed)));
  566. end;
  567. load32bitconstant := (smallint(a) < 0) or (a < 0);
  568. end;
  569. end;
  570. { loads a 32 bit constant into R0, using an optimal instruction sequence.
  571. This is either LIS, LI or LI+ORIS.
  572. Returns true if during these operations the upper 32 bits were filled with 1 bits (e.g.
  573. sign extension was performed) }
  574. function load32bitconstantR0(list : TAsmList; size : TCGSize; a : longint) : boolean;
  575. begin
  576. { if it's a value we can load with a single LI, do it }
  577. if (a >= low(smallint)) and (a <= high(smallint)) then begin
  578. list.concat(taicpu.op_reg_const(A_LI, NR_R0, smallint(a)));
  579. end else begin
  580. { if the lower 16 bits are zero, do a single LIS }
  581. list.concat(taicpu.op_reg_const(A_LIS, NR_R0, smallint(a shr 16)));
  582. if (smallint(a) <> 0) then begin
  583. list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(a)));
  584. end;
  585. end;
  586. load32bitconstantR0 := a < 0;
  587. end;
  588. { emits the code to load a constant by emitting various instructions into the output
  589. code}
  590. procedure loadConstantNormal(list: TAsmList; size : TCgSize; a: aint; reg: TRegister);
  591. var
  592. extendssign : boolean;
  593. instr : taicpu;
  594. begin
  595. if (lo(a) = 0) and (hi(a) <> 0) then begin
  596. { load only upper 32 bits, and shift }
  597. load32bitconstant(list, size, longint(hi(a)), reg);
  598. list.concat(taicpu.op_reg_reg_const(A_SLDI, reg, reg, 32));
  599. end else begin
  600. { load lower 32 bits }
  601. extendssign := load32bitconstant(list, size, longint(lo(a)), reg);
  602. if (extendssign) and (hi(a) = 0) then
  603. { if upper 32 bits are zero, but loading the lower 32 bit resulted in automatic
  604. sign extension, clear those bits }
  605. list.concat(taicpu.op_reg_reg_const_const(A_RLDICL, reg, reg, 0, 32))
  606. else if (not
  607. ((extendssign and (longint(hi(a)) = -1)) or
  608. ((not extendssign) and (hi(a)=0)))
  609. ) then begin
  610. { only load the upper 32 bits, if the automatic sign extension is not okay,
  611. that is, _not_ if
  612. - loading the lower 32 bits resulted in -1 in the upper 32 bits, and the upper
  613. 32 bits should contain -1
  614. - loading the lower 32 bits resulted in 0 in the upper 32 bits, and the upper
  615. 32 bits should contain 0 }
  616. a_reg_alloc(list, NR_R0);
  617. load32bitconstantR0(list, size, longint(hi(a)));
  618. { combine both registers }
  619. list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, reg, NR_R0, 32, 0));
  620. a_reg_dealloc(list, NR_R0);
  621. end;
  622. end;
  623. end;
  624. {$IFDEF EXTDEBUG}
  625. var
  626. astring : string;
  627. {$ENDIF EXTDEBUG}
  628. begin
  629. {$IFDEF EXTDEBUG}
  630. astring := 'a_load_const_reg ' + inttostr(hi(a)) + ' ' + inttostr(lo(a)) + ' ' + inttostr(ord(size)) + ' ' + inttostr(tcgsize2size[size]) + ' ' + hexstr(a, 16);
  631. list.concat(tai_comment.create(strpnew(astring)));
  632. {$ENDIF EXTDEBUG}
  633. if not (size in [OS_8, OS_S8, OS_16, OS_S16, OS_32, OS_S32, OS_64, OS_S64]) then
  634. internalerror(2002090902);
  635. { if PIC or basic optimizations are enabled, and the number of instructions which would be
  636. required to load the value is greater than 2, store (and later load) the value from there }
  637. // if (((cs_opt_peephole in current_settings.optimizerswitches) or (cs_create_pic in current_settings.moduleswitches)) and
  638. // (getInstructionLength(a) > 2)) then
  639. // loadConstantPIC(list, size, a, reg)
  640. // else
  641. loadConstantNormal(list, size, a, reg);
  642. end;
  643. procedure tcgppc.a_load_ref_reg(list: TAsmList; fromsize, tosize: tcgsize;
  644. const ref: treference; reg: tregister);
  645. const
  646. LoadInstr: array[OS_8..OS_S64, boolean, boolean] of TAsmOp =
  647. { indexed? updating? }
  648. (((A_LBZ, A_LBZU), (A_LBZX, A_LBZUX)),
  649. ((A_LHZ, A_LHZU), (A_LHZX, A_LHZUX)),
  650. ((A_LWZ, A_LWZU), (A_LWZX, A_LWZUX)),
  651. ((A_LD, A_LDU), (A_LDX, A_LDUX)),
  652. { 128bit stuff too }
  653. ((A_NONE, A_NONE), (A_NONE, A_NONE)),
  654. { there's no load-byte-with-sign-extend :( }
  655. ((A_LBZ, A_LBZU), (A_LBZX, A_LBZUX)),
  656. ((A_LHA, A_LHAU), (A_LHAX, A_LHAUX)),
  657. { there's no load-word-arithmetic-indexed with update, simulate it in code :( }
  658. ((A_LWA, A_NOP), (A_LWAX, A_LWAUX)),
  659. ((A_LD, A_LDU), (A_LDX, A_LDUX))
  660. );
  661. var
  662. op: tasmop;
  663. ref2: treference;
  664. begin
  665. {$IFDEF EXTDEBUG}
  666. list.concat(tai_comment.create(strpnew('a_load_ref_reg ' + ref2string(ref))));
  667. {$ENDIF EXTDEBUG}
  668. if not (fromsize in [OS_8, OS_S8, OS_16, OS_S16, OS_32, OS_S32, OS_64, OS_S64]) then
  669. internalerror(2002090904);
  670. ref2 := ref;
  671. fixref(list, ref2);
  672. { the caller is expected to have adjusted the reference already
  673. in this case }
  674. if (TCGSize2Size[fromsize] >= TCGSize2Size[tosize]) then
  675. fromsize := tosize;
  676. op := loadinstr[fromsize, ref2.index <> NR_NO, false];
  677. { there is no LWAU instruction, simulate using ADDI and LWA }
  678. if (op = A_NOP) then begin
  679. list.concat(taicpu.op_reg_reg_const(A_ADDI, reg, reg, ref2.offset));
  680. ref2.offset := 0;
  681. op := A_LWA;
  682. end;
  683. a_load_store(list, op, reg, ref2);
  684. { sign extend shortint if necessary, since there is no
  685. load instruction that does that automatically (JM) }
  686. if fromsize = OS_S8 then
  687. list.concat(taicpu.op_reg_reg(A_EXTSB, reg, reg));
  688. end;
  689. procedure tcgppc.a_load_reg_reg(list: TAsmList; fromsize, tosize: tcgsize;
  690. reg1, reg2: tregister);
  691. var
  692. instr: TAiCpu;
  693. bytesize : byte;
  694. begin
  695. {$ifdef extdebug}
  696. list.concat(tai_comment.create(strpnew('a_load_reg_reg from : ' + cgsize2string(fromsize) + ' to ' + cgsize2string(tosize))));
  697. {$endif}
  698. if (tcgsize2size[fromsize] > tcgsize2size[tosize]) or
  699. ((tcgsize2size[fromsize] = tcgsize2size[tosize]) and (fromsize <> tosize)) or
  700. { do we need to mask out the sign when loading from smaller signed to larger unsigned type? }
  701. ( is_signed_cgsize(fromsize) and (not is_signed_cgsize(tosize)) and
  702. (tcgsize2size[fromsize] < tcgsize2size[tosize]) and (tcgsize2size[tosize] <> tcgsize2size[OS_INT]) ) then begin
  703. case tosize of
  704. OS_S8:
  705. instr := taicpu.op_reg_reg(A_EXTSB,reg2,reg1);
  706. OS_S16:
  707. instr := taicpu.op_reg_reg(A_EXTSH,reg2,reg1);
  708. OS_S32:
  709. instr := taicpu.op_reg_reg(A_EXTSW,reg2,reg1);
  710. OS_8, OS_16, OS_32:
  711. instr := taicpu.op_reg_reg_const_const(A_RLDICL, reg2, reg1, 0, (8-tcgsize2size[tosize])*8);
  712. OS_S64, OS_64:
  713. instr := taicpu.op_reg_reg(A_MR, reg2, reg1);
  714. end;
  715. end else
  716. instr := taicpu.op_reg_reg(A_MR, reg2, reg1);
  717. list.concat(instr);
  718. rg[R_INTREGISTER].add_move_instruction(instr);
  719. end;
  720. procedure tcgppc.a_load_subsetreg_reg(list : TAsmList; subsetsize, tosize: tcgsize; const sreg: tsubsetregister; destreg: tregister);
  721. begin
  722. {$ifdef extdebug}
  723. list.concat(tai_comment.create(strpnew('a_load_subsetreg_reg subsetregsize = ' + cgsize2string(sreg.subsetregsize) + ' subsetsize = ' + cgsize2string(subsetsize) + ' startbit = ' + intToStr(sreg.startbit) + ' tosize = ' + cgsize2string(tosize))));
  724. {$endif}
  725. { do the extraction if required and then extend the sign correctly. (The latter is actually required only for signed subsets
  726. and if that subset is not >= the tosize). }
  727. if (sreg.startbit <> 0) or
  728. (sreg.bitlen <> tcgsize2size[subsetsize]*8) then begin
  729. list.concat(taicpu.op_reg_reg_const_const(A_RLDICL, destreg, sreg.subsetreg, (64 - sreg.startbit) and 63, 64 - sreg.bitlen));
  730. if (subsetsize in [OS_S8..OS_S128]) then
  731. if ((sreg.bitlen mod 8) = 0) then begin
  732. a_load_reg_reg(list, tcgsize2unsigned[subsetsize], subsetsize, destreg, destreg);
  733. a_load_reg_reg(list, subsetsize, tosize, destreg, destreg);
  734. end else begin
  735. a_op_const_reg(list,OP_SHL,OS_INT,64-sreg.bitlen,destreg);
  736. a_op_const_reg(list,OP_SAR,OS_INT,64-sreg.bitlen,destreg);
  737. end;
  738. end else begin
  739. a_load_reg_reg(list, tcgsize2unsigned[sreg.subsetregsize], subsetsize, sreg.subsetreg, destreg);
  740. a_load_reg_reg(list, subsetsize, tosize, destreg, destreg);
  741. end;
  742. end;
  743. procedure tcgppc.a_load_regconst_subsetreg_intern(list : TAsmList; fromsize, subsetsize: tcgsize; fromreg: tregister; const sreg: tsubsetregister; slopt: tsubsetloadopt);
  744. begin
  745. {$ifdef extdebug}
  746. list.concat(tai_comment.create(strpnew('a_load_reg_subsetreg fromsize = ' + cgsize2string(fromsize) + ' subsetregsize = ' + cgsize2string(sreg.subsetregsize) + ' subsetsize = ' + cgsize2string(subsetsize) + ' startbit = ' + IntToStr(sreg.startbit))));
  747. {$endif}
  748. if (slopt in [SL_SETZERO,SL_SETMAX]) then
  749. inherited a_load_regconst_subsetreg_intern(list,fromsize,subsetsize,fromreg,sreg,slopt)
  750. else if (sreg.bitlen <> sizeof(aint)*8) then
  751. { simply use the INSRDI instruction }
  752. list.concat(taicpu.op_reg_reg_const_const(A_INSRDI, sreg.subsetreg, fromreg, sreg.bitlen, (64 - (sreg.startbit + sreg.bitlen)) and 63))
  753. else
  754. a_load_reg_reg(list, fromsize, subsetsize, fromreg, sreg.subsetreg);
  755. end;
  756. procedure tcgppc.a_load_const_subsetreg(list: TAsmlist; subsetsize: tcgsize;
  757. a: aint; const sreg: tsubsetregister);
  758. var
  759. tmpreg : TRegister;
  760. begin
  761. {$ifdef extdebug}
  762. list.concat(tai_comment.create(strpnew('a_load_const_subsetreg subsetregsize = ' + cgsize2string(sreg.subsetregsize) + ' subsetsize = ' + cgsize2string(subsetsize) + ' startbit = ' + intToStr(sreg.startbit) + ' a = ' + intToStr(a))));
  763. {$endif}
  764. { loading the constant into the lowest bits of a temp register and then inserting is
  765. better than loading some usually large constants and do some masking and shifting on ppc64 }
  766. tmpreg := getintregister(list,subsetsize);
  767. a_load_const_reg(list,subsetsize,a,tmpreg);
  768. a_load_reg_subsetreg(list, subsetsize, subsetsize, tmpreg, sreg);
  769. end;
  770. procedure tcgppc.a_op_const_reg(list: TAsmList; Op: TOpCG; size: TCGSize; a:
  771. aint; reg: TRegister);
  772. begin
  773. a_op_const_reg_reg(list, op, size, a, reg, reg);
  774. end;
  775. procedure tcgppc.a_op_reg_reg(list: TAsmList; Op: TOpCG; size: TCGSize; src,
  776. dst: TRegister);
  777. begin
  778. a_op_reg_reg_reg(list, op, size, src, dst, dst);
  779. end;
  780. procedure tcgppc.a_op_const_reg_reg(list: TAsmList; op: TOpCg;
  781. size: tcgsize; a: aint; src, dst: tregister);
  782. var
  783. useReg : boolean;
  784. procedure do_lo_hi(loOp, hiOp : TAsmOp);
  785. begin
  786. { Optimization for logical ops (excluding AND), trying to do this as efficiently
  787. as possible by only generating code for the affected halfwords. Note that all
  788. the instructions handled here must have "X op 0 = X" for every halfword. }
  789. usereg := false;
  790. if (aword(a) > high(dword)) then begin
  791. usereg := true;
  792. end else begin
  793. if (word(a) <> 0) then begin
  794. list.concat(taicpu.op_reg_reg_const(loOp, dst, src, word(a)));
  795. if (word(a shr 16) <> 0) then
  796. list.concat(taicpu.op_reg_reg_const(hiOp, dst, dst, word(a shr 16)));
  797. end else if (word(a shr 16) <> 0) then
  798. list.concat(taicpu.op_reg_reg_const(hiOp, dst, src, word(a shr 16)));
  799. end;
  800. end;
  801. procedure do_lo_hi_and;
  802. begin
  803. { optimization logical and with immediate: only use "andi." for 16 bit
  804. ands, otherwise use register method. Doing this for 32 bit constants
  805. would not give any advantage to the register method (via useReg := true),
  806. requiring a scratch register and three instructions. }
  807. usereg := false;
  808. if (aword(a) > high(word)) then
  809. usereg := true
  810. else
  811. list.concat(taicpu.op_reg_reg_const(A_ANDI_, dst, src, word(a)));
  812. end;
  813. procedure do_constant_div(list : TAsmList; size : TCgSize; a : aint; src, dst : TRegister;
  814. signed : boolean);
  815. const
  816. negops : array[boolean] of tasmop = (A_NEG, A_NEGO);
  817. var
  818. magic, shift : int64;
  819. u_magic : qword;
  820. u_shift : byte;
  821. u_add : boolean;
  822. power : byte;
  823. isNegPower : boolean;
  824. divreg : tregister;
  825. begin
  826. if (a = 0) then begin
  827. internalerror(2005061701);
  828. end else if (a = 1) then begin
  829. cg.a_load_reg_reg(current_asmdata.CurrAsmList, OS_INT, OS_INT, src, dst);
  830. end else if (a = -1) and (signed) then begin
  831. { note: only in the signed case possible..., may overflow }
  832. current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(negops[cs_check_overflow in current_settings.localswitches], dst, src));
  833. end else if (ispowerof2(a, power, isNegPower)) then begin
  834. if (signed) then begin
  835. { From "The PowerPC Compiler Writer's Guide", pg. 52ff }
  836. cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SAR, OS_INT, power,
  837. src, dst);
  838. current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_ADDZE, dst, dst));
  839. if (isNegPower) then
  840. current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_NEG, dst, dst));
  841. end else begin
  842. cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHR, OS_INT, power, src, dst)
  843. end;
  844. end else begin
  845. { replace division by multiplication, both implementations }
  846. { from "The PowerPC Compiler Writer's Guide" pg. 53ff }
  847. divreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT);
  848. if (signed) then begin
  849. getmagic_signedN(sizeof(aInt)*8, a, magic, shift);
  850. { load magic value }
  851. cg.a_load_const_reg(current_asmdata.CurrAsmList, OS_INT, magic, divreg);
  852. { multiply }
  853. current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_MULHD, dst, src, divreg));
  854. { add/subtract numerator }
  855. if (a > 0) and (magic < 0) then begin
  856. cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_ADD, OS_INT, src, dst, dst);
  857. end else if (a < 0) and (magic > 0) then begin
  858. cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_SUB, OS_INT, src, dst, dst);
  859. end;
  860. { shift shift places to the right (arithmetic) }
  861. cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SAR, OS_INT, shift, dst, dst);
  862. { extract and add sign bit }
  863. if (a >= 0) then begin
  864. cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHR, OS_INT, 63, src, divreg);
  865. end else begin
  866. cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHR, OS_INT, 63, dst, divreg);
  867. end;
  868. cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_ADD, OS_INT, dst, divreg, dst);
  869. end else begin
  870. getmagic_unsignedN(sizeof(aWord)*8, a, u_magic, u_add, u_shift);
  871. { load magic in divreg }
  872. cg.a_load_const_reg(current_asmdata.CurrAsmList, OS_INT, aint(u_magic), divreg);
  873. current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_MULHDU, dst, src, divreg));
  874. if (u_add) then begin
  875. cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_SUB, OS_INT, dst, src, divreg);
  876. cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHR, OS_INT, 1, divreg, divreg);
  877. cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_ADD, OS_INT, divreg, dst, divreg);
  878. cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHR, OS_INT, u_shift-1, divreg, dst);
  879. end else begin
  880. cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHR, OS_INT, u_shift, dst, dst);
  881. end;
  882. end;
  883. end;
  884. end;
  885. var
  886. scratchreg: tregister;
  887. shift : byte;
  888. shiftmask : longint;
  889. isneg : boolean;
  890. begin
  891. { subtraction is the same as addition with negative constant }
  892. if op = OP_SUB then begin
  893. a_op_const_reg_reg(list, OP_ADD, size, -a, src, dst);
  894. exit;
  895. end;
  896. {$IFDEF EXTDEBUG}
  897. list.concat(tai_comment.create(strpnew('a_op_const_reg_reg ' + cgop2string(op))));
  898. {$ENDIF EXTDEBUG}
  899. { This case includes some peephole optimizations for the various operations,
  900. (e.g. AND, OR, XOR, ..) - can't this be done at some higher level,
  901. independent of architecture? }
  902. { assume that we do not need a scratch register for the operation }
  903. useReg := false;
  904. case (op) of
  905. OP_DIV, OP_IDIV:
  906. if (cs_opt_level1 in current_settings.optimizerswitches) then
  907. do_constant_div(list, size, a, src, dst, op = OP_IDIV)
  908. else
  909. usereg := true;
  910. OP_IMUL, OP_MUL:
  911. { idea: factorize constant multiplicands and use adds/shifts with few factors;
  912. however, even a 64 bit multiply is already quite fast on PPC64 }
  913. if (a = 0) then
  914. a_load_const_reg(list, size, 0, dst)
  915. else if (a = -1) then
  916. list.concat(taicpu.op_reg_reg(A_NEG, dst, dst))
  917. else if (a = 1) then
  918. a_load_reg_reg(list, OS_INT, OS_INT, src, dst)
  919. else if ispowerof2(a, shift, isneg) then begin
  920. list.concat(taicpu.op_reg_reg_const(A_SLDI, dst, src, shift));
  921. if (isneg) then
  922. current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_NEG, dst, dst));
  923. end else if (a >= low(smallint)) and (a <= high(smallint)) then
  924. list.concat(taicpu.op_reg_reg_const(A_MULLI, dst, src,
  925. smallint(a)))
  926. else
  927. usereg := true;
  928. OP_ADD:
  929. if (a = 0) then
  930. a_load_reg_reg(list, size, size, src, dst)
  931. else if (a >= low(smallint)) and (a <= high(smallint)) then
  932. list.concat(taicpu.op_reg_reg_const(A_ADDI, dst, src, smallint(a)))
  933. else
  934. useReg := true;
  935. OP_OR:
  936. if (a = 0) then
  937. a_load_reg_reg(list, size, size, src, dst)
  938. else if (a = -1) then
  939. a_load_const_reg(list, size, -1, dst)
  940. else
  941. do_lo_hi(A_ORI, A_ORIS);
  942. OP_AND:
  943. if (a = 0) then
  944. a_load_const_reg(list, size, 0, dst)
  945. else if (a = -1) then
  946. a_load_reg_reg(list, size, size, src, dst)
  947. else
  948. do_lo_hi_and;
  949. OP_XOR:
  950. if (a = 0) then
  951. a_load_reg_reg(list, size, size, src, dst)
  952. else if (a = -1) then
  953. list.concat(taicpu.op_reg_reg(A_NOT, dst, src))
  954. else
  955. do_lo_hi(A_XORI, A_XORIS);
  956. OP_SHL, OP_SHR, OP_SAR:
  957. begin
  958. if (size in [OS_64, OS_S64]) then
  959. shift := 6
  960. else
  961. shift := 5;
  962. shiftmask := (1 shl shift)-1;
  963. if (a and shiftmask) <> 0 then begin
  964. list.concat(taicpu.op_reg_reg_const(
  965. TShiftOpCG2AsmOpConst[size in [OS_64, OS_S64], op], dst, src, a and shiftmask));
  966. end else
  967. a_load_reg_reg(list, size, size, src, dst);
  968. if ((a shr shift) <> 0) then
  969. internalError(68991);
  970. end
  971. else
  972. internalerror(200109091);
  973. end;
  974. { if all else failed, load the constant in a register and then
  975. perform the operation }
  976. if (useReg) then begin
  977. scratchreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
  978. a_load_const_reg(list, size, a, scratchreg);
  979. a_op_reg_reg_reg(list, op, size, scratchreg, src, dst);
  980. end else
  981. maybeadjustresult(list, op, size, dst);
  982. end;
  983. procedure tcgppc.a_op_reg_reg_reg(list: TAsmList; op: TOpCg;
  984. size: tcgsize; src1, src2, dst: tregister);
  985. const
  986. op_reg_reg_opcg2asmop32: array[TOpCG] of tasmop =
  987. (A_NONE, A_MR, A_ADD, A_AND, A_DIVWU, A_DIVW, A_MULLW, A_MULLW, A_NEG, A_NOT, A_OR,
  988. A_SRAW, A_SLW, A_SRW, A_SUB, A_XOR);
  989. op_reg_reg_opcg2asmop64: array[TOpCG] of tasmop =
  990. (A_NONE, A_MR, A_ADD, A_AND, A_DIVDU, A_DIVD, A_MULLD, A_MULLD, A_NEG, A_NOT, A_OR,
  991. A_SRAD, A_SLD, A_SRD, A_SUB, A_XOR);
  992. begin
  993. case op of
  994. OP_NEG, OP_NOT:
  995. begin
  996. list.concat(taicpu.op_reg_reg(op_reg_reg_opcg2asmop64[op], dst, src1));
  997. if (op = OP_NOT) and not (size in [OS_64, OS_S64]) then
  998. { zero/sign extend result again, fromsize is not important here }
  999. a_load_reg_reg(list, OS_S64, size, dst, dst)
  1000. end;
  1001. else
  1002. if (size in [OS_64, OS_S64]) then begin
  1003. list.concat(taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop64[op], dst, src2,
  1004. src1));
  1005. end else begin
  1006. list.concat(taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop32[op], dst, src2,
  1007. src1));
  1008. maybeadjustresult(list, op, size, dst);
  1009. end;
  1010. end;
  1011. end;
  1012. {*************** compare instructructions ****************}
  1013. procedure tcgppc.a_cmp_const_reg_label(list: TAsmList; size: tcgsize;
  1014. cmp_op: topcmp; a: aint; reg: tregister; l: tasmlabel);
  1015. const
  1016. { unsigned useconst 32bit-op }
  1017. cmpop_table : array[boolean, boolean, boolean] of TAsmOp = (
  1018. ((A_CMPD, A_CMPW), (A_CMPDI, A_CMPWI)),
  1019. ((A_CMPLD, A_CMPLW), (A_CMPLDI, A_CMPLWI))
  1020. );
  1021. var
  1022. tmpreg : TRegister;
  1023. signed, useconst : boolean;
  1024. opsize : TCgSize;
  1025. op : TAsmOp;
  1026. begin
  1027. {$IFDEF EXTDEBUG}
  1028. 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) )));
  1029. {$ENDIF EXTDEBUG}
  1030. signed := cmp_op in [OC_GT, OC_LT, OC_GTE, OC_LTE];
  1031. { in the following case, we generate more efficient code when
  1032. signed is true }
  1033. if (cmp_op in [OC_EQ, OC_NE]) and
  1034. (aword(a) > $FFFF) then
  1035. signed := true;
  1036. opsize := size;
  1037. { do we need to change the operand size because ppc64 only supports 32 and
  1038. 64 bit compares? }
  1039. if (not (size in [OS_32, OS_S32, OS_64, OS_S64])) then begin
  1040. if (signed) then
  1041. opsize := OS_S32
  1042. else
  1043. opsize := OS_32;
  1044. a_load_reg_reg(current_asmdata.CurrAsmList, size, opsize, reg, reg);
  1045. end;
  1046. { can we use immediate compares? }
  1047. useconst := (signed and ( (a >= low(smallint)) and (a <= high(smallint)))) or
  1048. ((not signed) and (aword(a) <= $FFFF));
  1049. op := cmpop_table[not signed, useconst, opsize in [OS_32, OS_S32]];
  1050. if (useconst) then begin
  1051. list.concat(taicpu.op_reg_reg_const(op, NR_CR0, reg, a));
  1052. end else begin
  1053. tmpreg := getintregister(current_asmdata.CurrAsmList, OS_INT);
  1054. a_load_const_reg(current_asmdata.CurrAsmList, opsize, a, tmpreg);
  1055. list.concat(taicpu.op_reg_reg_reg(op, NR_CR0, reg, tmpreg));
  1056. end;
  1057. a_jmp(list, A_BC, TOpCmp2AsmCond[cmp_op], 0, l);
  1058. end;
  1059. procedure tcgppc.a_cmp_reg_reg_label(list: TAsmList; size: tcgsize;
  1060. cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel);
  1061. var
  1062. op: tasmop;
  1063. begin
  1064. {$IFDEF extdebug}
  1065. list.concat(tai_comment.create(strpnew('a_cmp_reg_reg_label, size ' + cgsize2string(size) + ' op ' + inttostr(ord(cmp_op)))));
  1066. {$ENDIF extdebug}
  1067. {$note Commented out below check because of compiler weirdness}
  1068. {
  1069. if (not (size in [OS_32, OS_S32, OS_64, OS_S64])) then
  1070. internalerror(200606041);
  1071. }
  1072. if cmp_op in [OC_GT, OC_LT, OC_GTE, OC_LTE] then
  1073. if (size in [OS_64, OS_S64]) then
  1074. op := A_CMPD
  1075. else
  1076. op := A_CMPW
  1077. else
  1078. if (size in [OS_64, OS_S64]) then
  1079. op := A_CMPLD
  1080. else
  1081. op := A_CMPLW;
  1082. list.concat(taicpu.op_reg_reg_reg(op, NR_CR0, reg2, reg1));
  1083. a_jmp(list, A_BC, TOpCmp2AsmCond[cmp_op], 0, l);
  1084. end;
  1085. procedure tcgppc.a_jmp_name_direct(list : TAsmList; s : string; prependDot : boolean);
  1086. var
  1087. p: taicpu;
  1088. begin
  1089. if (prependDot) then
  1090. s := '.' + s;
  1091. p := taicpu.op_sym(A_B, current_asmdata.RefAsmSymbol(s));
  1092. p.is_jmp := true;
  1093. list.concat(p)
  1094. end;
  1095. procedure tcgppc.a_jmp_name(list: TAsmList; const s: string);
  1096. var
  1097. p: taicpu;
  1098. begin
  1099. if (target_info.system = system_powerpc64_darwin) then
  1100. begin
  1101. p := taicpu.op_sym(A_B,get_darwin_call_stub(s));
  1102. p.is_jmp := true;
  1103. list.concat(p)
  1104. end
  1105. else
  1106. a_jmp_name_direct(list, s, true);
  1107. end;
  1108. procedure tcgppc.a_jmp_always(list: TAsmList; l: tasmlabel);
  1109. begin
  1110. a_jmp(list, A_B, C_None, 0, l);
  1111. end;
  1112. procedure tcgppc.a_jmp_flags(list: TAsmList; const f: TResFlags; l:
  1113. tasmlabel);
  1114. var
  1115. c: tasmcond;
  1116. begin
  1117. c := flags_to_cond(f);
  1118. a_jmp(list, A_BC, c.cond, c.cr - RS_CR0, l);
  1119. end;
  1120. procedure tcgppc.g_flags2reg(list: TAsmList; size: TCgSize; const f:
  1121. TResFlags; reg: TRegister);
  1122. var
  1123. testbit: byte;
  1124. bitvalue: boolean;
  1125. begin
  1126. { get the bit to extract from the conditional register + its requested value (0 or 1) }
  1127. testbit := ((f.cr - RS_CR0) * 4);
  1128. case f.flag of
  1129. F_EQ, F_NE:
  1130. begin
  1131. inc(testbit, 2);
  1132. bitvalue := f.flag = F_EQ;
  1133. end;
  1134. F_LT, F_GE:
  1135. begin
  1136. bitvalue := f.flag = F_LT;
  1137. end;
  1138. F_GT, F_LE:
  1139. begin
  1140. inc(testbit);
  1141. bitvalue := f.flag = F_GT;
  1142. end;
  1143. else
  1144. internalerror(200112261);
  1145. end;
  1146. { load the conditional register in the destination reg }
  1147. list.concat(taicpu.op_reg(A_MFCR, reg));
  1148. { we will move the bit that has to be tested to bit 0 by rotating left }
  1149. testbit := (testbit + 1) and 31;
  1150. { extract bit }
  1151. list.concat(taicpu.op_reg_reg_const_const_const(
  1152. A_RLWINM,reg,reg,testbit,31,31));
  1153. { if we need the inverse, xor with 1 }
  1154. if not bitvalue then
  1155. list.concat(taicpu.op_reg_reg_const(A_XORI, reg, reg, 1));
  1156. end;
  1157. { *********** entry/exit code and address loading ************ }
  1158. procedure tcgppc.g_save_standard_registers(list: TAsmList);
  1159. begin
  1160. { this work is done in g_proc_entry; additionally it is not safe
  1161. to use it because it is called at some weird time }
  1162. end;
  1163. procedure tcgppc.g_restore_standard_registers(list: TAsmList);
  1164. begin
  1165. { this work is done in g_proc_exit; mainly because it is not safe to
  1166. put the register restore code here because it is called at some weird time }
  1167. end;
  1168. procedure tcgppc.calcFirstUsedFPR(out firstfpr : TSuperRegister; out fprcount : aint);
  1169. var
  1170. reg : TSuperRegister;
  1171. begin
  1172. fprcount := 0;
  1173. firstfpr := RS_F31;
  1174. if not (po_assembler in current_procinfo.procdef.procoptions) then
  1175. for reg := RS_F14 to RS_F31 do
  1176. if reg in rg[R_FPUREGISTER].used_in_proc then begin
  1177. fprcount := ord(RS_F31)-ord(reg)+1;
  1178. firstfpr := reg;
  1179. break;
  1180. end;
  1181. end;
  1182. procedure tcgppc.calcFirstUsedGPR(out firstgpr : TSuperRegister; out gprcount : aint);
  1183. var
  1184. reg : TSuperRegister;
  1185. begin
  1186. gprcount := 0;
  1187. firstgpr := RS_R31;
  1188. if not (po_assembler in current_procinfo.procdef.procoptions) then
  1189. for reg := RS_R14 to RS_R31 do
  1190. if reg in rg[R_INTREGISTER].used_in_proc then begin
  1191. gprcount := ord(RS_R31)-ord(reg)+1;
  1192. firstgpr := reg;
  1193. break;
  1194. end;
  1195. end;
  1196. procedure tcgppc.profilecode_savepara(para : tparavarsym; list : TAsmList);
  1197. begin
  1198. case (para.paraloc[calleeside].location^.loc) of
  1199. LOC_REGISTER, LOC_CREGISTER:
  1200. a_load_reg_ref(list, OS_INT, para.paraloc[calleeside].Location^.size,
  1201. para.paraloc[calleeside].Location^.register, para.localloc.reference);
  1202. LOC_FPUREGISTER, LOC_CFPUREGISTER:
  1203. a_loadfpu_reg_ref(list, para.paraloc[calleeside].Location^.size,
  1204. para.paraloc[calleeside].Location^.size,
  1205. para.paraloc[calleeside].Location^.register, para.localloc.reference);
  1206. LOC_MMREGISTER, LOC_CMMREGISTER:
  1207. { not supported }
  1208. internalerror(2006041801);
  1209. end;
  1210. end;
  1211. procedure tcgppc.profilecode_restorepara(para : tparavarsym; list : TAsmList);
  1212. begin
  1213. case (para.paraloc[calleeside].Location^.loc) of
  1214. LOC_REGISTER, LOC_CREGISTER:
  1215. a_load_ref_reg(list, para.paraloc[calleeside].Location^.size, OS_INT,
  1216. para.localloc.reference, para.paraloc[calleeside].Location^.register);
  1217. LOC_FPUREGISTER, LOC_CFPUREGISTER:
  1218. a_loadfpu_ref_reg(list, para.paraloc[calleeside].Location^.size,
  1219. para.paraloc[calleeside].Location^.size,
  1220. para.localloc.reference, para.paraloc[calleeside].Location^.register);
  1221. LOC_MMREGISTER, LOC_CMMREGISTER:
  1222. { not supported }
  1223. internalerror(2006041802);
  1224. end;
  1225. end;
  1226. procedure tcgppc.g_profilecode(list: TAsmList);
  1227. begin
  1228. current_procinfo.procdef.paras.ForEachCall(TObjectListCallback(@profilecode_savepara), list);
  1229. a_call_name_direct(list, '_mcount', false, true);
  1230. current_procinfo.procdef.paras.ForEachCall(TObjectListCallback(@profilecode_restorepara), list);
  1231. end;
  1232. { Generates the entry code of a procedure/function.
  1233. This procedure may be called before, as well as after g_return_from_proc
  1234. is called. localsize is the sum of the size necessary for local variables
  1235. and the maximum possible combined size of ALL the parameters of a procedure
  1236. called by the current one
  1237. IMPORTANT: registers are not to be allocated through the register
  1238. allocator here, because the register colouring has already occured !!
  1239. }
  1240. procedure tcgppc.g_proc_entry(list: TAsmList; localsize: longint;
  1241. nostackframe: boolean);
  1242. var
  1243. firstregfpu, firstreggpr: TSuperRegister;
  1244. needslinkreg: boolean;
  1245. fprcount, gprcount : aint;
  1246. { Save standard registers, both FPR and GPR; does not support VMX/Altivec }
  1247. procedure save_standard_registers;
  1248. var
  1249. regcount : TSuperRegister;
  1250. href : TReference;
  1251. mayNeedLRStore : boolean;
  1252. begin
  1253. { there are two ways to do this: manually, by generating a few "std" instructions,
  1254. or via the restore helper functions. The latter are selected by the -Og switch,
  1255. i.e. "optimize for size" }
  1256. if (cs_opt_size in current_settings.optimizerswitches) then begin
  1257. mayNeedLRStore := false;
  1258. if ((fprcount > 0) and (gprcount > 0)) then begin
  1259. a_op_const_reg_reg(list, OP_SUB, OS_INT, 8 * fprcount, NR_R1, NR_R12);
  1260. a_call_name_direct(list, '_savegpr1_' + intToStr(32-gprcount), false, false, false);
  1261. a_call_name_direct(list, '_savefpr_' + intToStr(32-fprcount), false, false, false);
  1262. end else if (gprcount > 0) then
  1263. a_call_name_direct(list, '_savegpr0_' + intToStr(32-gprcount), false, false, false)
  1264. else if (fprcount > 0) then
  1265. a_call_name_direct(list, '_savefpr_' + intToStr(32-fprcount), false, false, false)
  1266. else
  1267. mayNeedLRStore := true;
  1268. end else begin
  1269. { save registers, FPU first, then GPR }
  1270. reference_reset_base(href, NR_STACK_POINTER_REG, -8);
  1271. if (fprcount > 0) then
  1272. for regcount := RS_F31 downto firstregfpu do begin
  1273. a_loadfpu_reg_ref(list, OS_FLOAT, OS_FLOAT, newreg(R_FPUREGISTER,
  1274. regcount, R_SUBNONE), href);
  1275. dec(href.offset, tcgsize2size[OS_FLOAT]);
  1276. end;
  1277. if (gprcount > 0) then
  1278. for regcount := RS_R31 downto firstreggpr do begin
  1279. a_load_reg_ref(list, OS_INT, OS_INT, newreg(R_INTREGISTER, regcount,
  1280. R_SUBNONE), href);
  1281. dec(href.offset, tcgsize2size[OS_INT]);
  1282. end;
  1283. { VMX registers not supported by FPC atm }
  1284. { in this branch we always need to store LR ourselves}
  1285. mayNeedLRStore := true;
  1286. end;
  1287. { we may need to store R0 (=LR) ourselves }
  1288. if ((cs_profile in init_settings.moduleswitches) or (mayNeedLRStore)) and (needslinkreg) then begin
  1289. reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_ELF);
  1290. list.concat(taicpu.op_reg_ref(A_STD, NR_R0, href));
  1291. end;
  1292. end;
  1293. var
  1294. href: treference;
  1295. begin
  1296. calcFirstUsedFPR(firstregfpu, fprcount);
  1297. calcFirstUsedGPR(firstreggpr, gprcount);
  1298. { calculate real stack frame size }
  1299. localsize := tppcprocinfo(current_procinfo).calc_stackframe_size(
  1300. gprcount, fprcount);
  1301. { determine whether we need to save the link register }
  1302. needslinkreg :=
  1303. not(nostackframe) and
  1304. (((not (po_assembler in current_procinfo.procdef.procoptions)) and
  1305. ((pi_do_call in current_procinfo.flags) or (cs_profile in init_settings.moduleswitches))) or
  1306. ((cs_opt_size in current_settings.optimizerswitches) and ((fprcount > 0) or (gprcount > 0))) or
  1307. ([cs_lineinfo, cs_debuginfo] * current_settings.moduleswitches <> []));
  1308. a_reg_alloc(list, NR_STACK_POINTER_REG);
  1309. a_reg_alloc(list, NR_R0);
  1310. { move link register to r0 }
  1311. if (needslinkreg) then
  1312. list.concat(taicpu.op_reg(A_MFLR, NR_R0));
  1313. save_standard_registers;
  1314. { save old stack frame pointer }
  1315. if (tppcprocinfo(current_procinfo).needs_frame_pointer) then begin
  1316. a_reg_alloc(list, NR_OLD_STACK_POINTER_REG);
  1317. list.concat(taicpu.op_reg_reg(A_MR, NR_OLD_STACK_POINTER_REG, NR_STACK_POINTER_REG));
  1318. end;
  1319. { create stack frame }
  1320. if (not nostackframe) and (localsize > 0) and
  1321. tppcprocinfo(current_procinfo).needstackframe then begin
  1322. if (localsize <= high(smallint)) then begin
  1323. reference_reset_base(href, NR_STACK_POINTER_REG, -localsize);
  1324. a_load_store(list, A_STDU, NR_STACK_POINTER_REG, href);
  1325. end else begin
  1326. reference_reset_base(href, NR_NO, -localsize);
  1327. { Use R0 for loading the constant (which is definitely > 32k when entering
  1328. this branch).
  1329. Inlined at this position because it must not use temp registers because
  1330. register allocations have already been done }
  1331. { Code template:
  1332. lis r0,ofs@highest
  1333. ori r0,r0,ofs@higher
  1334. sldi r0,r0,32
  1335. oris r0,r0,ofs@h
  1336. ori r0,r0,ofs@l
  1337. }
  1338. list.concat(taicpu.op_reg_const(A_LIS, NR_R0, word(href.offset shr 48)));
  1339. list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(href.offset shr 32)));
  1340. list.concat(taicpu.op_reg_reg_const(A_SLDI, NR_R0, NR_R0, 32));
  1341. list.concat(taicpu.op_reg_reg_const(A_ORIS, NR_R0, NR_R0, word(href.offset shr 16)));
  1342. list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(href.offset)));
  1343. list.concat(taicpu.op_reg_reg_reg(A_STDUX, NR_R1, NR_R1, NR_R0));
  1344. end;
  1345. end;
  1346. { CR register not used by FPC atm }
  1347. { keep R1 allocated??? }
  1348. a_reg_dealloc(list, NR_R0);
  1349. end;
  1350. { Generates the exit code for a method.
  1351. This procedure may be called before, as well as after g_stackframe_entry
  1352. is called.
  1353. IMPORTANT: registers are not to be allocated through the register
  1354. allocator here, because the register colouring has already occured !!
  1355. }
  1356. procedure tcgppc.g_proc_exit(list: TAsmList; parasize: longint; nostackframe:
  1357. boolean);
  1358. var
  1359. firstregfpu, firstreggpr: TSuperRegister;
  1360. needslinkreg : boolean;
  1361. fprcount, gprcount: aint;
  1362. { Restore standard registers, both FPR and GPR; does not support VMX/Altivec }
  1363. procedure restore_standard_registers;
  1364. var
  1365. { flag indicating whether we need to manually add the exit code (e.g. blr instruction)
  1366. or not }
  1367. needsExitCode : Boolean;
  1368. href : treference;
  1369. regcount : TSuperRegister;
  1370. begin
  1371. { there are two ways to do this: manually, by generating a few "ld" instructions,
  1372. or via the restore helper functions. The latter are selected by the -Og switch,
  1373. i.e. "optimize for size" }
  1374. if (cs_opt_size in current_settings.optimizerswitches) then begin
  1375. needsExitCode := false;
  1376. if ((fprcount > 0) and (gprcount > 0)) then begin
  1377. a_op_const_reg_reg(list, OP_SUB, OS_INT, 8 * fprcount, NR_R1, NR_R12);
  1378. a_call_name_direct(list, '_restgpr1_' + intToStr(32-gprcount), false, false, false);
  1379. a_jmp_name_direct(list, '_restfpr_' + intToStr(32-fprcount), false);
  1380. end else if (gprcount > 0) then
  1381. a_jmp_name_direct(list, '_restgpr0_' + intToStr(32-gprcount), false)
  1382. else if (fprcount > 0) then
  1383. a_jmp_name_direct(list, '_restfpr_' + intToStr(32-fprcount), false)
  1384. else
  1385. needsExitCode := true;
  1386. end else begin
  1387. needsExitCode := true;
  1388. { restore registers, FPU first, GPR next }
  1389. reference_reset_base(href, NR_STACK_POINTER_REG, -tcgsize2size[OS_FLOAT]);
  1390. if (fprcount > 0) then
  1391. for regcount := RS_F31 downto firstregfpu do begin
  1392. a_loadfpu_ref_reg(list, OS_FLOAT, OS_FLOAT, href, newreg(R_FPUREGISTER, regcount,
  1393. R_SUBNONE));
  1394. dec(href.offset, tcgsize2size[OS_FLOAT]);
  1395. end;
  1396. if (gprcount > 0) then
  1397. for regcount := RS_R31 downto firstreggpr do begin
  1398. a_load_ref_reg(list, OS_INT, OS_INT, href, newreg(R_INTREGISTER, regcount,
  1399. R_SUBNONE));
  1400. dec(href.offset, tcgsize2size[OS_INT]);
  1401. end;
  1402. { VMX not supported by FPC atm }
  1403. end;
  1404. if (needsExitCode) then begin
  1405. { restore LR (if needed) }
  1406. if (needslinkreg) then begin
  1407. reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_ELF);
  1408. list.concat(taicpu.op_reg_ref(A_LD, NR_R0, href));
  1409. list.concat(taicpu.op_reg(A_MTLR, NR_R0));
  1410. end;
  1411. { generate return instruction }
  1412. list.concat(taicpu.op_none(A_BLR));
  1413. end;
  1414. end;
  1415. var
  1416. href: treference;
  1417. localsize : aint;
  1418. begin
  1419. calcFirstUsedFPR(firstregfpu, fprcount);
  1420. calcFirstUsedGPR(firstreggpr, gprcount);
  1421. { determine whether we need to restore the link register }
  1422. needslinkreg :=
  1423. not(nostackframe) and
  1424. (((not (po_assembler in current_procinfo.procdef.procoptions)) and
  1425. ((pi_do_call in current_procinfo.flags) or (cs_profile in init_settings.moduleswitches))) or
  1426. ((cs_opt_size in current_settings.optimizerswitches) and ((fprcount > 0) or (gprcount > 0))) or
  1427. ([cs_lineinfo, cs_debuginfo] * current_settings.moduleswitches <> []));
  1428. { calculate stack frame }
  1429. localsize := tppcprocinfo(current_procinfo).calc_stackframe_size(
  1430. gprcount, fprcount);
  1431. { CR register not supported }
  1432. { restore stack pointer }
  1433. if (not nostackframe) and (localsize > 0) and
  1434. tppcprocinfo(current_procinfo).needstackframe then begin
  1435. if (localsize <= high(smallint)) then begin
  1436. list.concat(taicpu.op_reg_reg_const(A_ADDI, NR_STACK_POINTER_REG, NR_STACK_POINTER_REG, localsize));
  1437. end else begin
  1438. reference_reset_base(href, NR_NO, localsize);
  1439. { use R0 for loading the constant (which is definitely > 32k when entering
  1440. this branch)
  1441. Inlined because it must not use temp registers because register allocations
  1442. have already been done
  1443. }
  1444. { Code template:
  1445. lis r0,ofs@highest
  1446. ori r0,ofs@higher
  1447. sldi r0,r0,32
  1448. oris r0,r0,ofs@h
  1449. ori r0,r0,ofs@l
  1450. }
  1451. list.concat(taicpu.op_reg_const(A_LIS, NR_R0, word(href.offset shr 48)));
  1452. list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(href.offset shr 32)));
  1453. list.concat(taicpu.op_reg_reg_const(A_SLDI, NR_R0, NR_R0, 32));
  1454. list.concat(taicpu.op_reg_reg_const(A_ORIS, NR_R0, NR_R0, word(href.offset shr 16)));
  1455. list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(href.offset)));
  1456. list.concat(taicpu.op_reg_reg_reg(A_ADD, NR_R1, NR_R1, NR_R0));
  1457. end;
  1458. end;
  1459. restore_standard_registers;
  1460. end;
  1461. procedure tcgppc.a_loadaddr_ref_reg(list: TAsmList; const ref: treference; r:
  1462. tregister);
  1463. var
  1464. ref2, tmpref: treference;
  1465. { register used to construct address }
  1466. tempreg : TRegister;
  1467. begin
  1468. if (target_info.system = system_powerpc64_darwin) then
  1469. begin
  1470. inherited a_loadaddr_ref_reg(list,ref,r);
  1471. exit;
  1472. end;
  1473. ref2 := ref;
  1474. fixref(list, ref2);
  1475. { load a symbol }
  1476. if (assigned(ref2.symbol) or (hasLargeOffset(ref2))) then begin
  1477. { add the symbol's value to the base of the reference, and if the }
  1478. { reference doesn't have a base, create one }
  1479. reference_reset(tmpref);
  1480. tmpref.offset := ref2.offset;
  1481. tmpref.symbol := ref2.symbol;
  1482. tmpref.relsymbol := ref2.relsymbol;
  1483. { load 64 bit reference into r. If the reference already has a base register,
  1484. first load the 64 bit value into a temp register, then add it to the result
  1485. register rD }
  1486. if (ref2.base <> NR_NO) then begin
  1487. { already have a base register, so allocate a new one }
  1488. tempreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
  1489. end else begin
  1490. tempreg := r;
  1491. end;
  1492. { code for loading a reference from a symbol into a register rD }
  1493. (*
  1494. lis rX,SYM@highest
  1495. ori rX,SYM@higher
  1496. sldi rX,rX,32
  1497. oris rX,rX,SYM@h
  1498. ori rX,rX,SYM@l
  1499. *)
  1500. {$IFDEF EXTDEBUG}
  1501. list.concat(tai_comment.create(strpnew('loadaddr_ref_reg ')));
  1502. {$ENDIF EXTDEBUG}
  1503. if (assigned(tmpref.symbol)) then begin
  1504. tmpref.refaddr := addr_highest;
  1505. list.concat(taicpu.op_reg_ref(A_LIS, tempreg, tmpref));
  1506. tmpref.refaddr := addr_higher;
  1507. list.concat(taicpu.op_reg_reg_ref(A_ORI, tempreg, tempreg, tmpref));
  1508. list.concat(taicpu.op_reg_reg_const(A_SLDI, tempreg, tempreg, 32));
  1509. tmpref.refaddr := addr_high;
  1510. list.concat(taicpu.op_reg_reg_ref(A_ORIS, tempreg, tempreg, tmpref));
  1511. tmpref.refaddr := addr_low;
  1512. list.concat(taicpu.op_reg_reg_ref(A_ORI, tempreg, tempreg, tmpref));
  1513. end else
  1514. a_load_const_reg(list, OS_ADDR, tmpref.offset, tempreg);
  1515. { if there's already a base register, add the temp register contents to
  1516. the base register }
  1517. if (ref2.base <> NR_NO) then begin
  1518. list.concat(taicpu.op_reg_reg_reg(A_ADD, r, tempreg, ref2.base));
  1519. end;
  1520. end else if (ref2.offset <> 0) then begin
  1521. { no symbol, but offset <> 0 }
  1522. if (ref2.base <> NR_NO) then begin
  1523. a_op_const_reg_reg(list, OP_ADD, OS_64, ref2.offset, ref2.base, r)
  1524. { FixRef makes sure that "(ref.index <> R_NO) and (ref.offset <> 0)" never
  1525. occurs, so now only ref.offset has to be loaded }
  1526. end else begin
  1527. a_load_const_reg(list, OS_64, ref2.offset, r);
  1528. end;
  1529. end else if (ref2.index <> NR_NO) then begin
  1530. list.concat(taicpu.op_reg_reg_reg(A_ADD, r, ref2.base, ref2.index))
  1531. end else if (ref2.base <> NR_NO) and
  1532. (r <> ref2.base) then begin
  1533. a_load_reg_reg(list, OS_ADDR, OS_ADDR, ref2.base, r)
  1534. end else begin
  1535. list.concat(taicpu.op_reg_const(A_LI, r, 0));
  1536. end;
  1537. end;
  1538. { ************* concatcopy ************ }
  1539. const
  1540. maxmoveunit = 8;
  1541. procedure tcgppc.g_concatcopy(list: TAsmList; const source, dest: treference;
  1542. len: aint);
  1543. var
  1544. countreg, tempreg: TRegister;
  1545. src, dst: TReference;
  1546. lab: tasmlabel;
  1547. count, count2: longint;
  1548. size: tcgsize;
  1549. begin
  1550. {$IFDEF extdebug}
  1551. if len > high(aint) then
  1552. internalerror(2002072704);
  1553. list.concat(tai_comment.create(strpnew('g_concatcopy1 ' + inttostr(len) + ' bytes left ')));
  1554. {$ENDIF extdebug}
  1555. { if the references are equal, exit, there is no need to copy anything }
  1556. if (references_equal(source, dest)) then
  1557. exit;
  1558. { make sure short loads are handled as optimally as possible;
  1559. note that the data here never overlaps, so we can do a forward
  1560. copy at all times.
  1561. NOTE: maybe use some scratch registers to pair load/store instructions
  1562. }
  1563. if (len <= maxmoveunit) then begin
  1564. src := source; dst := dest;
  1565. {$IFDEF extdebug}
  1566. list.concat(tai_comment.create(strpnew('g_concatcopy3 ' + inttostr(src.offset) + ' ' + inttostr(dst.offset))));
  1567. {$ENDIF extdebug}
  1568. while (len <> 0) do begin
  1569. if (len = 8) then begin
  1570. a_load_ref_ref(list, OS_64, OS_64, src, dst);
  1571. dec(len, 8);
  1572. end else if (len >= 4) then begin
  1573. a_load_ref_ref(list, OS_32, OS_32, src, dst);
  1574. inc(src.offset, 4); inc(dst.offset, 4);
  1575. dec(len, 4);
  1576. end else if (len >= 2) then begin
  1577. a_load_ref_ref(list, OS_16, OS_16, src, dst);
  1578. inc(src.offset, 2); inc(dst.offset, 2);
  1579. dec(len, 2);
  1580. end else begin
  1581. a_load_ref_ref(list, OS_8, OS_8, src, dst);
  1582. inc(src.offset, 1); inc(dst.offset, 1);
  1583. dec(len, 1);
  1584. end;
  1585. end;
  1586. exit;
  1587. end;
  1588. {$IFDEF extdebug}
  1589. list.concat(tai_comment.create(strpnew('g_concatcopy2 ' + inttostr(len) + ' bytes left ')));
  1590. {$ENDIF extdebug}
  1591. count := len div maxmoveunit;
  1592. reference_reset(src);
  1593. reference_reset(dst);
  1594. { load the address of source into src.base }
  1595. if (count > 4) or
  1596. not issimpleref(source) or
  1597. ((source.index <> NR_NO) and
  1598. ((source.offset + len) > high(smallint))) then begin
  1599. src.base := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
  1600. a_loadaddr_ref_reg(list, source, src.base);
  1601. end else begin
  1602. src := source;
  1603. end;
  1604. { load the address of dest into dst.base }
  1605. if (count > 4) or
  1606. not issimpleref(dest) or
  1607. ((dest.index <> NR_NO) and
  1608. ((dest.offset + len) > high(smallint))) then begin
  1609. dst.base := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
  1610. a_loadaddr_ref_reg(list, dest, dst.base);
  1611. end else begin
  1612. dst := dest;
  1613. end;
  1614. { generate a loop }
  1615. if count > 4 then begin
  1616. { the offsets are zero after the a_loadaddress_ref_reg and just
  1617. have to be set to 8. I put an Inc there so debugging may be
  1618. easier (should offset be different from zero here, it will be
  1619. easy to notice in the generated assembler }
  1620. inc(dst.offset, 8);
  1621. inc(src.offset, 8);
  1622. list.concat(taicpu.op_reg_reg_const(A_SUBI, src.base, src.base, 8));
  1623. list.concat(taicpu.op_reg_reg_const(A_SUBI, dst.base, dst.base, 8));
  1624. countreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
  1625. a_load_const_reg(list, OS_64, count, countreg);
  1626. { explicitely allocate F0 since it can be used safely here
  1627. (for holding date that's being copied) }
  1628. a_reg_alloc(list, NR_F0);
  1629. current_asmdata.getjumplabel(lab);
  1630. a_label(list, lab);
  1631. list.concat(taicpu.op_reg_reg_const(A_SUBIC_, countreg, countreg, 1));
  1632. list.concat(taicpu.op_reg_ref(A_LFDU, NR_F0, src));
  1633. list.concat(taicpu.op_reg_ref(A_STFDU, NR_F0, dst));
  1634. a_jmp(list, A_BC, C_NE, 0, lab);
  1635. a_reg_dealloc(list, NR_F0);
  1636. len := len mod 8;
  1637. end;
  1638. count := len div 8;
  1639. { unrolled loop }
  1640. if count > 0 then begin
  1641. a_reg_alloc(list, NR_F0);
  1642. for count2 := 1 to count do begin
  1643. a_loadfpu_ref_reg(list, OS_F64, OS_F64, src, NR_F0);
  1644. a_loadfpu_reg_ref(list, OS_F64, OS_F64, NR_F0, dst);
  1645. inc(src.offset, 8);
  1646. inc(dst.offset, 8);
  1647. end;
  1648. a_reg_dealloc(list, NR_F0);
  1649. len := len mod 8;
  1650. end;
  1651. if (len and 4) <> 0 then begin
  1652. a_reg_alloc(list, NR_R0);
  1653. a_load_ref_reg(list, OS_32, OS_32, src, NR_R0);
  1654. a_load_reg_ref(list, OS_32, OS_32, NR_R0, dst);
  1655. inc(src.offset, 4);
  1656. inc(dst.offset, 4);
  1657. a_reg_dealloc(list, NR_R0);
  1658. end;
  1659. { copy the leftovers }
  1660. if (len and 2) <> 0 then begin
  1661. a_reg_alloc(list, NR_R0);
  1662. a_load_ref_reg(list, OS_16, OS_16, src, NR_R0);
  1663. a_load_reg_ref(list, OS_16, OS_16, NR_R0, dst);
  1664. inc(src.offset, 2);
  1665. inc(dst.offset, 2);
  1666. a_reg_dealloc(list, NR_R0);
  1667. end;
  1668. if (len and 1) <> 0 then begin
  1669. a_reg_alloc(list, NR_R0);
  1670. a_load_ref_reg(list, OS_8, OS_8, src, NR_R0);
  1671. a_load_reg_ref(list, OS_8, OS_8, NR_R0, dst);
  1672. a_reg_dealloc(list, NR_R0);
  1673. end;
  1674. end;
  1675. procedure tcgppc.g_external_wrapper(list: TAsmList; pd: TProcDef; const externalname: string);
  1676. var
  1677. href : treference;
  1678. begin
  1679. if (target_info.system <> system_powerpc64_linux) then begin
  1680. inherited;
  1681. exit;
  1682. end;
  1683. { for ppc64/linux emit correct code which sets up a stack frame and then calls the
  1684. external method normally to ensure that the GOT/TOC will be loaded correctly if
  1685. required.
  1686. It's not really advantageous to use cg methods here because they are too specialized.
  1687. I.e. the resulting code sequence looks as follows:
  1688. mflr r0
  1689. std r0, 16(r1)
  1690. stdu r1, -112(r1)
  1691. bl <external_method>
  1692. nop
  1693. addi r1, r1, 112
  1694. ld r0, 16(r1)
  1695. mtlr r0
  1696. blr
  1697. }
  1698. list.concat(taicpu.op_reg(A_MFLR, NR_R0));
  1699. reference_reset_base(href, NR_STACK_POINTER_REG, 16);
  1700. list.concat(taicpu.op_reg_ref(A_STD, NR_R0, href));
  1701. reference_reset_base(href, NR_STACK_POINTER_REG, -MINIMUM_STACKFRAME_SIZE);
  1702. list.concat(taicpu.op_reg_ref(A_STDU, NR_STACK_POINTER_REG, href));
  1703. list.concat(taicpu.op_sym(A_BL, current_asmdata.RefAsmSymbol(externalname)));
  1704. list.concat(taicpu.op_none(A_NOP));
  1705. list.concat(taicpu.op_reg_reg_const(A_ADDI, NR_STACK_POINTER_REG, NR_STACK_POINTER_REG, MINIMUM_STACKFRAME_SIZE));
  1706. reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_ELF);
  1707. list.concat(taicpu.op_reg_ref(A_LD, NR_R0, href));
  1708. list.concat(taicpu.op_reg(A_MTLR, NR_R0));
  1709. list.concat(taicpu.op_none(A_BLR));
  1710. end;
  1711. {***************** This is private property, keep out! :) *****************}
  1712. procedure tcgppc.maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister);
  1713. const
  1714. overflowops = [OP_MUL,OP_SHL,OP_ADD,OP_SUB,OP_NOT,OP_NEG];
  1715. begin
  1716. {$IFDEF EXTDEBUG}
  1717. list.concat(tai_comment.create(strpnew('maybeadjustresult op = ' + cgop2string(op) + ' size = ' + cgsize2string(size))));
  1718. {$ENDIF EXTDEBUG}
  1719. if (op in overflowops) and (size in [OS_8, OS_S8, OS_16, OS_S16, OS_32, OS_S32]) then
  1720. a_load_reg_reg(list, OS_64, size, dst, dst);
  1721. end;
  1722. function tcgppc.issimpleref(const ref: treference): boolean;
  1723. begin
  1724. if (ref.base = NR_NO) and
  1725. (ref.index <> NR_NO) then
  1726. internalerror(200208101);
  1727. result :=
  1728. not (assigned(ref.symbol)) and
  1729. (((ref.index = NR_NO) and
  1730. (ref.offset >= low(smallint)) and
  1731. (ref.offset <= high(smallint))) or
  1732. ((ref.index <> NR_NO) and
  1733. (ref.offset = 0)));
  1734. end;
  1735. function tcgppc.load_got_symbol(list: TAsmList; symbol : string) : tregister;
  1736. var
  1737. l: tasmsymbol;
  1738. ref: treference;
  1739. symname : string;
  1740. begin
  1741. l:=current_asmdata.getasmsymbol(symbol);
  1742. reference_reset_symbol(ref,l,0);
  1743. ref.base := NR_R2;
  1744. ref.refaddr := addr_pic;
  1745. result := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
  1746. {$IFDEF EXTDEBUG}
  1747. list.concat(tai_comment.create(strpnew('loading got reference for ' + symbol)));
  1748. {$ENDIF EXTDEBUG}
  1749. // cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,result);
  1750. list.concat(taicpu.op_reg_ref(A_LD, result, ref));
  1751. end;
  1752. function tcgppc.fixref(list: TAsmList; var ref: treference): boolean;
  1753. var
  1754. tmpreg: tregister;
  1755. name : string;
  1756. begin
  1757. result := false;
  1758. { Avoids recursion. }
  1759. if (ref.refaddr = addr_pic) then exit;
  1760. {$IFDEF EXTDEBUG}
  1761. list.concat(tai_comment.create(strpnew('fixref0 ' + ref2string(ref))));
  1762. {$ENDIF EXTDEBUG}
  1763. if (target_info.system = system_powerpc64_darwin) and
  1764. assigned(ref.symbol) and
  1765. (ref.symbol.bind = AB_EXTERNAL) then
  1766. begin
  1767. tmpreg := g_indirect_sym_load(list,ref.symbol.name);
  1768. if (ref.base = NR_NO) then
  1769. ref.base := tmpreg
  1770. else if (ref.index = NR_NO) then
  1771. ref.index := tmpreg
  1772. else
  1773. begin
  1774. list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg));
  1775. ref.base := tmpreg;
  1776. end;
  1777. ref.symbol := nil;
  1778. end;
  1779. { if we have to create PIC, add the symbol to the TOC/GOT }
  1780. if (target_info.system <> system_powerpc64_darwin) and
  1781. (cs_create_pic in current_settings.moduleswitches) and
  1782. (assigned(ref.symbol)) then begin
  1783. tmpreg := load_got_symbol(list, ref.symbol.name);
  1784. if (ref.base = NR_NO) then
  1785. ref.base := tmpreg
  1786. else if (ref.index = NR_NO) then
  1787. ref.index := tmpreg
  1788. else begin
  1789. a_op_reg_reg_reg(list, OP_ADD, OS_ADDR, ref.base, tmpreg, tmpreg);
  1790. ref.base := tmpreg;
  1791. end;
  1792. ref.symbol := nil;
  1793. {$IFDEF EXTDEBUG}
  1794. list.concat(tai_comment.create(strpnew('fixref-pic ' + ref2string(ref))));
  1795. {$ENDIF EXTDEBUG}
  1796. end;
  1797. if (ref.base = NR_NO) then begin
  1798. ref.base := ref.index;
  1799. ref.index := NR_NO;
  1800. end;
  1801. if (ref.base <> NR_NO) and (ref.index <> NR_NO) and
  1802. ((ref.offset <> 0) or assigned(ref.symbol)) then begin
  1803. result := true;
  1804. tmpreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
  1805. a_op_reg_reg_reg(list, OP_ADD, OS_ADDR, ref.base, ref.index, tmpreg);
  1806. ref.base := tmpreg;
  1807. ref.index := NR_NO;
  1808. end;
  1809. if (ref.index <> NR_NO) and (assigned(ref.symbol) or (ref.offset <> 0)) then
  1810. internalerror(2006010506);
  1811. {$IFDEF EXTDEBUG}
  1812. list.concat(tai_comment.create(strpnew('fixref1 ' + ref2string(ref))));
  1813. {$ENDIF EXTDEBUG}
  1814. end;
  1815. procedure tcgppc.a_load_store(list: TAsmList; op: tasmop; reg: tregister;
  1816. ref: treference);
  1817. procedure maybefixup64bitoffset;
  1818. var
  1819. tmpreg: tregister;
  1820. begin
  1821. { for some instructions we need to check that the offset is divisible by at
  1822. least four. If not, add the bytes which are "off" to the base register and
  1823. adjust the offset accordingly }
  1824. case op of
  1825. A_LD, A_LDU, A_STD, A_STDU, A_LWA :
  1826. if ((ref.offset mod 4) <> 0) then begin
  1827. tmpreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
  1828. if (ref.base <> NR_NO) then begin
  1829. a_op_const_reg_reg(list, OP_ADD, OS_ADDR, ref.offset mod 4, ref.base, tmpreg);
  1830. ref.base := tmpreg;
  1831. end else begin
  1832. list.concat(taicpu.op_reg_const(A_LI, tmpreg, ref.offset mod 4));
  1833. ref.base := tmpreg;
  1834. end;
  1835. ref.offset := (ref.offset div 4) * 4;
  1836. end;
  1837. end;
  1838. end;
  1839. var
  1840. tmpreg, tmpreg2: tregister;
  1841. tmpref: treference;
  1842. largeOffset: Boolean;
  1843. begin
  1844. if (target_info.system = system_powerpc64_darwin) then
  1845. begin
  1846. { darwin/ppc64 works with 32 bit relocatable symbol addresses }
  1847. maybefixup64bitoffset;
  1848. inherited a_load_store(list,op,reg,ref);
  1849. exit
  1850. end;
  1851. { at this point there must not be a combination of values in the ref treference
  1852. which is not possible to directly map to instructions of the PowerPC architecture }
  1853. if (ref.index <> NR_NO) and ((ref.offset <> 0) or (assigned(ref.symbol))) then
  1854. internalerror(200310131);
  1855. { if this is a PIC'ed address, handle it and exit }
  1856. if (ref.refaddr = addr_pic) then begin
  1857. if (ref.offset <> 0) then
  1858. internalerror(2006010501);
  1859. if (ref.index <> NR_NO) then
  1860. internalerror(2006010502);
  1861. if (not assigned(ref.symbol)) then
  1862. internalerror(200601050);
  1863. list.concat(taicpu.op_reg_ref(op, reg, ref));
  1864. exit;
  1865. end;
  1866. maybefixup64bitoffset;
  1867. {$IFDEF EXTDEBUG}
  1868. list.concat(tai_comment.create(strpnew('a_load_store1 ' + BoolToStr(ref.refaddr = addr_pic))));
  1869. {$ENDIF EXTDEBUG}
  1870. { if we have to load/store from a symbol or large addresses, use a temporary register
  1871. containing the address }
  1872. if (assigned(ref.symbol) or (hasLargeOffset(ref))) then begin
  1873. tmpreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
  1874. if (hasLargeOffset(ref) and (ref.base = NR_NO)) then begin
  1875. ref.base := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
  1876. a_load_const_reg(list, OS_ADDR, ref.offset, ref.base);
  1877. ref.offset := 0;
  1878. end;
  1879. reference_reset(tmpref);
  1880. tmpref.symbol := ref.symbol;
  1881. tmpref.relsymbol := ref.relsymbol;
  1882. tmpref.offset := ref.offset;
  1883. if (ref.base <> NR_NO) then begin
  1884. { As long as the TOC isn't working we try to achieve highest speed (in this
  1885. case by allowing instructions execute in parallel) as possible at the cost
  1886. of using another temporary register. So the code template when there is
  1887. a base register and an offset is the following:
  1888. lis rT1, SYM+offs@highest
  1889. ori rT1, rT1, SYM+offs@higher
  1890. lis rT2, SYM+offs@hi
  1891. ori rT2, SYM+offs@lo
  1892. rldimi rT2, rT1, 32
  1893. <op>X reg, base, rT2
  1894. }
  1895. tmpreg2 := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
  1896. if (assigned(tmpref.symbol)) then begin
  1897. tmpref.refaddr := addr_highest;
  1898. list.concat(taicpu.op_reg_ref(A_LIS, tmpreg, tmpref));
  1899. tmpref.refaddr := addr_higher;
  1900. list.concat(taicpu.op_reg_reg_ref(A_ORI, tmpreg, tmpreg, tmpref));
  1901. tmpref.refaddr := addr_high;
  1902. list.concat(taicpu.op_reg_ref(A_LIS, tmpreg2, tmpref));
  1903. tmpref.refaddr := addr_low;
  1904. list.concat(taicpu.op_reg_reg_ref(A_ORI, tmpreg2, tmpreg2, tmpref));
  1905. list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, tmpreg2, tmpreg, 32, 0));
  1906. end else
  1907. a_load_const_reg(list, OS_ADDR, tmpref.offset, tmpreg2);
  1908. reference_reset(tmpref);
  1909. tmpref.base := ref.base;
  1910. tmpref.index := tmpreg2;
  1911. case op of
  1912. { the code generator doesn't generate update instructions anyway, so
  1913. error out on those instructions }
  1914. A_LBZ : op := A_LBZX;
  1915. A_LHZ : op := A_LHZX;
  1916. A_LWZ : op := A_LWZX;
  1917. A_LD : op := A_LDX;
  1918. A_LHA : op := A_LHAX;
  1919. A_LWA : op := A_LWAX;
  1920. A_LFS : op := A_LFSX;
  1921. A_LFD : op := A_LFDX;
  1922. A_STB : op := A_STBX;
  1923. A_STH : op := A_STHX;
  1924. A_STW : op := A_STWX;
  1925. A_STD : op := A_STDX;
  1926. A_STFS : op := A_STFSX;
  1927. A_STFD : op := A_STFDX;
  1928. else
  1929. { unknown load/store opcode }
  1930. internalerror(2005101302);
  1931. end;
  1932. list.concat(taicpu.op_reg_ref(op, reg, tmpref));
  1933. end else begin
  1934. { when accessing value from a reference without a base register, use the
  1935. following code template:
  1936. lis rT,SYM+offs@highesta
  1937. ori rT,SYM+offs@highera
  1938. sldi rT,rT,32
  1939. oris rT,rT,SYM+offs@ha
  1940. ld rD,SYM+offs@l(rT)
  1941. }
  1942. tmpref.refaddr := addr_highesta;
  1943. list.concat(taicpu.op_reg_ref(A_LIS, tmpreg, tmpref));
  1944. tmpref.refaddr := addr_highera;
  1945. list.concat(taicpu.op_reg_reg_ref(A_ORI, tmpreg, tmpreg, tmpref));
  1946. list.concat(taicpu.op_reg_reg_const(A_SLDI, tmpreg, tmpreg, 32));
  1947. tmpref.refaddr := addr_higha;
  1948. list.concat(taicpu.op_reg_reg_ref(A_ORIS, tmpreg, tmpreg, tmpref));
  1949. tmpref.base := tmpreg;
  1950. tmpref.refaddr := addr_low;
  1951. list.concat(taicpu.op_reg_ref(op, reg, tmpref));
  1952. end;
  1953. end else begin
  1954. list.concat(taicpu.op_reg_ref(op, reg, ref));
  1955. end;
  1956. end;
  1957. procedure tcgppc.loadConstantPIC(list : TAsmList; size : TCGSize; a : aint; reg : TRegister);
  1958. var
  1959. l: tasmsymbol;
  1960. ref: treference;
  1961. symname : string;
  1962. begin
  1963. maybe_new_object_file(current_asmdata.asmlists[al_picdata]);
  1964. symname := '_$' + current_asmdata.name + '$toc$' + hexstr(a, sizeof(a)*2);
  1965. l:=current_asmdata.getasmsymbol(symname);
  1966. if not(assigned(l)) then begin
  1967. l:=current_asmdata.DefineAsmSymbol(symname,AB_GLOBAL, AT_DATA);
  1968. current_asmdata.asmlists[al_picdata].concat(tai_section.create(sec_toc, '.toc', 8));
  1969. current_asmdata.asmlists[al_picdata].concat(tai_symbol.create_global(l,0));
  1970. current_asmdata.asmlists[al_picdata].concat(tai_directive.create(asd_toc_entry, symname + '[TC], ' + inttostr(a)));
  1971. end;
  1972. reference_reset_symbol(ref,l,0);
  1973. ref.base := NR_R2;
  1974. ref.refaddr := addr_no;
  1975. {$IFDEF EXTDEBUG}
  1976. list.concat(tai_comment.create(strpnew('loading value from TOC reference for ' + symname)));
  1977. {$ENDIF EXTDEBUG}
  1978. cg.a_load_ref_reg(list, OS_INT, OS_INT, ref, reg);
  1979. end;
  1980. begin
  1981. cg := tcgppc.create;
  1982. end.