cgcpu.pas 85 KB

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