cgcpu.pas 59 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645
  1. {
  2. $Id$
  3. Copyright (c) 2003 by Florian Klaempfl
  4. Member of the Free Pascal development team
  5. This unit implements the code generator for the ARM
  6. This program is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2 of the License, or
  9. (at your option) any later version.
  10. This program is distributed in the hope that it will be useful,
  11. but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. GNU General Public License for more details.
  14. You should have received a copy of the GNU General Public License
  15. along with this program; if not, write to the Free Software
  16. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17. ****************************************************************************
  18. }
  19. unit cgcpu;
  20. {$i fpcdefs.inc}
  21. interface
  22. uses
  23. globtype,symtype,symdef,
  24. cgbase,cgutils,cgobj,
  25. aasmbase,aasmcpu,aasmtai,
  26. parabase,
  27. cpubase,cpuinfo,node,cg64f32,rgcpu;
  28. type
  29. tcgarm = class(tcg)
  30. { true, if the next arithmetic operation should modify the flags }
  31. cgsetflags : boolean;
  32. procedure init_register_allocators;override;
  33. procedure done_register_allocators;override;
  34. procedure a_param_const(list : taasmoutput;size : tcgsize;a : aint;const paraloc : TCGPara);override;
  35. procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const paraloc : TCGPara);override;
  36. procedure a_paramaddr_ref(list : taasmoutput;const r : treference;const paraloc : TCGPara);override;
  37. procedure a_call_name(list : taasmoutput;const s : string);override;
  38. procedure a_call_reg(list : taasmoutput;reg: tregister); override;
  39. procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: aint; reg: TRegister); override;
  40. procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister); override;
  41. procedure a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
  42. size: tcgsize; a: aint; src, dst: tregister); override;
  43. procedure a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
  44. size: tcgsize; src1, src2, dst: tregister); override;
  45. procedure a_op_const_reg_reg_checkoverflow(list: taasmoutput; op: TOpCg; size: tcgsize; a: aint; src, dst: tregister;setflags : boolean;var ovloc : tlocation);override;
  46. procedure a_op_reg_reg_reg_checkoverflow(list: taasmoutput; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation);override;
  47. { move instructions }
  48. procedure a_load_const_reg(list : taasmoutput; size: tcgsize; a : aint;reg : tregister);override;
  49. procedure a_load_reg_ref(list : taasmoutput; fromsize, tosize: tcgsize; reg : tregister;const ref : treference);override;
  50. procedure a_load_ref_reg(list : taasmoutput; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);override;
  51. procedure a_load_reg_reg(list : taasmoutput; fromsize, tosize : tcgsize;reg1,reg2 : tregister);override;
  52. { fpu move instructions }
  53. procedure a_loadfpu_reg_reg(list: taasmoutput; size: tcgsize; reg1, reg2: tregister); override;
  54. procedure a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister); override;
  55. procedure a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); override;
  56. { comparison operations }
  57. procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aint;reg : tregister;
  58. l : tasmlabel);override;
  59. procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override;
  60. procedure a_jmp_name(list : taasmoutput;const s : string); override;
  61. procedure a_jmp_always(list : taasmoutput;l: tasmlabel); override;
  62. procedure a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel); override;
  63. procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: TResFlags; reg: TRegister); override;
  64. procedure g_proc_entry(list : taasmoutput;localsize : longint;nostackframe:boolean);override;
  65. procedure g_proc_exit(list : taasmoutput;parasize : longint;nostackframe:boolean); override;
  66. procedure a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);override;
  67. procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aint);override;
  68. procedure g_overflowcheck(list: taasmoutput; const l: tlocation; def: tdef); override;
  69. procedure g_overflowCheck_loc(List:TAasmOutput;const Loc:TLocation;def:TDef;ovloc : tlocation);override;
  70. procedure g_save_standard_registers(list : taasmoutput);override;
  71. procedure g_restore_standard_registers(list : taasmoutput);override;
  72. procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
  73. procedure fixref(list : taasmoutput;var ref : treference);
  74. procedure handle_load_store(list:taasmoutput;op: tasmop;oppostfix : toppostfix;reg:tregister;ref: treference);
  75. procedure g_intf_wrapper(list: taasmoutput; procdef: tprocdef; const labelname: string; ioffset: longint);override;
  76. end;
  77. tcg64farm = class(tcg64f32)
  78. procedure a_op64_reg_reg(list : taasmoutput;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64);override;
  79. procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;size : tcgsize;value : int64;reg : tregister64);override;
  80. procedure a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64);override;
  81. procedure a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64);override;
  82. procedure a_op64_const_reg_reg_checkoverflow(list: taasmoutput;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);override;
  83. procedure a_op64_reg_reg_reg_checkoverflow(list: taasmoutput;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);override;
  84. end;
  85. const
  86. OpCmp2AsmCond : Array[topcmp] of TAsmCond = (C_NONE,C_EQ,C_GT,
  87. C_LT,C_GE,C_LE,C_NE,C_LS,C_CC,C_CS,C_HI);
  88. function is_shifter_const(d : aint;var imm_shift : byte) : boolean;
  89. function get_fpu_postfix(def : tdef) : toppostfix;
  90. implementation
  91. uses
  92. globals,verbose,systems,cutils,
  93. fmodule,
  94. symconst,symsym,
  95. tgobj,
  96. procinfo,cpupi,
  97. paramgr;
  98. function get_fpu_postfix(def : tdef) : toppostfix;
  99. begin
  100. if def.deftype=floatdef then
  101. begin
  102. case tfloatdef(def).typ of
  103. s32real:
  104. result:=PF_S;
  105. s64real:
  106. result:=PF_D;
  107. s80real:
  108. result:=PF_E;
  109. else
  110. internalerror(200401272);
  111. end;
  112. end
  113. else
  114. internalerror(200401271);
  115. end;
  116. procedure tcgarm.init_register_allocators;
  117. begin
  118. inherited init_register_allocators;
  119. { currently, we save R14 always, so we can use it }
  120. rg[R_INTREGISTER]:=trgintcpu.create(R_INTREGISTER,R_SUBWHOLE,
  121. [RS_R0,RS_R1,RS_R2,RS_R3,RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,
  122. RS_R9,RS_R10,RS_R12,RS_R14],first_int_imreg,[]);
  123. rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBNONE,
  124. [RS_F0,RS_F1,RS_F2,RS_F3,RS_F4,RS_F5,RS_F6,RS_F7],first_fpu_imreg,[]);
  125. rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBNONE,
  126. [RS_S0,RS_S1,RS_R2,RS_R3,RS_R4,RS_S31],first_mm_imreg,[]);
  127. end;
  128. procedure tcgarm.done_register_allocators;
  129. begin
  130. rg[R_INTREGISTER].free;
  131. rg[R_FPUREGISTER].free;
  132. rg[R_MMREGISTER].free;
  133. inherited done_register_allocators;
  134. end;
  135. procedure tcgarm.a_param_const(list : taasmoutput;size : tcgsize;a : aint;const paraloc : TCGPara);
  136. var
  137. ref: treference;
  138. begin
  139. paraloc.check_simple_location;
  140. case paraloc.location^.loc of
  141. LOC_REGISTER,LOC_CREGISTER:
  142. a_load_const_reg(list,size,a,paraloc.location^.register);
  143. LOC_REFERENCE:
  144. begin
  145. reference_reset(ref);
  146. ref.base:=paraloc.location^.reference.index;
  147. ref.offset:=paraloc.location^.reference.offset;
  148. a_load_const_ref(list,size,a,ref);
  149. end;
  150. else
  151. internalerror(2002081101);
  152. end;
  153. end;
  154. procedure tcgarm.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const paraloc : TCGPara);
  155. var
  156. ref: treference;
  157. tmpreg: tregister;
  158. begin
  159. paraloc.check_simple_location;
  160. case paraloc.location^.loc of
  161. LOC_REGISTER,LOC_CREGISTER:
  162. a_load_ref_reg(list,size,size,r,paraloc.location^.register);
  163. LOC_REFERENCE:
  164. begin
  165. reference_reset(ref);
  166. ref.base:=paraloc.location^.reference.index;
  167. ref.offset:=paraloc.location^.reference.offset;
  168. tmpreg := getintregister(list,size);
  169. a_load_ref_reg(list,size,size,r,tmpreg);
  170. a_load_reg_ref(list,size,size,tmpreg,ref);
  171. end;
  172. LOC_FPUREGISTER,LOC_CFPUREGISTER:
  173. case size of
  174. OS_F32, OS_F64:
  175. a_loadfpu_ref_reg(list,size,r,paraloc.location^.register);
  176. else
  177. internalerror(2002072801);
  178. end;
  179. else
  180. internalerror(2002081103);
  181. end;
  182. end;
  183. procedure tcgarm.a_paramaddr_ref(list : taasmoutput;const r : treference;const paraloc : TCGPara);
  184. var
  185. ref: treference;
  186. tmpreg: tregister;
  187. begin
  188. paraloc.check_simple_location;
  189. case paraloc.location^.loc of
  190. LOC_REGISTER,LOC_CREGISTER:
  191. a_loadaddr_ref_reg(list,r,paraloc.location^.register);
  192. LOC_REFERENCE:
  193. begin
  194. reference_reset(ref);
  195. ref.base := paraloc.location^.reference.index;
  196. ref.offset := paraloc.location^.reference.offset;
  197. tmpreg := getintregister(list,OS_ADDR);
  198. a_loadaddr_ref_reg(list,r,tmpreg);
  199. a_load_reg_ref(list,OS_ADDR,OS_ADDR,tmpreg,ref);
  200. end;
  201. else
  202. internalerror(2002080701);
  203. end;
  204. end;
  205. procedure tcgarm.a_call_name(list : taasmoutput;const s : string);
  206. begin
  207. list.concat(taicpu.op_sym(A_BL,objectlibrary.newasmsymbol(s,AB_EXTERNAL,AT_FUNCTION)));
  208. {
  209. the compiler does not properly set this flag anymore in pass 1, and
  210. for now we only need it after pass 2 (I hope) (JM)
  211. if not(pi_do_call in current_procinfo.flags) then
  212. internalerror(2003060703);
  213. }
  214. include(current_procinfo.flags,pi_do_call);
  215. end;
  216. procedure tcgarm.a_call_reg(list : taasmoutput;reg: tregister);
  217. var
  218. r : tregister;
  219. begin
  220. list.concat(taicpu.op_reg_reg(A_MOV,NR_R14,NR_PC));
  221. list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,reg));
  222. {
  223. the compiler does not properly set this flag anymore in pass 1, and
  224. for now we only need it after pass 2 (I hope) (JM)
  225. if not(pi_do_call in current_procinfo.flags) then
  226. internalerror(2003060703);
  227. }
  228. include(current_procinfo.flags,pi_do_call);
  229. end;
  230. procedure tcgarm.a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: aint; reg: TRegister);
  231. begin
  232. a_op_const_reg_reg(list,op,size,a,reg,reg);
  233. end;
  234. procedure tcgarm.a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister);
  235. begin
  236. case op of
  237. OP_NEG:
  238. list.concat(taicpu.op_reg_reg_const(A_RSB,dst,src,0));
  239. OP_NOT:
  240. begin
  241. list.concat(taicpu.op_reg_reg(A_MVN,dst,src));
  242. case size of
  243. OS_8 :
  244. a_op_const_reg_reg(list,OP_AND,OS_INT,$ff,dst,dst);
  245. OS_16 :
  246. a_op_const_reg_reg(list,OP_AND,OS_INT,$ffff,dst,dst);
  247. end;
  248. end
  249. else
  250. a_op_reg_reg_reg(list,op,OS_32,src,dst,dst);
  251. end;
  252. end;
  253. const
  254. op_reg_reg_opcg2asmop: array[TOpCG] of tasmop =
  255. (A_NONE,A_ADD,A_AND,A_NONE,A_NONE,A_MUL,A_MUL,A_NONE,A_NONE,A_ORR,
  256. A_NONE,A_NONE,A_NONE,A_SUB,A_EOR);
  257. procedure tcgarm.a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
  258. size: tcgsize; a: aint; src, dst: tregister);
  259. var
  260. ovloc : tlocation;
  261. begin
  262. a_op_const_reg_reg_checkoverflow(list,op,size,a,src,dst,false,ovloc);
  263. end;
  264. procedure tcgarm.a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
  265. size: tcgsize; src1, src2, dst: tregister);
  266. var
  267. ovloc : tlocation;
  268. begin
  269. a_op_reg_reg_reg_checkoverflow(list,op,size,src1,src2,dst,false,ovloc);
  270. end;
  271. procedure tcgarm.a_op_const_reg_reg_checkoverflow(list: taasmoutput; op: TOpCg; size: tcgsize; a: aint; src, dst: tregister;setflags : boolean;var ovloc : tlocation);
  272. var
  273. shift : byte;
  274. tmpreg : tregister;
  275. so : tshifterop;
  276. l1 : longint;
  277. begin
  278. ovloc.loc:=LOC_VOID;
  279. if is_shifter_const(-a,shift) then
  280. case op of
  281. OP_ADD:
  282. begin
  283. op:=OP_SUB;
  284. a:=dword(-a);
  285. end;
  286. OP_SUB:
  287. begin
  288. op:=OP_ADD;
  289. a:=dword(-a);
  290. end
  291. end;
  292. if is_shifter_const(a,shift) and not(op in [OP_IMUL,OP_MUL]) then
  293. case op of
  294. OP_NEG,OP_NOT,
  295. OP_DIV,OP_IDIV:
  296. internalerror(200308281);
  297. OP_SHL:
  298. begin
  299. if a>32 then
  300. internalerror(200308291);
  301. if a<>0 then
  302. begin
  303. shifterop_reset(so);
  304. so.shiftmode:=SM_LSL;
  305. so.shiftimm:=a;
  306. list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src,so));
  307. end
  308. else
  309. list.concat(taicpu.op_reg_reg(A_MOV,dst,src));
  310. end;
  311. OP_SHR:
  312. begin
  313. if a>32 then
  314. internalerror(200308292);
  315. shifterop_reset(so);
  316. if a<>0 then
  317. begin
  318. so.shiftmode:=SM_LSR;
  319. so.shiftimm:=a;
  320. list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src,so));
  321. end
  322. else
  323. list.concat(taicpu.op_reg_reg(A_MOV,dst,src));
  324. end;
  325. OP_SAR:
  326. begin
  327. if a>32 then
  328. internalerror(200308291);
  329. if a<>0 then
  330. begin
  331. shifterop_reset(so);
  332. so.shiftmode:=SM_ASR;
  333. so.shiftimm:=a;
  334. list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src,so));
  335. end
  336. else
  337. list.concat(taicpu.op_reg_reg(A_MOV,dst,src));
  338. end;
  339. else
  340. list.concat(setoppostfix(
  341. taicpu.op_reg_reg_const(op_reg_reg_opcg2asmop[op],dst,src,a),toppostfix(ord(cgsetflags or setflags)*ord(PF_S))
  342. ));
  343. if (cgsetflags or setflags) and (size in [OS_8,OS_16,OS_32]) then
  344. begin
  345. ovloc.loc:=LOC_FLAGS;
  346. case op of
  347. OP_ADD:
  348. ovloc.resflags:=F_CS;
  349. OP_SUB:
  350. ovloc.resflags:=F_CC;
  351. end;
  352. end;
  353. end
  354. else
  355. begin
  356. { there could be added some more sophisticated optimizations }
  357. if (op in [OP_MUL,OP_IMUL]) and (a=1) then
  358. a_load_reg_reg(list,size,size,src,dst)
  359. else if (op in [OP_MUL,OP_IMUL]) and (a=0) then
  360. a_load_const_reg(list,size,0,dst)
  361. else if (op in [OP_IMUL]) and (a=-1) then
  362. a_op_reg_reg(list,OP_NEG,size,src,dst)
  363. { we do this here instead in the peephole optimizer because
  364. it saves us a register }
  365. else if (op in [OP_MUL,OP_IMUL]) and ispowerof2(a,l1) and not(cgsetflags or setflags) then
  366. a_op_const_reg_reg(list,OP_SHL,size,l1,src,dst)
  367. else
  368. begin
  369. tmpreg:=getintregister(list,size);
  370. a_load_const_reg(list,size,a,tmpreg);
  371. a_op_reg_reg_reg_checkoverflow(list,op,size,tmpreg,src,dst,setflags,ovloc);
  372. end;
  373. end;
  374. end;
  375. procedure tcgarm.a_op_reg_reg_reg_checkoverflow(list: taasmoutput; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation);
  376. var
  377. so : tshifterop;
  378. tmpreg,overflowreg : tregister;
  379. asmop : tasmop;
  380. begin
  381. ovloc.loc:=LOC_VOID;
  382. case op of
  383. OP_NEG,OP_NOT,
  384. OP_DIV,OP_IDIV:
  385. internalerror(200308281);
  386. OP_SHL:
  387. begin
  388. shifterop_reset(so);
  389. so.rs:=src1;
  390. so.shiftmode:=SM_LSL;
  391. list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src2,so));
  392. end;
  393. OP_SHR:
  394. begin
  395. shifterop_reset(so);
  396. so.rs:=src1;
  397. so.shiftmode:=SM_LSR;
  398. list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src2,so));
  399. end;
  400. OP_SAR:
  401. begin
  402. shifterop_reset(so);
  403. so.rs:=src1;
  404. so.shiftmode:=SM_ASR;
  405. list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src2,so));
  406. end;
  407. OP_IMUL,
  408. OP_MUL:
  409. begin
  410. if cgsetflags or setflags then
  411. begin
  412. overflowreg:=getintregister(list,size);
  413. if op=OP_IMUL then
  414. asmop:=A_SMULL
  415. else
  416. asmop:=A_UMULL;
  417. { the arm doesn't allow that rd and rm are the same }
  418. if dst=src2 then
  419. begin
  420. if dst<>src1 then
  421. list.concat(taicpu.op_reg_reg_reg_reg(asmop,dst,overflowreg,src1,src2))
  422. else
  423. begin
  424. tmpreg:=getintregister(list,size);
  425. a_load_reg_reg(list,size,size,src2,dst);
  426. list.concat(taicpu.op_reg_reg_reg_reg(asmop,dst,overflowreg,tmpreg,src1));
  427. end;
  428. end
  429. else
  430. list.concat(taicpu.op_reg_reg_reg_reg(asmop,dst,overflowreg,src2,src1));
  431. if op=OP_IMUL then
  432. begin
  433. shifterop_reset(so);
  434. so.shiftmode:=SM_ASR;
  435. so.shiftimm:=31;
  436. list.concat(taicpu.op_reg_reg_shifterop(A_CMP,overflowreg,overflowreg,so));
  437. end
  438. else
  439. list.concat(taicpu.op_reg_const(A_CMP,overflowreg,0));
  440. ovloc.loc:=LOC_FLAGS;
  441. ovloc.resflags:=F_NE;
  442. end
  443. else
  444. begin
  445. { the arm doesn't allow that rd and rm are the same }
  446. if dst=src2 then
  447. begin
  448. if dst<>src1 then
  449. list.concat(taicpu.op_reg_reg_reg(A_MUL,dst,src1,src2))
  450. else
  451. begin
  452. tmpreg:=getintregister(list,size);
  453. a_load_reg_reg(list,size,size,src2,dst);
  454. list.concat(taicpu.op_reg_reg_reg(A_MUL,dst,tmpreg,src1));
  455. end;
  456. end
  457. else
  458. list.concat(taicpu.op_reg_reg_reg(A_MUL,dst,src2,src1));
  459. end;
  460. end;
  461. else
  462. list.concat(setoppostfix(
  463. taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop[op],dst,src2,src1),toppostfix(ord(cgsetflags or setflags)*ord(PF_S))
  464. ));
  465. end;
  466. end;
  467. function rotl(d : dword;b : byte) : dword;
  468. begin
  469. result:=(d shr (32-b)) or (d shl b);
  470. end;
  471. function is_shifter_const(d : aint;var imm_shift : byte) : boolean;
  472. var
  473. i : longint;
  474. begin
  475. for i:=0 to 15 do
  476. begin
  477. if (dword(d) and not(rotl($ff,i*2)))=0 then
  478. begin
  479. imm_shift:=i*2;
  480. result:=true;
  481. exit;
  482. end;
  483. end;
  484. result:=false;
  485. end;
  486. procedure tcgarm.a_load_const_reg(list : taasmoutput; size: tcgsize; a : aint;reg : tregister);
  487. var
  488. imm_shift : byte;
  489. l : tasmlabel;
  490. hr : treference;
  491. begin
  492. if not(size in [OS_8,OS_S8,OS_16,OS_S16,OS_32,OS_S32]) then
  493. internalerror(2002090902);
  494. if is_shifter_const(a,imm_shift) then
  495. list.concat(taicpu.op_reg_const(A_MOV,reg,a))
  496. else if is_shifter_const(not(a),imm_shift) then
  497. list.concat(taicpu.op_reg_const(A_MVN,reg,not(a)))
  498. else
  499. begin
  500. reference_reset(hr);
  501. objectlibrary.getlabel(l);
  502. cg.a_label(current_procinfo.aktlocaldata,l);
  503. hr.symboldata:=current_procinfo.aktlocaldata.last;
  504. current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(longint(a)));
  505. hr.symbol:=l;
  506. list.concat(taicpu.op_reg_ref(A_LDR,reg,hr));
  507. end;
  508. end;
  509. procedure tcgarm.handle_load_store(list:taasmoutput;op: tasmop;oppostfix : toppostfix;reg:tregister;ref: treference);
  510. var
  511. tmpreg : tregister;
  512. tmpref : treference;
  513. l : tasmlabel;
  514. begin
  515. tmpreg:=NR_NO;
  516. { Be sure to have a base register }
  517. if (ref.base=NR_NO) then
  518. begin
  519. if ref.shiftmode<>SM_None then
  520. internalerror(200308294);
  521. ref.base:=ref.index;
  522. ref.index:=NR_NO;
  523. end;
  524. { absolute symbols can't be handled directly, we've to store the symbol reference
  525. in the text segment and access it pc relative
  526. For now, we assume that references where base or index equals to PC are already
  527. relative, all other references are assumed to be absolute and thus they need
  528. to be handled extra.
  529. A proper solution would be to change refoptions to a set and store the information
  530. if the symbol is absolute or relative there.
  531. }
  532. if (assigned(ref.symbol) and
  533. not(is_pc(ref.base)) and
  534. not(is_pc(ref.index))
  535. ) or
  536. (ref.offset<-4095) or
  537. (ref.offset>4095) or
  538. ((oppostfix in [PF_SB,PF_H,PF_SH]) and
  539. ((ref.offset<-255) or
  540. (ref.offset>255)
  541. )
  542. ) or
  543. ((op in [A_LDF,A_STF]) and
  544. ((ref.offset<-1020) or
  545. (ref.offset>1020)
  546. )
  547. ) then
  548. begin
  549. reference_reset(tmpref);
  550. { create consts entry }
  551. objectlibrary.getlabel(l);
  552. cg.a_label(current_procinfo.aktlocaldata,l);
  553. tmpref.symboldata:=current_procinfo.aktlocaldata.last;
  554. if assigned(ref.symbol) then
  555. current_procinfo.aktlocaldata.concat(tai_const.create_sym_offset(ref.symbol,ref.offset))
  556. else
  557. current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(ref.offset));
  558. { load consts entry }
  559. tmpreg:=getintregister(list,OS_INT);
  560. tmpref.symbol:=l;
  561. tmpref.base:=NR_R15;
  562. list.concat(taicpu.op_reg_ref(A_LDR,tmpreg,tmpref));
  563. if (ref.base<>NR_NO) then
  564. begin
  565. if ref.index<>NR_NO then
  566. begin
  567. list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg));
  568. ref.base:=tmpreg;
  569. end
  570. else
  571. begin
  572. ref.index:=tmpreg;
  573. ref.shiftimm:=0;
  574. ref.signindex:=1;
  575. ref.shiftmode:=SM_None;
  576. end;
  577. end
  578. else
  579. ref.base:=tmpreg;
  580. ref.offset:=0;
  581. ref.symbol:=nil;
  582. end;
  583. if (ref.base<>NR_NO) and (ref.index<>NR_NO) and (ref.offset<>0) then
  584. begin
  585. if tmpreg<>NR_NO then
  586. a_op_const_reg_reg(list,OP_ADD,OS_ADDR,ref.offset,tmpreg,tmpreg)
  587. else
  588. begin
  589. tmpreg:=getintregister(list,OS_ADDR);
  590. a_op_const_reg_reg(list,OP_ADD,OS_ADDR,ref.offset,ref.base,tmpreg);
  591. ref.base:=tmpreg;
  592. end;
  593. ref.offset:=0;
  594. end;
  595. { floating point operations have only limited references
  596. we expect here, that a base is already set }
  597. if (op in [A_LDF,A_STF]) and (ref.index<>NR_NO) then
  598. begin
  599. if ref.shiftmode<>SM_none then
  600. internalerror(200309121);
  601. if tmpreg<>NR_NO then
  602. begin
  603. if ref.base=tmpreg then
  604. begin
  605. if ref.signindex<0 then
  606. list.concat(taicpu.op_reg_reg_reg(A_SUB,tmpreg,tmpreg,ref.index))
  607. else
  608. list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,tmpreg,ref.index));
  609. ref.index:=NR_NO;
  610. end
  611. else
  612. begin
  613. if ref.index<>tmpreg then
  614. internalerror(200403161);
  615. if ref.signindex<0 then
  616. list.concat(taicpu.op_reg_reg_reg(A_SUB,tmpreg,ref.base,tmpreg))
  617. else
  618. list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg));
  619. ref.base:=tmpreg;
  620. ref.index:=NR_NO;
  621. end;
  622. end
  623. else
  624. begin
  625. tmpreg:=getintregister(list,OS_ADDR);
  626. list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,ref.index));
  627. ref.base:=tmpreg;
  628. ref.index:=NR_NO;
  629. end;
  630. end;
  631. list.concat(setoppostfix(taicpu.op_reg_ref(op,reg,ref),oppostfix));
  632. end;
  633. procedure tcgarm.a_load_reg_ref(list : taasmoutput; fromsize, tosize: tcgsize; reg : tregister;const ref : treference);
  634. var
  635. oppostfix:toppostfix;
  636. begin
  637. case ToSize of
  638. { signed integer registers }
  639. OS_8,
  640. OS_S8:
  641. oppostfix:=PF_B;
  642. OS_16,
  643. OS_S16:
  644. oppostfix:=PF_H;
  645. OS_32,
  646. OS_S32:
  647. oppostfix:=PF_None;
  648. else
  649. InternalError(200308295);
  650. end;
  651. handle_load_store(list,A_STR,oppostfix,reg,ref);
  652. end;
  653. procedure tcgarm.a_load_ref_reg(list : taasmoutput; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);
  654. var
  655. oppostfix:toppostfix;
  656. begin
  657. case FromSize of
  658. { signed integer registers }
  659. OS_8:
  660. oppostfix:=PF_B;
  661. OS_S8:
  662. oppostfix:=PF_SB;
  663. OS_16:
  664. oppostfix:=PF_H;
  665. OS_S16:
  666. oppostfix:=PF_SH;
  667. OS_32,
  668. OS_S32:
  669. oppostfix:=PF_None;
  670. else
  671. InternalError(200308291);
  672. end;
  673. handle_load_store(list,A_LDR,oppostfix,reg,ref);
  674. end;
  675. procedure tcgarm.a_load_reg_reg(list : taasmoutput; fromsize, tosize : tcgsize;reg1,reg2 : tregister);
  676. var
  677. instr: taicpu;
  678. so : tshifterop;
  679. begin
  680. shifterop_reset(so);
  681. if (tcgsize2size[tosize] < tcgsize2size[fromsize]) or
  682. (
  683. (tcgsize2size[tosize] = tcgsize2size[fromsize]) and
  684. (tosize <> fromsize) and
  685. not(fromsize in [OS_32,OS_S32])
  686. ) then
  687. begin
  688. case tosize of
  689. OS_8:
  690. list.concat(taicpu.op_reg_reg_const(A_AND,
  691. reg2,reg1,$ff));
  692. OS_S8:
  693. begin
  694. so.shiftmode:=SM_LSL;
  695. so.shiftimm:=24;
  696. list.concat(taicpu.op_reg_reg_shifterop(A_MOV,reg2,reg1,so));
  697. so.shiftmode:=SM_ASR;
  698. so.shiftimm:=24;
  699. list.concat(taicpu.op_reg_reg_shifterop(A_MOV,reg2,reg2,so));
  700. end;
  701. OS_16:
  702. begin
  703. so.shiftmode:=SM_LSL;
  704. so.shiftimm:=16;
  705. list.concat(taicpu.op_reg_reg_shifterop(A_MOV,reg2,reg1,so));
  706. so.shiftmode:=SM_LSR;
  707. so.shiftimm:=16;
  708. list.concat(taicpu.op_reg_reg_shifterop(A_MOV,reg2,reg2,so));
  709. end;
  710. OS_S16:
  711. begin
  712. so.shiftmode:=SM_LSL;
  713. so.shiftimm:=16;
  714. list.concat(taicpu.op_reg_reg_shifterop(A_MOV,reg2,reg1,so));
  715. so.shiftmode:=SM_ASR;
  716. so.shiftimm:=16;
  717. list.concat(taicpu.op_reg_reg_shifterop(A_MOV,reg2,reg2,so));
  718. end;
  719. OS_32,OS_S32:
  720. begin
  721. instr:=taicpu.op_reg_reg(A_MOV,reg2,reg1);
  722. list.concat(instr);
  723. add_move_instruction(instr);
  724. end;
  725. else internalerror(2002090901);
  726. end;
  727. end
  728. else
  729. begin
  730. if reg1<>reg2 then
  731. begin
  732. { same size, only a register mov required }
  733. instr:=taicpu.op_reg_reg(A_MOV,reg2,reg1);
  734. list.Concat(instr);
  735. { Notify the register allocator that we have written a move instruction so
  736. it can try to eliminate it. }
  737. add_move_instruction(instr);
  738. end;
  739. end;
  740. end;
  741. procedure tcgarm.a_loadfpu_reg_reg(list: taasmoutput; size: tcgsize; reg1, reg2: tregister);
  742. begin
  743. list.concat(setoppostfix(taicpu.op_reg_reg(A_MVF,reg2,reg1),cgsize2fpuoppostfix[size]));
  744. end;
  745. procedure tcgarm.a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister);
  746. var
  747. oppostfix:toppostfix;
  748. begin
  749. case size of
  750. OS_F32:
  751. oppostfix:=PF_S;
  752. OS_F64:
  753. oppostfix:=PF_D;
  754. OS_F80:
  755. oppostfix:=PF_E;
  756. else
  757. InternalError(200309021);
  758. end;
  759. handle_load_store(list,A_LDF,oppostfix,reg,ref);
  760. end;
  761. procedure tcgarm.a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference);
  762. var
  763. oppostfix:toppostfix;
  764. begin
  765. case size of
  766. OS_F32:
  767. oppostfix:=PF_S;
  768. OS_F64:
  769. oppostfix:=PF_D;
  770. OS_F80:
  771. oppostfix:=PF_E;
  772. else
  773. InternalError(200309021);
  774. end;
  775. handle_load_store(list,A_STF,oppostfix,reg,ref);
  776. end;
  777. { comparison operations }
  778. procedure tcgarm.a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aint;reg : tregister;
  779. l : tasmlabel);
  780. var
  781. tmpreg : tregister;
  782. b : byte;
  783. begin
  784. if is_shifter_const(a,b) then
  785. list.concat(taicpu.op_reg_const(A_CMP,reg,a))
  786. { CMN reg,0 and CMN reg,$80000000 are different from CMP reg,$ffffffff
  787. and CMP reg,$7fffffff regarding the flags according to the ARM manual }
  788. else if (a<>$7fffffff) and (a<>-1) and is_shifter_const(-a,b) then
  789. list.concat(taicpu.op_reg_const(A_CMN,reg,-a))
  790. else
  791. begin
  792. tmpreg:=getintregister(list,size);
  793. a_load_const_reg(list,size,a,tmpreg);
  794. list.concat(taicpu.op_reg_reg(A_CMP,reg,tmpreg));
  795. end;
  796. a_jmp_cond(list,cmp_op,l);
  797. end;
  798. procedure tcgarm.a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
  799. begin
  800. list.concat(taicpu.op_reg_reg(A_CMP,reg2,reg1));
  801. a_jmp_cond(list,cmp_op,l);
  802. end;
  803. procedure tcgarm.a_jmp_name(list : taasmoutput;const s : string);
  804. begin
  805. list.concat(taicpu.op_sym(A_B,objectlibrary.newasmsymbol(s,AB_EXTERNAL,AT_FUNCTION)));
  806. end;
  807. procedure tcgarm.a_jmp_always(list : taasmoutput;l: tasmlabel);
  808. begin
  809. list.concat(taicpu.op_sym(A_B,objectlibrary.newasmsymbol(l.name,AB_EXTERNAL,AT_FUNCTION)));
  810. end;
  811. procedure tcgarm.a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel);
  812. var
  813. ai : taicpu;
  814. begin
  815. ai:=setcondition(taicpu.op_sym(A_B,l),flags_to_cond(f));
  816. ai.is_jmp:=true;
  817. list.concat(ai);
  818. end;
  819. procedure tcgarm.g_flags2reg(list: taasmoutput; size: TCgSize; const f: TResFlags; reg: TRegister);
  820. var
  821. ai : taicpu;
  822. begin
  823. list.concat(setcondition(taicpu.op_reg_const(A_MOV,reg,1),flags_to_cond(f)));
  824. list.concat(setcondition(taicpu.op_reg_const(A_MOV,reg,0),inverse_cond[flags_to_cond(f)]));
  825. end;
  826. procedure tcgarm.g_proc_entry(list : taasmoutput;localsize : longint;nostackframe:boolean);
  827. var
  828. ref : treference;
  829. shift : byte;
  830. firstfloatreg,lastfloatreg,
  831. r : byte;
  832. begin
  833. LocalSize:=align(LocalSize,4);
  834. if not(nostackframe) then
  835. begin
  836. firstfloatreg:=RS_NO;
  837. { save floating point registers? }
  838. for r:=RS_F0 to RS_F7 do
  839. if r in rg[R_FPUREGISTER].used_in_proc-paramanager.get_volatile_registers_fpu(pocall_stdcall) then
  840. begin
  841. if firstfloatreg=RS_NO then
  842. firstfloatreg:=r;
  843. lastfloatreg:=r;
  844. end;
  845. a_reg_alloc(list,NR_STACK_POINTER_REG);
  846. a_reg_alloc(list,NR_FRAME_POINTER_REG);
  847. a_reg_alloc(list,NR_R12);
  848. list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_STACK_POINTER_REG));
  849. { save int registers }
  850. reference_reset(ref);
  851. ref.index:=NR_STACK_POINTER_REG;
  852. ref.addressmode:=AM_PREINDEXED;
  853. list.concat(setoppostfix(taicpu.op_ref_regset(A_STM,ref,
  854. rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall)+[RS_R11,RS_R12,RS_R14,RS_R15]),
  855. PF_FD));
  856. list.concat(taicpu.op_reg_reg_const(A_SUB,NR_FRAME_POINTER_REG,NR_R12,4));
  857. { allocate necessary stack size }
  858. { don't use a_op_const_reg_reg here because we don't allow register allocations
  859. in the entry/exit code }
  860. if not(is_shifter_const(localsize,shift)) then
  861. begin
  862. a_load_const_reg(list,OS_ADDR,LocalSize,NR_R12);
  863. list.concat(taicpu.op_reg_reg_reg(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,NR_R12));
  864. a_reg_dealloc(list,NR_R12);
  865. end
  866. else
  867. begin
  868. a_reg_dealloc(list,NR_R12);
  869. list.concat(taicpu.op_reg_reg_const(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,LocalSize));
  870. end;
  871. if firstfloatreg<>RS_NO then
  872. begin
  873. reference_reset(ref);
  874. ref.base:=NR_FRAME_POINTER_REG;
  875. ref.offset:=tarmprocinfo(current_procinfo).floatregstart;
  876. list.concat(taicpu.op_reg_const_ref(A_SFM,newreg(R_FPUREGISTER,firstfloatreg,R_SUBWHOLE),
  877. lastfloatreg-firstfloatreg+1,ref));
  878. end;
  879. end;
  880. end;
  881. procedure tcgarm.g_proc_exit(list : taasmoutput;parasize : longint;nostackframe:boolean);
  882. var
  883. ref : treference;
  884. firstfloatreg,lastfloatreg,
  885. r : byte;
  886. begin
  887. if not(nostackframe) then
  888. begin
  889. { restore floating point register }
  890. firstfloatreg:=RS_NO;
  891. { save floating point registers? }
  892. for r:=RS_F0 to RS_F7 do
  893. if r in rg[R_FPUREGISTER].used_in_proc-paramanager.get_volatile_registers_fpu(pocall_stdcall) then
  894. begin
  895. if firstfloatreg=RS_NO then
  896. firstfloatreg:=r;
  897. lastfloatreg:=r;
  898. end;
  899. if firstfloatreg<>RS_NO then
  900. begin
  901. reference_reset(ref);
  902. ref.base:=NR_FRAME_POINTER_REG;
  903. ref.offset:=tarmprocinfo(current_procinfo).floatregstart;
  904. list.concat(taicpu.op_reg_const_ref(A_LFM,newreg(R_FPUREGISTER,firstfloatreg,R_SUBWHOLE),
  905. lastfloatreg-firstfloatreg+1,ref));
  906. end;
  907. if (current_procinfo.framepointer=NR_STACK_POINTER_REG) then
  908. list.concat(taicpu.op_reg_reg(A_MOV,NR_R15,NR_R14))
  909. else
  910. begin
  911. { restore int registers and return }
  912. reference_reset(ref);
  913. ref.index:=NR_FRAME_POINTER_REG;
  914. list.concat(setoppostfix(taicpu.op_ref_regset(A_LDM,ref,rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall)+[RS_R11,RS_R13,RS_R15]),PF_EA));
  915. end;
  916. end
  917. else
  918. list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R14));
  919. end;
  920. procedure tcgarm.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);
  921. var
  922. b : byte;
  923. tmpref : treference;
  924. instr : taicpu;
  925. begin
  926. if ref.addressmode<>AM_OFFSET then
  927. internalerror(200309071);
  928. tmpref:=ref;
  929. { Be sure to have a base register }
  930. if (tmpref.base=NR_NO) then
  931. begin
  932. if tmpref.shiftmode<>SM_None then
  933. internalerror(200308294);
  934. if tmpref.signindex<0 then
  935. internalerror(200312023);
  936. tmpref.base:=tmpref.index;
  937. tmpref.index:=NR_NO;
  938. end;
  939. if assigned(tmpref.symbol) or
  940. not((is_shifter_const(tmpref.offset,b)) or
  941. (is_shifter_const(-tmpref.offset,b))
  942. ) then
  943. fixref(list,tmpref);
  944. { expect a base here }
  945. if tmpref.base=NR_NO then
  946. internalerror(200312022);
  947. if tmpref.index<>NR_NO then
  948. begin
  949. if tmpref.shiftmode<>SM_None then
  950. internalerror(200312021);
  951. if tmpref.signindex<0 then
  952. a_op_reg_reg_reg(list,OP_SUB,OS_ADDR,tmpref.base,tmpref.index,r)
  953. else
  954. a_op_reg_reg_reg(list,OP_ADD,OS_ADDR,tmpref.base,tmpref.index,r);
  955. if tmpref.offset<>0 then
  956. a_op_const_reg_reg(list,OP_ADD,OS_ADDR,tmpref.offset,r,r);
  957. end
  958. else
  959. begin
  960. if tmpref.offset<>0 then
  961. a_op_const_reg_reg(list,OP_ADD,OS_ADDR,tmpref.offset,tmpref.base,r)
  962. else
  963. begin
  964. instr:=taicpu.op_reg_reg(A_MOV,r,tmpref.base);
  965. list.concat(instr);
  966. add_move_instruction(instr);
  967. end;
  968. end;
  969. end;
  970. procedure tcgarm.fixref(list : taasmoutput;var ref : treference);
  971. var
  972. tmpreg : tregister;
  973. tmpref : treference;
  974. l : tasmlabel;
  975. begin
  976. { absolute symbols can't be handled directly, we've to store the symbol reference
  977. in the text segment and access it pc relative
  978. For now, we assume that references where base or index equals to PC are already
  979. relative, all other references are assumed to be absolute and thus they need
  980. to be handled extra.
  981. A proper solution would be to change refoptions to a set and store the information
  982. if the symbol is absolute or relative there.
  983. }
  984. { create consts entry }
  985. reference_reset(tmpref);
  986. objectlibrary.getlabel(l);
  987. cg.a_label(current_procinfo.aktlocaldata,l);
  988. tmpref.symboldata:=current_procinfo.aktlocaldata.last;
  989. if assigned(ref.symbol) then
  990. current_procinfo.aktlocaldata.concat(tai_const.create_sym_offset(ref.symbol,ref.offset))
  991. else
  992. current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(ref.offset));
  993. { load consts entry }
  994. tmpreg:=getintregister(list,OS_INT);
  995. tmpref.symbol:=l;
  996. tmpref.base:=NR_PC;
  997. list.concat(taicpu.op_reg_ref(A_LDR,tmpreg,tmpref));
  998. if (ref.base<>NR_NO) then
  999. begin
  1000. if ref.index<>NR_NO then
  1001. begin
  1002. list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg));
  1003. ref.base:=tmpreg;
  1004. end
  1005. else
  1006. begin
  1007. ref.index:=tmpreg;
  1008. ref.shiftimm:=0;
  1009. ref.signindex:=1;
  1010. ref.shiftmode:=SM_None;
  1011. end;
  1012. end
  1013. else
  1014. ref.base:=tmpreg;
  1015. ref.offset:=0;
  1016. ref.symbol:=nil;
  1017. end;
  1018. procedure tcgarm.g_concatcopy(list : taasmoutput;const source,dest : treference;len : aint);
  1019. var
  1020. srcref,dstref:treference;
  1021. srcreg,destreg,countreg,r:tregister;
  1022. helpsize:aword;
  1023. copysize:byte;
  1024. cgsize:Tcgsize;
  1025. procedure genloop(count : aword;size : byte);
  1026. const
  1027. size2opsize : array[1..4] of tcgsize = (OS_8,OS_16,OS_NO,OS_32);
  1028. var
  1029. l : tasmlabel;
  1030. begin
  1031. objectlibrary.getlabel(l);
  1032. a_load_const_reg(list,OS_INT,count,countreg);
  1033. cg.a_label(list,l);
  1034. srcref.addressmode:=AM_POSTINDEXED;
  1035. dstref.addressmode:=AM_POSTINDEXED;
  1036. srcref.offset:=size;
  1037. dstref.offset:=size;
  1038. r:=getintregister(list,size2opsize[size]);
  1039. a_load_ref_reg(list,size2opsize[size],size2opsize[size],srcref,r);
  1040. a_load_reg_ref(list,size2opsize[size],size2opsize[size],r,dstref);
  1041. list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SUB,countreg,countreg,1),PF_S));
  1042. list.concat(setcondition(taicpu.op_sym(A_B,l),C_NE));
  1043. { keep the registers alive }
  1044. list.concat(taicpu.op_reg_reg(A_MOV,countreg,countreg));
  1045. list.concat(taicpu.op_reg_reg(A_MOV,srcreg,srcreg));
  1046. list.concat(taicpu.op_reg_reg(A_MOV,destreg,destreg));
  1047. end;
  1048. begin
  1049. if len=0 then
  1050. exit;
  1051. helpsize:=12;
  1052. dstref:=dest;
  1053. srcref:=source;
  1054. if cs_littlesize in aktglobalswitches then
  1055. helpsize:=8;
  1056. if (len<=helpsize) then
  1057. begin
  1058. copysize:=4;
  1059. cgsize:=OS_32;
  1060. while len<>0 do
  1061. begin
  1062. if len<2 then
  1063. begin
  1064. copysize:=1;
  1065. cgsize:=OS_8;
  1066. end
  1067. else if len<4 then
  1068. begin
  1069. copysize:=2;
  1070. cgsize:=OS_16;
  1071. end;
  1072. dec(len,copysize);
  1073. r:=getintregister(list,cgsize);
  1074. a_load_ref_reg(list,cgsize,cgsize,srcref,r);
  1075. a_load_reg_ref(list,cgsize,cgsize,r,dstref);
  1076. inc(srcref.offset,copysize);
  1077. inc(dstref.offset,copysize);
  1078. end;
  1079. end
  1080. else
  1081. begin
  1082. destreg:=getintregister(list,OS_ADDR);
  1083. a_loadaddr_ref_reg(list,dest,destreg);
  1084. reference_reset_base(dstref,destreg,0);
  1085. srcreg:=getintregister(list,OS_ADDR);
  1086. a_loadaddr_ref_reg(list,source,srcreg);
  1087. reference_reset_base(srcref,srcreg,0);
  1088. countreg:=getintregister(list,OS_32);
  1089. // if cs_littlesize in aktglobalswitches then
  1090. genloop(len,1);
  1091. {
  1092. else
  1093. begin
  1094. helpsize:=len shr 2;
  1095. len:=len and 3;
  1096. if helpsize>1 then
  1097. begin
  1098. a_load_const_reg(list,OS_INT,helpsize,countreg);
  1099. list.concat(Taicpu.op_none(A_REP,S_NO));
  1100. end;
  1101. if helpsize>0 then
  1102. list.concat(Taicpu.op_none(A_MOVSD,S_NO));
  1103. if len>1 then
  1104. begin
  1105. dec(len,2);
  1106. list.concat(Taicpu.op_none(A_MOVSW,S_NO));
  1107. end;
  1108. if len=1 then
  1109. list.concat(Taicpu.op_none(A_MOVSB,S_NO));
  1110. end;
  1111. }
  1112. end;
  1113. end;
  1114. procedure tcgarm.g_overflowCheck(list : taasmoutput;const l : tlocation;def : tdef);
  1115. var
  1116. ovloc : tlocation;
  1117. begin
  1118. ovloc.loc:=LOC_VOID;
  1119. g_overflowCheck_loc(list,l,def,ovloc);
  1120. end;
  1121. procedure tcgarm.g_overflowCheck_loc(List:TAasmOutput;const Loc:TLocation;def:TDef;ovloc : tlocation);
  1122. var
  1123. hl : tasmlabel;
  1124. ai:TAiCpu;
  1125. hflags : tresflags;
  1126. begin
  1127. if not(cs_check_overflow in aktlocalswitches) then
  1128. exit;
  1129. objectlibrary.getlabel(hl);
  1130. case ovloc.loc of
  1131. LOC_VOID:
  1132. begin
  1133. ai:=taicpu.op_sym(A_B,hl);
  1134. ai.is_jmp:=true;
  1135. if not((def.deftype=pointerdef) or
  1136. ((def.deftype=orddef) and
  1137. (torddef(def).typ in [u64bit,u16bit,u32bit,u8bit,uchar,bool8bit,bool16bit,bool32bit]))) then
  1138. ai.SetCondition(C_VC)
  1139. else
  1140. ai.SetCondition(C_CC);
  1141. list.concat(ai);
  1142. end;
  1143. LOC_FLAGS:
  1144. begin
  1145. hflags:=ovloc.resflags;
  1146. inverse_flags(hflags);
  1147. cg.a_jmp_flags(list,hflags,hl);
  1148. end;
  1149. else
  1150. internalerror(200409281);
  1151. end;
  1152. a_call_name(list,'FPC_OVERFLOW');
  1153. a_label(list,hl);
  1154. end;
  1155. procedure tcgarm.g_save_standard_registers(list : taasmoutput);
  1156. begin
  1157. { this work is done in g_proc_entry }
  1158. end;
  1159. procedure tcgarm.g_restore_standard_registers(list : taasmoutput);
  1160. begin
  1161. { this work is done in g_proc_exit }
  1162. end;
  1163. procedure tcgarm.a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
  1164. var
  1165. ai : taicpu;
  1166. begin
  1167. ai:=Taicpu.Op_sym(A_B,l);
  1168. ai.SetCondition(OpCmp2AsmCond[cond]);
  1169. ai.is_jmp:=true;
  1170. list.concat(ai);
  1171. end;
  1172. procedure tcgarm.g_intf_wrapper(list: taasmoutput; procdef: tprocdef; const labelname: string; ioffset: longint);
  1173. procedure loadvmttor12;
  1174. var
  1175. href : treference;
  1176. begin
  1177. reference_reset_base(href,NR_R0,0);
  1178. cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R12);
  1179. end;
  1180. procedure op_onr12methodaddr;
  1181. var
  1182. href : treference;
  1183. begin
  1184. if (procdef.extnumber=$ffff) then
  1185. Internalerror(200006139);
  1186. { call/jmp vmtoffs(%eax) ; method offs }
  1187. reference_reset_base(href,NR_R12,procdef._class.vmtmethodoffset(procdef.extnumber));
  1188. cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R12);
  1189. list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R12));
  1190. end;
  1191. var
  1192. lab : tasmsymbol;
  1193. make_global : boolean;
  1194. href : treference;
  1195. begin
  1196. if procdef.proctypeoption<>potype_none then
  1197. Internalerror(200006137);
  1198. if not assigned(procdef._class) or
  1199. (procdef.procoptions*[po_classmethod, po_staticmethod,
  1200. po_methodpointer, po_interrupt, po_iocheck]<>[]) then
  1201. Internalerror(200006138);
  1202. if procdef.owner.symtabletype<>objectsymtable then
  1203. Internalerror(200109191);
  1204. make_global:=false;
  1205. if (not current_module.is_unit) or
  1206. (cs_create_smart in aktmoduleswitches) or
  1207. (procdef.owner.defowner.owner.symtabletype=globalsymtable) then
  1208. make_global:=true;
  1209. if make_global then
  1210. list.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
  1211. else
  1212. list.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
  1213. { set param1 interface to self }
  1214. g_adjust_self_value(list,procdef,ioffset);
  1215. { case 4 }
  1216. if po_virtualmethod in procdef.procoptions then
  1217. begin
  1218. loadvmttor12;
  1219. op_onr12methodaddr;
  1220. end
  1221. { case 0 }
  1222. else
  1223. list.concat(taicpu.op_sym(A_B,objectlibrary.newasmsymbol(procdef.mangledname,AB_EXTERNAL,AT_FUNCTION)));
  1224. list.concat(Tai_symbol_end.Createname(labelname));
  1225. end;
  1226. procedure tcg64farm.a_op64_reg_reg(list : taasmoutput;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64);
  1227. var
  1228. tmpreg : tregister;
  1229. begin
  1230. case op of
  1231. OP_NEG:
  1232. begin
  1233. list.concat(setoppostfix(taicpu.op_reg_reg_const(A_RSB,regdst.reglo,regsrc.reglo,0),PF_S));
  1234. list.concat(taicpu.op_reg_reg_const(A_RSC,regdst.reghi,regsrc.reghi,0));
  1235. end;
  1236. OP_NOT:
  1237. begin
  1238. cg.a_op_reg_reg(list,OP_NOT,OS_INT,regsrc.reglo,regdst.reglo);
  1239. cg.a_op_reg_reg(list,OP_NOT,OS_INT,regsrc.reghi,regdst.reghi);
  1240. end;
  1241. else
  1242. a_op64_reg_reg_reg(list,op,size,regsrc,regdst,regdst);
  1243. end;
  1244. end;
  1245. procedure tcg64farm.a_op64_const_reg(list : taasmoutput;op:TOpCG;size : tcgsize;value : int64;reg : tregister64);
  1246. begin
  1247. a_op64_const_reg_reg(list,op,size,value,reg,reg);
  1248. end;
  1249. procedure tcg64farm.a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64);
  1250. var
  1251. ovloc : tlocation;
  1252. begin
  1253. a_op64_const_reg_reg_checkoverflow(list,op,size,value,regsrc,regdst,false,ovloc);
  1254. end;
  1255. procedure tcg64farm.a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64);
  1256. var
  1257. ovloc : tlocation;
  1258. begin
  1259. a_op64_reg_reg_reg_checkoverflow(list,op,size,regsrc1,regsrc2,regdst,false,ovloc);
  1260. end;
  1261. procedure tcg64farm.a_op64_const_reg_reg_checkoverflow(list: taasmoutput;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);
  1262. var
  1263. tmpreg : tregister;
  1264. b : byte;
  1265. begin
  1266. ovloc.loc:=LOC_VOID;
  1267. case op of
  1268. OP_NEG,
  1269. OP_NOT :
  1270. internalerror(200306017);
  1271. end;
  1272. if (setflags or tcgarm(cg).cgsetflags) and (op in [OP_ADD,OP_SUB]) then
  1273. begin
  1274. case op of
  1275. OP_ADD:
  1276. begin
  1277. if is_shifter_const(lo(value),b) then
  1278. list.concat(setoppostfix(taicpu.op_reg_reg_const(A_ADD,regdst.reglo,regsrc.reglo,lo(value)),PF_S))
  1279. else
  1280. begin
  1281. tmpreg:=cg.getintregister(list,OS_32);
  1282. cg.a_load_const_reg(list,OS_32,lo(value),tmpreg);
  1283. list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc.reglo,tmpreg),PF_S));
  1284. end;
  1285. if is_shifter_const(hi(value),b) then
  1286. list.concat(setoppostfix(taicpu.op_reg_reg_const(A_ADC,regdst.reghi,regsrc.reghi,hi(value)),PF_S))
  1287. else
  1288. begin
  1289. tmpreg:=cg.getintregister(list,OS_32);
  1290. cg.a_load_const_reg(list,OS_32,hi(value),tmpreg);
  1291. list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc.reghi,tmpreg),PF_S));
  1292. end;
  1293. end;
  1294. OP_SUB:
  1295. begin
  1296. if is_shifter_const(lo(value),b) then
  1297. list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SUB,regdst.reglo,regsrc.reglo,lo(value)),PF_S))
  1298. else
  1299. begin
  1300. tmpreg:=cg.getintregister(list,OS_32);
  1301. cg.a_load_const_reg(list,OS_32,lo(value),tmpreg);
  1302. list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc.reglo,tmpreg),PF_S));
  1303. end;
  1304. if is_shifter_const(hi(value),b) then
  1305. list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SBC,regdst.reghi,regsrc.reghi,hi(value)),PF_S))
  1306. else
  1307. begin
  1308. tmpreg:=cg.getintregister(list,OS_32);
  1309. cg.a_load_const_reg(list,OS_32,hi(value),tmpreg);
  1310. list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc.reghi,tmpreg),PF_S));
  1311. end;
  1312. end;
  1313. else
  1314. internalerror(200502131);
  1315. end;
  1316. if size=OS_64 then
  1317. begin
  1318. { the arm has an weired opinion how flags for SUB/ADD are handled }
  1319. ovloc.loc:=LOC_FLAGS;
  1320. case op of
  1321. OP_ADD:
  1322. ovloc.resflags:=F_CS;
  1323. OP_SUB:
  1324. ovloc.resflags:=F_CC;
  1325. end;
  1326. end;
  1327. end
  1328. else
  1329. begin
  1330. case op of
  1331. OP_AND,OP_OR,OP_XOR:
  1332. begin
  1333. cg.a_op_const_reg_reg(list,op,OS_32,lo(value),regsrc.reglo,regdst.reglo);
  1334. cg.a_op_const_reg_reg(list,op,OS_32,hi(value),regsrc.reghi,regdst.reghi);
  1335. end;
  1336. OP_ADD:
  1337. begin
  1338. if is_shifter_const(lo(value),b) then
  1339. list.concat(setoppostfix(taicpu.op_reg_reg_const(A_ADD,regdst.reglo,regsrc.reglo,lo(value)),PF_S))
  1340. else
  1341. begin
  1342. tmpreg:=cg.getintregister(list,OS_32);
  1343. cg.a_load_const_reg(list,OS_32,lo(value),tmpreg);
  1344. list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc.reglo,tmpreg),PF_S));
  1345. end;
  1346. if is_shifter_const(hi(value),b) then
  1347. list.concat(taicpu.op_reg_reg_const(A_ADC,regdst.reghi,regsrc.reghi,hi(value)))
  1348. else
  1349. begin
  1350. tmpreg:=cg.getintregister(list,OS_32);
  1351. cg.a_load_const_reg(list,OS_32,hi(value),tmpreg);
  1352. list.concat(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc.reghi,tmpreg));
  1353. end;
  1354. end;
  1355. OP_SUB:
  1356. begin
  1357. if is_shifter_const(lo(value),b) then
  1358. list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SUB,regdst.reglo,regsrc.reglo,lo(value)),PF_S))
  1359. else
  1360. begin
  1361. tmpreg:=cg.getintregister(list,OS_32);
  1362. cg.a_load_const_reg(list,OS_32,lo(value),tmpreg);
  1363. list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc.reglo,tmpreg),PF_S));
  1364. end;
  1365. if is_shifter_const(hi(value),b) then
  1366. list.concat(taicpu.op_reg_reg_const(A_SBC,regdst.reghi,regsrc.reghi,hi(value)))
  1367. else
  1368. begin
  1369. tmpreg:=cg.getintregister(list,OS_32);
  1370. cg.a_load_const_reg(list,OS_32,hi(value),tmpreg);
  1371. list.concat(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc.reghi,tmpreg));
  1372. end;
  1373. end;
  1374. else
  1375. internalerror(2003083101);
  1376. end;
  1377. end;
  1378. end;
  1379. procedure tcg64farm.a_op64_reg_reg_reg_checkoverflow(list: taasmoutput;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);
  1380. var
  1381. op1,op2:TAsmOp;
  1382. begin
  1383. ovloc.loc:=LOC_VOID;
  1384. case op of
  1385. OP_NEG,
  1386. OP_NOT :
  1387. internalerror(200306017);
  1388. end;
  1389. if (setflags or tcgarm(cg).cgsetflags) and (op in [OP_ADD,OP_SUB]) then
  1390. begin
  1391. case op of
  1392. OP_ADD:
  1393. begin
  1394. list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc1.reglo,regsrc2.reglo),PF_S));
  1395. list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc1.reghi,regsrc2.reghi),PF_S));
  1396. end;
  1397. OP_SUB:
  1398. begin
  1399. list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc2.reglo,regsrc1.reglo),PF_S));
  1400. list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc2.reghi,regsrc1.reghi),PF_S));
  1401. end;
  1402. else
  1403. internalerror(2003083101);
  1404. end;
  1405. if size=OS_64 then
  1406. begin
  1407. { the arm has an weired opinion how flags for SUB/ADD are handled }
  1408. ovloc.loc:=LOC_FLAGS;
  1409. case op of
  1410. OP_ADD:
  1411. ovloc.resflags:=F_CC;
  1412. OP_SUB:
  1413. ovloc.resflags:=F_CS;
  1414. end;
  1415. end;
  1416. end
  1417. else
  1418. begin
  1419. case op of
  1420. OP_AND,OP_OR,OP_XOR:
  1421. begin
  1422. cg.a_op_reg_reg_reg(list,op,OS_32,regsrc1.reglo,regsrc2.reglo,regdst.reglo);
  1423. cg.a_op_reg_reg_reg(list,op,OS_32,regsrc1.reghi,regsrc2.reghi,regdst.reghi);
  1424. end;
  1425. OP_ADD:
  1426. begin
  1427. list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc1.reglo,regsrc2.reglo),PF_S));
  1428. list.concat(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc1.reghi,regsrc2.reghi));
  1429. end;
  1430. OP_SUB:
  1431. begin
  1432. list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc2.reglo,regsrc1.reglo),PF_S));
  1433. list.concat(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc2.reghi,regsrc1.reghi));
  1434. end;
  1435. else
  1436. internalerror(2003083101);
  1437. end;
  1438. end;
  1439. end;
  1440. begin
  1441. cg:=tcgarm.create;
  1442. cg64:=tcg64farm.create;
  1443. end.
  1444. {
  1445. $Log$
  1446. Revision 1.69 2005-02-14 17:13:09 peter
  1447. * truncate log
  1448. Revision 1.68 2005/02/13 18:55:19 florian
  1449. + overflow checking for the arm
  1450. Revision 1.67 2005/01/30 14:43:40 florian
  1451. * fixed compilation of arm compiler
  1452. Revision 1.66 2005/01/04 21:00:48 florian
  1453. * not operator for byte/word fixed
  1454. Revision 1.65 2005/01/04 20:15:05 florian
  1455. * load_reg_reg fixed
  1456. Revision 1.64 2005/01/04 15:36:32 florian
  1457. * implemented nostackframe calling convention directive
  1458. }