cgppc.pas 49 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265
  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. function g_indirect_sym_load(list:TAsmList;const symname: string; const flags: tindsymflags): tregister; override;
  48. { Transform unsupported methods into Internal errors }
  49. procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); override;
  50. procedure g_stackpointer_alloc(list : TAsmList;localsize : longint);override;
  51. procedure get_aix_toc_sym(list: TAsmList; const symname: string; const flags: tindsymflags; out ref: treference; force_direct_toc: boolean);
  52. procedure g_load_check_simple(list: TAsmList; const ref: treference; size: aint);
  53. procedure g_external_wrapper(list: TAsmList; pd: TProcDef; const externalname: string); override;
  54. protected
  55. function get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
  56. procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); override;
  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,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_MS8', 'OS_MS16', 'OS_MS32',
  129. 'OS_MS64', 'OS_MS128');
  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.RefAsmSymbol(stubname);
  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.RefAsmSymbol('L'+s+'$lazy_ptr');
  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. if target_info.system in systems_aix then
  391. begin
  392. { load function address in R0, and swap "reg" for R0 }
  393. reference_reset_base(tmpref,reg,0,sizeof(pint));
  394. a_load_ref_reg(list,OS_ADDR,OS_ADDR,tmpref,NR_R0);
  395. tmpreg:=reg;
  396. { no need to allocate/free R0, is already allocated by call node
  397. because it's a volatile register }
  398. reg:=NR_R0;
  399. { save current TOC }
  400. reference_reset_base(tmpref,NR_STACK_POINTER_REG,LA_RTOC_AIX,sizeof(pint));
  401. a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_RTOC,tmpref);
  402. end;
  403. list.concat(taicpu.op_reg(A_MTCTR,reg));
  404. if target_info.system in systems_aix then
  405. begin
  406. { load target TOC and possible link register }
  407. reference_reset_base(tmpref,tmpreg,sizeof(pint),sizeof(pint));
  408. a_load_ref_reg(list,OS_ADDR,OS_ADDR,tmpref,NR_RTOC);
  409. tmpref.offset:=2*sizeof(pint);
  410. a_load_ref_reg(list,OS_ADDR,OS_ADDR,tmpref,NR_R11);
  411. end;
  412. list.concat(taicpu.op_none(A_BCTRL));
  413. if target_info.system in systems_aix then
  414. begin
  415. { restore our TOC }
  416. reference_reset_base(tmpref,NR_STACK_POINTER_REG,LA_RTOC_AIX,sizeof(pint));
  417. a_load_ref_reg(list,OS_ADDR,OS_ADDR,tmpref,NR_RTOC);
  418. end;
  419. include(current_procinfo.flags,pi_do_call);
  420. end;
  421. procedure tcgppcgen.a_load_reg_ref(list: TAsmList; fromsize, tosize: TCGSize;
  422. reg: tregister; const ref: treference);
  423. const
  424. StoreInstr: array[OS_8..OS_INT, boolean, boolean] of TAsmOp =
  425. { indexed? updating?}
  426. (((A_STB, A_STBU), (A_STBX, A_STBUX)),
  427. ((A_STH, A_STHU), (A_STHX, A_STHUX)),
  428. ((A_STW, A_STWU), (A_STWX, A_STWUX))
  429. {$ifdef cpu64bitalu}
  430. ,
  431. ((A_STD, A_STDU), (A_STDX, A_STDUX))
  432. {$endif cpu64bitalu}
  433. );
  434. var
  435. ref2: TReference;
  436. tmpreg: tregister;
  437. op: TAsmOp;
  438. begin
  439. if not (fromsize in [OS_8..OS_INT,OS_S8..OS_SINT]) then
  440. internalerror(2002090904);
  441. if not (tosize in [OS_8..OS_INT,OS_S8..OS_SINT]) then
  442. internalerror(2002090905);
  443. if tosize in [OS_S8..OS_SINT] then
  444. { storing is the same for signed and unsigned values }
  445. tosize := tcgsize(ord(tosize) - (ord(OS_S8) - ord(OS_8)));
  446. ref2 := ref;
  447. fixref(list, ref2);
  448. op := storeinstr[tcgsize2unsigned[tosize], ref2.index <> NR_NO, false];
  449. a_load_store(list, op, reg, ref2);
  450. end;
  451. procedure tcgppcgen.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister);
  452. var
  453. op: tasmop;
  454. instr: taicpu;
  455. begin
  456. if not(fromsize in [OS_F32,OS_F64]) or
  457. not(tosize in [OS_F32,OS_F64]) then
  458. internalerror(2006123110);
  459. if (tosize < fromsize) then
  460. op:=A_FRSP
  461. else
  462. op:=A_FMR;
  463. instr := taicpu.op_reg_reg(op,reg2,reg1);
  464. list.concat(instr);
  465. if (op = A_FMR) then
  466. rg[R_FPUREGISTER].add_move_instruction(instr);
  467. end;
  468. procedure tcgppcgen.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister);
  469. const
  470. FpuLoadInstr: Array[OS_F32..OS_F64,boolean, boolean] of TAsmOp =
  471. { indexed? updating?}
  472. (((A_LFS,A_LFSU),(A_LFSX,A_LFSUX)),
  473. ((A_LFD,A_LFDU),(A_LFDX,A_LFDUX)));
  474. var
  475. op: tasmop;
  476. ref2: treference;
  477. begin
  478. if target_info.system in systems_aix then
  479. g_load_check_simple(list,ref,65536);
  480. if not(fromsize in [OS_F32,OS_F64]) or
  481. not(tosize in [OS_F32,OS_F64]) then
  482. internalerror(200201121);
  483. ref2 := ref;
  484. fixref(list,ref2);
  485. op := fpuloadinstr[fromsize,ref2.index <> NR_NO,false];
  486. a_load_store(list,op,reg,ref2);
  487. if (fromsize > tosize) then
  488. a_loadfpu_reg_reg(list,fromsize,tosize,reg,reg);
  489. end;
  490. procedure tcgppcgen.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference);
  491. const
  492. FpuStoreInstr: Array[OS_F32..OS_F64,boolean, boolean] of TAsmOp =
  493. { indexed? updating?}
  494. (((A_STFS,A_STFSU),(A_STFSX,A_STFSUX)),
  495. ((A_STFD,A_STFDU),(A_STFDX,A_STFDUX)));
  496. var
  497. op: tasmop;
  498. ref2: treference;
  499. reg2: tregister;
  500. begin
  501. if not(fromsize in [OS_F32,OS_F64]) or
  502. not(tosize in [OS_F32,OS_F64]) then
  503. internalerror(200201122);
  504. ref2 := ref;
  505. fixref(list,ref2);
  506. op := fpustoreinstr[tosize,ref2.index <> NR_NO,false];
  507. { some PPCs have a bug whereby storing a double to memory }
  508. { as single corrupts the value -> convert double to single }
  509. { first (bug confirmed on some G4s, but not on G5s) }
  510. if (tosize < fromsize) and
  511. (current_settings.cputype < cpu_PPC970) then
  512. begin
  513. reg2:=getfpuregister(list,tosize);
  514. a_loadfpu_reg_reg(list,fromsize,tosize,reg,reg2);
  515. reg:=reg2;
  516. end;
  517. a_load_store(list,op,reg,ref2);
  518. end;
  519. procedure tcgppcgen.g_stackpointer_alloc(list : TAsmList;localsize : longint);
  520. begin
  521. Comment(V_Error,'tcgppcgen.g_stackpointer_alloc method not implemented');
  522. end;
  523. procedure tcgppcgen.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister);
  524. begin
  525. Comment(V_Error,'tcgppcgen.a_bit_scan_reg_reg method not implemented');
  526. end;
  527. procedure tcgppcgen.a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister);
  528. var
  529. fromsreg, tosreg: tsubsetregister;
  530. restbits: byte;
  531. begin
  532. restbits := (sref.bitlen - (loadbitsize - sref.startbit));
  533. if (subsetsize in [OS_S8..OS_S128]) then
  534. begin
  535. { sign extend }
  536. a_op_const_reg(list,OP_SHL,OS_INT,AIntBits-loadbitsize+sref.startbit,valuereg);
  537. a_op_const_reg(list,OP_SAR,OS_INT,AIntBits-sref.bitlen,valuereg);
  538. end
  539. else
  540. begin
  541. a_op_const_reg(list,OP_SHL,OS_INT,restbits,valuereg);
  542. { mask other bits }
  543. if (sref.bitlen <> AIntBits) then
  544. a_op_const_reg(list,OP_AND,OS_INT,(aword(1) shl sref.bitlen)-1,valuereg);
  545. end;
  546. { use subsetreg routine, it may have been overridden with an optimized version }
  547. fromsreg.subsetreg := extra_value_reg;
  548. fromsreg.subsetregsize := OS_INT;
  549. { subsetregs always count bits from right to left }
  550. fromsreg.startbit := loadbitsize-restbits;
  551. fromsreg.bitlen := restbits;
  552. tosreg.subsetreg := valuereg;
  553. tosreg.subsetregsize := OS_INT;
  554. tosreg.startbit := 0;
  555. tosreg.bitlen := restbits;
  556. a_load_subsetreg_subsetreg(list,subsetsize,subsetsize,fromsreg,tosreg);
  557. end;
  558. procedure tcgppcgen.g_overflowcheck(list: TAsmList; const l: tlocation; def: tdef);
  559. var
  560. hl : tasmlabel;
  561. flags : TResFlags;
  562. begin
  563. if not(cs_check_overflow in current_settings.localswitches) then
  564. exit;
  565. current_asmdata.getjumplabel(hl);
  566. if not ((def.typ=pointerdef) or
  567. ((def.typ=orddef) and
  568. (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
  569. pasbool8,pasbool16,pasbool32,pasbool64]))) then
  570. begin
  571. if (current_settings.optimizecputype >= cpu_ppc970) or
  572. (current_settings.cputype >= cpu_ppc970) then
  573. begin
  574. { ... instructions setting overflow flag ...
  575. mfxerf R0
  576. mtcrf 128, R0
  577. ble cr0, label }
  578. list.concat(taicpu.op_reg(A_MFXER, NR_R0));
  579. list.concat(taicpu.op_const_reg(A_MTCRF, 128, NR_R0));
  580. flags.cr := RS_CR0;
  581. flags.flag := F_LE;
  582. a_jmp_flags(list, flags, hl);
  583. end
  584. else
  585. begin
  586. list.concat(taicpu.op_reg(A_MCRXR,NR_CR7));
  587. a_jmp(list,A_BC,C_NO,7,hl)
  588. end;
  589. end
  590. else
  591. a_jmp_cond(list,OC_AE,hl);
  592. a_call_name(list,'FPC_OVERFLOW',false);
  593. a_label(list,hl);
  594. end;
  595. procedure tcgppcgen.g_profilecode(list: TAsmList);
  596. var
  597. paraloc1 : tcgpara;
  598. begin
  599. if (target_info.system in [system_powerpc_darwin]) then
  600. begin
  601. paraloc1.init;
  602. paramanager.getintparaloc(pocall_cdecl,1,paraloc1);
  603. a_load_reg_cgpara(list,OS_ADDR,NR_R0,paraloc1);
  604. paramanager.freecgpara(list,paraloc1);
  605. paraloc1.done;
  606. allocallcpuregisters(list);
  607. a_call_name(list,'mcount',false);
  608. deallocallcpuregisters(list);
  609. a_reg_dealloc(list,NR_R0);
  610. end;
  611. end;
  612. procedure tcgppcgen.a_jmp_cond(list : TAsmList;cond : TOpCmp; l: tasmlabel);
  613. begin
  614. a_jmp(list,A_BC,TOpCmp2AsmCond[cond],0,l);
  615. end;
  616. procedure tcgppcgen.a_jmp(list: TAsmList; op: tasmop; c: tasmcondflag;
  617. crval: longint; l: tasmlabel);
  618. var
  619. p: taicpu;
  620. begin
  621. p := taicpu.op_sym(op,l);
  622. if op <> A_B then
  623. create_cond_norm(c,crval,p.condition);
  624. p.is_jmp := true;
  625. list.concat(p)
  626. end;
  627. procedure tcgppcgen.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
  628. procedure loadvmttor11;
  629. var
  630. href : treference;
  631. begin
  632. reference_reset_base(href,NR_R3,0,sizeof(pint));
  633. cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R11);
  634. end;
  635. procedure op_onr11methodaddr;
  636. var
  637. href : treference;
  638. begin
  639. if (procdef.extnumber=$ffff) then
  640. Internalerror(200006139);
  641. { call/jmp vmtoffs(%eax) ; method offs }
  642. reference_reset_base(href,NR_R11,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
  643. if hasLargeOffset(href) then
  644. begin
  645. {$ifdef cpu64}
  646. if (longint(href.offset) <> href.offset) then
  647. { add support for offsets > 32 bit }
  648. internalerror(200510201);
  649. {$endif cpu64}
  650. list.concat(taicpu.op_reg_reg_const(A_ADDIS,NR_R11,NR_R11,
  651. smallint((href.offset shr 16)+ord(smallint(href.offset and $ffff) < 0))));
  652. href.offset := smallint(href.offset and $ffff);
  653. end;
  654. a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R11);
  655. if (target_info.system in ([system_powerpc64_linux]+systems_aix)) then
  656. begin
  657. reference_reset_base(href, NR_R11, 0, sizeof(pint));
  658. a_load_ref_reg(list, OS_ADDR, OS_ADDR, href, NR_R11);
  659. end;
  660. list.concat(taicpu.op_reg(A_MTCTR,NR_R11));
  661. list.concat(taicpu.op_none(A_BCTR));
  662. if (target_info.system in ([system_powerpc64_linux]+systems_aix)) then
  663. list.concat(taicpu.op_none(A_NOP));
  664. end;
  665. var
  666. make_global : boolean;
  667. begin
  668. if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
  669. Internalerror(200006137);
  670. if not assigned(procdef.struct) or
  671. (procdef.procoptions*[po_classmethod, po_staticmethod,
  672. po_methodpointer, po_interrupt, po_iocheck]<>[]) then
  673. Internalerror(200006138);
  674. if procdef.owner.symtabletype<>ObjectSymtable then
  675. Internalerror(200109191);
  676. make_global:=false;
  677. if (not current_module.is_unit) or
  678. create_smartlink or
  679. (procdef.owner.defowner.owner.symtabletype=globalsymtable) then
  680. make_global:=true;
  681. if make_global then
  682. List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
  683. else
  684. List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
  685. { set param1 interface to self }
  686. g_adjust_self_value(list,procdef,ioffset);
  687. { case 4 }
  688. if (po_virtualmethod in procdef.procoptions) and
  689. not is_objectpascal_helper(procdef.struct) then
  690. begin
  691. loadvmttor11;
  692. op_onr11methodaddr;
  693. end
  694. { case 0 }
  695. else
  696. case target_info.system of
  697. system_powerpc_darwin,
  698. system_powerpc64_darwin:
  699. list.concat(taicpu.op_sym(A_B,get_darwin_call_stub(procdef.mangledname,false)));
  700. system_powerpc64_linux,
  701. system_powerpc_aix,
  702. system_powerpc64_aix:
  703. {$note ts:todo add GOT change?? - think not needed :) }
  704. list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol('.' + procdef.mangledname)));
  705. else
  706. list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(procdef.mangledname)))
  707. end;
  708. List.concat(Tai_symbol_end.Createname(labelname));
  709. end;
  710. function tcgppcgen.load_got_symbol(list: TAsmList; const symbol : string; const flags: tindsymflags) : tregister;
  711. var
  712. l: tasmsymbol;
  713. ref: treference;
  714. begin
  715. if target_info.system=system_powerpc64_linux then
  716. begin
  717. l:=current_asmdata.getasmsymbol(symbol);
  718. reference_reset_symbol(ref,l,0,sizeof(pint));
  719. ref.base:=NR_RTOC;
  720. ref.refaddr:=addr_pic;
  721. end
  722. else if target_info.system in systems_aix then
  723. get_aix_toc_sym(list,symbol,flags,ref,false)
  724. else
  725. internalerror(2007102010);
  726. result := getaddressregister(list);
  727. {$ifdef cpu64bitaddr}
  728. list.concat(taicpu.op_reg_ref(A_LD, result, ref));
  729. {$else cpu64bitaddr}
  730. list.concat(taicpu.op_reg_ref(A_LWZ, result, ref));
  731. {$endif cpu64bitaddr}
  732. end;
  733. procedure tcgppcgen.get_aix_toc_sym(list: TAsmList; const symname: string; const flags: tindsymflags; out ref: treference; force_direct_toc: boolean);
  734. const
  735. { The TOC on AIX is limited to 32KB worth of entries on AIX. If you need
  736. more entries, you have to add a level of indirection. In some cases,
  737. it's not possible to do this (e.g. assembler code). So by default, we
  738. use direct TOC entries until we're 500 from the maximum, and then start
  739. using indirect TOC entries. }
  740. AutoDirectTOCLimit = (high(smallint) div sizeof(pint)) - 500;
  741. var
  742. tmpref: treference;
  743. { can have more than 16384 (32 bit) or 8192 (64 bit) toc entries and, as
  744. as consequence, toc subsections -> 5 extra characters for the number}
  745. tocsecname: string[length('tocsubtable')+5];
  746. nlsymname: string;
  747. newsymname: ansistring;
  748. sym: TAsmSymbol;
  749. tocsym: TTOCAsmSymbol;
  750. tocnr,
  751. entrynr: longint;
  752. tmpreg: tregister;
  753. begin
  754. { all global symbol accesses always must be done via the TOC }
  755. nlsymname:='LC..'+symname;
  756. reference_reset_symbol(ref,current_asmdata.getasmsymbol(nlsymname),0,sizeof(pint));
  757. if (assigned(ref.symbol) and
  758. not(ref.symbol is TTOCAsmSymbol)) or
  759. (not(ts_small_toc in current_settings.targetswitches) and
  760. (TPPCAsmData(current_asmdata).DirectTOCEntries<AutoDirectTOCLimit)) or
  761. force_direct_toc then
  762. begin
  763. ref.refaddr:=addr_pic_no_got;
  764. ref.base:=NR_RTOC;
  765. if not assigned(ref.symbol) then
  766. begin
  767. TPPCAsmData(current_asmdata).DirectTOCEntries:=TPPCAsmData(current_asmdata).DirectTOCEntries+1;
  768. new_section(current_asmdata.AsmLists[al_picdata],sec_toc,'',sizeof(pint));
  769. ref.symbol:=current_asmdata.DefineAsmSymbol(nlsymname,AB_LOCAL,AT_DATA);
  770. current_asmdata.asmlists[al_picdata].concat(tai_symbol.create(ref.symbol,0));
  771. { do not assign the result of these statements to ref.symbol: the
  772. access must be done via the LC..symname symbol; these are just
  773. to define the symbol that's being accessed as either weak or
  774. not }
  775. if not(is_weak in flags) then
  776. current_asmdata.RefAsmSymbol(symname)
  777. else if is_data in flags then
  778. current_asmdata.WeakRefAsmSymbol(symname)
  779. else
  780. current_asmdata.WeakRefAsmSymbol('.'+symname);
  781. newsymname:=ReplaceForbiddenAsmSymbolChars(symname);
  782. current_asmdata.asmlists[al_picdata].concat(tai_directive.Create(asd_toc_entry,newsymname+'[TC],'+newsymname));
  783. end;
  784. end
  785. else
  786. begin
  787. if not assigned(ref.symbol) then
  788. begin
  789. TPPCAsmData(current_asmdata).GetNextSmallTocEntry(tocnr,entrynr);
  790. { new TOC entry? }
  791. if entrynr=0 then
  792. begin
  793. { create new toc entry that contains the address of the next
  794. table of addresses }
  795. get_aix_toc_sym(list,'tocsubtable'+tostr(tocnr),[is_data],tmpref,true);
  796. sym:=tmpref.symbol;
  797. { base address for this batch of toc table entries that we'll
  798. put in a data block instead }
  799. new_section(current_asmdata.AsmLists[al_indirectpicdata],sec_rodata,'',sizeof(pint));
  800. sym:=current_asmdata.DefineAsmSymbol('tocsubtable'+tostr(tocnr),AB_LOCAL,AT_DATA);
  801. current_asmdata.asmlists[al_indirectpicdata].concat(tai_symbol.create(sym,0));
  802. end;
  803. { add the reference to the actual symbol inside the tocsubtable }
  804. if not(is_weak in flags) then
  805. current_asmdata.RefAsmSymbol(symname)
  806. else if is_data in flags then
  807. current_asmdata.WeakRefAsmSymbol(symname)
  808. else
  809. current_asmdata.WeakRefAsmSymbol('.'+symname);
  810. tocsym:=TTOCAsmSymbol(current_asmdata.DefineAsmSymbolByClass(TTOCAsmSymbol,nlsymname,AB_LOCAL,AT_DATA));
  811. ref.symbol:=tocsym;
  812. tocsym.ftocsecnr:=tocnr;
  813. current_asmdata.asmlists[al_indirectpicdata].concat(tai_symbol.create(tocsym,0));
  814. newsymname:=ReplaceForbiddenAsmSymbolChars(symname);
  815. sym:=current_asmdata.RefAsmSymbol(newsymname);
  816. current_asmdata.asmlists[al_indirectpicdata].concat(tai_const.Create_sym(sym));
  817. end;
  818. { first load the address of the table from the TOC }
  819. get_aix_toc_sym(list,'tocsubtable'+tostr(TTOCAsmSymbol(ref.symbol).ftocsecnr),[is_data],tmpref,true);
  820. tmpreg:=getaddressregister(list);
  821. a_load_ref_reg(list,OS_ADDR,OS_ADDR,tmpref,tmpreg);
  822. { and now set up the address of the entry, relative to the start of
  823. the table }
  824. ref.base:=tmpreg;
  825. ref.refaddr:=addr_pic;
  826. ref.relsymbol:=current_asmdata.GetAsmSymbol('tocsubtable'+tostr(TTOCAsmSymbol(ref.symbol).ftocsecnr));
  827. end;
  828. end;
  829. procedure tcgppcgen.g_load_check_simple(list: TAsmList; const ref: treference; size: aint);
  830. var
  831. reg: tregister;
  832. lab: tasmlabel;
  833. begin
  834. if not(cs_check_low_addr_load in current_settings.localswitches) then
  835. exit;
  836. { this is mainly for AIX, which does not trap loads from address 0. A
  837. global symbol (if not weak) will always map to a proper address, and
  838. the same goes for stack addresses -> skip }
  839. if assigned(ref.symbol) and
  840. (ref.symbol.bind<>AB_WEAK_EXTERNAL) then
  841. exit;
  842. if (ref.base=NR_STACK_POINTER_REG) or
  843. (ref.index=NR_STACK_POINTER_REG) or
  844. (assigned(current_procinfo) and
  845. ((ref.base=current_procinfo.framepointer) or
  846. (ref.index=current_procinfo.framepointer))) then
  847. exit;
  848. if assigned(ref.symbol) or
  849. (ref.offset<>0) or
  850. ((ref.base<>NR_NO) and (ref.index<>NR_NO)) then
  851. begin
  852. { can't allocate register, also used in wrappers and the like }
  853. reg:=NR_R0;
  854. a_reg_alloc(list,reg);
  855. a_loadaddr_ref_reg(list,ref,reg);
  856. end
  857. else if ref.base<>NR_NO then
  858. reg:=ref.base
  859. else
  860. reg:=ref.index;
  861. current_asmdata.getjumplabel(lab);
  862. if reg=NR_R0 then
  863. a_reg_dealloc(list,reg);
  864. a_cmp_const_reg_label(list,OS_ADDR,OC_A,size-1,reg,lab);
  865. a_call_name(list,'FPC_INVALIDPOINTER',false);
  866. a_label(list,lab);
  867. end;
  868. procedure tcgppcgen.g_external_wrapper(list: TAsmList; pd: TProcDef; const externalname: string);
  869. var
  870. href : treference;
  871. begin
  872. if not(target_info.system in ([system_powerpc64_linux]+systems_aix)) then begin
  873. inherited;
  874. exit;
  875. end;
  876. { for ppc64/linux and aix emit correct code which sets up a stack frame
  877. and then calls the external method normally to ensure that the GOT/TOC
  878. will be loaded correctly if required.
  879. The resulting code sequence looks as follows:
  880. mflr r0
  881. stw/d r0, 16(r1)
  882. stw/du r1, -112(r1)
  883. bl <external_method>
  884. nop
  885. addi r1, r1, 112
  886. lwz/d r0, 16(r1)
  887. mtlr r0
  888. blr
  889. }
  890. list.concat(taicpu.op_reg(A_MFLR, NR_R0));
  891. if target_info.abi=abi_powerpc_sysv then
  892. reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_SYSV, 8)
  893. else
  894. reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_AIX, 8);
  895. a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_R0,href);
  896. reference_reset_base(href, NR_STACK_POINTER_REG, -MINIMUM_STACKFRAME_SIZE, 8);
  897. list.concat(taicpu.op_reg_ref({$ifdef cpu64bitaddr}A_STDU{$else}A_STWU{$endif}, NR_STACK_POINTER_REG, href));
  898. a_call_name(list,externalname,false);
  899. list.concat(taicpu.op_reg_reg_const(A_ADDI, NR_STACK_POINTER_REG, NR_STACK_POINTER_REG, MINIMUM_STACKFRAME_SIZE));
  900. if target_info.abi=abi_powerpc_sysv then
  901. reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_SYSV, 8)
  902. else
  903. reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_AIX, 8);
  904. a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R0);
  905. list.concat(taicpu.op_reg(A_MTLR, NR_R0));
  906. list.concat(taicpu.op_none(A_BLR));
  907. end;
  908. function tcgppcgen.fixref(list: TAsmList; var ref: treference): boolean;
  909. var
  910. tmpreg: tregister;
  911. begin
  912. result := false;
  913. { Avoid recursion. }
  914. if (ref.refaddr in [addr_pic,addr_pic_no_got]) then
  915. exit;
  916. {$IFDEF EXTDEBUG}
  917. list.concat(tai_comment.create(strpnew('fixref0 ' + ref2string(ref))));
  918. {$ENDIF EXTDEBUG}
  919. if (target_info.system in [system_powerpc_darwin,system_powerpc64_darwin]) and
  920. assigned(ref.symbol) and
  921. not assigned(ref.relsymbol) and
  922. ((ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) or
  923. (cs_create_pic in current_settings.moduleswitches))then
  924. begin
  925. if (ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) or
  926. ((cs_create_pic in current_settings.moduleswitches) and
  927. (ref.symbol.bind in [AB_COMMON,AB_GLOBAL,AB_PRIVATE_EXTERN])) then
  928. begin
  929. tmpreg := g_indirect_sym_load(list,ref.symbol.name,asmsym2indsymflags(ref.symbol));
  930. ref.symbol:=nil;
  931. end
  932. else
  933. begin
  934. include(current_procinfo.flags,pi_needs_got);
  935. tmpreg := current_procinfo.got;
  936. if assigned(ref.relsymbol) then
  937. internalerror(2007093501);
  938. ref.relsymbol := current_procinfo.CurrGOTLabel;
  939. end;
  940. if (ref.base = NR_NO) then
  941. ref.base := tmpreg
  942. else if (ref.index = NR_NO) then
  943. ref.index := tmpreg
  944. else
  945. begin
  946. list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg));
  947. ref.base := tmpreg;
  948. end;
  949. end;
  950. { if we have to create PIC, add the symbol to the TOC/GOT }
  951. if (((target_info.system = system_powerpc64_linux) and
  952. (cs_create_pic in current_settings.moduleswitches)) or
  953. (target_info.system in systems_aix)) and
  954. (assigned(ref.symbol) and
  955. not assigned(ref.relsymbol)) then
  956. begin
  957. tmpreg := load_got_symbol(list, ref.symbol.name, asmsym2indsymflags(ref.symbol));
  958. if (ref.base = NR_NO) then
  959. ref.base := tmpreg
  960. else if (ref.index = NR_NO) then
  961. ref.index := tmpreg
  962. else begin
  963. a_op_reg_reg_reg(list, OP_ADD, OS_ADDR, ref.base, tmpreg, tmpreg);
  964. ref.base := tmpreg;
  965. end;
  966. ref.symbol := nil;
  967. {$IFDEF EXTDEBUG}
  968. list.concat(tai_comment.create(strpnew('fixref-pic ' + ref2string(ref))));
  969. {$ENDIF EXTDEBUG}
  970. end;
  971. if (ref.base = NR_NO) then
  972. begin
  973. ref.base := ref.index;
  974. ref.index := NR_NO;
  975. end;
  976. if (ref.base <> NR_NO) then
  977. begin
  978. if (ref.index <> NR_NO) and
  979. ((ref.offset <> 0) or assigned(ref.symbol)) then
  980. begin
  981. result := true;
  982. tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE);
  983. list.concat(taicpu.op_reg_reg_reg(
  984. A_ADD,tmpreg,ref.base,ref.index));
  985. ref.index := NR_NO;
  986. ref.base := tmpreg;
  987. end
  988. end;
  989. if (ref.index <> NR_NO) and
  990. (assigned(ref.symbol) or
  991. (ref.offset <> 0)) then
  992. internalerror(200208102);
  993. {$IFDEF EXTDEBUG}
  994. list.concat(tai_comment.create(strpnew('fixref1 ' + ref2string(ref))));
  995. {$ENDIF EXTDEBUG}
  996. end;
  997. procedure tcgppcgen.a_load_store(list:TAsmList;op: tasmop;reg:tregister;
  998. ref: treference);
  999. var
  1000. tmpreg: tregister;
  1001. {$ifdef cpu64bitaddr}
  1002. tmpreg2: tregister;
  1003. {$endif cpu64bitaddr}
  1004. tmpref: treference;
  1005. largeOffset: Boolean;
  1006. begin
  1007. tmpreg := NR_NO;
  1008. largeOffset:= hasLargeOffset(ref);
  1009. if target_info.system in ([system_powerpc_macos]+systems_aix) then
  1010. begin
  1011. if assigned(ref.symbol) and
  1012. (ref.refaddr<>addr_pic_no_got) then
  1013. begin {Load symbol's value}
  1014. tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE);
  1015. reference_reset(tmpref,sizeof(pint));
  1016. tmpref.symbol := ref.symbol;
  1017. tmpref.base := NR_RTOC;
  1018. tmpref.refaddr := addr_pic_no_got;
  1019. if macos_direct_globals then
  1020. list.concat(taicpu.op_reg_ref(A_LA,tmpreg,tmpref))
  1021. else
  1022. {$ifdef cpu64bitaddr}
  1023. list.concat(taicpu.op_reg_ref(A_LD,tmpreg,tmpref));
  1024. {$else cpu64bitaddr}
  1025. list.concat(taicpu.op_reg_ref(A_LWZ,tmpreg,tmpref));
  1026. {$endif cpu64bitaddr}
  1027. end;
  1028. if largeOffset then
  1029. begin {Add hi part of offset}
  1030. reference_reset(tmpref,ref.alignment);
  1031. {$ifdef cpu64bitaddr}
  1032. if (ref.offset < low(longint)) or
  1033. (ref.offset > high(longint)) then
  1034. begin
  1035. { load upper 32 bits of the offset, adjusted for adding
  1036. the lower 32 bits later }
  1037. tmpreg2:=getintregister(list,OS_ADDR);
  1038. a_load_const_reg(list,OS_ADDR,(ref.offset and $ffffffff00000000) + ord(longint(ref.offset)<0),tmpreg2);
  1039. if tmpreg=NR_NO then
  1040. tmpreg:=tmpreg2
  1041. else
  1042. a_op_reg_reg(list,OP_ADD,OS_ADDR,tmpreg2,tmpreg);
  1043. ref.offset:=longint(ref.offset);
  1044. end;
  1045. {$endif cpu64bitaddr}
  1046. {Compensate when lo part is negative}
  1047. tmpref.offset := Smallint(ref.offset >> 16) + ord(Smallint(ref.offset) < 0);
  1048. if (tmpreg <> NR_NO) then
  1049. list.concat(taicpu.op_reg_reg_const(A_ADDIS,tmpreg, tmpreg,tmpref.offset))
  1050. else
  1051. begin
  1052. tmpreg := getintregister(list,OS_ADDR);
  1053. list.concat(taicpu.op_reg_const(A_LIS,tmpreg,tmpref.offset));
  1054. end;
  1055. end;
  1056. if (tmpreg <> NR_NO) then
  1057. begin
  1058. {Add content of base register}
  1059. if ref.base <> NR_NO then
  1060. list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,
  1061. ref.base,tmpreg));
  1062. {Make ref ready to be used by op}
  1063. ref.symbol:= nil;
  1064. ref.base:= tmpreg;
  1065. if largeOffset then
  1066. ref.offset := Smallint(ref.offset);
  1067. list.concat(taicpu.op_reg_ref(op,reg,ref));
  1068. //list.concat(tai_comment.create(strpnew('*** a_load_store indirect global')));
  1069. end
  1070. else
  1071. list.concat(taicpu.op_reg_ref(op,reg,ref));
  1072. end
  1073. else {if target_info.system <> system_powerpc_macos}
  1074. begin
  1075. if assigned(ref.symbol) or
  1076. largeOffset then
  1077. begin
  1078. // TODO: offsets > 32 bit
  1079. tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE);
  1080. reference_reset(tmpref,ref.alignment);
  1081. tmpref.symbol := ref.symbol;
  1082. tmpref.relsymbol := ref.relsymbol;
  1083. tmpref.offset := ref.offset;
  1084. tmpref.refaddr := addr_higha;
  1085. if ref.base <> NR_NO then
  1086. list.concat(taicpu.op_reg_reg_ref(A_ADDIS,tmpreg,
  1087. ref.base,tmpref))
  1088. else
  1089. list.concat(taicpu.op_reg_ref(A_LIS,tmpreg,tmpref));
  1090. ref.base := tmpreg;
  1091. ref.refaddr := addr_low;
  1092. list.concat(taicpu.op_reg_ref(op,reg,ref));
  1093. end
  1094. else
  1095. list.concat(taicpu.op_reg_ref(op,reg,ref));
  1096. end;
  1097. end;
  1098. { TPPCAsmData }
  1099. procedure TPPCAsmData.GetNextSmallTocEntry(out tocnr, entrynr: longint);
  1100. begin
  1101. if fcurrenttocentries>(high(word) div sizeof(pint)) then
  1102. begin
  1103. fcurrenttocentries:=0;
  1104. inc(ftocsections);
  1105. end;
  1106. tocnr:=ftocsections;
  1107. entrynr:=fcurrenttocentries;
  1108. inc(fcurrenttocentries);
  1109. end;
  1110. begin
  1111. casmdata:=TPPCAsmData;
  1112. end.