cgppc.pas 49 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274
  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. { Transform unsupported methods into Internal errors }
  48. procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); override;
  49. procedure g_stackpointer_alloc(list : TAsmList;localsize : longint);override;
  50. procedure get_aix_toc_sym(list: TAsmList; const symname: string; const flags: tindsymflags; out ref: treference; force_direct_toc: boolean);
  51. procedure g_load_check_simple(list: TAsmList; const ref: treference; size: aint);
  52. procedure g_external_wrapper(list: TAsmList; pd: TProcDef; const externalname: string); override;
  53. procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister); override;
  54. protected
  55. function g_indirect_sym_load(list:TAsmList;const symname: string; const flags: tindsymflags): tregister; override;
  56. function get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
  57. { Make sure ref is a valid reference for the PowerPC and sets the }
  58. { base to the value of the index if (base = R_NO). }
  59. { Returns true if the reference contained a base, index and an }
  60. { offset or symbol, in which case the base will have been changed }
  61. { to a tempreg (which has to be freed by the caller) containing }
  62. { the sum of part of the original reference }
  63. function fixref(list: TAsmList; var ref: treference): boolean;
  64. { contains the common code of a_load_reg_ref and a_load_ref_reg }
  65. procedure a_load_store(list:TAsmList;op: tasmop;reg:tregister;ref: treference);virtual;
  66. { creates the correct branch instruction for a given combination }
  67. { of asmcondflags and destination addressing mode }
  68. procedure a_jmp(list: TAsmList; op: tasmop;
  69. c: tasmcondflag; crval: longint; l: tasmlabel);
  70. { returns true if the offset of the given reference can not be }
  71. { represented by a 16 bit immediate as required by some PowerPC }
  72. { instructions }
  73. function hasLargeOffset(const ref : TReference) : Boolean; inline;
  74. function save_lr_in_prologue: boolean;
  75. function load_got_symbol(list : TAsmList; const symbol : string; const flags: tindsymflags) : tregister;
  76. end;
  77. TPPCAsmData = class(TAsmData)
  78. private
  79. { number of entries in the TOC }
  80. fdirecttocentries,
  81. { number of fake TOC subsections we have created }
  82. ftocsections,
  83. { number of fake TOC entries in the current TOC subsection }
  84. fcurrenttocentries: longint;
  85. public
  86. procedure GetNextSmallTocEntry(out tocnr, entrynr: longint);
  87. property DirectTOCEntries: longint read fdirecttocentries write fdirecttocentries;
  88. end;
  89. TTOCAsmSymbol = class(TAsmSymbol)
  90. private
  91. { we split the toc into several sections of 32KB each, this number
  92. indicates which subsection this symbol is defined in }
  93. ftocsecnr: longint;
  94. public
  95. property TocSecNr: longint read ftocsecnr;
  96. end;
  97. const
  98. TOpCmp2AsmCond: Array[topcmp] of TAsmCondFlag = (C_NONE,C_EQ,C_GT,
  99. C_LT,C_GE,C_LE,C_NE,C_LE,C_LT,C_GE,C_GT);
  100. TocSecBaseName = 'toc_table';
  101. {$ifdef extdebug}
  102. function ref2string(const ref : treference) : string;
  103. function cgsize2string(const size : TCgSize) : string;
  104. function cgop2string(const op : TOpCg) : String;
  105. {$endif extdebug}
  106. implementation
  107. uses
  108. {$ifdef extdebug}sysutils,{$endif}
  109. globals,verbose,systems,cutils,
  110. symconst,symsym,symtable,fmodule,
  111. rgobj,tgobj,cpupi,procinfo,paramgr;
  112. { We know that macos_direct_globals is a const boolean
  113. but we don't care about this warning }
  114. {$NOTE Is macos_direct_globals still useful?}
  115. {$WARN 6018 OFF}
  116. {$ifdef extdebug}
  117. function ref2string(const ref : treference) : string;
  118. begin
  119. result := 'base : ' + inttostr(ord(ref.base)) + ' index : ' + inttostr(ord(ref.index)) + ' refaddr : ' + inttostr(ord(ref.refaddr)) + ' offset : ' + inttostr(ref.offset) + ' symbol : ';
  120. if (assigned(ref.symbol)) then
  121. result := result + ref.symbol.name;
  122. end;
  123. function cgsize2string(const size : TCgSize) : string;
  124. const
  125. cgsize_strings : array[TCgSize] of string[8] = (
  126. 'OS_NO', 'OS_8', 'OS_16', 'OS_32', 'OS_64', 'OS_128', 'OS_S8', 'OS_S16', 'OS_S32',
  127. 'OS_S64', 'OS_S128', 'OS_F32', 'OS_F64', 'OS_F80', 'OS_C64', 'OS_F128',
  128. 'OS_M8', 'OS_M16', 'OS_M32', 'OS_M64', 'OS_M128', 'OS_M256', 'OS_MS8', 'OS_MS16', 'OS_MS32',
  129. 'OS_MS64', 'OS_MS128', 'OS_MS256');
  130. begin
  131. result := cgsize_strings[size];
  132. end;
  133. function cgop2string(const op : TOpCg) : String;
  134. const
  135. opcg_strings : array[TOpCg] of string[6] = (
  136. 'None', 'Move', 'Add', 'And', 'Div', 'IDiv', 'IMul', 'Mul',
  137. 'Neg', 'Not', 'Or', 'Sar', 'Shl', 'Shr', 'Sub', 'Xor', 'Rol', 'Ror'
  138. );
  139. begin
  140. result := opcg_strings[op];
  141. end;
  142. {$endif extdebug}
  143. function tcgppcgen.hasLargeOffset(const ref : TReference) : Boolean;
  144. begin
  145. result := aword(ref.offset-low(smallint)) > high(smallint)-low(smallint);
  146. end;
  147. function tcgppcgen.save_lr_in_prologue: boolean;
  148. begin
  149. result:=
  150. (not (po_assembler in current_procinfo.procdef.procoptions) and
  151. ((pi_do_call in current_procinfo.flags) or
  152. (cs_profile in init_settings.moduleswitches))) or
  153. ([cs_lineinfo,cs_debuginfo] * current_settings.moduleswitches <> []);
  154. end;
  155. procedure tcgppcgen.a_load_const_cgpara(list: TAsmList; size: tcgsize; a: tcgint; const
  156. paraloc: tcgpara);
  157. var
  158. ref: treference;
  159. begin
  160. paraloc.check_simple_location;
  161. paramanager.allocparaloc(list,paraloc.location);
  162. case paraloc.location^.loc of
  163. LOC_REGISTER, LOC_CREGISTER:
  164. a_load_const_reg(list, size, a, paraloc.location^.register);
  165. LOC_REFERENCE:
  166. begin
  167. reference_reset(ref,paraloc.alignment);
  168. ref.base := paraloc.location^.reference.index;
  169. ref.offset := paraloc.location^.reference.offset;
  170. a_load_const_ref(list, size, a, ref);
  171. end;
  172. else
  173. internalerror(2002081101);
  174. end;
  175. end;
  176. procedure tcgppcgen.a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const paraloc : tcgpara);
  177. var
  178. ref: treference;
  179. tmpreg: tregister;
  180. begin
  181. paraloc.check_simple_location;
  182. paramanager.allocparaloc(list,paraloc.location);
  183. case paraloc.location^.loc of
  184. LOC_REGISTER,LOC_CREGISTER:
  185. a_loadaddr_ref_reg(list,r,paraloc.location^.register);
  186. LOC_REFERENCE:
  187. begin
  188. reference_reset(ref,paraloc.alignment);
  189. ref.base := paraloc.location^.reference.index;
  190. ref.offset := paraloc.location^.reference.offset;
  191. tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE);
  192. a_loadaddr_ref_reg(list,r,tmpreg);
  193. a_load_reg_ref(list,OS_ADDR,OS_ADDR,tmpreg,ref);
  194. end;
  195. else
  196. internalerror(2002080701);
  197. end;
  198. end;
  199. procedure tcgppcgen.g_maybe_got_init(list: TAsmList);
  200. var
  201. instr: taicpu;
  202. cond: tasmcond;
  203. savedlr: boolean;
  204. begin
  205. if not(po_assembler in current_procinfo.procdef.procoptions) then
  206. begin
  207. if (cs_create_pic in current_settings.moduleswitches) and
  208. (pi_needs_got in current_procinfo.flags) then
  209. case target_info.system of
  210. system_powerpc_darwin,
  211. system_powerpc64_darwin:
  212. begin
  213. savedlr:=save_lr_in_prologue;
  214. if not savedlr then
  215. list.concat(taicpu.op_reg_reg(A_MFSPR,NR_R0,NR_LR));
  216. fillchar(cond,sizeof(cond),0);
  217. cond.simple:=false;
  218. cond.bo:=20;
  219. cond.bi:=31;
  220. instr:=taicpu.op_sym(A_BCL,current_procinfo.CurrGOTLabel);
  221. instr.setcondition(cond);
  222. list.concat(instr);
  223. a_label(list,current_procinfo.CurrGOTLabel);
  224. a_reg_alloc(list,current_procinfo.got);
  225. list.concat(taicpu.op_reg_reg(A_MFSPR,current_procinfo.got,NR_LR));
  226. if not savedlr or
  227. { in the following case lr is saved, but not restored }
  228. { (happens e.g. when generating debug info for leaf }
  229. { procedures) }
  230. not(pi_do_call in current_procinfo.flags) then
  231. list.concat(taicpu.op_reg_reg(A_MTSPR,NR_LR,NR_R0));
  232. end;
  233. end;
  234. end;
  235. end;
  236. function tcgppcgen.g_indirect_sym_load(list: TAsmList; const symname: string; const flags: tindsymflags): tregister;
  237. begin
  238. case target_info.system of
  239. system_powerpc_aix,
  240. system_powerpc64_aix:
  241. result:=load_got_symbol(list,symname,flags);
  242. else
  243. result:=inherited;
  244. end;
  245. end;
  246. function tcgppcgen.get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
  247. var
  248. stubname: string;
  249. instr: taicpu;
  250. href: treference;
  251. l1: tasmsymbol;
  252. localgotlab: tasmlabel;
  253. cond: tasmcond;
  254. stubalign: byte;
  255. begin
  256. { function declared in the current unit? }
  257. { doesn't work correctly, because this will also return a hit if we }
  258. { previously took the address of an external procedure. It doesn't }
  259. { really matter, the linker will remove all unnecessary stubs. }
  260. stubname := 'L'+s+'$stub';
  261. result := current_asmdata.getasmsymbol(stubname);
  262. if assigned(result) then
  263. exit;
  264. if current_asmdata.asmlists[al_imports]=nil then
  265. current_asmdata.asmlists[al_imports]:=TAsmList.create;
  266. if (cs_create_pic in current_settings.moduleswitches) then
  267. stubalign:=32
  268. else
  269. stubalign:=16;
  270. new_section(current_asmdata.asmlists[al_imports],sec_stub,'',stubalign);
  271. result := current_asmdata.DefineAsmSymbol(stubname,AB_LOCAL,AT_FUNCTION);
  272. current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(result,0));
  273. { register as a weak symbol if necessary }
  274. if weak then
  275. current_asmdata.weakrefasmsymbol(s);
  276. current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s));
  277. l1 := current_asmdata.DefineAsmSymbol('L'+s+'$lazy_ptr',AB_LOCAL,AT_DATA);
  278. reference_reset_symbol(href,l1,0,sizeof(pint));
  279. href.refaddr := addr_higha;
  280. if (cs_create_pic in current_settings.moduleswitches) then
  281. begin
  282. current_asmdata.getjumplabel(localgotlab);
  283. href.relsymbol:=localgotlab;
  284. fillchar(cond,sizeof(cond),0);
  285. cond.simple:=false;
  286. cond.bo:=20;
  287. cond.bi:=31;
  288. current_asmdata.asmlists[al_imports].concat(taicpu.op_reg(A_MFLR,NR_R0));
  289. instr:=taicpu.op_sym(A_BCL,localgotlab);
  290. instr.setcondition(cond);
  291. current_asmdata.asmlists[al_imports].concat(instr);
  292. a_label(current_asmdata.asmlists[al_imports],localgotlab);
  293. current_asmdata.asmlists[al_imports].concat(taicpu.op_reg(A_MFLR,NR_R11));
  294. current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_reg_ref(A_ADDIS,NR_R11,NR_R11,href));
  295. current_asmdata.asmlists[al_imports].concat(taicpu.op_reg(A_MTLR,NR_R0));
  296. end
  297. else
  298. current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_ref(A_LIS,NR_R11,href));
  299. href.refaddr := addr_low;
  300. href.base := NR_R11;
  301. {$ifndef cpu64bitaddr}
  302. current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_ref(A_LWZU,NR_R12,href));
  303. {$else cpu64bitaddr}
  304. { darwin/ppc64 uses a 32 bit absolute address here, strange... }
  305. current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_ref(A_LDU,NR_R12,href));
  306. {$endif cpu64bitaddr}
  307. current_asmdata.asmlists[al_imports].concat(taicpu.op_reg(A_MTCTR,NR_R12));
  308. current_asmdata.asmlists[al_imports].concat(taicpu.op_none(A_BCTR));
  309. new_section(current_asmdata.asmlists[al_imports],sec_data_lazy,'',sizeof(pint));
  310. current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(l1,0));
  311. current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s));
  312. current_asmdata.asmlists[al_imports].concat(tai_const.createname('dyld_stub_binding_helper',0));
  313. end;
  314. procedure tcgppcgen.a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);
  315. var
  316. ref2, tmpref: treference;
  317. begin
  318. ref2 := ref;
  319. fixref(list,ref2);
  320. if assigned(ref2.symbol) then
  321. begin
  322. if target_info.system = system_powerpc_macos then
  323. begin
  324. if macos_direct_globals then
  325. begin
  326. reference_reset(tmpref,ref2.alignment);
  327. tmpref.offset := ref2.offset;
  328. tmpref.symbol := ref2.symbol;
  329. tmpref.base := NR_NO;
  330. list.concat(taicpu.op_reg_reg_ref(A_ADDI,r,NR_RTOC,tmpref));
  331. end
  332. else
  333. begin
  334. reference_reset(tmpref,ref2.alignment);
  335. tmpref.symbol := ref2.symbol;
  336. tmpref.offset := 0;
  337. tmpref.base := NR_RTOC;
  338. list.concat(taicpu.op_reg_ref(A_LWZ,r,tmpref));
  339. if ref2.offset<>0 then
  340. a_op_const_reg(list,OP_ADD,OS_ADDR,ref2.offset,r);
  341. end;
  342. if ref2.base <> NR_NO then
  343. list.concat(taicpu.op_reg_reg_reg(A_ADD,r,r,ref2.base));
  344. //list.concat(tai_comment.create(strpnew('*** a_loadaddr_ref_reg')));
  345. end
  346. else
  347. begin
  348. { add the symbol's value to the base of the reference, and if the }
  349. { reference doesn't have a base, create one }
  350. reference_reset(tmpref,ref2.alignment);
  351. tmpref.offset := ref2.offset;
  352. tmpref.symbol := ref2.symbol;
  353. tmpref.relsymbol := ref2.relsymbol;
  354. tmpref.refaddr := addr_higha;
  355. if ref2.base<> NR_NO then
  356. begin
  357. list.concat(taicpu.op_reg_reg_ref(A_ADDIS,r,
  358. ref2.base,tmpref));
  359. end
  360. else
  361. list.concat(taicpu.op_reg_ref(A_LIS,r,tmpref));
  362. tmpref.base := NR_NO;
  363. tmpref.refaddr := addr_low;
  364. { can be folded with one of the next instructions by the }
  365. { optimizer probably }
  366. list.concat(taicpu.op_reg_reg_ref(A_ADDI,r,r,tmpref));
  367. end
  368. end
  369. else if ref2.offset <> 0 Then
  370. if ref2.base <> NR_NO then
  371. a_op_const_reg_reg(list,OP_ADD,OS_ADDR,ref2.offset,ref2.base,r)
  372. { FixRef makes sure that "(ref.index <> R_NO) and (ref.offset <> 0)" never}
  373. { occurs, so now only ref.offset has to be loaded }
  374. else
  375. a_load_const_reg(list,OS_ADDR,ref2.offset,r)
  376. else if ref2.index <> NR_NO Then
  377. list.concat(taicpu.op_reg_reg_reg(A_ADD,r,ref2.base,ref2.index))
  378. else if (ref2.base <> NR_NO) and
  379. (r <> ref2.base) then
  380. a_load_reg_reg(list,OS_ADDR,OS_ADDR,ref2.base,r)
  381. else
  382. list.concat(taicpu.op_reg_const(A_LI,r,0));
  383. end;
  384. { calling a procedure by address }
  385. procedure tcgppcgen.a_call_reg(list : TAsmList;reg: tregister);
  386. var
  387. tmpref: treference;
  388. tmpreg: tregister;
  389. begin
  390. tmpreg:=NR_NO;
  391. if target_info.system in systems_aix then
  392. begin
  393. { load function address in R0, and swap "reg" for R0 }
  394. reference_reset_base(tmpref,reg,0,sizeof(pint));
  395. a_load_ref_reg(list,OS_ADDR,OS_ADDR,tmpref,NR_R0);
  396. tmpreg:=reg;
  397. { no need to allocate/free R0, is already allocated by call node
  398. because it's a volatile register }
  399. reg:=NR_R0;
  400. { save current TOC }
  401. reference_reset_base(tmpref,NR_STACK_POINTER_REG,LA_RTOC_AIX,sizeof(pint));
  402. a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_RTOC,tmpref);
  403. end;
  404. list.concat(taicpu.op_reg(A_MTCTR,reg));
  405. if target_info.system in systems_aix then
  406. begin
  407. { load target TOC and possible link register }
  408. reference_reset_base(tmpref,tmpreg,sizeof(pint),sizeof(pint));
  409. a_load_ref_reg(list,OS_ADDR,OS_ADDR,tmpref,NR_RTOC);
  410. tmpref.offset:=2*sizeof(pint);
  411. a_load_ref_reg(list,OS_ADDR,OS_ADDR,tmpref,NR_R11);
  412. end;
  413. list.concat(taicpu.op_none(A_BCTRL));
  414. if target_info.system in systems_aix then
  415. begin
  416. { restore our TOC }
  417. reference_reset_base(tmpref,NR_STACK_POINTER_REG,LA_RTOC_AIX,sizeof(pint));
  418. a_load_ref_reg(list,OS_ADDR,OS_ADDR,tmpref,NR_RTOC);
  419. end;
  420. include(current_procinfo.flags,pi_do_call);
  421. end;
  422. procedure tcgppcgen.a_load_reg_ref(list: TAsmList; fromsize, tosize: TCGSize;
  423. reg: tregister; const ref: treference);
  424. const
  425. StoreInstr: array[OS_8..OS_INT, boolean, boolean] of TAsmOp =
  426. { indexed? updating?}
  427. (((A_STB, A_STBU), (A_STBX, A_STBUX)),
  428. ((A_STH, A_STHU), (A_STHX, A_STHUX)),
  429. ((A_STW, A_STWU), (A_STWX, A_STWUX))
  430. {$ifdef cpu64bitalu}
  431. ,
  432. ((A_STD, A_STDU), (A_STDX, A_STDUX))
  433. {$endif cpu64bitalu}
  434. );
  435. var
  436. ref2: TReference;
  437. tmpreg: tregister;
  438. op: TAsmOp;
  439. begin
  440. if not (fromsize in [OS_8..OS_INT,OS_S8..OS_SINT]) then
  441. internalerror(2002090904);
  442. if not (tosize in [OS_8..OS_INT,OS_S8..OS_SINT]) then
  443. internalerror(2002090905);
  444. if tosize in [OS_S8..OS_SINT] then
  445. { storing is the same for signed and unsigned values }
  446. tosize := tcgsize(ord(tosize) - (ord(OS_S8) - ord(OS_8)));
  447. ref2 := ref;
  448. fixref(list, ref2);
  449. op := storeinstr[tcgsize2unsigned[tosize], ref2.index <> NR_NO, false];
  450. a_load_store(list, op, reg, ref2);
  451. end;
  452. procedure tcgppcgen.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister);
  453. var
  454. op: tasmop;
  455. instr: taicpu;
  456. begin
  457. if not(fromsize in [OS_F32,OS_F64]) or
  458. not(tosize in [OS_F32,OS_F64]) then
  459. internalerror(2006123110);
  460. if (tosize < fromsize) then
  461. op:=A_FRSP
  462. else
  463. op:=A_FMR;
  464. instr := taicpu.op_reg_reg(op,reg2,reg1);
  465. list.concat(instr);
  466. if (op = A_FMR) then
  467. rg[R_FPUREGISTER].add_move_instruction(instr);
  468. end;
  469. procedure tcgppcgen.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister);
  470. const
  471. FpuLoadInstr: Array[OS_F32..OS_F64,boolean, boolean] of TAsmOp =
  472. { indexed? updating?}
  473. (((A_LFS,A_LFSU),(A_LFSX,A_LFSUX)),
  474. ((A_LFD,A_LFDU),(A_LFDX,A_LFDUX)));
  475. var
  476. op: tasmop;
  477. ref2: treference;
  478. begin
  479. if target_info.system in systems_aix then
  480. g_load_check_simple(list,ref,65536);
  481. if not(fromsize in [OS_F32,OS_F64]) or
  482. not(tosize in [OS_F32,OS_F64]) then
  483. internalerror(200201121);
  484. ref2 := ref;
  485. fixref(list,ref2);
  486. op := fpuloadinstr[fromsize,ref2.index <> NR_NO,false];
  487. a_load_store(list,op,reg,ref2);
  488. if (fromsize > tosize) then
  489. a_loadfpu_reg_reg(list,fromsize,tosize,reg,reg);
  490. end;
  491. procedure tcgppcgen.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference);
  492. const
  493. FpuStoreInstr: Array[OS_F32..OS_F64,boolean, boolean] of TAsmOp =
  494. { indexed? updating?}
  495. (((A_STFS,A_STFSU),(A_STFSX,A_STFSUX)),
  496. ((A_STFD,A_STFDU),(A_STFDX,A_STFDUX)));
  497. var
  498. op: tasmop;
  499. ref2: treference;
  500. reg2: tregister;
  501. begin
  502. if not(fromsize in [OS_F32,OS_F64]) or
  503. not(tosize in [OS_F32,OS_F64]) then
  504. internalerror(200201122);
  505. ref2 := ref;
  506. fixref(list,ref2);
  507. op := fpustoreinstr[tosize,ref2.index <> NR_NO,false];
  508. { some PPCs have a bug whereby storing a double to memory }
  509. { as single corrupts the value -> convert double to single }
  510. { first (bug confirmed on some G4s, but not on G5s) }
  511. if (tosize < fromsize) and
  512. (current_settings.cputype < cpu_PPC970) then
  513. begin
  514. reg2:=getfpuregister(list,tosize);
  515. a_loadfpu_reg_reg(list,fromsize,tosize,reg,reg2);
  516. reg:=reg2;
  517. end;
  518. a_load_store(list,op,reg,ref2);
  519. end;
  520. procedure tcgppcgen.g_stackpointer_alloc(list : TAsmList;localsize : longint);
  521. begin
  522. Comment(V_Error,'tcgppcgen.g_stackpointer_alloc method not implemented');
  523. end;
  524. procedure tcgppcgen.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister);
  525. begin
  526. Comment(V_Error,'tcgppcgen.a_bit_scan_reg_reg method not implemented');
  527. end;
  528. procedure tcgppcgen.g_overflowcheck(list: TAsmList; const l: tlocation; def: tdef);
  529. var
  530. hl : tasmlabel;
  531. flags : TResFlags;
  532. begin
  533. if not(cs_check_overflow in current_settings.localswitches) then
  534. exit;
  535. current_asmdata.getjumplabel(hl);
  536. if not ((def.typ=pointerdef) or
  537. ((def.typ=orddef) and
  538. (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
  539. pasbool8,pasbool16,pasbool32,pasbool64]))) then
  540. begin
  541. if (current_settings.optimizecputype >= cpu_ppc970) or
  542. (current_settings.cputype >= cpu_ppc970) then
  543. begin
  544. { ... instructions setting overflow flag ...
  545. mfxerf R0
  546. mtcrf 128, R0
  547. ble cr0, label }
  548. list.concat(taicpu.op_reg(A_MFXER, NR_R0));
  549. list.concat(taicpu.op_const_reg(A_MTCRF, 128, NR_R0));
  550. flags.cr := RS_CR0;
  551. flags.flag := F_LE;
  552. a_jmp_flags(list, flags, hl);
  553. end
  554. else
  555. begin
  556. list.concat(taicpu.op_reg(A_MCRXR,NR_CR7));
  557. a_jmp(list,A_BC,C_NO,7,hl)
  558. end;
  559. end
  560. else
  561. a_jmp_cond(list,OC_AE,hl);
  562. a_call_name(list,'FPC_OVERFLOW',false);
  563. a_label(list,hl);
  564. end;
  565. procedure tcgppcgen.g_profilecode(list: TAsmList);
  566. var
  567. paraloc1 : tcgpara;
  568. pd : tprocdef;
  569. begin
  570. if (target_info.system in [system_powerpc_darwin]) then
  571. begin
  572. pd:=search_system_proc('mcount');
  573. paraloc1.init;
  574. paramanager.getintparaloc(pd,1,paraloc1);
  575. a_load_reg_cgpara(list,OS_ADDR,NR_R0,paraloc1);
  576. paramanager.freecgpara(list,paraloc1);
  577. paraloc1.done;
  578. allocallcpuregisters(list);
  579. a_call_name(list,'mcount',false);
  580. deallocallcpuregisters(list);
  581. a_reg_dealloc(list,NR_R0);
  582. end;
  583. end;
  584. procedure tcgppcgen.a_jmp_cond(list : TAsmList;cond : TOpCmp; l: tasmlabel);
  585. begin
  586. a_jmp(list,A_BC,TOpCmp2AsmCond[cond],0,l);
  587. end;
  588. procedure tcgppcgen.a_jmp(list: TAsmList; op: tasmop; c: tasmcondflag;
  589. crval: longint; l: tasmlabel);
  590. var
  591. p: taicpu;
  592. begin
  593. p := taicpu.op_sym(op,l);
  594. if op <> A_B then
  595. create_cond_norm(c,crval,p.condition);
  596. p.is_jmp := true;
  597. list.concat(p)
  598. end;
  599. procedure tcgppcgen.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
  600. procedure loadvmttor11;
  601. var
  602. href : treference;
  603. begin
  604. reference_reset_base(href,NR_R3,0,sizeof(pint));
  605. cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R11);
  606. end;
  607. procedure op_onr11methodaddr;
  608. var
  609. href : treference;
  610. begin
  611. if (procdef.extnumber=$ffff) then
  612. Internalerror(200006139);
  613. { call/jmp vmtoffs(%eax) ; method offs }
  614. reference_reset_base(href,NR_R11,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
  615. if hasLargeOffset(href) then
  616. begin
  617. {$ifdef cpu64}
  618. if (longint(href.offset) <> href.offset) then
  619. { add support for offsets > 32 bit }
  620. internalerror(200510201);
  621. {$endif cpu64}
  622. list.concat(taicpu.op_reg_reg_const(A_ADDIS,NR_R11,NR_R11,
  623. smallint((href.offset shr 16)+ord(smallint(href.offset and $ffff) < 0))));
  624. href.offset := smallint(href.offset and $ffff);
  625. end;
  626. a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R11);
  627. if (target_info.system in ([system_powerpc64_linux]+systems_aix)) then
  628. begin
  629. reference_reset_base(href, NR_R11, 0, sizeof(pint));
  630. a_load_ref_reg(list, OS_ADDR, OS_ADDR, href, NR_R11);
  631. end;
  632. list.concat(taicpu.op_reg(A_MTCTR,NR_R11));
  633. list.concat(taicpu.op_none(A_BCTR));
  634. if (target_info.system in ([system_powerpc64_linux]+systems_aix)) then
  635. list.concat(taicpu.op_none(A_NOP));
  636. end;
  637. var
  638. make_global : boolean;
  639. begin
  640. if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
  641. Internalerror(200006137);
  642. if not assigned(procdef.struct) or
  643. (procdef.procoptions*[po_classmethod, po_staticmethod,
  644. po_methodpointer, po_interrupt, po_iocheck]<>[]) then
  645. Internalerror(200006138);
  646. if procdef.owner.symtabletype<>ObjectSymtable then
  647. Internalerror(200109191);
  648. make_global:=false;
  649. if (not current_module.is_unit) or
  650. create_smartlink or
  651. (procdef.owner.defowner.owner.symtabletype=globalsymtable) then
  652. make_global:=true;
  653. if make_global then
  654. List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
  655. else
  656. List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
  657. { set param1 interface to self }
  658. g_adjust_self_value(list,procdef,ioffset);
  659. { case 4 }
  660. if (po_virtualmethod in procdef.procoptions) and
  661. not is_objectpascal_helper(procdef.struct) then
  662. begin
  663. loadvmttor11;
  664. op_onr11methodaddr;
  665. end
  666. { case 0 }
  667. else
  668. case target_info.system of
  669. system_powerpc_darwin,
  670. system_powerpc64_darwin:
  671. list.concat(taicpu.op_sym(A_B,get_darwin_call_stub(procdef.mangledname,false)));
  672. system_powerpc64_linux,
  673. system_powerpc_aix,
  674. system_powerpc64_aix:
  675. {$note ts:todo add GOT change?? - think not needed :) }
  676. list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol('.' + procdef.mangledname)));
  677. else
  678. list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(procdef.mangledname)))
  679. end;
  680. List.concat(Tai_symbol_end.Createname(labelname));
  681. end;
  682. function tcgppcgen.load_got_symbol(list: TAsmList; const symbol : string; const flags: tindsymflags) : tregister;
  683. var
  684. l: tasmsymbol;
  685. ref: treference;
  686. begin
  687. if target_info.system=system_powerpc64_linux then
  688. begin
  689. l:=current_asmdata.getasmsymbol(symbol);
  690. reference_reset_symbol(ref,l,0,sizeof(pint));
  691. ref.base:=NR_RTOC;
  692. ref.refaddr:=addr_pic;
  693. end
  694. else if target_info.system in systems_aix then
  695. get_aix_toc_sym(list,symbol,flags,ref,false)
  696. else
  697. internalerror(2007102010);
  698. result := getaddressregister(list);
  699. {$ifdef cpu64bitaddr}
  700. list.concat(taicpu.op_reg_ref(A_LD, result, ref));
  701. {$else cpu64bitaddr}
  702. list.concat(taicpu.op_reg_ref(A_LWZ, result, ref));
  703. {$endif cpu64bitaddr}
  704. end;
  705. procedure tcgppcgen.get_aix_toc_sym(list: TAsmList; const symname: string; const flags: tindsymflags; out ref: treference; force_direct_toc: boolean);
  706. const
  707. { The TOC on AIX is limited to 32KB worth of entries on AIX. If you need
  708. more entries, you have to add a level of indirection. In some cases,
  709. it's not possible to do this (e.g. assembler code). So by default, we
  710. use direct TOC entries until we're 500 from the maximum, and then start
  711. using indirect TOC entries. }
  712. AutoDirectTOCLimit = (high(smallint) div sizeof(pint)) - 500;
  713. var
  714. tmpref: treference;
  715. { can have more than 16384 (32 bit) or 8192 (64 bit) toc entries and, as
  716. as consequence, toc subsections -> 5 extra characters for the number}
  717. tocsecname: string[length('tocsubtable')+5];
  718. nlsymname: string;
  719. newsymname: ansistring;
  720. sym: TAsmSymbol;
  721. tocsym: TTOCAsmSymbol;
  722. tocnr,
  723. entrynr: longint;
  724. tmpreg: tregister;
  725. begin
  726. { all global symbol accesses always must be done via the TOC }
  727. nlsymname:='LC..'+symname;
  728. reference_reset_symbol(ref,current_asmdata.getasmsymbol(nlsymname),0,sizeof(pint));
  729. if (assigned(ref.symbol) and
  730. not(ref.symbol is TTOCAsmSymbol)) or
  731. (not(ts_small_toc in current_settings.targetswitches) and
  732. (TPPCAsmData(current_asmdata).DirectTOCEntries<AutoDirectTOCLimit)) or
  733. force_direct_toc then
  734. begin
  735. ref.refaddr:=addr_pic_no_got;
  736. ref.base:=NR_RTOC;
  737. if not assigned(ref.symbol) then
  738. begin
  739. TPPCAsmData(current_asmdata).DirectTOCEntries:=TPPCAsmData(current_asmdata).DirectTOCEntries+1;
  740. new_section(current_asmdata.AsmLists[al_picdata],sec_toc,'',sizeof(pint));
  741. ref.symbol:=current_asmdata.DefineAsmSymbol(nlsymname,AB_LOCAL,AT_DATA);
  742. current_asmdata.asmlists[al_picdata].concat(tai_symbol.create(ref.symbol,0));
  743. { do not assign the result of these statements to ref.symbol: the
  744. access must be done via the LC..symname symbol; these are just
  745. to define the symbol that's being accessed as either weak or
  746. not }
  747. if not(is_weak in flags) then
  748. current_asmdata.RefAsmSymbol(symname)
  749. else if is_data in flags then
  750. current_asmdata.WeakRefAsmSymbol(symname)
  751. else
  752. current_asmdata.WeakRefAsmSymbol('.'+symname);
  753. newsymname:=ReplaceForbiddenAsmSymbolChars(symname);
  754. current_asmdata.asmlists[al_picdata].concat(tai_directive.Create(asd_toc_entry,newsymname+'[TC],'+newsymname));
  755. end;
  756. end
  757. else
  758. begin
  759. if not assigned(ref.symbol) then
  760. begin
  761. TPPCAsmData(current_asmdata).GetNextSmallTocEntry(tocnr,entrynr);
  762. { new TOC entry? }
  763. if entrynr=0 then
  764. begin
  765. { create new toc entry that contains the address of the next
  766. table of addresses }
  767. get_aix_toc_sym(list,'tocsubtable'+tostr(tocnr),[is_data],tmpref,true);
  768. sym:=tmpref.symbol;
  769. { base address for this batch of toc table entries that we'll
  770. put in a data block instead }
  771. new_section(current_asmdata.AsmLists[al_indirectpicdata],sec_rodata,'',sizeof(pint));
  772. sym:=current_asmdata.DefineAsmSymbol('tocsubtable'+tostr(tocnr),AB_LOCAL,AT_DATA);
  773. current_asmdata.asmlists[al_indirectpicdata].concat(tai_symbol.create(sym,0));
  774. end;
  775. { add the reference to the actual symbol inside the tocsubtable }
  776. if not(is_weak in flags) then
  777. current_asmdata.RefAsmSymbol(symname)
  778. else if is_data in flags then
  779. current_asmdata.WeakRefAsmSymbol(symname)
  780. else
  781. current_asmdata.WeakRefAsmSymbol('.'+symname);
  782. tocsym:=TTOCAsmSymbol(current_asmdata.DefineAsmSymbolByClass(TTOCAsmSymbol,nlsymname,AB_LOCAL,AT_DATA));
  783. ref.symbol:=tocsym;
  784. tocsym.ftocsecnr:=tocnr;
  785. current_asmdata.asmlists[al_indirectpicdata].concat(tai_symbol.create(tocsym,0));
  786. newsymname:=ReplaceForbiddenAsmSymbolChars(symname);
  787. sym:=current_asmdata.RefAsmSymbol(newsymname);
  788. current_asmdata.asmlists[al_indirectpicdata].concat(tai_const.Create_sym(sym));
  789. end;
  790. { first load the address of the table from the TOC }
  791. get_aix_toc_sym(list,'tocsubtable'+tostr(TTOCAsmSymbol(ref.symbol).ftocsecnr),[is_data],tmpref,true);
  792. tmpreg:=getaddressregister(list);
  793. a_load_ref_reg(list,OS_ADDR,OS_ADDR,tmpref,tmpreg);
  794. { and now set up the address of the entry, relative to the start of
  795. the table }
  796. ref.base:=tmpreg;
  797. ref.refaddr:=addr_pic;
  798. ref.relsymbol:=current_asmdata.GetAsmSymbol('tocsubtable'+tostr(TTOCAsmSymbol(ref.symbol).ftocsecnr));
  799. end;
  800. end;
  801. procedure tcgppcgen.g_load_check_simple(list: TAsmList; const ref: treference; size: aint);
  802. var
  803. reg: tregister;
  804. lab: tasmlabel;
  805. begin
  806. if not(cs_check_low_addr_load in current_settings.localswitches) then
  807. exit;
  808. { this is mainly for AIX, which does not trap loads from address 0. A
  809. global symbol (if not weak) will always map to a proper address, and
  810. the same goes for stack addresses -> skip }
  811. if assigned(ref.symbol) and
  812. (ref.symbol.bind<>AB_WEAK_EXTERNAL) then
  813. exit;
  814. if (ref.base=NR_STACK_POINTER_REG) or
  815. (ref.index=NR_STACK_POINTER_REG) or
  816. (assigned(current_procinfo) and
  817. ((ref.base=current_procinfo.framepointer) or
  818. (ref.index=current_procinfo.framepointer))) then
  819. exit;
  820. if assigned(ref.symbol) or
  821. (ref.offset<>0) or
  822. ((ref.base<>NR_NO) and (ref.index<>NR_NO)) then
  823. begin
  824. { can't allocate register, also used in wrappers and the like }
  825. reg:=NR_R0;
  826. a_reg_alloc(list,reg);
  827. a_loadaddr_ref_reg(list,ref,reg);
  828. end
  829. else if ref.base<>NR_NO then
  830. reg:=ref.base
  831. else
  832. reg:=ref.index;
  833. current_asmdata.getjumplabel(lab);
  834. if reg=NR_R0 then
  835. a_reg_dealloc(list,reg);
  836. a_cmp_const_reg_label(list,OS_ADDR,OC_A,size-1,reg,lab);
  837. a_call_name(list,'FPC_INVALIDPOINTER',false);
  838. a_label(list,lab);
  839. end;
  840. procedure tcgppcgen.g_external_wrapper(list: TAsmList; pd: TProcDef; const externalname: string);
  841. var
  842. href : treference;
  843. begin
  844. if not(target_info.system in ([system_powerpc64_linux]+systems_aix)) then begin
  845. inherited;
  846. exit;
  847. end;
  848. { for ppc64/linux and aix emit correct code which sets up a stack frame
  849. and then calls the external method normally to ensure that the GOT/TOC
  850. will be loaded correctly if required.
  851. The resulting code sequence looks as follows:
  852. mflr r0
  853. stw/d r0, 16(r1)
  854. stw/du r1, -112(r1)
  855. bl <external_method>
  856. nop
  857. addi r1, r1, 112
  858. lwz/d r0, 16(r1)
  859. mtlr r0
  860. blr
  861. }
  862. list.concat(taicpu.op_reg(A_MFLR, NR_R0));
  863. if target_info.abi=abi_powerpc_sysv then
  864. reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_SYSV, 8)
  865. else
  866. reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_AIX, 8);
  867. a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_R0,href);
  868. reference_reset_base(href, NR_STACK_POINTER_REG, -MINIMUM_STACKFRAME_SIZE, 8);
  869. list.concat(taicpu.op_reg_ref({$ifdef cpu64bitaddr}A_STDU{$else}A_STWU{$endif}, NR_STACK_POINTER_REG, href));
  870. a_call_name(list,externalname,false);
  871. list.concat(taicpu.op_reg_reg_const(A_ADDI, NR_STACK_POINTER_REG, NR_STACK_POINTER_REG, MINIMUM_STACKFRAME_SIZE));
  872. if target_info.abi=abi_powerpc_sysv then
  873. reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_SYSV, 8)
  874. else
  875. reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_AIX, 8);
  876. a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R0);
  877. list.concat(taicpu.op_reg(A_MTLR, NR_R0));
  878. list.concat(taicpu.op_none(A_BLR));
  879. end;
  880. procedure tcgppcgen.g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister);
  881. var
  882. testbit: byte;
  883. bitvalue: boolean;
  884. begin
  885. { get the bit to extract from the conditional register + its requested value (0 or 1) }
  886. testbit := ((f.cr - RS_CR0) * 4);
  887. case f.flag of
  888. F_EQ, F_NE:
  889. begin
  890. inc(testbit, 2);
  891. bitvalue := f.flag = F_EQ;
  892. end;
  893. F_LT, F_GE:
  894. begin
  895. bitvalue := f.flag = F_LT;
  896. end;
  897. F_GT, F_LE:
  898. begin
  899. inc(testbit);
  900. bitvalue := f.flag = F_GT;
  901. end;
  902. else
  903. internalerror(200112261);
  904. end;
  905. { load the conditional register in the destination reg }
  906. list.concat(taicpu.op_reg(A_MFCR, reg));
  907. { we will move the bit that has to be tested to bit 0 by rotating left }
  908. testbit := (testbit + 1) and 31;
  909. { extract bit }
  910. list.concat(taicpu.op_reg_reg_const_const_const(
  911. A_RLWINM,reg,reg,testbit,31,31));
  912. { if we need the inverse, xor with 1 }
  913. if not bitvalue then
  914. list.concat(taicpu.op_reg_reg_const(A_XORI, reg, reg, 1));
  915. end;
  916. function tcgppcgen.fixref(list: TAsmList; var ref: treference): boolean;
  917. var
  918. tmpreg: tregister;
  919. begin
  920. result := false;
  921. { Avoid recursion. }
  922. if (ref.refaddr in [addr_pic,addr_pic_no_got]) then
  923. exit;
  924. {$IFDEF EXTDEBUG}
  925. list.concat(tai_comment.create(strpnew('fixref0 ' + ref2string(ref))));
  926. {$ENDIF EXTDEBUG}
  927. if (target_info.system in [system_powerpc_darwin,system_powerpc64_darwin]) and
  928. assigned(ref.symbol) and
  929. not assigned(ref.relsymbol) and
  930. ((ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL,AB_PRIVATE_EXTERN,AB_COMMON]) or
  931. (cs_create_pic in current_settings.moduleswitches))then
  932. begin
  933. if (ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL,AB_PRIVATE_EXTERN,AB_COMMON]) or
  934. ((target_info.system=system_powerpc64_darwin) and
  935. (ref.symbol.bind=AB_GLOBAL)) then
  936. begin
  937. tmpreg := g_indirect_sym_load(list,ref.symbol.name,asmsym2indsymflags(ref.symbol));
  938. ref.symbol:=nil;
  939. end
  940. else
  941. begin
  942. include(current_procinfo.flags,pi_needs_got);
  943. tmpreg := getaddressregister(list);
  944. a_load_reg_reg(list,OS_ADDR,OS_ADDR,current_procinfo.got,tmpreg);
  945. if assigned(ref.relsymbol) then
  946. internalerror(2007093501);
  947. ref.relsymbol := current_procinfo.CurrGOTLabel;
  948. end;
  949. if (ref.base = NR_NO) then
  950. ref.base := tmpreg
  951. else if (ref.index = NR_NO) then
  952. ref.index := tmpreg
  953. else
  954. begin
  955. list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg));
  956. ref.base := tmpreg;
  957. end;
  958. end;
  959. { if we have to create PIC, add the symbol to the TOC/GOT }
  960. if (((target_info.system = system_powerpc64_linux) and
  961. (cs_create_pic in current_settings.moduleswitches)) or
  962. (target_info.system in systems_aix)) and
  963. (assigned(ref.symbol) and
  964. not assigned(ref.relsymbol)) then
  965. begin
  966. tmpreg := load_got_symbol(list, ref.symbol.name, asmsym2indsymflags(ref.symbol));
  967. if (ref.base = NR_NO) then
  968. ref.base := tmpreg
  969. else if (ref.index = NR_NO) then
  970. ref.index := tmpreg
  971. else begin
  972. a_op_reg_reg_reg(list, OP_ADD, OS_ADDR, ref.base, tmpreg, tmpreg);
  973. ref.base := tmpreg;
  974. end;
  975. ref.symbol := nil;
  976. {$IFDEF EXTDEBUG}
  977. list.concat(tai_comment.create(strpnew('fixref-pic ' + ref2string(ref))));
  978. {$ENDIF EXTDEBUG}
  979. end;
  980. if (ref.base = NR_NO) then
  981. begin
  982. ref.base := ref.index;
  983. ref.index := NR_NO;
  984. end;
  985. if (ref.base <> NR_NO) then
  986. begin
  987. if (ref.index <> NR_NO) and
  988. ((ref.offset <> 0) or assigned(ref.symbol)) then
  989. begin
  990. result := true;
  991. tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE);
  992. list.concat(taicpu.op_reg_reg_reg(
  993. A_ADD,tmpreg,ref.base,ref.index));
  994. ref.index := NR_NO;
  995. ref.base := tmpreg;
  996. end
  997. end;
  998. if (ref.index <> NR_NO) and
  999. (assigned(ref.symbol) or
  1000. (ref.offset <> 0)) then
  1001. internalerror(200208102);
  1002. {$IFDEF EXTDEBUG}
  1003. list.concat(tai_comment.create(strpnew('fixref1 ' + ref2string(ref))));
  1004. {$ENDIF EXTDEBUG}
  1005. end;
  1006. procedure tcgppcgen.a_load_store(list:TAsmList;op: tasmop;reg:tregister;
  1007. ref: treference);
  1008. var
  1009. tmpreg: tregister;
  1010. {$ifdef cpu64bitaddr}
  1011. tmpreg2: tregister;
  1012. {$endif cpu64bitaddr}
  1013. tmpref: treference;
  1014. largeOffset: Boolean;
  1015. begin
  1016. tmpreg := NR_NO;
  1017. largeOffset:= hasLargeOffset(ref);
  1018. if target_info.system in ([system_powerpc_macos]+systems_aix) then
  1019. begin
  1020. if assigned(ref.symbol) and
  1021. (ref.refaddr<>addr_pic_no_got) then
  1022. begin {Load symbol's value}
  1023. tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE);
  1024. reference_reset(tmpref,sizeof(pint));
  1025. tmpref.symbol := ref.symbol;
  1026. tmpref.base := NR_RTOC;
  1027. tmpref.refaddr := addr_pic_no_got;
  1028. if macos_direct_globals then
  1029. list.concat(taicpu.op_reg_ref(A_LA,tmpreg,tmpref))
  1030. else
  1031. {$ifdef cpu64bitaddr}
  1032. list.concat(taicpu.op_reg_ref(A_LD,tmpreg,tmpref));
  1033. {$else cpu64bitaddr}
  1034. list.concat(taicpu.op_reg_ref(A_LWZ,tmpreg,tmpref));
  1035. {$endif cpu64bitaddr}
  1036. end;
  1037. if largeOffset then
  1038. begin {Add hi part of offset}
  1039. reference_reset(tmpref,ref.alignment);
  1040. {$ifdef cpu64bitaddr}
  1041. if (ref.offset < low(longint)) or
  1042. (ref.offset > high(longint)) then
  1043. begin
  1044. { load upper 32 bits of the offset, adjusted for adding
  1045. the lower 32 bits later }
  1046. tmpreg2:=getintregister(list,OS_ADDR);
  1047. a_load_const_reg(list,OS_ADDR,(ref.offset and $ffffffff00000000) + ord(longint(ref.offset)<0),tmpreg2);
  1048. if tmpreg=NR_NO then
  1049. tmpreg:=tmpreg2
  1050. else
  1051. a_op_reg_reg(list,OP_ADD,OS_ADDR,tmpreg2,tmpreg);
  1052. ref.offset:=longint(ref.offset);
  1053. end;
  1054. {$endif cpu64bitaddr}
  1055. {Compensate when lo part is negative}
  1056. tmpref.offset := Smallint(ref.offset >> 16) + ord(Smallint(ref.offset) < 0);
  1057. if (tmpreg <> NR_NO) then
  1058. list.concat(taicpu.op_reg_reg_const(A_ADDIS,tmpreg, tmpreg,tmpref.offset))
  1059. else
  1060. begin
  1061. tmpreg := getintregister(list,OS_ADDR);
  1062. list.concat(taicpu.op_reg_const(A_LIS,tmpreg,tmpref.offset));
  1063. end;
  1064. end;
  1065. if (tmpreg <> NR_NO) then
  1066. begin
  1067. {Add content of base register}
  1068. if ref.base <> NR_NO then
  1069. list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,
  1070. ref.base,tmpreg));
  1071. {Make ref ready to be used by op}
  1072. ref.symbol:= nil;
  1073. ref.base:= tmpreg;
  1074. if largeOffset then
  1075. ref.offset := Smallint(ref.offset);
  1076. list.concat(taicpu.op_reg_ref(op,reg,ref));
  1077. //list.concat(tai_comment.create(strpnew('*** a_load_store indirect global')));
  1078. end
  1079. else
  1080. list.concat(taicpu.op_reg_ref(op,reg,ref));
  1081. end
  1082. else {if target_info.system <> system_powerpc_macos}
  1083. begin
  1084. if assigned(ref.symbol) or
  1085. largeOffset then
  1086. begin
  1087. // TODO: offsets > 32 bit
  1088. tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE);
  1089. reference_reset(tmpref,ref.alignment);
  1090. tmpref.symbol := ref.symbol;
  1091. tmpref.relsymbol := ref.relsymbol;
  1092. tmpref.offset := ref.offset;
  1093. tmpref.refaddr := addr_higha;
  1094. if ref.base <> NR_NO then
  1095. list.concat(taicpu.op_reg_reg_ref(A_ADDIS,tmpreg,
  1096. ref.base,tmpref))
  1097. else
  1098. list.concat(taicpu.op_reg_ref(A_LIS,tmpreg,tmpref));
  1099. ref.base := tmpreg;
  1100. ref.refaddr := addr_low;
  1101. list.concat(taicpu.op_reg_ref(op,reg,ref));
  1102. end
  1103. else
  1104. list.concat(taicpu.op_reg_ref(op,reg,ref));
  1105. end;
  1106. end;
  1107. { TPPCAsmData }
  1108. procedure TPPCAsmData.GetNextSmallTocEntry(out tocnr, entrynr: longint);
  1109. begin
  1110. if fcurrenttocentries>(high(word) div sizeof(pint)) then
  1111. begin
  1112. fcurrenttocentries:=0;
  1113. inc(ftocsections);
  1114. end;
  1115. tocnr:=ftocsections;
  1116. entrynr:=fcurrenttocentries;
  1117. inc(fcurrenttocentries);
  1118. end;
  1119. begin
  1120. casmdata:=TPPCAsmData;
  1121. end.