cgcpu.pas 84 KB

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