cgcpu.pas 65 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929
  1. {
  2. Copyright (c) 1998-2012 by Florian Klaempfl and David Zhang
  3. This unit implements the code generator for MIPS
  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 cgcpu;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. globtype, parabase,
  22. cgbase, cgutils, cgobj, cg64f32, cpupara,
  23. aasmbase, aasmtai, aasmcpu, aasmdata,
  24. cpubase, cpuinfo,
  25. node, symconst, SymType, symdef,
  26. rgcpu;
  27. type
  28. TCGMIPS = class(tcg)
  29. public
  30. procedure init_register_allocators; override;
  31. procedure done_register_allocators; override;
  32. /// { needed by cg64 }
  33. procedure make_simple_ref(list: tasmlist; var ref: treference);
  34. procedure handle_reg_const_reg(list: tasmlist; op: Tasmop; src: tregister; a: tcgint; dst: tregister);
  35. procedure maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister);
  36. procedure overflowcheck_internal(list: TAsmList; arg1, arg2: TRegister);
  37. { parameter }
  38. procedure a_loadfpu_reg_cgpara(list: tasmlist; size: tcgsize; const r: tregister; const paraloc: TCGPara); override;
  39. procedure a_loadfpu_ref_cgpara(list: tasmlist; size: tcgsize; const ref: treference; const paraloc: TCGPara); override;
  40. procedure a_call_name(list: tasmlist; const s: string; weak : boolean); override;
  41. procedure a_call_reg(list: tasmlist; Reg: TRegister); override;
  42. procedure a_call_sym_pic(list: tasmlist; sym: tasmsymbol);
  43. { General purpose instructions }
  44. procedure a_op_const_reg(list: tasmlist; Op: TOpCG; size: tcgsize; a: tcgint; reg: TRegister); override;
  45. procedure a_op_reg_reg(list: tasmlist; Op: TOpCG; size: TCGSize; src, dst: TRegister); override;
  46. procedure a_op_const_reg_reg(list: tasmlist; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister); override;
  47. procedure a_op_reg_reg_reg(list: tasmlist; op: TOpCg; size: tcgsize; src1, src2, dst: tregister); override;
  48. procedure a_op_const_reg_reg_checkoverflow(list: tasmlist; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister; setflags: boolean; var ovloc: tlocation); override;
  49. procedure a_op_reg_reg_reg_checkoverflow(list: tasmlist; op: TOpCg; size: tcgsize; src1, src2, dst: tregister; setflags: boolean; var ovloc: tlocation); override;
  50. { move instructions }
  51. procedure a_load_const_reg(list: tasmlist; size: tcgsize; a: tcgint; reg: tregister); override;
  52. procedure a_load_const_ref(list: tasmlist; size: tcgsize; a: tcgint; const ref: TReference); override;
  53. procedure a_load_reg_ref(list: tasmlist; FromSize, ToSize: TCgSize; reg: TRegister; const ref: TReference); override;
  54. procedure a_load_ref_reg(list: tasmlist; FromSize, ToSize: TCgSize; const ref: TReference; reg: tregister); override;
  55. procedure a_load_reg_reg(list: tasmlist; FromSize, ToSize: TCgSize; reg1, reg2: tregister); override;
  56. procedure a_loadaddr_ref_reg(list: tasmlist; const ref: TReference; r: tregister); override;
  57. { fpu move instructions }
  58. procedure a_loadfpu_reg_reg(list: tasmlist; fromsize, tosize: tcgsize; reg1, reg2: tregister); override;
  59. procedure a_loadfpu_ref_reg(list: tasmlist; fromsize, tosize: tcgsize; const ref: TReference; reg: tregister); override;
  60. procedure a_loadfpu_reg_ref(list: tasmlist; fromsize, tosize: tcgsize; reg: tregister; const ref: TReference); override;
  61. { comparison operations }
  62. procedure a_cmp_const_reg_label(list: tasmlist; size: tcgsize; cmp_op: topcmp; a: tcgint; reg: tregister; l: tasmlabel); override;
  63. procedure a_cmp_reg_reg_label(list: tasmlist; size: tcgsize; cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel); override;
  64. procedure a_jmp_flags(list: tasmlist; const f: TResFlags; l: tasmlabel); override;
  65. procedure g_flags2reg(list: tasmlist; size: TCgSize; const f: TResFlags; reg: tregister); override;
  66. procedure a_jmp_always(List: tasmlist; l: TAsmLabel); override;
  67. procedure a_jmp_name(list: tasmlist; const s: string); override;
  68. procedure a_mul_reg_reg_pair(list: tasmlist; size: tcgsize; src1,src2,dstlo,dsthi: tregister); override;
  69. procedure g_overflowCheck(List: tasmlist; const Loc: TLocation; def: TDef); override;
  70. procedure g_overflowCheck_loc(List: tasmlist; const Loc: TLocation; def: TDef; ovloc: tlocation); override;
  71. procedure g_proc_entry(list: tasmlist; localsize: longint; nostackframe: boolean); override;
  72. procedure g_proc_exit(list: tasmlist; parasize: longint; nostackframe: boolean); override;
  73. procedure g_concatcopy(list: tasmlist; const Source, dest: treference; len: tcgint); override;
  74. procedure g_concatcopy_unaligned(list: tasmlist; const Source, dest: treference; len: tcgint); override;
  75. procedure g_concatcopy_move(list: tasmlist; const Source, dest: treference; len: tcgint);
  76. procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: tcgint); override;
  77. procedure g_profilecode(list: TAsmList);override;
  78. end;
  79. TCg64MPSel = class(tcg64f32)
  80. public
  81. procedure a_load64_reg_ref(list: tasmlist; reg: tregister64; const ref: treference); override;
  82. procedure a_load64_ref_reg(list: tasmlist; const ref: treference; reg: tregister64); override;
  83. procedure a_load64_ref_cgpara(list: tasmlist; const r: treference; const paraloc: tcgpara); override;
  84. procedure a_op64_reg_reg(list: tasmlist; op: TOpCG; size: tcgsize; regsrc, regdst: TRegister64); override;
  85. procedure a_op64_const_reg(list: tasmlist; op: TOpCG; size: tcgsize; Value: int64; regdst: TRegister64); override;
  86. procedure a_op64_const_reg_reg(list: tasmlist; op: TOpCG; size: tcgsize; Value: int64; regsrc, regdst: tregister64); override;
  87. procedure a_op64_reg_reg_reg(list: tasmlist; op: TOpCG; size: tcgsize; regsrc1, regsrc2, regdst: tregister64); override;
  88. procedure a_op64_const_reg_reg_checkoverflow(list: tasmlist; op: TOpCG; size: tcgsize; Value: int64; regsrc, regdst: tregister64; setflags: boolean; var ovloc: tlocation); override;
  89. procedure a_op64_reg_reg_reg_checkoverflow(list: tasmlist; op: TOpCG; size: tcgsize; regsrc1, regsrc2, regdst: tregister64; setflags: boolean; var ovloc: tlocation); override;
  90. end;
  91. procedure create_codegen;
  92. const
  93. TOpCmp2AsmCond : array[topcmp] of TAsmCond=(C_NONE,
  94. C_EQ,C_GT,C_LT,C_GE,C_LE,C_NE,C_LEU,C_LTU,C_GEU,C_GTU
  95. );
  96. implementation
  97. uses
  98. globals, verbose, systems, cutils,
  99. paramgr, fmodule,
  100. symtable, symsym,
  101. tgobj,
  102. procinfo, cpupi;
  103. const
  104. TOpcg2AsmOp: array[TOpCg] of TAsmOp = (
  105. A_NONE,A_NONE,A_ADDU,A_AND,A_NONE,A_NONE,A_MULT,A_MULTU,A_NONE,A_NONE,
  106. A_OR,A_SRAV,A_SLLV,A_SRLV,A_SUBU,A_XOR,A_NONE,A_NONE
  107. );
  108. procedure TCGMIPS.make_simple_ref(list: tasmlist; var ref: treference);
  109. var
  110. tmpreg, tmpreg1: tregister;
  111. tmpref: treference;
  112. base_replaced: boolean;
  113. begin
  114. { Enforce some discipline for callers:
  115. - gp is always implicit
  116. - reference is processed only once }
  117. if (ref.base=NR_GP) or (ref.index=NR_GP) then
  118. InternalError(2013022801);
  119. if (ref.refaddr<>addr_no) then
  120. InternalError(2013022802);
  121. { fixup base/index, if both are present then add them together }
  122. base_replaced:=false;
  123. tmpreg:=ref.base;
  124. if (tmpreg=NR_NO) then
  125. tmpreg:=ref.index
  126. else if (ref.index<>NR_NO) then
  127. begin
  128. tmpreg:=getintregister(list,OS_ADDR);
  129. list.concat(taicpu.op_reg_reg_reg(A_ADDU,tmpreg,ref.base,ref.index));
  130. base_replaced:=true;
  131. end;
  132. ref.base:=tmpreg;
  133. ref.index:=NR_NO;
  134. if (ref.symbol=nil) and
  135. (ref.offset>=simm16lo) and
  136. (ref.offset<=simm16hi-sizeof(pint)) then
  137. exit;
  138. { Symbol present or offset > 16bits }
  139. if assigned(ref.symbol) then
  140. begin
  141. ref.base:=getintregister(list,OS_ADDR);
  142. reference_reset_symbol(tmpref,ref.symbol,ref.offset,ref.alignment);
  143. if (cs_create_pic in current_settings.moduleswitches) then
  144. begin
  145. if not (pi_needs_got in current_procinfo.flags) then
  146. InternalError(2013060102);
  147. { For PIC global symbols offset must be handled separately.
  148. Otherwise (non-PIC or local symbols) offset can be encoded
  149. into relocation even if exceeds 16 bits. }
  150. if (ref.symbol.bind<>AB_LOCAL) then
  151. tmpref.offset:=0;
  152. tmpref.refaddr:=addr_pic;
  153. tmpref.base:=NR_GP;
  154. list.concat(taicpu.op_reg_ref(A_LW,ref.base,tmpref));
  155. end
  156. else
  157. begin
  158. tmpref.refaddr:=addr_high;
  159. list.concat(taicpu.op_reg_ref(A_LUI,ref.base,tmpref));
  160. end;
  161. { Add original base/index, if any. }
  162. if (tmpreg<>NR_NO) then
  163. list.concat(taicpu.op_reg_reg_reg(A_ADDU,ref.base,tmpreg,ref.base));
  164. if (ref.symbol.bind=AB_LOCAL) or
  165. not (cs_create_pic in current_settings.moduleswitches) then
  166. begin
  167. ref.refaddr:=addr_low;
  168. exit;
  169. end;
  170. { PIC global symbol }
  171. ref.symbol:=nil;
  172. if (ref.offset>=simm16lo) and
  173. (ref.offset<=simm16hi-sizeof(pint)) then
  174. exit;
  175. { fallthrough to the case of large offset }
  176. end;
  177. tmpreg1:=getintregister(list,OS_INT);
  178. a_load_const_reg(list,OS_INT,ref.offset,tmpreg1);
  179. if (ref.base=NR_NO) then
  180. ref.base:=tmpreg1 { offset alone, weird but possible }
  181. else
  182. begin
  183. if (not base_replaced) then
  184. ref.base:=getintregister(list,OS_ADDR);
  185. list.concat(taicpu.op_reg_reg_reg(A_ADDU,ref.base,tmpreg,tmpreg1))
  186. end;
  187. ref.offset:=0;
  188. end;
  189. procedure TCGMIPS.handle_reg_const_reg(list: tasmlist; op: Tasmop; src: tregister; a: tcgint; dst: tregister);
  190. var
  191. tmpreg: tregister;
  192. op2: Tasmop;
  193. negate: boolean;
  194. begin
  195. case op of
  196. A_ADD,A_SUB:
  197. op2:=A_ADDI;
  198. A_ADDU,A_SUBU:
  199. op2:=A_ADDIU;
  200. else
  201. InternalError(2013052001);
  202. end;
  203. negate:=op in [A_SUB,A_SUBU];
  204. { subtraction is actually addition of negated value, so possible range is
  205. off by one (-32767..32768) }
  206. if (a < simm16lo+ord(negate)) or
  207. (a > simm16hi+ord(negate)) then
  208. begin
  209. tmpreg := GetIntRegister(list, OS_INT);
  210. a_load_const_reg(list, OS_INT, a, tmpreg);
  211. list.concat(taicpu.op_reg_reg_reg(op, dst, src, tmpreg));
  212. end
  213. else
  214. begin
  215. if negate then
  216. a:=-a;
  217. list.concat(taicpu.op_reg_reg_const(op2, dst, src, a));
  218. end;
  219. end;
  220. {****************************************************************************
  221. Assembler code
  222. ****************************************************************************}
  223. procedure TCGMIPS.init_register_allocators;
  224. begin
  225. inherited init_register_allocators;
  226. { Keep RS_R25, i.e. $t9 for PIC call }
  227. if (cs_create_pic in current_settings.moduleswitches) and assigned(current_procinfo) and
  228. (pi_needs_got in current_procinfo.flags) then
  229. begin
  230. current_procinfo.got := NR_GP;
  231. rg[R_INTREGISTER] := Trgintcpu.Create(R_INTREGISTER, R_SUBD,
  232. [RS_R2,RS_R3,RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,RS_R9,
  233. RS_R10,RS_R11,RS_R12,RS_R13,RS_R14,RS_R15,RS_R16,RS_R17,RS_R18,RS_R19,
  234. RS_R20,RS_R21,RS_R22,RS_R23,RS_R24{,RS_R25}],
  235. first_int_imreg, []);
  236. end
  237. else
  238. rg[R_INTREGISTER] := trgintcpu.Create(R_INTREGISTER, R_SUBD,
  239. [RS_R2,RS_R3,RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,RS_R9,
  240. RS_R10,RS_R11,RS_R12,RS_R13,RS_R14,RS_R15,RS_R16,RS_R17,RS_R18,RS_R19,
  241. RS_R20,RS_R21,RS_R22,RS_R23,RS_R24{,RS_R25}],
  242. first_int_imreg, []);
  243. {
  244. rg[R_FPUREGISTER] := trgcpu.Create(R_FPUREGISTER, R_SUBFS,
  245. [RS_F0,RS_F1,RS_F2,RS_F3,RS_F4,RS_F5,RS_F6,RS_F7,
  246. RS_F8,RS_F9,RS_F10,RS_F11,RS_F12,RS_F13,RS_F14,RS_F15,
  247. RS_F16,RS_F17,RS_F18,RS_F19,RS_F20,RS_F21,RS_F22,RS_F23,
  248. RS_F24,RS_F25,RS_F26,RS_F27,RS_F28,RS_F29,RS_F30,RS_F31],
  249. first_fpu_imreg, []);
  250. }
  251. rg[R_FPUREGISTER] := trgcpu.Create(R_FPUREGISTER, R_SUBFS,
  252. [RS_F0,RS_F2,RS_F4,RS_F6, RS_F8,RS_F10,RS_F12,RS_F14,
  253. RS_F16,RS_F18,RS_F20,RS_F22, RS_F24,RS_F26,RS_F28,RS_F30],
  254. first_fpu_imreg, []);
  255. end;
  256. procedure TCGMIPS.done_register_allocators;
  257. begin
  258. rg[R_INTREGISTER].Free;
  259. rg[R_FPUREGISTER].Free;
  260. inherited done_register_allocators;
  261. end;
  262. procedure TCGMIPS.a_loadfpu_ref_cgpara(list: tasmlist; size: tcgsize; const ref: treference; const paraloc: TCGPara);
  263. var
  264. href, href2: treference;
  265. hloc: pcgparalocation;
  266. begin
  267. { TODO: inherited cannot deal with individual locations for each of OS_32 registers.
  268. Must change parameter management to allocate a single 64-bit register pair,
  269. then this method can be removed. }
  270. href := ref;
  271. hloc := paraloc.location;
  272. while assigned(hloc) do
  273. begin
  274. paramanager.allocparaloc(list,hloc);
  275. case hloc^.loc of
  276. LOC_REGISTER:
  277. a_load_ref_reg(list, hloc^.size, hloc^.size, href, hloc^.Register);
  278. LOC_FPUREGISTER,LOC_CFPUREGISTER :
  279. a_loadfpu_ref_reg(list,hloc^.size,hloc^.size,href,hloc^.register);
  280. LOC_REFERENCE:
  281. begin
  282. paraloc.check_simple_location;
  283. reference_reset_base(href2,paraloc.location^.reference.index,paraloc.location^.reference.offset,paraloc.alignment);
  284. { concatcopy should choose the best way to copy the data }
  285. g_concatcopy(list,ref,href2,tcgsize2size[size]);
  286. end;
  287. else
  288. internalerror(200408241);
  289. end;
  290. Inc(href.offset, tcgsize2size[hloc^.size]);
  291. hloc := hloc^.Next;
  292. end;
  293. end;
  294. procedure TCGMIPS.a_loadfpu_reg_cgpara(list: tasmlist; size: tcgsize; const r: tregister; const paraloc: TCGPara);
  295. var
  296. href: treference;
  297. begin
  298. if paraloc.Location^.next=nil then
  299. begin
  300. inherited a_loadfpu_reg_cgpara(list,size,r,paraloc);
  301. exit;
  302. end;
  303. tg.GetTemp(list, TCGSize2Size[size], TCGSize2Size[size], tt_normal, href);
  304. a_loadfpu_reg_ref(list, size, size, r, href);
  305. a_loadfpu_ref_cgpara(list, size, href, paraloc);
  306. tg.Ungettemp(list, href);
  307. end;
  308. procedure TCGMIPS.a_call_sym_pic(list: tasmlist; sym: tasmsymbol);
  309. var
  310. href: treference;
  311. begin
  312. reference_reset_symbol(href,sym,0,sizeof(aint));
  313. if (sym.bind=AB_LOCAL) then
  314. href.refaddr:=addr_pic
  315. else
  316. href.refaddr:=addr_pic_call16;
  317. href.base:=NR_GP;
  318. list.concat(taicpu.op_reg_ref(A_LW,NR_PIC_FUNC,href));
  319. if (sym.bind=AB_LOCAL) then
  320. begin
  321. href.refaddr:=addr_low;
  322. list.concat(taicpu.op_reg_ref(A_ADDIU,NR_PIC_FUNC,href));
  323. end;
  324. list.concat(taicpu.op_reg(A_JALR,NR_PIC_FUNC));
  325. { Delay slot }
  326. list.concat(taicpu.op_none(A_NOP));
  327. { Restore GP if in PIC mode }
  328. if (cs_create_pic in current_settings.moduleswitches) then
  329. begin
  330. if TMIPSProcinfo(current_procinfo).save_gp_ref.offset=0 then
  331. InternalError(2013071001);
  332. list.concat(taicpu.op_reg_ref(A_LW,NR_GP,TMIPSProcinfo(current_procinfo).save_gp_ref));
  333. end;
  334. end;
  335. procedure TCGMIPS.a_call_name(list: tasmlist; const s: string; weak: boolean);
  336. var
  337. sym: tasmsymbol;
  338. begin
  339. if assigned(current_procinfo) and
  340. not (pi_do_call in current_procinfo.flags) then
  341. InternalError(2013022101);
  342. if weak then
  343. sym:=current_asmdata.WeakRefAsmSymbol(s)
  344. else
  345. sym:=current_asmdata.RefAsmSymbol(s);
  346. if (cs_create_pic in current_settings.moduleswitches) then
  347. a_call_sym_pic(list,sym)
  348. else
  349. begin
  350. list.concat(taicpu.op_sym(A_JAL,sym));
  351. { Delay slot }
  352. list.concat(taicpu.op_none(A_NOP));
  353. end;
  354. end;
  355. procedure TCGMIPS.a_call_reg(list: tasmlist; Reg: TRegister);
  356. begin
  357. if assigned(current_procinfo) and
  358. not (pi_do_call in current_procinfo.flags) then
  359. InternalError(2013022102);
  360. if (Reg <> NR_PIC_FUNC) then
  361. list.concat(taicpu.op_reg_reg(A_MOVE,NR_PIC_FUNC,reg));
  362. list.concat(taicpu.op_reg(A_JALR,NR_PIC_FUNC));
  363. { Delay slot }
  364. list.concat(taicpu.op_none(A_NOP));
  365. { Restore GP if in PIC mode }
  366. if (cs_create_pic in current_settings.moduleswitches) then
  367. begin
  368. if TMIPSProcinfo(current_procinfo).save_gp_ref.offset=0 then
  369. InternalError(2013071002);
  370. list.concat(taicpu.op_reg_ref(A_LW,NR_GP,TMIPSProcinfo(current_procinfo).save_gp_ref));
  371. end;
  372. end;
  373. {********************** load instructions ********************}
  374. procedure TCGMIPS.a_load_const_reg(list: tasmlist; size: TCGSize; a: tcgint; reg: TRegister);
  375. begin
  376. if (a = 0) then
  377. a_load_reg_reg(list, OS_INT, OS_INT, NR_R0, reg)
  378. else if (a >= simm16lo) and (a <= simm16hi) then
  379. list.concat(taicpu.op_reg_reg_const(A_ADDIU, reg, NR_R0, a))
  380. else if (a>=0) and (a <= 65535) then
  381. list.concat(taicpu.op_reg_reg_const(A_ORI, reg, NR_R0, a))
  382. else
  383. begin
  384. list.concat(taicpu.op_reg_const(A_LUI, reg, aint(a) shr 16));
  385. if (a and aint($FFFF))<>0 then
  386. list.concat(taicpu.op_reg_reg_const(A_ORI,reg,reg,a and aint($FFFF)));
  387. end;
  388. end;
  389. procedure TCGMIPS.a_load_const_ref(list: tasmlist; size: tcgsize; a: tcgint; const ref: TReference);
  390. begin
  391. if a = 0 then
  392. a_load_reg_ref(list, size, size, NR_R0, ref)
  393. else
  394. inherited a_load_const_ref(list, size, a, ref);
  395. end;
  396. procedure TCGMIPS.a_load_reg_ref(list: tasmlist; FromSize, ToSize: TCGSize; reg: tregister; const Ref: TReference);
  397. var
  398. op: tasmop;
  399. href: treference;
  400. begin
  401. if (TCGSize2Size[fromsize] < TCGSize2Size[tosize]) then
  402. a_load_reg_reg(list,fromsize,tosize,reg,reg);
  403. case tosize of
  404. OS_8,
  405. OS_S8:
  406. Op := A_SB;
  407. OS_16,
  408. OS_S16:
  409. Op := A_SH;
  410. OS_32,
  411. OS_S32:
  412. Op := A_SW;
  413. else
  414. InternalError(2002122100);
  415. end;
  416. href:=ref;
  417. make_simple_ref(list,href);
  418. list.concat(taicpu.op_reg_ref(op,reg,href));
  419. end;
  420. procedure TCGMIPS.a_load_ref_reg(list: tasmlist; FromSize, ToSize: TCgSize; const ref: TReference; reg: tregister);
  421. var
  422. op: tasmop;
  423. href: treference;
  424. begin
  425. if (TCGSize2Size[fromsize] >= TCGSize2Size[tosize]) then
  426. fromsize := tosize;
  427. case fromsize of
  428. OS_S8:
  429. Op := A_LB;{Load Signed Byte}
  430. OS_8:
  431. Op := A_LBU;{Load Unsigned Byte}
  432. OS_S16:
  433. Op := A_LH;{Load Signed Halfword}
  434. OS_16:
  435. Op := A_LHU;{Load Unsigned Halfword}
  436. OS_S32:
  437. Op := A_LW;{Load Word}
  438. OS_32:
  439. Op := A_LW;//A_LWU;{Load Unsigned Word}
  440. OS_S64,
  441. OS_64:
  442. Op := A_LD;{Load a Long Word}
  443. else
  444. InternalError(2002122101);
  445. end;
  446. href:=ref;
  447. make_simple_ref(list,href);
  448. list.concat(taicpu.op_reg_ref(op,reg,href));
  449. if (fromsize=OS_S8) and (tosize=OS_16) then
  450. a_load_reg_reg(list,fromsize,tosize,reg,reg);
  451. end;
  452. procedure TCGMIPS.a_load_reg_reg(list: tasmlist; fromsize, tosize: tcgsize; reg1, reg2: tregister);
  453. var
  454. instr: taicpu;
  455. done: boolean;
  456. begin
  457. if (tcgsize2size[tosize] < tcgsize2size[fromsize]) or
  458. (
  459. (tcgsize2size[tosize] = tcgsize2size[fromsize]) and (tosize <> fromsize)
  460. ) or ((fromsize = OS_S8) and
  461. (tosize = OS_16)) then
  462. begin
  463. done:=true;
  464. case tosize of
  465. OS_8:
  466. list.concat(taicpu.op_reg_reg_const(A_ANDI, reg2, reg1, $ff));
  467. OS_16:
  468. list.concat(taicpu.op_reg_reg_const(A_ANDI, reg2, reg1, $ffff));
  469. OS_32,
  470. OS_S32:
  471. done:=false;
  472. OS_S8:
  473. begin
  474. if (CPUMIPS_HAS_ISA32R2 in cpu_capabilities[current_settings.cputype]) then
  475. list.concat(taicpu.op_reg_reg(A_SEB,reg2,reg1))
  476. else
  477. begin
  478. list.concat(taicpu.op_reg_reg_const(A_SLL, reg2, reg1, 24));
  479. list.concat(taicpu.op_reg_reg_const(A_SRA, reg2, reg2, 24));
  480. end;
  481. end;
  482. OS_S16:
  483. begin
  484. if (CPUMIPS_HAS_ISA32R2 in cpu_capabilities[current_settings.cputype]) then
  485. list.concat(taicpu.op_reg_reg(A_SEH,reg2,reg1))
  486. else
  487. begin
  488. list.concat(taicpu.op_reg_reg_const(A_SLL, reg2, reg1, 16));
  489. list.concat(taicpu.op_reg_reg_const(A_SRA, reg2, reg2, 16));
  490. end;
  491. end;
  492. else
  493. internalerror(2002090901);
  494. end;
  495. end
  496. else
  497. done:=false;
  498. if (not done) and (reg1 <> reg2) then
  499. begin
  500. { same size, only a register mov required }
  501. instr := taicpu.op_reg_reg(A_MOVE, reg2, reg1);
  502. list.Concat(instr);
  503. { Notify the register allocator that we have written a move instruction so
  504. it can try to eliminate it. }
  505. add_move_instruction(instr);
  506. end;
  507. end;
  508. procedure TCGMIPS.a_loadaddr_ref_reg(list: tasmlist; const ref: TReference; r: tregister);
  509. var
  510. href: treference;
  511. hreg: tregister;
  512. begin
  513. { Enforce some discipline for callers:
  514. - reference must be a "raw" one and not use gp }
  515. if (ref.base=NR_GP) or (ref.index=NR_GP) then
  516. InternalError(2013022803);
  517. if (ref.refaddr<>addr_no) then
  518. InternalError(2013022804);
  519. if (ref.base=NR_NO) and (ref.index<>NR_NO) then
  520. InternalError(200306171);
  521. if (ref.symbol=nil) then
  522. begin
  523. if (ref.base<>NR_NO) then
  524. begin
  525. if (ref.offset<simm16lo) or (ref.offset>simm16hi) then
  526. begin
  527. hreg:=getintregister(list,OS_INT);
  528. a_load_const_reg(list,OS_INT,ref.offset,hreg);
  529. list.concat(taicpu.op_reg_reg_reg(A_ADDU,r,ref.base,hreg));
  530. end
  531. else if (ref.offset<>0) then
  532. list.concat(taicpu.op_reg_reg_const(A_ADDIU,r,ref.base,ref.offset))
  533. else
  534. a_load_reg_reg(list,OS_INT,OS_INT,ref.base,r); { emit optimizable move }
  535. if (ref.index<>NR_NO) then
  536. list.concat(taicpu.op_reg_reg_reg(A_ADDU,r,r,ref.index));
  537. end
  538. else
  539. a_load_const_reg(list,OS_INT,ref.offset,r);
  540. exit;
  541. end;
  542. reference_reset_symbol(href,ref.symbol,ref.offset,ref.alignment);
  543. if (cs_create_pic in current_settings.moduleswitches) then
  544. begin
  545. if not (pi_needs_got in current_procinfo.flags) then
  546. InternalError(2013060103);
  547. { For PIC global symbols offset must be handled separately.
  548. Otherwise (non-PIC or local symbols) offset can be encoded
  549. into relocation even if exceeds 16 bits. }
  550. if (href.symbol.bind<>AB_LOCAL) then
  551. href.offset:=0;
  552. href.refaddr:=addr_pic;
  553. href.base:=NR_GP;
  554. list.concat(taicpu.op_reg_ref(A_LW,r,href));
  555. end
  556. else
  557. begin
  558. href.refaddr:=addr_high;
  559. list.concat(taicpu.op_reg_ref(A_LUI,r,href));
  560. end;
  561. { Add original base/index, if any. }
  562. if (ref.base<>NR_NO) then
  563. list.concat(taicpu.op_reg_reg_reg(A_ADDU,r,r,ref.base));
  564. if (ref.index<>NR_NO) then
  565. list.concat(taicpu.op_reg_reg_reg(A_ADDU,r,r,ref.index));
  566. { add low part if necessary }
  567. if (ref.symbol.bind=AB_LOCAL) or
  568. not (cs_create_pic in current_settings.moduleswitches) then
  569. begin
  570. href.refaddr:=addr_low;
  571. href.base:=NR_NO;
  572. list.concat(taicpu.op_reg_reg_ref(A_ADDIU,r,r,href));
  573. exit;
  574. end;
  575. if (ref.offset<simm16lo) or (ref.offset>simm16hi) then
  576. begin
  577. hreg:=getintregister(list,OS_INT);
  578. a_load_const_reg(list,OS_INT,ref.offset,hreg);
  579. list.concat(taicpu.op_reg_reg_reg(A_ADDU,r,r,hreg));
  580. end
  581. else if (ref.offset<>0) then
  582. list.concat(taicpu.op_reg_reg_const(A_ADDIU,r,r,ref.offset));
  583. end;
  584. procedure TCGMIPS.a_loadfpu_reg_reg(list: tasmlist; fromsize, tosize: tcgsize; reg1, reg2: tregister);
  585. const
  586. FpuMovInstr: array[OS_F32..OS_F64,OS_F32..OS_F64] of TAsmOp =
  587. ((A_MOV_S, A_CVT_D_S),(A_CVT_S_D,A_MOV_D));
  588. var
  589. instr: taicpu;
  590. begin
  591. if (reg1 <> reg2) or (fromsize<>tosize) then
  592. begin
  593. instr := taicpu.op_reg_reg(fpumovinstr[fromsize,tosize], reg2, reg1);
  594. list.Concat(instr);
  595. { Notify the register allocator that we have written a move instruction so
  596. it can try to eliminate it. }
  597. if (fromsize=tosize) then
  598. add_move_instruction(instr);
  599. end;
  600. end;
  601. procedure TCGMIPS.a_loadfpu_ref_reg(list: tasmlist; fromsize, tosize: tcgsize; const ref: TReference; reg: tregister);
  602. var
  603. href: TReference;
  604. begin
  605. href:=ref;
  606. make_simple_ref(list,href);
  607. case fromsize of
  608. OS_F32:
  609. list.concat(taicpu.op_reg_ref(A_LWC1,reg,href));
  610. OS_F64:
  611. list.concat(taicpu.op_reg_ref(A_LDC1,reg,href));
  612. else
  613. InternalError(2007042701);
  614. end;
  615. if tosize<>fromsize then
  616. a_loadfpu_reg_reg(list,fromsize,tosize,reg,reg);
  617. end;
  618. procedure TCGMIPS.a_loadfpu_reg_ref(list: tasmlist; fromsize, tosize: tcgsize; reg: tregister; const ref: TReference);
  619. var
  620. href: TReference;
  621. begin
  622. if tosize<>fromsize then
  623. a_loadfpu_reg_reg(list,fromsize,tosize,reg,reg);
  624. href:=ref;
  625. make_simple_ref(list,href);
  626. case tosize of
  627. OS_F32:
  628. list.concat(taicpu.op_reg_ref(A_SWC1,reg,href));
  629. OS_F64:
  630. list.concat(taicpu.op_reg_ref(A_SDC1,reg,href));
  631. else
  632. InternalError(2007042702);
  633. end;
  634. end;
  635. procedure TCGMIPS.maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister);
  636. const
  637. overflowops = [OP_MUL,OP_SHL,OP_ADD,OP_SUB,OP_NOT,OP_NEG];
  638. begin
  639. if (op in overflowops) and
  640. (size in [OS_8,OS_S8,OS_16,OS_S16]) then
  641. a_load_reg_reg(list,OS_32,size,dst,dst);
  642. end;
  643. procedure TCGMIPS.overflowcheck_internal(list: tasmlist; arg1, arg2: tregister);
  644. var
  645. carry, hreg: tregister;
  646. begin
  647. if (arg1=arg2) then
  648. InternalError(2013050501);
  649. carry:=GetIntRegister(list,OS_INT);
  650. hreg:=GetIntRegister(list,OS_INT);
  651. list.concat(taicpu.op_reg_reg_reg(A_SLTU,carry,arg1,arg2));
  652. { if carry<>0, this will cause hardware overflow interrupt }
  653. a_load_const_reg(list,OS_INT,$80000000,hreg);
  654. list.concat(taicpu.op_reg_reg_reg(A_SUB,hreg,hreg,carry));
  655. end;
  656. const
  657. ops_add: array[boolean] of TAsmOp = (A_ADDU, A_ADD);
  658. ops_sub: array[boolean] of TAsmOp = (A_SUBU, A_SUB);
  659. ops_slt: array[boolean] of TAsmOp = (A_SLTU, A_SLT);
  660. ops_slti: array[boolean] of TAsmOp = (A_SLTIU, A_SLTI);
  661. ops_and: array[boolean] of TAsmOp = (A_AND, A_ANDI);
  662. ops_or: array[boolean] of TAsmOp = (A_OR, A_ORI);
  663. ops_xor: array[boolean] of TasmOp = (A_XOR, A_XORI);
  664. procedure TCGMIPS.a_op_const_reg(list: tasmlist; Op: TOpCG; size: tcgsize; a: tcgint; reg: TRegister);
  665. begin
  666. optimize_op_const(size,op,a);
  667. case op of
  668. OP_NONE:
  669. exit;
  670. OP_MOVE:
  671. a_load_const_reg(list,size,a,reg);
  672. OP_NEG,OP_NOT:
  673. internalerror(200306011);
  674. else
  675. a_op_const_reg_reg(list,op,size,a,reg,reg);
  676. end;
  677. end;
  678. procedure TCGMIPS.a_op_reg_reg(list: tasmlist; Op: TOpCG; size: TCGSize; src, dst: TRegister);
  679. begin
  680. case Op of
  681. OP_NEG:
  682. list.concat(taicpu.op_reg_reg_reg(A_SUBU, dst, NR_R0, src));
  683. OP_NOT:
  684. list.concat(taicpu.op_reg_reg_reg(A_NOR, dst, NR_R0, src));
  685. OP_IMUL,OP_MUL:
  686. begin
  687. list.concat(taicpu.op_reg_reg(TOpcg2AsmOp[op], dst, src));
  688. list.concat(taicpu.op_reg(A_MFLO, dst));
  689. end;
  690. else
  691. a_op_reg_reg_reg(list, op, size, src, dst, dst);
  692. exit;
  693. end;
  694. maybeadjustresult(list,op,size,dst);
  695. end;
  696. procedure TCGMIPS.a_op_const_reg_reg(list: tasmlist; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister);
  697. var
  698. l: TLocation;
  699. begin
  700. a_op_const_reg_reg_checkoverflow(list, op, size, a, src, dst, false, l);
  701. end;
  702. procedure TCGMIPS.a_op_reg_reg_reg(list: tasmlist; op: TOpCg; size: tcgsize; src1, src2, dst: tregister);
  703. begin
  704. if (TOpcg2AsmOp[op]=A_NONE) then
  705. InternalError(2013070305);
  706. if (op=OP_SAR) then
  707. begin
  708. if (size in [OS_S8,OS_S16]) then
  709. begin
  710. { Sign-extend before shiting }
  711. list.concat(taicpu.op_reg_reg_const(A_SLL, dst, src2, 32-(tcgsize2size[size]*8)));
  712. list.concat(taicpu.op_reg_reg_const(A_SRA, dst, dst, 32-(tcgsize2size[size]*8)));
  713. src2:=dst;
  714. end
  715. else if not (size in [OS_32,OS_S32]) then
  716. InternalError(2013070306);
  717. end;
  718. list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOp[op], dst, src2, src1));
  719. maybeadjustresult(list,op,size,dst);
  720. end;
  721. procedure TCGMIPS.a_op_const_reg_reg_checkoverflow(list: tasmlist; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister; setflags: boolean; var ovloc: tlocation);
  722. var
  723. signed,immed: boolean;
  724. hreg: TRegister;
  725. asmop: TAsmOp;
  726. begin
  727. a:=aint(a);
  728. ovloc.loc := LOC_VOID;
  729. optimize_op_const(size,op,a);
  730. signed:=(size in [OS_S8,OS_S16,OS_S32]);
  731. if (setflags and (not signed) and (src=dst) and (op in [OP_ADD,OP_SUB])) then
  732. hreg:=GetIntRegister(list,OS_INT)
  733. else
  734. hreg:=dst;
  735. case op of
  736. OP_NONE:
  737. a_load_reg_reg(list,size,size,src,dst);
  738. OP_MOVE:
  739. a_load_const_reg(list,size,a,dst);
  740. OP_ADD:
  741. begin
  742. handle_reg_const_reg(list,ops_add[setflags and signed],src,a,hreg);
  743. if setflags and (not signed) then
  744. overflowcheck_internal(list,hreg,src);
  745. { does nothing if hreg=dst }
  746. a_load_reg_reg(list,OS_INT,OS_INT,hreg,dst);
  747. end;
  748. OP_SUB:
  749. begin
  750. handle_reg_const_reg(list,ops_sub[setflags and signed],src,a,hreg);
  751. if setflags and (not signed) then
  752. overflowcheck_internal(list,src,hreg);
  753. a_load_reg_reg(list,OS_INT,OS_INT,hreg,dst);
  754. end;
  755. OP_MUL,OP_IMUL:
  756. begin
  757. hreg:=GetIntRegister(list,OS_INT);
  758. a_load_const_reg(list,OS_INT,a,hreg);
  759. a_op_reg_reg_reg_checkoverflow(list,op,size,src,hreg,dst,setflags,ovloc);
  760. exit;
  761. end;
  762. OP_AND,OP_OR,OP_XOR:
  763. begin
  764. { logical operations zero-extend, not sign-extend, the immediate }
  765. immed:=(a>=0) and (a<=65535);
  766. case op of
  767. OP_AND: asmop:=ops_and[immed];
  768. OP_OR: asmop:=ops_or[immed];
  769. OP_XOR: asmop:=ops_xor[immed];
  770. else
  771. InternalError(2013050401);
  772. end;
  773. if immed then
  774. list.concat(taicpu.op_reg_reg_const(asmop,dst,src,a))
  775. else
  776. begin
  777. hreg:=GetIntRegister(list,OS_INT);
  778. a_load_const_reg(list,OS_INT,a,hreg);
  779. list.concat(taicpu.op_reg_reg_reg(asmop,dst,src,hreg));
  780. end;
  781. end;
  782. OP_SHL:
  783. list.concat(taicpu.op_reg_reg_const(A_SLL,dst,src,a));
  784. OP_SHR:
  785. list.concat(taicpu.op_reg_reg_const(A_SRL,dst,src,a));
  786. OP_SAR:
  787. begin
  788. if (size in [OS_S8,OS_S16]) then
  789. begin
  790. list.concat(taicpu.op_reg_reg_const(A_SLL,dst,src,32-(tcgsize2size[size]*8)));
  791. inc(a,32-tcgsize2size[size]*8);
  792. src:=dst;
  793. end
  794. else if not (size in [OS_32,OS_S32]) then
  795. InternalError(2013070303);
  796. list.concat(taicpu.op_reg_reg_const(A_SRA,dst,src,a));
  797. end;
  798. else
  799. internalerror(2007012601);
  800. end;
  801. maybeadjustresult(list,op,size,dst);
  802. end;
  803. procedure TCGMIPS.a_op_reg_reg_reg_checkoverflow(list: tasmlist; op: TOpCg; size: tcgsize; src1, src2, dst: tregister; setflags: boolean; var ovloc: tlocation);
  804. var
  805. signed: boolean;
  806. hreg,hreg2: TRegister;
  807. hl: tasmlabel;
  808. begin
  809. ovloc.loc := LOC_VOID;
  810. signed:=(size in [OS_S8,OS_S16,OS_S32]);
  811. if (setflags and (not signed) and (src2=dst) and (op in [OP_ADD,OP_SUB])) then
  812. hreg:=GetIntRegister(list,OS_INT)
  813. else
  814. hreg:=dst;
  815. case op of
  816. OP_ADD:
  817. begin
  818. list.concat(taicpu.op_reg_reg_reg(ops_add[setflags and signed], hreg, src2, src1));
  819. if setflags and (not signed) then
  820. overflowcheck_internal(list, hreg, src2);
  821. a_load_reg_reg(list, OS_INT, OS_INT, hreg, dst);
  822. end;
  823. OP_SUB:
  824. begin
  825. list.concat(taicpu.op_reg_reg_reg(ops_sub[setflags and signed], hreg, src2, src1));
  826. if setflags and (not signed) then
  827. overflowcheck_internal(list, src2, hreg);
  828. a_load_reg_reg(list, OS_INT, OS_INT, hreg, dst);
  829. end;
  830. OP_MUL,OP_IMUL:
  831. begin
  832. if (CPUMIPS_HAS_ISA32R2 in cpu_capabilities[current_settings.cputype]) and
  833. (not setflags) then
  834. { NOTE: MUL is actually mips32r1 instruction; on older cores it is handled as macro }
  835. list.concat(taicpu.op_reg_reg_reg(A_MUL,dst,src2,src1))
  836. else
  837. begin
  838. list.concat(taicpu.op_reg_reg(TOpCg2AsmOp[op], src2, src1));
  839. list.concat(taicpu.op_reg(A_MFLO, dst));
  840. if setflags then
  841. begin
  842. current_asmdata.getjumplabel(hl);
  843. hreg:=GetIntRegister(list,OS_INT);
  844. list.concat(taicpu.op_reg(A_MFHI,hreg));
  845. if (op=OP_IMUL) then
  846. begin
  847. hreg2:=GetIntRegister(list,OS_INT);
  848. list.concat(taicpu.op_reg_reg_const(A_SRA,hreg2,dst,31));
  849. a_cmp_reg_reg_label(list,OS_INT,OC_EQ,hreg2,hreg,hl);
  850. end
  851. else
  852. a_cmp_reg_reg_label(list,OS_INT,OC_EQ,hreg,NR_R0,hl);
  853. list.concat(taicpu.op_const(A_BREAK,6));
  854. a_label(list,hl);
  855. end;
  856. end;
  857. end;
  858. OP_AND,OP_OR,OP_XOR:
  859. begin
  860. list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOp[op], dst, src2, src1));
  861. end;
  862. else
  863. internalerror(2007012602);
  864. end;
  865. maybeadjustresult(list,op,size,dst);
  866. end;
  867. {*************** compare instructructions ****************}
  868. procedure TCGMIPS.a_cmp_const_reg_label(list: tasmlist; size: tcgsize; cmp_op: topcmp; a: tcgint; reg: tregister; l: tasmlabel);
  869. var
  870. tmpreg: tregister;
  871. begin
  872. if a = 0 then
  873. a_cmp_reg_reg_label(list,size,cmp_op,NR_R0,reg,l)
  874. else
  875. begin
  876. tmpreg := GetIntRegister(list,OS_INT);
  877. if (a>=simm16lo) and (a<=simm16hi) and
  878. (cmp_op in [OC_LT,OC_B,OC_GTE,OC_AE]) then
  879. begin
  880. list.concat(taicpu.op_reg_reg_const(ops_slti[cmp_op in [OC_LT,OC_GTE]],tmpreg,reg,a));
  881. if cmp_op in [OC_LT,OC_B] then
  882. a_cmp_reg_reg_label(list,size,OC_NE,NR_R0,tmpreg,l)
  883. else
  884. a_cmp_reg_reg_label(list,size,OC_EQ,NR_R0,tmpreg,l);
  885. end
  886. else
  887. begin
  888. a_load_const_reg(list,OS_INT,a,tmpreg);
  889. a_cmp_reg_reg_label(list, size, cmp_op, tmpreg, reg, l);
  890. end;
  891. end;
  892. end;
  893. const
  894. TOpCmp2AsmCond_z : array[OC_GT..OC_LTE] of TAsmCond=(
  895. C_GTZ,C_LTZ,C_GEZ,C_LEZ
  896. );
  897. TOpCmp2AsmCond_eqne: array[topcmp] of TAsmCond = (C_NONE,
  898. { eq gt lt gte lte ne }
  899. C_NONE, C_NE, C_NE, C_EQ, C_EQ, C_NONE,
  900. { be b ae a }
  901. C_EQ, C_NE, C_EQ, C_NE
  902. );
  903. procedure TCGMIPS.a_cmp_reg_reg_label(list: tasmlist; size: tcgsize; cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel);
  904. var
  905. ai : Taicpu;
  906. op: TAsmOp;
  907. hreg: TRegister;
  908. begin
  909. if not (cmp_op in [OC_EQ,OC_NE]) then
  910. begin
  911. if ((reg1=NR_R0) or (reg2=NR_R0)) and (cmp_op in [OC_GT,OC_LT,OC_GTE,OC_LTE]) then
  912. begin
  913. if (reg2=NR_R0) then
  914. begin
  915. ai:=taicpu.op_reg_sym(A_BC,reg1,l);
  916. ai.setcondition(TOpCmp2AsmCond_z[swap_opcmp(cmp_op)]);
  917. end
  918. else
  919. begin
  920. ai:=taicpu.op_reg_sym(A_BC,reg2,l);
  921. ai.setcondition(TOpCmp2AsmCond_z[cmp_op]);
  922. end;
  923. end
  924. else
  925. begin
  926. hreg:=GetIntRegister(list,OS_INT);
  927. op:=ops_slt[cmp_op in [OC_LT,OC_LTE,OC_GT,OC_GTE]];
  928. if (cmp_op in [OC_LTE,OC_GT,OC_BE,OC_A]) then { swap operands }
  929. list.concat(taicpu.op_reg_reg_reg(op,hreg,reg1,reg2))
  930. else
  931. list.concat(taicpu.op_reg_reg_reg(op,hreg,reg2,reg1));
  932. if (TOpCmp2AsmCond_eqne[cmp_op]=C_NONE) then
  933. InternalError(2013051501);
  934. ai:=taicpu.op_reg_reg_sym(A_BC,hreg,NR_R0,l);
  935. ai.SetCondition(TOpCmp2AsmCond_eqne[cmp_op]);
  936. end;
  937. end
  938. else
  939. begin
  940. ai:=taicpu.op_reg_reg_sym(A_BC,reg2,reg1,l);
  941. ai.SetCondition(TOpCmp2AsmCond[cmp_op]);
  942. end;
  943. list.concat(ai);
  944. { Delay slot }
  945. list.Concat(TAiCpu.Op_none(A_NOP));
  946. end;
  947. procedure TCGMIPS.a_jmp_always(List: tasmlist; l: TAsmLabel);
  948. var
  949. ai : Taicpu;
  950. begin
  951. ai := taicpu.op_sym(A_BA, l);
  952. list.concat(ai);
  953. { Delay slot }
  954. list.Concat(TAiCpu.Op_none(A_NOP));
  955. end;
  956. procedure TCGMIPS.a_jmp_name(list: tasmlist; const s: string);
  957. begin
  958. List.Concat(TAiCpu.op_sym(A_BA, current_asmdata.RefAsmSymbol(s)));
  959. { Delay slot }
  960. list.Concat(TAiCpu.Op_none(A_NOP));
  961. end;
  962. procedure TCGMIPS.a_jmp_flags(list: tasmlist; const f: TResFlags; l: tasmlabel);
  963. var
  964. ai: taicpu;
  965. begin
  966. case f.reg1 of
  967. NR_FCC0..NR_FCC7:
  968. begin
  969. if (f.reg1=NR_FCC0) then
  970. ai:=taicpu.op_sym(A_BC,l)
  971. else
  972. ai:=taicpu.op_reg_sym(A_BC,f.reg1,l);
  973. list.concat(ai);
  974. { delay slot }
  975. list.concat(taicpu.op_none(A_NOP));
  976. case f.cond of
  977. OC_NE: ai.SetCondition(C_COP1TRUE);
  978. OC_EQ: ai.SetCondition(C_COP1FALSE);
  979. else
  980. InternalError(2014082901);
  981. end;
  982. exit;
  983. end;
  984. end;
  985. if f.use_const then
  986. a_cmp_const_reg_label(list,OS_INT,f.cond,f.value,f.reg1,l)
  987. else
  988. a_cmp_reg_reg_label(list,OS_INT,f.cond,f.reg2,f.reg1,l);
  989. end;
  990. procedure TCGMIPS.g_flags2reg(list: tasmlist; size: tcgsize; const f: tresflags; reg: tregister);
  991. var
  992. left,right: tregister;
  993. unsigned: boolean;
  994. hl: tasmlabel;
  995. begin
  996. case f.reg1 of
  997. NR_FCC0..NR_FCC7:
  998. begin
  999. if (current_settings.cputype>=cpu_mips4) then
  1000. begin
  1001. a_load_const_reg(list,size,1,reg);
  1002. case f.cond of
  1003. OC_NE: list.concat(taicpu.op_reg_reg_reg(A_MOVF,reg,NR_R0,f.reg1));
  1004. OC_EQ: list.concat(taicpu.op_reg_reg_reg(A_MOVT,reg,NR_R0,f.reg1));
  1005. else
  1006. InternalError(2014082902);
  1007. end;
  1008. end
  1009. else
  1010. begin
  1011. { TODO: still possible to do branchless by extracting appropriate bit from FCSR? }
  1012. current_asmdata.getjumplabel(hl);
  1013. a_load_const_reg(list,size,1,reg);
  1014. a_jmp_flags(list,f,hl);
  1015. a_load_const_reg(list,size,0,reg);
  1016. a_label(list,hl);
  1017. end;
  1018. exit;
  1019. end;
  1020. end;
  1021. if (f.cond in [OC_EQ,OC_NE]) then
  1022. begin
  1023. left:=reg;
  1024. if f.use_const and (f.value>=0) and (f.value<=65535) then
  1025. begin
  1026. if (f.value<>0) then
  1027. list.concat(taicpu.op_reg_reg_const(A_XORI,reg,f.reg1,f.value))
  1028. else
  1029. left:=f.reg1;
  1030. end
  1031. else
  1032. begin
  1033. if f.use_const then
  1034. begin
  1035. right:=GetIntRegister(list,OS_INT);
  1036. a_load_const_reg(list,OS_INT,f.value,right);
  1037. end
  1038. else
  1039. right:=f.reg2;
  1040. list.concat(taicpu.op_reg_reg_reg(A_XOR,reg,f.reg1,right));
  1041. end;
  1042. if f.cond=OC_EQ then
  1043. list.concat(taicpu.op_reg_reg_const(A_SLTIU,reg,left,1))
  1044. else
  1045. list.concat(taicpu.op_reg_reg_reg(A_SLTU,reg,NR_R0,left));
  1046. end
  1047. else
  1048. begin
  1049. {
  1050. sle x,a,b --> slt x,b,a; xori x,x,1 immediate not possible (or must be at left)
  1051. sgt x,a,b --> slt x,b,a likewise
  1052. sge x,a,b --> slt x,a,b; xori x,x,1
  1053. slt x,a,b --> unchanged
  1054. }
  1055. unsigned:=f.cond in [OC_GT,OC_LT,OC_GTE,OC_LTE];
  1056. if (f.cond in [OC_GTE,OC_LT,OC_B,OC_AE]) and
  1057. f.use_const and
  1058. (f.value>=simm16lo) and
  1059. (f.value<=simm16hi) then
  1060. list.Concat(taicpu.op_reg_reg_const(ops_slti[unsigned],reg,f.reg1,f.value))
  1061. else
  1062. begin
  1063. if f.use_const then
  1064. begin
  1065. if (f.value=0) then
  1066. right:=NR_R0
  1067. else
  1068. begin
  1069. right:=GetIntRegister(list,OS_INT);
  1070. a_load_const_reg(list,OS_INT,f.value,right);
  1071. end;
  1072. end
  1073. else
  1074. right:=f.reg2;
  1075. if (f.cond in [OC_LTE,OC_GT,OC_BE,OC_A]) then
  1076. list.Concat(taicpu.op_reg_reg_reg(ops_slt[unsigned],reg,right,f.reg1))
  1077. else
  1078. list.Concat(taicpu.op_reg_reg_reg(ops_slt[unsigned],reg,f.reg1,right));
  1079. end;
  1080. if (f.cond in [OC_LTE,OC_GTE,OC_BE,OC_AE]) then
  1081. list.Concat(taicpu.op_reg_reg_const(A_XORI,reg,reg,1));
  1082. end;
  1083. end;
  1084. procedure TCGMIPS.a_mul_reg_reg_pair(list: tasmlist; size: tcgsize; src1,src2,dstlo,dsthi: tregister);
  1085. var
  1086. asmop: tasmop;
  1087. begin
  1088. case size of
  1089. OS_32: asmop:=A_MULTU;
  1090. OS_S32: asmop:=A_MULT;
  1091. else
  1092. InternalError(2014060802);
  1093. end;
  1094. list.concat(taicpu.op_reg_reg(asmop,src1,src2));
  1095. if (dstlo<>NR_NO) then
  1096. list.concat(taicpu.op_reg(A_MFLO,dstlo));
  1097. if (dsthi<>NR_NO) then
  1098. list.concat(taicpu.op_reg(A_MFHI,dsthi));
  1099. end;
  1100. procedure TCGMIPS.g_overflowCheck(List: tasmlist; const Loc: TLocation; def: TDef);
  1101. begin
  1102. // this is an empty procedure
  1103. end;
  1104. procedure TCGMIPS.g_overflowCheck_loc(List: tasmlist; const Loc: TLocation; def: TDef; ovloc: tlocation);
  1105. begin
  1106. // this is an empty procedure
  1107. end;
  1108. { *********** entry/exit code and address loading ************ }
  1109. procedure FixupOffsets(p:TObject;arg:pointer);
  1110. var
  1111. sym: tabstractnormalvarsym absolute p;
  1112. begin
  1113. if (tsym(p).typ=paravarsym) and
  1114. (sym.localloc.loc=LOC_REFERENCE) and
  1115. (sym.localloc.reference.base=NR_FRAME_POINTER_REG) then
  1116. begin
  1117. sym.localloc.reference.base:=NR_STACK_POINTER_REG;
  1118. Inc(sym.localloc.reference.offset,PLongint(arg)^);
  1119. end;
  1120. end;
  1121. procedure TCGMIPS.g_proc_entry(list: tasmlist; localsize: longint; nostackframe: boolean);
  1122. var
  1123. lastintoffset,lastfpuoffset,
  1124. nextoffset : aint;
  1125. i : longint;
  1126. ra_save,framesave : taicpu;
  1127. fmask,mask : dword;
  1128. saveregs : tcpuregisterset;
  1129. href: treference;
  1130. reg : Tsuperregister;
  1131. helplist : TAsmList;
  1132. largeoffs : boolean;
  1133. begin
  1134. list.concat(tai_directive.create(asd_ent,current_procinfo.procdef.mangledname));
  1135. if nostackframe then
  1136. begin
  1137. list.concat(taicpu.op_none(A_P_SET_NOMIPS16));
  1138. list.concat(taicpu.op_none(A_P_SET_NOREORDER));
  1139. exit;
  1140. end;
  1141. helplist:=TAsmList.Create;
  1142. reference_reset(href,0);
  1143. href.base:=NR_STACK_POINTER_REG;
  1144. fmask:=0;
  1145. nextoffset:=TMIPSProcInfo(current_procinfo).floatregstart;
  1146. lastfpuoffset:=LocalSize;
  1147. for reg := RS_F0 to RS_F31 do { to check: what if F30 is double? }
  1148. begin
  1149. if reg in (rg[R_FPUREGISTER].used_in_proc-paramanager.get_volatile_registers_fpu(pocall_stdcall)) then
  1150. begin
  1151. fmask:=fmask or (longword(1) shl ord(reg));
  1152. href.offset:=nextoffset;
  1153. lastfpuoffset:=nextoffset;
  1154. helplist.concat(taicpu.op_reg_ref(A_SWC1,newreg(R_FPUREGISTER,reg,R_SUBFS),href));
  1155. inc(nextoffset,4);
  1156. { IEEE Double values are stored in floating point
  1157. register pairs f2X/f2X+1,
  1158. as the f2X+1 register is not correctly marked as used for now,
  1159. we simply assume it is also used if f2X is used
  1160. Should be fixed by a proper inclusion of f2X+1 into used_in_proc }
  1161. if (ord(reg)-ord(RS_F0)) mod 2 = 0 then
  1162. include(rg[R_FPUREGISTER].used_in_proc,succ(reg));
  1163. end;
  1164. end;
  1165. mask:=0;
  1166. nextoffset:=TMIPSProcInfo(current_procinfo).intregstart;
  1167. saveregs:=rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall);
  1168. if (current_procinfo.flags*[pi_do_call,pi_is_assembler]<>[]) then
  1169. include(saveregs,RS_R31);
  1170. if (pi_needs_stackframe in current_procinfo.flags) then
  1171. include(saveregs,RS_FRAME_POINTER_REG);
  1172. lastintoffset:=LocalSize;
  1173. framesave:=nil;
  1174. ra_save:=nil;
  1175. for reg:=RS_R1 to RS_R31 do
  1176. begin
  1177. if reg in saveregs then
  1178. begin
  1179. mask:=mask or (longword(1) shl ord(reg));
  1180. href.offset:=nextoffset;
  1181. lastintoffset:=nextoffset;
  1182. if (reg=RS_FRAME_POINTER_REG) then
  1183. framesave:=taicpu.op_reg_ref(A_SW,newreg(R_INTREGISTER,reg,R_SUBWHOLE),href)
  1184. else if (reg=RS_R31) then
  1185. ra_save:=taicpu.op_reg_ref(A_SW,newreg(R_INTREGISTER,reg,R_SUBWHOLE),href)
  1186. else
  1187. helplist.concat(taicpu.op_reg_ref(A_SW,newreg(R_INTREGISTER,reg,R_SUBWHOLE),href));
  1188. inc(nextoffset,4);
  1189. end;
  1190. end;
  1191. //list.concat(Taicpu.Op_reg_reg_const(A_ADDIU,NR_FRAME_POINTER_REG,NR_STACK_POINTER_REG,current_procinfo.para_stack_size));
  1192. list.concat(Taicpu.op_none(A_P_SET_NOMIPS16));
  1193. list.concat(Taicpu.op_reg_const_reg(A_P_FRAME,current_procinfo.framepointer,LocalSize,NR_R31));
  1194. list.concat(Taicpu.op_const_const(A_P_MASK,aint(mask),-(LocalSize-lastintoffset)));
  1195. list.concat(Taicpu.op_const_const(A_P_FMASK,aint(Fmask),-(LocalSize-lastfpuoffset)));
  1196. list.concat(Taicpu.op_none(A_P_SET_NOREORDER));
  1197. if (cs_create_pic in current_settings.moduleswitches) and
  1198. (pi_needs_got in current_procinfo.flags) then
  1199. begin
  1200. list.concat(Taicpu.op_reg(A_P_CPLOAD,NR_PIC_FUNC));
  1201. end;
  1202. if (-LocalSize >= simm16lo) and (-LocalSize <= simm16hi) then
  1203. begin
  1204. list.concat(Taicpu.op_none(A_P_SET_NOMACRO));
  1205. list.concat(Taicpu.Op_reg_reg_const(A_ADDIU,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,-LocalSize));
  1206. if assigned(ra_save) then
  1207. list.concat(ra_save);
  1208. if assigned(framesave) then
  1209. begin
  1210. list.concat(framesave);
  1211. list.concat(Taicpu.op_reg_reg_const(A_ADDIU,NR_FRAME_POINTER_REG,
  1212. NR_STACK_POINTER_REG,LocalSize));
  1213. end;
  1214. end
  1215. else
  1216. begin
  1217. a_load_const_reg(list,OS_32,-LocalSize,NR_R9);
  1218. list.concat(Taicpu.Op_reg_reg_reg(A_ADDU,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,NR_R9));
  1219. if assigned(ra_save) then
  1220. list.concat(ra_save);
  1221. if assigned(framesave) then
  1222. begin
  1223. list.concat(framesave);
  1224. list.concat(Taicpu.op_reg_reg_reg(A_SUBU,NR_FRAME_POINTER_REG,
  1225. NR_STACK_POINTER_REG,NR_R9));
  1226. end;
  1227. { The instructions before are macros that can extend to multiple instructions,
  1228. the settings of R9 to -LocalSize surely does,
  1229. but the saving of RA and FP also might, and might
  1230. even use AT register, which is why we use R9 instead of AT here for -LocalSize }
  1231. list.concat(Taicpu.op_none(A_P_SET_NOMACRO));
  1232. end;
  1233. if (cs_create_pic in current_settings.moduleswitches) and
  1234. (pi_needs_got in current_procinfo.flags) then
  1235. begin
  1236. largeoffs:=(TMIPSProcinfo(current_procinfo).save_gp_ref.offset>simm16hi);
  1237. if largeoffs then
  1238. list.concat(Taicpu.op_none(A_P_SET_MACRO));
  1239. list.concat(Taicpu.op_const(A_P_CPRESTORE,TMIPSProcinfo(current_procinfo).save_gp_ref.offset));
  1240. if largeoffs then
  1241. list.concat(Taicpu.op_none(A_P_SET_NOMACRO));
  1242. end;
  1243. href.base:=NR_STACK_POINTER_REG;
  1244. for i:=0 to MIPS_MAX_REGISTERS_USED_IN_CALL-1 do
  1245. if TMIPSProcInfo(current_procinfo).register_used[i] then
  1246. begin
  1247. reg:=parasupregs[i];
  1248. href.offset:=i*sizeof(aint)+LocalSize;
  1249. list.concat(taicpu.op_reg_ref(A_SW, newreg(R_INTREGISTER,reg,R_SUBWHOLE), href));
  1250. end;
  1251. list.concatList(helplist);
  1252. helplist.Free;
  1253. if current_procinfo.has_nestedprocs then
  1254. current_procinfo.procdef.parast.SymList.ForEachCall(@FixupOffsets,@LocalSize);
  1255. end;
  1256. procedure TCGMIPS.g_proc_exit(list: tasmlist; parasize: longint; nostackframe: boolean);
  1257. var
  1258. href : treference;
  1259. stacksize : aint;
  1260. saveregs : tcpuregisterset;
  1261. nextoffset : aint;
  1262. reg : Tsuperregister;
  1263. begin
  1264. stacksize:=current_procinfo.calc_stackframe_size;
  1265. if nostackframe then
  1266. begin
  1267. list.concat(taicpu.op_reg(A_JR, NR_R31));
  1268. list.concat(Taicpu.op_none(A_NOP));
  1269. list.concat(Taicpu.op_none(A_P_SET_MACRO));
  1270. list.concat(Taicpu.op_none(A_P_SET_REORDER));
  1271. end
  1272. else
  1273. begin
  1274. if TMIPSProcinfo(current_procinfo).save_gp_ref.offset<>0 then
  1275. tg.ungettemp(list,TMIPSProcinfo(current_procinfo).save_gp_ref);
  1276. reference_reset(href,0);
  1277. href.base:=NR_STACK_POINTER_REG;
  1278. nextoffset:=TMIPSProcInfo(current_procinfo).floatregstart;
  1279. for reg := RS_F0 to RS_F31 do
  1280. begin
  1281. if reg in (rg[R_FPUREGISTER].used_in_proc-paramanager.get_volatile_registers_fpu(pocall_stdcall)) then
  1282. begin
  1283. href.offset:=nextoffset;
  1284. list.concat(taicpu.op_reg_ref(A_LWC1,newreg(R_FPUREGISTER,reg,R_SUBFS),href));
  1285. inc(nextoffset,4);
  1286. end;
  1287. end;
  1288. nextoffset:=TMIPSProcInfo(current_procinfo).intregstart;
  1289. saveregs:=rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall);
  1290. if (current_procinfo.flags*[pi_do_call,pi_is_assembler]<>[]) then
  1291. include(saveregs,RS_R31);
  1292. if (pi_needs_stackframe in current_procinfo.flags) then
  1293. include(saveregs,RS_FRAME_POINTER_REG);
  1294. // GP does not need to be restored on exit
  1295. for reg:=RS_R1 to RS_R31 do
  1296. begin
  1297. if reg in saveregs then
  1298. begin
  1299. href.offset:=nextoffset;
  1300. list.concat(taicpu.op_reg_ref(A_LW,newreg(R_INTREGISTER,reg,R_SUBWHOLE),href));
  1301. inc(nextoffset,sizeof(aint));
  1302. end;
  1303. end;
  1304. if (-stacksize >= simm16lo) and (-stacksize <= simm16hi) then
  1305. begin
  1306. list.concat(taicpu.op_reg(A_JR, NR_R31));
  1307. { correct stack pointer in the delay slot }
  1308. list.concat(Taicpu.Op_reg_reg_const(A_ADDIU, NR_STACK_POINTER_REG, NR_STACK_POINTER_REG, stacksize));
  1309. end
  1310. else
  1311. begin
  1312. a_load_const_reg(list,OS_32,stacksize,NR_R1);
  1313. list.concat(taicpu.op_reg(A_JR, NR_R31));
  1314. { correct stack pointer in the delay slot }
  1315. list.concat(taicpu.op_reg_reg_reg(A_ADD,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,NR_R1));
  1316. end;
  1317. list.concat(Taicpu.op_none(A_P_SET_MACRO));
  1318. list.concat(Taicpu.op_none(A_P_SET_REORDER));
  1319. end;
  1320. list.concat(tai_directive.create(asd_ent_end,current_procinfo.procdef.mangledname));
  1321. end;
  1322. { ************* concatcopy ************ }
  1323. procedure TCGMIPS.g_concatcopy_move(list: tasmlist; const Source, dest: treference; len: tcgint);
  1324. var
  1325. paraloc1, paraloc2, paraloc3: TCGPara;
  1326. pd: tprocdef;
  1327. begin
  1328. pd:=search_system_proc('MOVE');
  1329. paraloc1.init;
  1330. paraloc2.init;
  1331. paraloc3.init;
  1332. paramanager.getintparaloc(list, pd, 1, paraloc1);
  1333. paramanager.getintparaloc(list, pd, 2, paraloc2);
  1334. paramanager.getintparaloc(list, pd, 3, paraloc3);
  1335. a_load_const_cgpara(list, OS_SINT, len, paraloc3);
  1336. a_loadaddr_ref_cgpara(list, dest, paraloc2);
  1337. a_loadaddr_ref_cgpara(list, Source, paraloc1);
  1338. paramanager.freecgpara(list, paraloc3);
  1339. paramanager.freecgpara(list, paraloc2);
  1340. paramanager.freecgpara(list, paraloc1);
  1341. alloccpuregisters(list, R_INTREGISTER, paramanager.get_volatile_registers_int(pocall_default));
  1342. alloccpuregisters(list, R_FPUREGISTER, paramanager.get_volatile_registers_fpu(pocall_default));
  1343. a_call_name(list, 'FPC_MOVE', false);
  1344. dealloccpuregisters(list, R_FPUREGISTER, paramanager.get_volatile_registers_fpu(pocall_default));
  1345. dealloccpuregisters(list, R_INTREGISTER, paramanager.get_volatile_registers_int(pocall_default));
  1346. paraloc3.done;
  1347. paraloc2.done;
  1348. paraloc1.done;
  1349. end;
  1350. procedure TCGMIPS.g_concatcopy(list: tasmlist; const Source, dest: treference; len: tcgint);
  1351. var
  1352. tmpreg1, hreg, countreg: TRegister;
  1353. src, dst: TReference;
  1354. lab: tasmlabel;
  1355. Count, count2: aint;
  1356. function reference_is_reusable(const ref: treference): boolean;
  1357. begin
  1358. result:=(ref.base<>NR_NO) and (ref.index=NR_NO) and
  1359. (ref.symbol=nil) and
  1360. (ref.offset>=simm16lo) and (ref.offset+len<=simm16hi);
  1361. end;
  1362. begin
  1363. if len > high(longint) then
  1364. internalerror(2002072704);
  1365. { A call (to FPC_MOVE) requires the outgoing parameter area to be properly
  1366. allocated on stack. This can only be done before tmipsprocinfo.set_first_temp_offset,
  1367. i.e. before secondpass. Other internal procedures request correct stack frame
  1368. by setting pi_do_call during firstpass, but for this particular one it is impossible.
  1369. Therefore, if the current procedure is a leaf one, we have to leave it that way. }
  1370. { anybody wants to determine a good value here :)? }
  1371. if (len > 100) and
  1372. assigned(current_procinfo) and
  1373. (pi_do_call in current_procinfo.flags) then
  1374. g_concatcopy_move(list, Source, dest, len)
  1375. else
  1376. begin
  1377. Count := len div 4;
  1378. if (count<=4) and reference_is_reusable(source) then
  1379. src:=source
  1380. else
  1381. begin
  1382. reference_reset(src,sizeof(aint));
  1383. { load the address of source into src.base }
  1384. src.base := GetAddressRegister(list);
  1385. a_loadaddr_ref_reg(list, Source, src.base);
  1386. end;
  1387. if (count<=4) and reference_is_reusable(dest) then
  1388. dst:=dest
  1389. else
  1390. begin
  1391. reference_reset(dst,sizeof(aint));
  1392. { load the address of dest into dst.base }
  1393. dst.base := GetAddressRegister(list);
  1394. a_loadaddr_ref_reg(list, dest, dst.base);
  1395. end;
  1396. { generate a loop }
  1397. if Count > 4 then
  1398. begin
  1399. countreg := GetIntRegister(list, OS_INT);
  1400. tmpreg1 := GetIntRegister(list, OS_INT);
  1401. a_load_const_reg(list, OS_INT, Count, countreg);
  1402. current_asmdata.getjumplabel(lab);
  1403. a_label(list, lab);
  1404. list.concat(taicpu.op_reg_ref(A_LW, tmpreg1, src));
  1405. list.concat(taicpu.op_reg_ref(A_SW, tmpreg1, dst));
  1406. list.concat(taicpu.op_reg_reg_const(A_ADDIU, src.base, src.base, 4));
  1407. list.concat(taicpu.op_reg_reg_const(A_ADDIU, dst.base, dst.base, 4));
  1408. list.concat(taicpu.op_reg_reg_const(A_ADDIU, countreg, countreg, -1));
  1409. a_cmp_reg_reg_label(list,OS_INT,OC_GT,NR_R0,countreg,lab);
  1410. len := len mod 4;
  1411. end;
  1412. { unrolled loop }
  1413. Count := len div 4;
  1414. if Count > 0 then
  1415. begin
  1416. tmpreg1 := GetIntRegister(list, OS_INT);
  1417. for count2 := 1 to Count do
  1418. begin
  1419. list.concat(taicpu.op_reg_ref(A_LW, tmpreg1, src));
  1420. list.concat(taicpu.op_reg_ref(A_SW, tmpreg1, dst));
  1421. Inc(src.offset, 4);
  1422. Inc(dst.offset, 4);
  1423. end;
  1424. len := len mod 4;
  1425. end;
  1426. if (len and 4) <> 0 then
  1427. begin
  1428. hreg := GetIntRegister(list, OS_INT);
  1429. a_load_ref_reg(list, OS_32, OS_32, src, hreg);
  1430. a_load_reg_ref(list, OS_32, OS_32, hreg, dst);
  1431. Inc(src.offset, 4);
  1432. Inc(dst.offset, 4);
  1433. end;
  1434. { copy the leftovers }
  1435. if (len and 2) <> 0 then
  1436. begin
  1437. hreg := GetIntRegister(list, OS_INT);
  1438. a_load_ref_reg(list, OS_16, OS_16, src, hreg);
  1439. a_load_reg_ref(list, OS_16, OS_16, hreg, dst);
  1440. Inc(src.offset, 2);
  1441. Inc(dst.offset, 2);
  1442. end;
  1443. if (len and 1) <> 0 then
  1444. begin
  1445. hreg := GetIntRegister(list, OS_INT);
  1446. a_load_ref_reg(list, OS_8, OS_8, src, hreg);
  1447. a_load_reg_ref(list, OS_8, OS_8, hreg, dst);
  1448. end;
  1449. end;
  1450. end;
  1451. procedure TCGMIPS.g_concatcopy_unaligned(list: tasmlist; const Source, dest: treference; len: tcgint);
  1452. var
  1453. src, dst: TReference;
  1454. tmpreg1, countreg: TRegister;
  1455. i: aint;
  1456. lab: tasmlabel;
  1457. begin
  1458. if (len > 31) and
  1459. { see comment in g_concatcopy }
  1460. assigned(current_procinfo) and
  1461. (pi_do_call in current_procinfo.flags) then
  1462. g_concatcopy_move(list, Source, dest, len)
  1463. else
  1464. begin
  1465. reference_reset(src,sizeof(aint));
  1466. reference_reset(dst,sizeof(aint));
  1467. { load the address of source into src.base }
  1468. src.base := GetAddressRegister(list);
  1469. a_loadaddr_ref_reg(list, Source, src.base);
  1470. { load the address of dest into dst.base }
  1471. dst.base := GetAddressRegister(list);
  1472. a_loadaddr_ref_reg(list, dest, dst.base);
  1473. { generate a loop }
  1474. if len > 4 then
  1475. begin
  1476. countreg := GetIntRegister(list, OS_INT);
  1477. tmpreg1 := GetIntRegister(list, OS_INT);
  1478. a_load_const_reg(list, OS_INT, len, countreg);
  1479. current_asmdata.getjumplabel(lab);
  1480. a_label(list, lab);
  1481. list.concat(taicpu.op_reg_ref(A_LBU, tmpreg1, src));
  1482. list.concat(taicpu.op_reg_ref(A_SB, tmpreg1, dst));
  1483. list.concat(taicpu.op_reg_reg_const(A_ADDIU, src.base, src.base, 1));
  1484. list.concat(taicpu.op_reg_reg_const(A_ADDIU, dst.base, dst.base, 1));
  1485. list.concat(taicpu.op_reg_reg_const(A_ADDIU, countreg, countreg, -1));
  1486. a_cmp_reg_reg_label(list,OS_INT,OC_GT,NR_R0,countreg,lab);
  1487. end
  1488. else
  1489. begin
  1490. { unrolled loop }
  1491. tmpreg1 := GetIntRegister(list, OS_INT);
  1492. for i := 1 to len do
  1493. begin
  1494. list.concat(taicpu.op_reg_ref(A_LBU, tmpreg1, src));
  1495. list.concat(taicpu.op_reg_ref(A_SB, tmpreg1, dst));
  1496. Inc(src.offset);
  1497. Inc(dst.offset);
  1498. end;
  1499. end;
  1500. end;
  1501. end;
  1502. procedure TCGMIPS.g_profilecode(list:TAsmList);
  1503. var
  1504. href: treference;
  1505. begin
  1506. if not (cs_create_pic in current_settings.moduleswitches) then
  1507. begin
  1508. reference_reset_symbol(href,current_asmdata.RefAsmSymbol('_gp'),0,sizeof(pint));
  1509. a_loadaddr_ref_reg(list,href,NR_GP);
  1510. end;
  1511. list.concat(taicpu.op_reg_reg(A_MOVE,NR_R1,NR_RA));
  1512. list.concat(taicpu.op_reg_reg_const(A_ADDIU,NR_SP,NR_SP,-8));
  1513. a_call_sym_pic(list,current_asmdata.RefAsmSymbol('_mcount'));
  1514. end;
  1515. procedure TCGMIPS.g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: tcgint);
  1516. begin
  1517. { This method is integrated into g_intf_wrapper and shouldn't be called separately }
  1518. InternalError(2013020102);
  1519. end;
  1520. {****************************************************************************
  1521. TCG64_MIPSel
  1522. ****************************************************************************}
  1523. procedure TCg64MPSel.a_load64_reg_ref(list: tasmlist; reg: tregister64; const ref: treference);
  1524. var
  1525. tmpref: treference;
  1526. tmpreg: tregister;
  1527. begin
  1528. if target_info.endian = endian_big then
  1529. begin
  1530. tmpreg := reg.reglo;
  1531. reg.reglo := reg.reghi;
  1532. reg.reghi := tmpreg;
  1533. end;
  1534. tmpref := ref;
  1535. tcgmips(cg).make_simple_ref(list,tmpref);
  1536. list.concat(taicpu.op_reg_ref(A_SW,reg.reglo,tmpref));
  1537. Inc(tmpref.offset, 4);
  1538. list.concat(taicpu.op_reg_ref(A_SW,reg.reghi,tmpref));
  1539. end;
  1540. procedure TCg64MPSel.a_load64_ref_reg(list: tasmlist; const ref: treference; reg: tregister64);
  1541. var
  1542. tmpref: treference;
  1543. tmpreg: tregister;
  1544. begin
  1545. if target_info.endian = endian_big then
  1546. begin
  1547. tmpreg := reg.reglo;
  1548. reg.reglo := reg.reghi;
  1549. reg.reghi := tmpreg;
  1550. end;
  1551. tmpref := ref;
  1552. tcgmips(cg).make_simple_ref(list,tmpref);
  1553. list.concat(taicpu.op_reg_ref(A_LW,reg.reglo,tmpref));
  1554. Inc(tmpref.offset, 4);
  1555. list.concat(taicpu.op_reg_ref(A_LW,reg.reghi,tmpref));
  1556. end;
  1557. procedure TCg64MPSel.a_load64_ref_cgpara(list: tasmlist; const r: treference; const paraloc: tcgpara);
  1558. var
  1559. hreg64: tregister64;
  1560. begin
  1561. { Override this function to prevent loading the reference twice.
  1562. Use here some extra registers, but those are optimized away by the RA }
  1563. hreg64.reglo := cg.GetIntRegister(list, OS_S32);
  1564. hreg64.reghi := cg.GetIntRegister(list, OS_S32);
  1565. a_load64_ref_reg(list, r, hreg64);
  1566. a_load64_reg_cgpara(list, hreg64, paraloc);
  1567. end;
  1568. procedure TCg64MPSel.a_op64_reg_reg(list: tasmlist; op: TOpCG; size: tcgsize; regsrc, regdst: TRegister64);
  1569. var
  1570. tmpreg1: TRegister;
  1571. begin
  1572. case op of
  1573. OP_NEG:
  1574. begin
  1575. tmpreg1 := cg.GetIntRegister(list, OS_INT);
  1576. list.concat(taicpu.op_reg_reg_reg(A_SUBU, regdst.reglo, NR_R0, regsrc.reglo));
  1577. list.concat(taicpu.op_reg_reg_reg(A_SLTU, tmpreg1, NR_R0, regdst.reglo));
  1578. list.concat(taicpu.op_reg_reg_reg(A_SUBU, regdst.reghi, NR_R0, regsrc.reghi));
  1579. list.concat(taicpu.op_reg_reg_reg(A_SUBU, regdst.reghi, regdst.reghi, tmpreg1));
  1580. end;
  1581. OP_NOT:
  1582. begin
  1583. list.concat(taicpu.op_reg_reg_reg(A_NOR, regdst.reglo, NR_R0, regsrc.reglo));
  1584. list.concat(taicpu.op_reg_reg_reg(A_NOR, regdst.reghi, NR_R0, regsrc.reghi));
  1585. end;
  1586. else
  1587. a_op64_reg_reg_reg(list,op,size,regsrc,regdst,regdst);
  1588. end;
  1589. end;
  1590. procedure TCg64MPSel.a_op64_const_reg(list: tasmlist; op: TOpCG; size: tcgsize; Value: int64; regdst: TRegister64);
  1591. begin
  1592. a_op64_const_reg_reg(list, op, size, value, regdst, regdst);
  1593. end;
  1594. procedure TCg64MPSel.a_op64_const_reg_reg(list: tasmlist; op: TOpCG; size: tcgsize; Value: int64; regsrc, regdst: tregister64);
  1595. var
  1596. l: tlocation;
  1597. begin
  1598. a_op64_const_reg_reg_checkoverflow(list, op, size, Value, regsrc, regdst, False, l);
  1599. end;
  1600. procedure TCg64MPSel.a_op64_reg_reg_reg(list: tasmlist; op: TOpCG; size: tcgsize; regsrc1, regsrc2, regdst: tregister64);
  1601. var
  1602. l: tlocation;
  1603. begin
  1604. a_op64_reg_reg_reg_checkoverflow(list, op, size, regsrc1, regsrc2, regdst, False, l);
  1605. end;
  1606. procedure TCg64MPSel.a_op64_const_reg_reg_checkoverflow(list: tasmlist; op: TOpCG; size: tcgsize; Value: int64; regsrc, regdst: tregister64; setflags: boolean; var ovloc: tlocation);
  1607. var
  1608. tmplo,carry: TRegister;
  1609. hisize: tcgsize;
  1610. begin
  1611. carry:=NR_NO;
  1612. if (size in [OS_S64]) then
  1613. hisize:=OS_S32
  1614. else
  1615. hisize:=OS_32;
  1616. case op of
  1617. OP_AND,OP_OR,OP_XOR:
  1618. begin
  1619. cg.a_op_const_reg_reg(list,op,OS_32,aint(lo(value)),regsrc.reglo,regdst.reglo);
  1620. cg.a_op_const_reg_reg(list,op,OS_32,aint(hi(value)),regsrc.reghi,regdst.reghi);
  1621. end;
  1622. OP_ADD:
  1623. begin
  1624. if lo(value)<>0 then
  1625. begin
  1626. tmplo:=cg.GetIntRegister(list,OS_32);
  1627. carry:=cg.GetIntRegister(list,OS_32);
  1628. tcgmips(cg).handle_reg_const_reg(list,A_ADDU,regsrc.reglo,aint(lo(value)),tmplo);
  1629. list.concat(taicpu.op_reg_reg_reg(A_SLTU,carry,tmplo,regsrc.reglo));
  1630. cg.a_load_reg_reg(list,OS_32,OS_32,tmplo,regdst.reglo);
  1631. end
  1632. else
  1633. cg.a_load_reg_reg(list,OS_32,OS_32,regsrc.reglo,regdst.reglo);
  1634. { With overflow checking and unsigned args, this generates slighly suboptimal code
  1635. ($80000000 constant loaded twice). Other cases are fine. Getting it perfect does not
  1636. look worth the effort. }
  1637. cg.a_op_const_reg_reg_checkoverflow(list,OP_ADD,hisize,aint(hi(value)),regsrc.reghi,regdst.reghi,setflags,ovloc);
  1638. if carry<>NR_NO then
  1639. cg.a_op_reg_reg_reg_checkoverflow(list,OP_ADD,hisize,carry,regdst.reghi,regdst.reghi,setflags,ovloc);
  1640. end;
  1641. OP_SUB:
  1642. begin
  1643. carry:=NR_NO;
  1644. if lo(value)<>0 then
  1645. begin
  1646. tmplo:=cg.GetIntRegister(list,OS_32);
  1647. carry:=cg.GetIntRegister(list,OS_32);
  1648. tcgmips(cg).handle_reg_const_reg(list,A_SUBU,regsrc.reglo,aint(lo(value)),tmplo);
  1649. list.concat(taicpu.op_reg_reg_reg(A_SLTU,carry,regsrc.reglo,tmplo));
  1650. cg.a_load_reg_reg(list,OS_32,OS_32,tmplo,regdst.reglo);
  1651. end
  1652. else
  1653. cg.a_load_reg_reg(list,OS_32,OS_32,regsrc.reglo,regdst.reglo);
  1654. cg.a_op_const_reg_reg_checkoverflow(list,OP_SUB,hisize,aint(hi(value)),regsrc.reghi,regdst.reghi,setflags,ovloc);
  1655. if carry<>NR_NO then
  1656. cg.a_op_reg_reg_reg_checkoverflow(list,OP_SUB,hisize,carry,regdst.reghi,regdst.reghi,setflags,ovloc);
  1657. end;
  1658. else
  1659. InternalError(2013050301);
  1660. end;
  1661. end;
  1662. procedure TCg64MPSel.a_op64_reg_reg_reg_checkoverflow(list: tasmlist; op: TOpCG; size: tcgsize; regsrc1, regsrc2, regdst: tregister64; setflags: boolean; var ovloc: tlocation);
  1663. var
  1664. tmplo,tmphi,carry,hreg: TRegister;
  1665. signed: boolean;
  1666. begin
  1667. case op of
  1668. OP_ADD:
  1669. begin
  1670. signed:=(size in [OS_S64]);
  1671. tmplo := cg.GetIntRegister(list,OS_S32);
  1672. carry := cg.GetIntRegister(list,OS_S32);
  1673. // destreg.reglo could be regsrc1.reglo or regsrc2.reglo
  1674. list.concat(taicpu.op_reg_reg_reg(A_ADDU, tmplo, regsrc2.reglo, regsrc1.reglo));
  1675. list.concat(taicpu.op_reg_reg_reg(A_SLTU, carry, tmplo, regsrc2.reglo));
  1676. cg.a_load_reg_reg(list,OS_INT,OS_INT,tmplo,regdst.reglo);
  1677. if signed or (not setflags) then
  1678. begin
  1679. list.concat(taicpu.op_reg_reg_reg(ops_add[setflags and signed], regdst.reghi, regsrc2.reghi, regsrc1.reghi));
  1680. list.concat(taicpu.op_reg_reg_reg(ops_add[setflags and signed], regdst.reghi, regdst.reghi, carry));
  1681. end
  1682. else
  1683. begin
  1684. tmphi:=cg.GetIntRegister(list,OS_INT);
  1685. hreg:=cg.GetIntRegister(list,OS_INT);
  1686. cg.a_load_const_reg(list,OS_INT,$80000000,hreg);
  1687. // first add carry to one of the addends
  1688. list.concat(taicpu.op_reg_reg_reg(A_ADDU, tmphi, regsrc2.reghi, carry));
  1689. list.concat(taicpu.op_reg_reg_reg(A_SLTU, carry, tmphi, regsrc2.reghi));
  1690. list.concat(taicpu.op_reg_reg_reg(A_SUB, carry, hreg, carry));
  1691. // then add another addend
  1692. list.concat(taicpu.op_reg_reg_reg(A_ADDU, regdst.reghi, tmphi, regsrc1.reghi));
  1693. list.concat(taicpu.op_reg_reg_reg(A_SLTU, carry, regdst.reghi, tmphi));
  1694. list.concat(taicpu.op_reg_reg_reg(A_SUB, carry, hreg, carry));
  1695. end;
  1696. end;
  1697. OP_SUB:
  1698. begin
  1699. signed:=(size in [OS_S64]);
  1700. tmplo := cg.GetIntRegister(list,OS_S32);
  1701. carry := cg.GetIntRegister(list,OS_S32);
  1702. // destreg.reglo could be regsrc1.reglo or regsrc2.reglo
  1703. list.concat(taicpu.op_reg_reg_reg(A_SUBU, tmplo, regsrc2.reglo, regsrc1.reglo));
  1704. list.concat(taicpu.op_reg_reg_reg(A_SLTU, carry, regsrc2.reglo,tmplo));
  1705. cg.a_load_reg_reg(list,OS_INT,OS_INT,tmplo,regdst.reglo);
  1706. if signed or (not setflags) then
  1707. begin
  1708. list.concat(taicpu.op_reg_reg_reg(ops_sub[setflags and signed], regdst.reghi, regsrc2.reghi, regsrc1.reghi));
  1709. list.concat(taicpu.op_reg_reg_reg(ops_sub[setflags and signed], regdst.reghi, regdst.reghi, carry));
  1710. end
  1711. else
  1712. begin
  1713. tmphi:=cg.GetIntRegister(list,OS_INT);
  1714. hreg:=cg.GetIntRegister(list,OS_INT);
  1715. cg.a_load_const_reg(list,OS_INT,$80000000,hreg);
  1716. // first subtract the carry...
  1717. list.concat(taicpu.op_reg_reg_reg(A_SUBU, tmphi, regsrc2.reghi, carry));
  1718. list.concat(taicpu.op_reg_reg_reg(A_SLTU, carry, regsrc2.reghi, tmphi));
  1719. list.concat(taicpu.op_reg_reg_reg(A_SUB, carry, hreg, carry));
  1720. // ...then the subtrahend
  1721. list.concat(taicpu.op_reg_reg_reg(A_SUBU, regdst.reghi, tmphi, regsrc1.reghi));
  1722. list.concat(taicpu.op_reg_reg_reg(A_SLTU, carry, tmphi, regdst.reghi));
  1723. list.concat(taicpu.op_reg_reg_reg(A_SUB, carry, hreg, carry));
  1724. end;
  1725. end;
  1726. OP_AND,OP_OR,OP_XOR:
  1727. begin
  1728. cg.a_op_reg_reg_reg(list,op,size,regsrc1.reglo,regsrc2.reglo,regdst.reglo);
  1729. cg.a_op_reg_reg_reg(list,op,size,regsrc1.reghi,regsrc2.reghi,regdst.reghi);
  1730. end;
  1731. else
  1732. internalerror(200306017);
  1733. end;
  1734. end;
  1735. procedure create_codegen;
  1736. begin
  1737. cg:=TCGMIPS.Create;
  1738. cg64:=TCg64MPSel.Create;
  1739. end;
  1740. end.