cgcpu.pas 70 KB

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