cgppc.pas 47 KB

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