cgppc.pas 35 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945
  1. {
  2. Copyright (c) 2006 by Florian Klaempfl
  3. This unit implements the common part of 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 cgppc;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. globtype,symtype,symdef,
  22. cgbase,cgobj,
  23. aasmbase,aasmcpu,aasmtai,aasmdata,
  24. cpubase,cpuinfo,cgutils,rgcpu,
  25. parabase;
  26. type
  27. tcgppcgen = class(tcg)
  28. procedure a_load_const_cgpara(list: TAsmList; size: tcgsize; a: tcgint; const paraloc : tcgpara); override;
  29. procedure a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const paraloc : tcgpara); override;
  30. procedure a_call_reg(list : TAsmList;reg: tregister); override;
  31. { stores the contents of register reg to the memory location described by
  32. ref }
  33. procedure a_load_reg_ref(list: TAsmList; fromsize, tosize: TCGSize;
  34. reg: tregister; const ref: treference); override;
  35. procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);override;
  36. { fpu move instructions }
  37. procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); override;
  38. procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); override;
  39. procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); override;
  40. { overflow checking }
  41. procedure g_overflowcheck(list: TAsmList; const l: tlocation; def: tdef);override;
  42. { entry code }
  43. procedure g_profilecode(list: TAsmList); override;
  44. procedure a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel);
  45. procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
  46. procedure g_maybe_got_init(list: TAsmList); override;
  47. protected
  48. function get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
  49. procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); override;
  50. { Make sure ref is a valid reference for the PowerPC and sets the }
  51. { base to the value of the index if (base = R_NO). }
  52. { Returns true if the reference contained a base, index and an }
  53. { offset or symbol, in which case the base will have been changed }
  54. { to a tempreg (which has to be freed by the caller) containing }
  55. { the sum of part of the original reference }
  56. function fixref(list: TAsmList; var ref: treference): boolean;
  57. { contains the common code of a_load_reg_ref and a_load_ref_reg }
  58. procedure a_load_store(list:TAsmList;op: tasmop;reg:tregister;ref: treference);virtual;
  59. { creates the correct branch instruction for a given combination }
  60. { of asmcondflags and destination addressing mode }
  61. procedure a_jmp(list: TAsmList; op: tasmop;
  62. c: tasmcondflag; crval: longint; l: tasmlabel);
  63. { returns true if the offset of the given reference can not be }
  64. { represented by a 16 bit immediate as required by some PowerPC }
  65. { instructions }
  66. function hasLargeOffset(const ref : TReference) : Boolean; inline;
  67. function save_lr_in_prologue: boolean;
  68. function load_got_symbol(list : TAsmList; symbol : string) : tregister;
  69. end;
  70. const
  71. TOpCmp2AsmCond: Array[topcmp] of TAsmCondFlag = (C_NONE,C_EQ,C_GT,
  72. C_LT,C_GE,C_LE,C_NE,C_LE,C_LT,C_GE,C_GT);
  73. {$ifdef extdebug}
  74. function ref2string(const ref : treference) : string;
  75. function cgsize2string(const size : TCgSize) : string;
  76. function cgop2string(const op : TOpCg) : String;
  77. {$endif extdebug}
  78. implementation
  79. uses
  80. {$ifdef extdebug}sysutils,{$endif}
  81. globals,verbose,systems,cutils,
  82. symconst,symsym,fmodule,
  83. rgobj,tgobj,cpupi,procinfo,paramgr;
  84. {$ifdef extdebug}
  85. function ref2string(const ref : treference) : string;
  86. begin
  87. result := 'base : ' + inttostr(ord(ref.base)) + ' index : ' + inttostr(ord(ref.index)) + ' refaddr : ' + inttostr(ord(ref.refaddr)) + ' offset : ' + inttostr(ref.offset) + ' symbol : ';
  88. if (assigned(ref.symbol)) then
  89. result := result + ref.symbol.name;
  90. end;
  91. function cgsize2string(const size : TCgSize) : string;
  92. const
  93. cgsize_strings : array[TCgSize] of string[8] = (
  94. 'OS_NO', 'OS_8', 'OS_16', 'OS_32', 'OS_64', 'OS_128', 'OS_S8', 'OS_S16', 'OS_S32',
  95. 'OS_S64', 'OS_S128', 'OS_F32', 'OS_F64', 'OS_F80', 'OS_C64', 'OS_F128',
  96. 'OS_M8', 'OS_M16', 'OS_M32', 'OS_M64', 'OS_M128', 'OS_MS8', 'OS_MS16', 'OS_MS32',
  97. 'OS_MS64', 'OS_MS128');
  98. begin
  99. result := cgsize_strings[size];
  100. end;
  101. function cgop2string(const op : TOpCg) : String;
  102. const
  103. opcg_strings : array[TOpCg] of string[6] = (
  104. 'None', 'Move', 'Add', 'And', 'Div', 'IDiv', 'IMul', 'Mul',
  105. 'Neg', 'Not', 'Or', 'Sar', 'Shl', 'Shr', 'Sub', 'Xor', 'Rol', 'Ror'
  106. );
  107. begin
  108. result := opcg_strings[op];
  109. end;
  110. {$endif extdebug}
  111. function tcgppcgen.hasLargeOffset(const ref : TReference) : Boolean;
  112. begin
  113. result := aword(ref.offset-low(smallint)) > high(smallint)-low(smallint);
  114. end;
  115. function tcgppcgen.save_lr_in_prologue: boolean;
  116. begin
  117. result:=
  118. (not (po_assembler in current_procinfo.procdef.procoptions) and
  119. ((pi_do_call in current_procinfo.flags) or
  120. (cs_profile in init_settings.moduleswitches))) or
  121. ([cs_lineinfo,cs_debuginfo] * current_settings.moduleswitches <> []);
  122. end;
  123. procedure tcgppcgen.a_load_const_cgpara(list: TAsmList; size: tcgsize; a: tcgint; const
  124. paraloc: tcgpara);
  125. var
  126. ref: treference;
  127. begin
  128. paraloc.check_simple_location;
  129. paramanager.allocparaloc(list,paraloc.location);
  130. case paraloc.location^.loc of
  131. LOC_REGISTER, LOC_CREGISTER:
  132. a_load_const_reg(list, size, a, paraloc.location^.register);
  133. LOC_REFERENCE:
  134. begin
  135. reference_reset(ref,paraloc.alignment);
  136. ref.base := paraloc.location^.reference.index;
  137. ref.offset := paraloc.location^.reference.offset;
  138. a_load_const_ref(list, size, a, ref);
  139. end;
  140. else
  141. internalerror(2002081101);
  142. end;
  143. end;
  144. procedure tcgppcgen.a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const paraloc : tcgpara);
  145. var
  146. ref: treference;
  147. tmpreg: tregister;
  148. begin
  149. paraloc.check_simple_location;
  150. paramanager.allocparaloc(list,paraloc.location);
  151. case paraloc.location^.loc of
  152. LOC_REGISTER,LOC_CREGISTER:
  153. a_loadaddr_ref_reg(list,r,paraloc.location^.register);
  154. LOC_REFERENCE:
  155. begin
  156. reference_reset(ref,paraloc.alignment);
  157. ref.base := paraloc.location^.reference.index;
  158. ref.offset := paraloc.location^.reference.offset;
  159. tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE);
  160. a_loadaddr_ref_reg(list,r,tmpreg);
  161. a_load_reg_ref(list,OS_ADDR,OS_ADDR,tmpreg,ref);
  162. end;
  163. else
  164. internalerror(2002080701);
  165. end;
  166. end;
  167. procedure tcgppcgen.g_maybe_got_init(list: TAsmList);
  168. var
  169. instr: taicpu;
  170. cond: tasmcond;
  171. savedlr: boolean;
  172. begin
  173. if not(po_assembler in current_procinfo.procdef.procoptions) then
  174. begin
  175. if (cs_create_pic in current_settings.moduleswitches) and
  176. (pi_needs_got in current_procinfo.flags) then
  177. case target_info.system of
  178. system_powerpc_darwin,
  179. system_powerpc64_darwin:
  180. begin
  181. savedlr:=save_lr_in_prologue;
  182. if not savedlr then
  183. list.concat(taicpu.op_reg_reg(A_MFSPR,NR_R0,NR_LR));
  184. fillchar(cond,sizeof(cond),0);
  185. cond.simple:=false;
  186. cond.bo:=20;
  187. cond.bi:=31;
  188. instr:=taicpu.op_sym(A_BCL,current_procinfo.CurrGOTLabel);
  189. instr.setcondition(cond);
  190. list.concat(instr);
  191. a_label(list,current_procinfo.CurrGOTLabel);
  192. a_reg_alloc(list,current_procinfo.got);
  193. list.concat(taicpu.op_reg_reg(A_MFSPR,current_procinfo.got,NR_LR));
  194. if not savedlr or
  195. { in the following case lr is saved, but not restored }
  196. { (happens e.g. when generating debug info for leaf }
  197. { procedures) }
  198. not(pi_do_call in current_procinfo.flags) then
  199. list.concat(taicpu.op_reg_reg(A_MTSPR,NR_LR,NR_R0));
  200. end;
  201. end;
  202. end;
  203. end;
  204. function tcgppcgen.get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
  205. var
  206. stubname: string;
  207. instr: taicpu;
  208. href: treference;
  209. l1: tasmsymbol;
  210. localgotlab: tasmlabel;
  211. cond: tasmcond;
  212. stubalign: byte;
  213. begin
  214. { function declared in the current unit? }
  215. { doesn't work correctly, because this will also return a hit if we }
  216. { previously took the address of an external procedure. It doesn't }
  217. { really matter, the linker will remove all unnecessary stubs. }
  218. stubname := 'L'+s+'$stub';
  219. result := current_asmdata.getasmsymbol(stubname);
  220. if assigned(result) then
  221. exit;
  222. if current_asmdata.asmlists[al_imports]=nil then
  223. current_asmdata.asmlists[al_imports]:=TAsmList.create;
  224. if (cs_create_pic in current_settings.moduleswitches) then
  225. stubalign:=32
  226. else
  227. stubalign:=16;
  228. new_section(current_asmdata.asmlists[al_imports],sec_stub,'',stubalign);
  229. result := current_asmdata.RefAsmSymbol(stubname);
  230. current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(result,0));
  231. { register as a weak symbol if necessary }
  232. if weak then
  233. current_asmdata.weakrefasmsymbol(s);
  234. current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s));
  235. l1 := current_asmdata.RefAsmSymbol('L'+s+'$lazy_ptr');
  236. reference_reset_symbol(href,l1,0,sizeof(pint));
  237. href.refaddr := addr_higha;
  238. if (cs_create_pic in current_settings.moduleswitches) then
  239. begin
  240. current_asmdata.getjumplabel(localgotlab);
  241. href.relsymbol:=localgotlab;
  242. fillchar(cond,sizeof(cond),0);
  243. cond.simple:=false;
  244. cond.bo:=20;
  245. cond.bi:=31;
  246. current_asmdata.asmlists[al_imports].concat(taicpu.op_reg(A_MFLR,NR_R0));
  247. instr:=taicpu.op_sym(A_BCL,localgotlab);
  248. instr.setcondition(cond);
  249. current_asmdata.asmlists[al_imports].concat(instr);
  250. a_label(current_asmdata.asmlists[al_imports],localgotlab);
  251. current_asmdata.asmlists[al_imports].concat(taicpu.op_reg(A_MFLR,NR_R11));
  252. current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_reg_ref(A_ADDIS,NR_R11,NR_R11,href));
  253. current_asmdata.asmlists[al_imports].concat(taicpu.op_reg(A_MTLR,NR_R0));
  254. end
  255. else
  256. current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_ref(A_LIS,NR_R11,href));
  257. href.refaddr := addr_low;
  258. href.base := NR_R11;
  259. {$ifndef cpu64bitaddr}
  260. current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_ref(A_LWZU,NR_R12,href));
  261. {$else cpu64bitaddr}
  262. { darwin/ppc64 uses a 32 bit absolute address here, strange... }
  263. current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_ref(A_LDU,NR_R12,href));
  264. {$endif cpu64bitaddr}
  265. current_asmdata.asmlists[al_imports].concat(taicpu.op_reg(A_MTCTR,NR_R12));
  266. current_asmdata.asmlists[al_imports].concat(taicpu.op_none(A_BCTR));
  267. new_section(current_asmdata.asmlists[al_imports],sec_data_lazy,'',sizeof(pint));
  268. current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(l1,0));
  269. current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s));
  270. current_asmdata.asmlists[al_imports].concat(tai_const.createname('dyld_stub_binding_helper',0));
  271. end;
  272. procedure tcgppcgen.a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);
  273. var
  274. ref2, tmpref: treference;
  275. begin
  276. ref2 := ref;
  277. fixref(list,ref2);
  278. if assigned(ref2.symbol) then
  279. begin
  280. if target_info.system = system_powerpc_macos then
  281. begin
  282. if macos_direct_globals then
  283. begin
  284. reference_reset(tmpref,ref2.alignment);
  285. tmpref.offset := ref2.offset;
  286. tmpref.symbol := ref2.symbol;
  287. tmpref.base := NR_NO;
  288. list.concat(taicpu.op_reg_reg_ref(A_ADDI,r,NR_RTOC,tmpref));
  289. end
  290. else
  291. begin
  292. reference_reset(tmpref,ref2.alignment);
  293. tmpref.symbol := ref2.symbol;
  294. tmpref.offset := 0;
  295. tmpref.base := NR_RTOC;
  296. list.concat(taicpu.op_reg_ref(A_LWZ,r,tmpref));
  297. if ref2.offset <> 0 then
  298. begin
  299. reference_reset(tmpref,ref2.alignment);
  300. tmpref.offset := ref2.offset;
  301. tmpref.base:= r;
  302. list.concat(taicpu.op_reg_ref(A_LA,r,tmpref));
  303. end;
  304. end;
  305. if ref2.base <> NR_NO then
  306. list.concat(taicpu.op_reg_reg_reg(A_ADD,r,r,ref2.base));
  307. //list.concat(tai_comment.create(strpnew('*** a_loadaddr_ref_reg')));
  308. end
  309. else
  310. begin
  311. { add the symbol's value to the base of the reference, and if the }
  312. { reference doesn't have a base, create one }
  313. reference_reset(tmpref,ref2.alignment);
  314. tmpref.offset := ref2.offset;
  315. tmpref.symbol := ref2.symbol;
  316. tmpref.relsymbol := ref2.relsymbol;
  317. tmpref.refaddr := addr_higha;
  318. if ref2.base<> NR_NO then
  319. begin
  320. list.concat(taicpu.op_reg_reg_ref(A_ADDIS,r,
  321. ref2.base,tmpref));
  322. end
  323. else
  324. list.concat(taicpu.op_reg_ref(A_LIS,r,tmpref));
  325. tmpref.base := NR_NO;
  326. tmpref.refaddr := addr_low;
  327. { can be folded with one of the next instructions by the }
  328. { optimizer probably }
  329. list.concat(taicpu.op_reg_reg_ref(A_ADDI,r,r,tmpref));
  330. end
  331. end
  332. else if ref2.offset <> 0 Then
  333. if ref2.base <> NR_NO then
  334. a_op_const_reg_reg(list,OP_ADD,OS_ADDR,ref2.offset,ref2.base,r)
  335. { FixRef makes sure that "(ref.index <> R_NO) and (ref.offset <> 0)" never}
  336. { occurs, so now only ref.offset has to be loaded }
  337. else
  338. a_load_const_reg(list,OS_ADDR,ref2.offset,r)
  339. else if ref2.index <> NR_NO Then
  340. list.concat(taicpu.op_reg_reg_reg(A_ADD,r,ref2.base,ref2.index))
  341. else if (ref2.base <> NR_NO) and
  342. (r <> ref2.base) then
  343. a_load_reg_reg(list,OS_ADDR,OS_ADDR,ref2.base,r)
  344. else
  345. list.concat(taicpu.op_reg_const(A_LI,r,0));
  346. end;
  347. { calling a procedure by address }
  348. procedure tcgppcgen.a_call_reg(list : TAsmList;reg: tregister);
  349. begin
  350. list.concat(taicpu.op_reg(A_MTCTR,reg));
  351. list.concat(taicpu.op_none(A_BCTRL));
  352. include(current_procinfo.flags,pi_do_call);
  353. end;
  354. procedure tcgppcgen.a_load_reg_ref(list: TAsmList; fromsize, tosize: TCGSize;
  355. reg: tregister; const ref: treference);
  356. const
  357. StoreInstr: array[OS_8..OS_INT, boolean, boolean] of TAsmOp =
  358. { indexed? updating?}
  359. (((A_STB, A_STBU), (A_STBX, A_STBUX)),
  360. ((A_STH, A_STHU), (A_STHX, A_STHUX)),
  361. ((A_STW, A_STWU), (A_STWX, A_STWUX))
  362. {$ifdef cpu64bitalu}
  363. ,
  364. ((A_STD, A_STDU), (A_STDX, A_STDUX))
  365. {$endif cpu64bitalu}
  366. );
  367. var
  368. ref2: TReference;
  369. tmpreg: tregister;
  370. op: TAsmOp;
  371. begin
  372. if not (fromsize in [OS_8..OS_INT,OS_S8..OS_SINT]) then
  373. internalerror(2002090904);
  374. if not (tosize in [OS_8..OS_INT,OS_S8..OS_SINT]) then
  375. internalerror(2002090905);
  376. if tosize in [OS_S8..OS_SINT] then
  377. { storing is the same for signed and unsigned values }
  378. tosize := tcgsize(ord(tosize) - (ord(OS_S8) - ord(OS_8)));
  379. ref2 := ref;
  380. fixref(list, ref2);
  381. op := storeinstr[tcgsize2unsigned[tosize], ref2.index <> NR_NO, false];
  382. a_load_store(list, op, reg, ref2);
  383. end;
  384. procedure tcgppcgen.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister);
  385. var
  386. op: tasmop;
  387. instr: taicpu;
  388. begin
  389. if not(fromsize in [OS_F32,OS_F64]) or
  390. not(tosize in [OS_F32,OS_F64]) then
  391. internalerror(2006123110);
  392. if (tosize < fromsize) then
  393. op:=A_FRSP
  394. else
  395. op:=A_FMR;
  396. instr := taicpu.op_reg_reg(op,reg2,reg1);
  397. list.concat(instr);
  398. if (op = A_FMR) then
  399. rg[R_FPUREGISTER].add_move_instruction(instr);
  400. end;
  401. procedure tcgppcgen.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister);
  402. const
  403. FpuLoadInstr: Array[OS_F32..OS_F64,boolean, boolean] of TAsmOp =
  404. { indexed? updating?}
  405. (((A_LFS,A_LFSU),(A_LFSX,A_LFSUX)),
  406. ((A_LFD,A_LFDU),(A_LFDX,A_LFDUX)));
  407. var
  408. op: tasmop;
  409. ref2: treference;
  410. begin
  411. if not(fromsize in [OS_F32,OS_F64]) or
  412. not(tosize in [OS_F32,OS_F64]) then
  413. internalerror(200201121);
  414. ref2 := ref;
  415. fixref(list,ref2);
  416. op := fpuloadinstr[fromsize,ref2.index <> NR_NO,false];
  417. a_load_store(list,op,reg,ref2);
  418. if (fromsize > tosize) then
  419. a_loadfpu_reg_reg(list,fromsize,tosize,reg,reg);
  420. end;
  421. procedure tcgppcgen.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference);
  422. const
  423. FpuStoreInstr: Array[OS_F32..OS_F64,boolean, boolean] of TAsmOp =
  424. { indexed? updating?}
  425. (((A_STFS,A_STFSU),(A_STFSX,A_STFSUX)),
  426. ((A_STFD,A_STFDU),(A_STFDX,A_STFDUX)));
  427. var
  428. op: tasmop;
  429. ref2: treference;
  430. reg2: tregister;
  431. begin
  432. if not(fromsize in [OS_F32,OS_F64]) or
  433. not(tosize in [OS_F32,OS_F64]) then
  434. internalerror(200201122);
  435. ref2 := ref;
  436. fixref(list,ref2);
  437. op := fpustoreinstr[tosize,ref2.index <> NR_NO,false];
  438. { some PPCs have a bug whereby storing a double to memory }
  439. { as single corrupts the value -> convert double to single }
  440. { first (bug confirmed on some G4s, but not on G5s) }
  441. if (tosize < fromsize) and
  442. (current_settings.cputype < cpu_PPC970) then
  443. begin
  444. reg2:=getfpuregister(list,tosize);
  445. a_loadfpu_reg_reg(list,fromsize,tosize,reg,reg2);
  446. reg:=reg2;
  447. end;
  448. a_load_store(list,op,reg,ref2);
  449. end;
  450. procedure tcgppcgen.a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister);
  451. var
  452. fromsreg, tosreg: tsubsetregister;
  453. restbits: byte;
  454. begin
  455. restbits := (sref.bitlen - (loadbitsize - sref.startbit));
  456. if (subsetsize in [OS_S8..OS_S128]) then
  457. begin
  458. { sign extend }
  459. a_op_const_reg(list,OP_SHL,OS_INT,AIntBits-loadbitsize+sref.startbit,valuereg);
  460. a_op_const_reg(list,OP_SAR,OS_INT,AIntBits-sref.bitlen,valuereg);
  461. end
  462. else
  463. begin
  464. a_op_const_reg(list,OP_SHL,OS_INT,restbits,valuereg);
  465. { mask other bits }
  466. if (sref.bitlen <> AIntBits) then
  467. a_op_const_reg(list,OP_AND,OS_INT,(aword(1) shl sref.bitlen)-1,valuereg);
  468. end;
  469. { use subsetreg routine, it may have been overridden with an optimized version }
  470. fromsreg.subsetreg := extra_value_reg;
  471. fromsreg.subsetregsize := OS_INT;
  472. { subsetregs always count bits from right to left }
  473. fromsreg.startbit := loadbitsize-restbits;
  474. fromsreg.bitlen := restbits;
  475. tosreg.subsetreg := valuereg;
  476. tosreg.subsetregsize := OS_INT;
  477. tosreg.startbit := 0;
  478. tosreg.bitlen := restbits;
  479. a_load_subsetreg_subsetreg(list,subsetsize,subsetsize,fromsreg,tosreg);
  480. end;
  481. procedure tcgppcgen.g_overflowcheck(list: TAsmList; const l: tlocation; def: tdef);
  482. var
  483. hl : tasmlabel;
  484. flags : TResFlags;
  485. begin
  486. if not(cs_check_overflow in current_settings.localswitches) then
  487. exit;
  488. current_asmdata.getjumplabel(hl);
  489. if not ((def.typ=pointerdef) or
  490. ((def.typ=orddef) and
  491. (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
  492. pasbool8,pasbool16,pasbool32,pasbool64]))) then
  493. begin
  494. if (current_settings.optimizecputype >= cpu_ppc970) or
  495. (current_settings.cputype >= cpu_ppc970) then
  496. begin
  497. { ... instructions setting overflow flag ...
  498. mfxerf R0
  499. mtcrf 128, R0
  500. ble cr0, label }
  501. list.concat(taicpu.op_reg(A_MFXER, NR_R0));
  502. list.concat(taicpu.op_const_reg(A_MTCRF, 128, NR_R0));
  503. flags.cr := RS_CR0;
  504. flags.flag := F_LE;
  505. a_jmp_flags(list, flags, hl);
  506. end
  507. else
  508. begin
  509. list.concat(taicpu.op_reg(A_MCRXR,NR_CR7));
  510. a_jmp(list,A_BC,C_NO,7,hl)
  511. end;
  512. end
  513. else
  514. a_jmp_cond(list,OC_AE,hl);
  515. a_call_name(list,'FPC_OVERFLOW',false);
  516. a_label(list,hl);
  517. end;
  518. procedure tcgppcgen.g_profilecode(list: TAsmList);
  519. var
  520. paraloc1 : tcgpara;
  521. begin
  522. if (target_info.system in [system_powerpc_darwin]) then
  523. begin
  524. paraloc1.init;
  525. paramanager.getintparaloc(pocall_cdecl,1,paraloc1);
  526. a_load_reg_cgpara(list,OS_ADDR,NR_R0,paraloc1);
  527. paramanager.freecgpara(list,paraloc1);
  528. paraloc1.done;
  529. allocallcpuregisters(list);
  530. a_call_name(list,'mcount',false);
  531. deallocallcpuregisters(list);
  532. a_reg_dealloc(list,NR_R0);
  533. end;
  534. end;
  535. procedure tcgppcgen.a_jmp_cond(list : TAsmList;cond : TOpCmp; l: tasmlabel);
  536. begin
  537. a_jmp(list,A_BC,TOpCmp2AsmCond[cond],0,l);
  538. end;
  539. procedure tcgppcgen.a_jmp(list: TAsmList; op: tasmop; c: tasmcondflag;
  540. crval: longint; l: tasmlabel);
  541. var
  542. p: taicpu;
  543. begin
  544. p := taicpu.op_sym(op,l);
  545. if op <> A_B then
  546. create_cond_norm(c,crval,p.condition);
  547. p.is_jmp := true;
  548. list.concat(p)
  549. end;
  550. procedure tcgppcgen.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
  551. procedure loadvmttor11;
  552. var
  553. href : treference;
  554. begin
  555. reference_reset_base(href,NR_R3,0,sizeof(pint));
  556. cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R11);
  557. end;
  558. procedure op_onr11methodaddr;
  559. var
  560. href : treference;
  561. begin
  562. if (procdef.extnumber=$ffff) then
  563. Internalerror(200006139);
  564. { call/jmp vmtoffs(%eax) ; method offs }
  565. reference_reset_base(href,NR_R11,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
  566. if hasLargeOffset(href) then
  567. begin
  568. {$ifdef cpu64}
  569. if (longint(href.offset) <> href.offset) then
  570. { add support for offsets > 32 bit }
  571. internalerror(200510201);
  572. {$endif cpu64}
  573. list.concat(taicpu.op_reg_reg_const(A_ADDIS,NR_R11,NR_R11,
  574. smallint((href.offset shr 16)+ord(smallint(href.offset and $ffff) < 0))));
  575. href.offset := smallint(href.offset and $ffff);
  576. end;
  577. a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R11);
  578. if (target_info.system = system_powerpc64_linux) then
  579. begin
  580. reference_reset_base(href, NR_R11, 0, sizeof(pint));
  581. a_load_ref_reg(list, OS_ADDR, OS_ADDR, href, NR_R11);
  582. end;
  583. list.concat(taicpu.op_reg(A_MTCTR,NR_R11));
  584. list.concat(taicpu.op_none(A_BCTR));
  585. if (target_info.system = system_powerpc64_linux) then
  586. list.concat(taicpu.op_none(A_NOP));
  587. end;
  588. var
  589. make_global : boolean;
  590. begin
  591. if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
  592. Internalerror(200006137);
  593. if not assigned(procdef.struct) or
  594. (procdef.procoptions*[po_classmethod, po_staticmethod,
  595. po_methodpointer, po_interrupt, po_iocheck]<>[]) then
  596. Internalerror(200006138);
  597. if procdef.owner.symtabletype<>ObjectSymtable then
  598. Internalerror(200109191);
  599. make_global:=false;
  600. if (not current_module.is_unit) or
  601. create_smartlink or
  602. (procdef.owner.defowner.owner.symtabletype=globalsymtable) then
  603. make_global:=true;
  604. if make_global then
  605. List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
  606. else
  607. List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
  608. { set param1 interface to self }
  609. g_adjust_self_value(list,procdef,ioffset);
  610. { case 4 }
  611. if (po_virtualmethod in procdef.procoptions) and
  612. not is_objectpascal_helper(procdef.struct) then
  613. begin
  614. loadvmttor11;
  615. op_onr11methodaddr;
  616. end
  617. { case 0 }
  618. else
  619. case target_info.system of
  620. system_powerpc_darwin,
  621. system_powerpc64_darwin:
  622. list.concat(taicpu.op_sym(A_B,get_darwin_call_stub(procdef.mangledname,false)));
  623. system_powerpc64_linux:
  624. {$note ts:todo add GOT change?? - think not needed :) }
  625. list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol('.' + procdef.mangledname)));
  626. else
  627. list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(procdef.mangledname)))
  628. end;
  629. List.concat(Tai_symbol_end.Createname(labelname));
  630. end;
  631. function tcgppcgen.load_got_symbol(list: TAsmList; symbol : string) : tregister;
  632. var
  633. l: tasmsymbol;
  634. ref: treference;
  635. begin
  636. if (target_info.system <> system_powerpc64_linux) then
  637. internalerror(2007102010);
  638. l:=current_asmdata.getasmsymbol(symbol);
  639. reference_reset_symbol(ref,l,0,sizeof(pint));
  640. ref.base := NR_R2;
  641. ref.refaddr := addr_pic;
  642. result := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
  643. {$IFDEF EXTDEBUG}
  644. list.concat(tai_comment.create(strpnew('loading got reference for ' + symbol)));
  645. {$ENDIF EXTDEBUG}
  646. // cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,result);
  647. {$ifdef cpu64bitaddr}
  648. list.concat(taicpu.op_reg_ref(A_LD, result, ref));
  649. {$else cpu64bitaddr}
  650. list.concat(taicpu.op_reg_ref(A_LWZ, result, ref));
  651. {$endif cpu64bitaddr}
  652. end;
  653. function tcgppcgen.fixref(list: TAsmList; var ref: treference): boolean;
  654. var
  655. tmpreg: tregister;
  656. begin
  657. result := false;
  658. { Avoid recursion. }
  659. if (ref.refaddr = addr_pic) then
  660. exit;
  661. {$IFDEF EXTDEBUG}
  662. list.concat(tai_comment.create(strpnew('fixref0 ' + ref2string(ref))));
  663. {$ENDIF EXTDEBUG}
  664. if (target_info.system in [system_powerpc_darwin,system_powerpc64_darwin]) and
  665. assigned(ref.symbol) and
  666. not assigned(ref.relsymbol) and
  667. ((ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) or
  668. (cs_create_pic in current_settings.moduleswitches))then
  669. begin
  670. if (ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) or
  671. ((cs_create_pic in current_settings.moduleswitches) and
  672. (ref.symbol.bind in [AB_COMMON,AB_GLOBAL,AB_PRIVATE_EXTERN])) then
  673. begin
  674. tmpreg := g_indirect_sym_load(list,ref.symbol.name,ref.symbol.bind=AB_WEAK_EXTERNAL);
  675. ref.symbol:=nil;
  676. end
  677. else
  678. begin
  679. include(current_procinfo.flags,pi_needs_got);
  680. tmpreg := current_procinfo.got;
  681. if assigned(ref.relsymbol) then
  682. internalerror(2007093501);
  683. ref.relsymbol := current_procinfo.CurrGOTLabel;
  684. end;
  685. if (ref.base = NR_NO) then
  686. ref.base := tmpreg
  687. else if (ref.index = NR_NO) then
  688. ref.index := tmpreg
  689. else
  690. begin
  691. list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg));
  692. ref.base := tmpreg;
  693. end;
  694. end;
  695. { if we have to create PIC, add the symbol to the TOC/GOT }
  696. if (target_info.system = system_powerpc64_linux) and
  697. (cs_create_pic in current_settings.moduleswitches) and
  698. (assigned(ref.symbol)) then
  699. begin
  700. tmpreg := load_got_symbol(list, ref.symbol.name);
  701. if (ref.base = NR_NO) then
  702. ref.base := tmpreg
  703. else if (ref.index = NR_NO) then
  704. ref.index := tmpreg
  705. else begin
  706. a_op_reg_reg_reg(list, OP_ADD, OS_ADDR, ref.base, tmpreg, tmpreg);
  707. ref.base := tmpreg;
  708. end;
  709. ref.symbol := nil;
  710. {$IFDEF EXTDEBUG}
  711. list.concat(tai_comment.create(strpnew('fixref-pic ' + ref2string(ref))));
  712. {$ENDIF EXTDEBUG}
  713. end;
  714. if (ref.base = NR_NO) then
  715. begin
  716. ref.base := ref.index;
  717. ref.index := NR_NO;
  718. end;
  719. if (ref.base <> NR_NO) then
  720. begin
  721. if (ref.index <> NR_NO) and
  722. ((ref.offset <> 0) or assigned(ref.symbol)) then
  723. begin
  724. result := true;
  725. tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE);
  726. list.concat(taicpu.op_reg_reg_reg(
  727. A_ADD,tmpreg,ref.base,ref.index));
  728. ref.index := NR_NO;
  729. ref.base := tmpreg;
  730. end
  731. end;
  732. if (ref.index <> NR_NO) and
  733. (assigned(ref.symbol) or
  734. (ref.offset <> 0)) then
  735. internalerror(200208102);
  736. {$IFDEF EXTDEBUG}
  737. list.concat(tai_comment.create(strpnew('fixref1 ' + ref2string(ref))));
  738. {$ENDIF EXTDEBUG}
  739. end;
  740. procedure tcgppcgen.a_load_store(list:TAsmList;op: tasmop;reg:tregister;
  741. ref: treference);
  742. var
  743. tmpreg: tregister;
  744. tmpref: treference;
  745. largeOffset: Boolean;
  746. begin
  747. tmpreg := NR_NO;
  748. largeOffset:= hasLargeOffset(ref);
  749. if target_info.system = system_powerpc_macos then
  750. begin
  751. if assigned(ref.symbol) then
  752. begin {Load symbol's value}
  753. tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE);
  754. reference_reset(tmpref,sizeof(pint));
  755. tmpref.symbol := ref.symbol;
  756. tmpref.base := NR_RTOC;
  757. if macos_direct_globals then
  758. list.concat(taicpu.op_reg_ref(A_LA,tmpreg,tmpref))
  759. else
  760. list.concat(taicpu.op_reg_ref(A_LWZ,tmpreg,tmpref));
  761. end;
  762. if largeOffset then
  763. begin {Add hi part of offset}
  764. reference_reset(tmpref,ref.alignment);
  765. if Smallint(Lo(ref.offset)) < 0 then
  766. tmpref.offset := Hi(ref.offset) + 1 {Compensate when lo part is negative}
  767. else
  768. tmpref.offset := Hi(ref.offset);
  769. if (tmpreg <> NR_NO) then
  770. list.concat(taicpu.op_reg_reg_ref(A_ADDIS,tmpreg, tmpreg,tmpref))
  771. else
  772. begin
  773. tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE);
  774. list.concat(taicpu.op_reg_ref(A_LIS,tmpreg,tmpref));
  775. end;
  776. end;
  777. if (tmpreg <> NR_NO) then
  778. begin
  779. {Add content of base register}
  780. if ref.base <> NR_NO then
  781. list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,
  782. ref.base,tmpreg));
  783. {Make ref ready to be used by op}
  784. ref.symbol:= nil;
  785. ref.base:= tmpreg;
  786. if largeOffset then
  787. ref.offset := Smallint(Lo(ref.offset));
  788. list.concat(taicpu.op_reg_ref(op,reg,ref));
  789. //list.concat(tai_comment.create(strpnew('*** a_load_store indirect global')));
  790. end
  791. else
  792. list.concat(taicpu.op_reg_ref(op,reg,ref));
  793. end
  794. else {if target_info.system <> system_powerpc_macos}
  795. begin
  796. if assigned(ref.symbol) or
  797. largeOffset then
  798. begin
  799. tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE);
  800. reference_reset(tmpref,ref.alignment);
  801. tmpref.symbol := ref.symbol;
  802. tmpref.relsymbol := ref.relsymbol;
  803. tmpref.offset := ref.offset;
  804. tmpref.refaddr := addr_higha;
  805. if ref.base <> NR_NO then
  806. list.concat(taicpu.op_reg_reg_ref(A_ADDIS,tmpreg,
  807. ref.base,tmpref))
  808. else
  809. list.concat(taicpu.op_reg_ref(A_LIS,tmpreg,tmpref));
  810. ref.base := tmpreg;
  811. ref.refaddr := addr_low;
  812. list.concat(taicpu.op_reg_ref(op,reg,ref));
  813. end
  814. else
  815. list.concat(taicpu.op_reg_ref(op,reg,ref));
  816. end;
  817. end;
  818. end.