cgcpu.pas 102 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618
  1. {
  2. Copyright (c) 1998-2002 by the FPC team
  3. This unit implements the code generator for the 680x0
  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. cgbase,cgobj,globtype,
  22. aasmbase,aasmtai,aasmdata,aasmcpu,
  23. cpubase,cpuinfo,
  24. parabase,cpupara,
  25. node,symconst,symtype,symdef,
  26. cgutils,cg64f32;
  27. type
  28. tcg68k = class(tcg)
  29. procedure init_register_allocators;override;
  30. procedure done_register_allocators;override;
  31. procedure a_load_reg_cgpara(list : TAsmList;size : tcgsize;r : tregister;const cgpara : tcgpara);override;
  32. procedure a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const cgpara : tcgpara);override;
  33. procedure a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : tcgpara);override;
  34. procedure a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const cgpara : tcgpara);override;
  35. procedure a_call_name(list : TAsmList;const s : string; weak: boolean);override;
  36. procedure a_call_reg(list : TAsmList;reg : tregister);override;
  37. procedure a_load_const_reg(list : TAsmList;size : tcgsize;a : tcgint;register : tregister);override;
  38. procedure a_load_const_ref(list : TAsmList; tosize: tcgsize; a : tcgint;const ref : treference);override;
  39. procedure a_load_reg_ref(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);override;
  40. procedure a_load_reg_ref_unaligned(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);override;
  41. procedure a_load_reg_reg(list : TAsmList;fromsize,tosize : tcgsize;reg1,reg2 : tregister);override;
  42. procedure a_load_ref_reg(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);override;
  43. procedure a_load_ref_reg_unaligned(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);override;
  44. procedure a_load_ref_ref(list : TAsmList;fromsize,tosize : tcgsize;const sref : treference;const dref : treference);override;
  45. procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);override;
  46. procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); override;
  47. procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); override;
  48. procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); override;
  49. procedure a_loadfpu_reg_cgpara(list : TAsmList; size : tcgsize;const reg : tregister;const cgpara : TCGPara); override;
  50. procedure a_loadfpu_ref_cgpara(list : TAsmList; size : tcgsize;const ref : treference;const cgpara : TCGPara);override;
  51. procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: tcgsize; a: tcgint; reg: TRegister); override;
  52. procedure a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference); override;
  53. procedure a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; src, dst: TRegister); override;
  54. procedure a_op_reg_ref(list : TAsmList; Op: TOpCG; size: TCGSize; reg: TRegister; const ref: TReference); override;
  55. procedure a_op_ref_reg(list : TAsmList; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); override;
  56. procedure a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister; l : tasmlabel);override;
  57. procedure a_cmp_const_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;const ref : treference; l : tasmlabel); override;
  58. procedure a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override;
  59. procedure a_jmp_name(list : TAsmList;const s : string); override;
  60. procedure a_jmp_always(list : TAsmList;l: tasmlabel); override;
  61. procedure a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel); override;
  62. procedure a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel);
  63. procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: tresflags; reg: TRegister); override;
  64. procedure g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);override;
  65. { generates overflow checking code for a node }
  66. procedure g_overflowcheck(list: TAsmList; const l:tlocation; def:tdef); override;
  67. procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);override;
  68. procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);override;
  69. procedure g_save_registers(list:TAsmList);override;
  70. procedure g_restore_registers(list:TAsmList);override;
  71. procedure g_adjust_self_value(list:TAsmList;procdef:tprocdef;ioffset:tcgint);override;
  72. { # Sign or zero extend the register to a full 32-bit value.
  73. The new value is left in the same register.
  74. }
  75. procedure sign_extend(list: TAsmList;_oldsize : tcgsize; reg: tregister);
  76. procedure sign_extend(list: TAsmList;_oldsize : tcgsize; _newsize : tcgsize; reg: tregister);
  77. procedure g_stackpointer_alloc(list : TAsmList;localsize : longint);override;
  78. function fixref(list: TAsmList; var ref: treference; fullyresolve: boolean): boolean;
  79. function force_to_dataregister(list: TAsmList; size: TCGSize; reg: TRegister): TRegister;
  80. procedure move_if_needed(list: TAsmList; size: TCGSize; src: TRegister; dest: TRegister);
  81. { optimize mul with const to a sequence of shifts and subs/adds, mainly for the '000 to '030 }
  82. function optimize_const_mul_to_shift_sub_add(list: TAsmList; maxops: longint; a: tcgint; size: tcgsize; reg: TRegister): boolean;
  83. protected
  84. procedure call_rtl_mul_const_reg(list:tasmlist;size:tcgsize;a:tcgint;reg:tregister;const name:string);
  85. procedure call_rtl_mul_reg_reg(list:tasmlist;reg1,reg2:tregister;const name:string);
  86. procedure check_register_size(size:tcgsize;reg:tregister);
  87. end;
  88. tcg64f68k = class(tcg64f32)
  89. procedure a_op64_reg_reg(list : TAsmList;op:TOpCG; size: tcgsize; regsrc,regdst : tregister64);override;
  90. procedure a_op64_const_reg(list : TAsmList;op:TOpCG; size: tcgsize; value : int64;regdst : tregister64);override;
  91. procedure a_op64_ref_reg(list : TAsmList;op:TOpCG;size : tcgsize;const ref : treference;reg : tregister64);override;
  92. procedure a_op64_reg_ref(list : TAsmList;op:TOpCG;size : tcgsize;reg : tregister64;const ref : treference);override;
  93. procedure a_load64_reg_ref(list : TAsmList;reg : tregister64;const ref : treference); override;
  94. procedure a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64); override;
  95. end;
  96. { This function returns true if the reference+offset is valid.
  97. Otherwise extra code must be generated to solve the reference.
  98. On the m68k, this verifies that the reference is valid
  99. (e.g : if index register is used, then the max displacement
  100. is 256 bytes, if only base is used, then max displacement
  101. is 32K
  102. }
  103. function isvalidrefoffset(const ref: treference): boolean;
  104. function isvalidreference(const ref: treference): boolean;
  105. procedure create_codegen;
  106. implementation
  107. uses
  108. globals,verbose,systems,cutils,
  109. symsym,symtable,defutil,paramgr,procinfo,
  110. rgobj,tgobj,rgcpu,fmodule;
  111. { Range check must be disabled explicitly as conversions between signed and unsigned
  112. 32-bit values are done without explicit typecasts }
  113. {$R-}
  114. const
  115. { opcode table lookup }
  116. topcg2tasmop: Array[topcg] of tasmop =
  117. (
  118. A_NONE,
  119. A_MOVE,
  120. A_ADD,
  121. A_AND,
  122. A_DIVU,
  123. A_DIVS,
  124. A_MULS,
  125. A_MULU,
  126. A_NEG,
  127. A_NOT,
  128. A_OR,
  129. A_ASR,
  130. A_LSL,
  131. A_LSR,
  132. A_SUB,
  133. A_EOR,
  134. A_ROL,
  135. A_ROR
  136. );
  137. { opcode with extend bits table lookup, used by 64bit cg }
  138. topcg2tasmopx: Array[topcg] of tasmop =
  139. (
  140. A_NONE,
  141. A_NONE,
  142. A_ADDX,
  143. A_NONE,
  144. A_NONE,
  145. A_NONE,
  146. A_NONE,
  147. A_NONE,
  148. A_NEGX,
  149. A_NONE,
  150. A_NONE,
  151. A_NONE,
  152. A_NONE,
  153. A_NONE,
  154. A_SUBX,
  155. A_NONE,
  156. A_NONE,
  157. A_NONE
  158. );
  159. TOpCmp2AsmCond: Array[topcmp] of TAsmCond =
  160. (
  161. C_NONE,
  162. C_EQ,
  163. C_GT,
  164. C_LT,
  165. C_GE,
  166. C_LE,
  167. C_NE,
  168. C_LS,
  169. C_CS,
  170. C_CC,
  171. C_HI
  172. );
  173. function isvalidreference(const ref: treference): boolean;
  174. begin
  175. isvalidreference:=isvalidrefoffset(ref) and
  176. { don't try to generate addressing with symbol and base reg and offset
  177. it might fail in linking stage if the symbol is more than 32k away (KB) }
  178. not (assigned(ref.symbol) and (ref.base <> NR_NO) and (ref.offset <> 0)) and
  179. { coldfire and 68000 cannot handle non-addressregs as bases }
  180. not ((current_settings.cputype in cpu_coldfire+[cpu_mc68000]) and
  181. not isaddressregister(ref.base));
  182. end;
  183. function isvalidrefoffset(const ref: treference): boolean;
  184. begin
  185. isvalidrefoffset := true;
  186. if ref.index <> NR_NO then
  187. begin
  188. // if ref.base <> NR_NO then
  189. // internalerror(2002081401);
  190. if (ref.offset < low(shortint)) or (ref.offset > high(shortint)) then
  191. isvalidrefoffset := false
  192. end
  193. else
  194. begin
  195. if (ref.offset < low(smallint)) or (ref.offset > high(smallint)) then
  196. isvalidrefoffset := false;
  197. end;
  198. end;
  199. {****************************************************************************}
  200. { TCG68K }
  201. {****************************************************************************}
  202. function use_push(const cgpara:tcgpara):boolean;
  203. begin
  204. result:=(not paramanager.use_fixed_stack) and
  205. assigned(cgpara.location) and
  206. (cgpara.location^.loc=LOC_REFERENCE) and
  207. (cgpara.location^.reference.index=NR_STACK_POINTER_REG);
  208. end;
  209. procedure tcg68k.init_register_allocators;
  210. var
  211. reg: TSuperRegister;
  212. address_regs: array of TSuperRegister;
  213. begin
  214. inherited init_register_allocators;
  215. address_regs:=nil;
  216. rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,
  217. [RS_D0,RS_D1,RS_D2,RS_D3,RS_D4,RS_D5,RS_D6,RS_D7],
  218. first_int_imreg,[]);
  219. { set up the array of address registers to use }
  220. for reg:=RS_A0 to RS_A6 do
  221. begin
  222. { don't hardwire the frame pointer register, because it can vary between target OS }
  223. if (assigned(current_procinfo) and (current_procinfo.framepointer = NR_FRAME_POINTER_REG)
  224. and (reg = RS_FRAME_POINTER_REG))
  225. or ((reg = RS_PIC_OFFSET_REG) and (tf_static_reg_based in target_info.flags)) then
  226. continue;
  227. setlength(address_regs,length(address_regs)+1);
  228. address_regs[length(address_regs)-1]:=reg;
  229. end;
  230. rg[R_ADDRESSREGISTER]:=trgcpu.create(R_ADDRESSREGISTER,R_SUBWHOLE,
  231. address_regs, first_addr_imreg, []);
  232. rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBNONE,
  233. [RS_FP0,RS_FP1,RS_FP2,RS_FP3,RS_FP4,RS_FP5,RS_FP6,RS_FP7],
  234. first_fpu_imreg,[]);
  235. end;
  236. procedure tcg68k.done_register_allocators;
  237. begin
  238. rg[R_INTREGISTER].free;
  239. rg[R_FPUREGISTER].free;
  240. rg[R_ADDRESSREGISTER].free;
  241. inherited done_register_allocators;
  242. end;
  243. procedure tcg68k.a_load_reg_cgpara(list : TAsmList;size : tcgsize;r : tregister;const cgpara : tcgpara);
  244. var
  245. pushsize : tcgsize;
  246. ref : treference;
  247. begin
  248. { it's probably necessary to port this from x86 later, or provide an m68k solution (KB) }
  249. { TODO: FIX ME! check_register_size()}
  250. // check_register_size(size,r);
  251. if use_push(cgpara) then
  252. begin
  253. cgpara.check_simple_location;
  254. if tcgsize2size[cgpara.location^.size]>cgpara.alignment then
  255. pushsize:=cgpara.location^.size
  256. else
  257. pushsize:=int_cgsize(cgpara.alignment);
  258. reference_reset_base(ref, NR_STACK_POINTER_REG, 0, ctempposinvalid ,cgpara.alignment, []);
  259. ref.direction := dir_dec;
  260. list.concat(taicpu.op_reg_ref(A_MOVE,tcgsize2opsize[pushsize],makeregsize(list,r,pushsize),ref));
  261. end
  262. else
  263. inherited a_load_reg_cgpara(list,size,r,cgpara);
  264. end;
  265. procedure tcg68k.a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const cgpara : tcgpara);
  266. var
  267. pushsize : tcgsize;
  268. ref : treference;
  269. begin
  270. if use_push(cgpara) then
  271. begin
  272. cgpara.check_simple_location;
  273. if tcgsize2size[cgpara.location^.size]>cgpara.alignment then
  274. pushsize:=cgpara.location^.size
  275. else
  276. pushsize:=int_cgsize(cgpara.alignment);
  277. reference_reset_base(ref, NR_STACK_POINTER_REG, 0, ctempposinvalid, cgpara.alignment, []);
  278. ref.direction := dir_dec;
  279. a_load_const_ref(list, pushsize, a, ref);
  280. end
  281. else
  282. inherited a_load_const_cgpara(list,size,a,cgpara);
  283. end;
  284. procedure tcg68k.a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : tcgpara);
  285. procedure pushdata(paraloc:pcgparalocation;ofs:tcgint);
  286. var
  287. pushsize : tcgsize;
  288. tmpreg : tregister;
  289. href : treference;
  290. ref : treference;
  291. begin
  292. if not assigned(paraloc) then
  293. exit;
  294. if (paraloc^.loc<>LOC_REFERENCE) or
  295. (paraloc^.reference.index<>NR_STACK_POINTER_REG) or
  296. (tcgsize2size[paraloc^.size]>sizeof(tcgint)) then
  297. internalerror(200501162);
  298. { Pushes are needed in reverse order, add the size of the
  299. current location to the offset where to load from. This
  300. prevents wrong calculations for the last location when
  301. the size is not a power of 2 }
  302. if assigned(paraloc^.next) then
  303. pushdata(paraloc^.next,ofs+tcgsize2size[paraloc^.size]);
  304. { Push the data starting at ofs }
  305. href:=r;
  306. inc(href.offset,ofs);
  307. fixref(list,href,false);
  308. if tcgsize2size[paraloc^.size]>cgpara.alignment then
  309. pushsize:=paraloc^.size
  310. else
  311. pushsize:=int_cgsize(cgpara.alignment);
  312. reference_reset_base(ref, NR_STACK_POINTER_REG, 0, ctempposinvalid, tcgsize2size[pushsize], []);
  313. ref.direction := dir_dec;
  314. a_load_ref_ref(list,int_cgsize(tcgsize2size[paraloc^.size]),pushsize,href,ref);
  315. end;
  316. var
  317. len : tcgint;
  318. ofs : tcgint;
  319. href : treference;
  320. begin
  321. { cgpara.size=OS_NO requires a copy on the stack }
  322. if use_push(cgpara) then
  323. begin
  324. { Record copy? }
  325. if (cgpara.size in [OS_NO,OS_F64]) or (size in [OS_NO,OS_F64]) then
  326. begin
  327. //list.concat(tai_comment.create(strpnew('a_load_ref_cgpara: g_concatcopy')));
  328. cgpara.check_simple_location;
  329. len:=align(cgpara.intsize,cgpara.alignment);
  330. g_stackpointer_alloc(list,len);
  331. ofs:=0;
  332. if (cgpara.intsize<cgpara.alignment) then
  333. ofs:=cgpara.alignment-cgpara.intsize;
  334. reference_reset_base(href,NR_STACK_POINTER_REG,ofs,ctempposinvalid,cgpara.alignment,[]);
  335. g_concatcopy(list,r,href,cgpara.intsize);
  336. end
  337. else
  338. begin
  339. if tcgsize2size[cgpara.size]<>tcgsize2size[size] then
  340. internalerror(200501161);
  341. { We need to push the data in reverse order,
  342. therefore we use a recursive algorithm }
  343. pushdata(cgpara.location,0);
  344. end
  345. end
  346. else
  347. inherited a_load_ref_cgpara(list,size,r,cgpara);
  348. end;
  349. procedure tcg68k.a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const cgpara : tcgpara);
  350. var
  351. tmpref : treference;
  352. begin
  353. { 68k always passes arguments on the stack }
  354. if use_push(cgpara) then
  355. begin
  356. //list.concat(tai_comment.create(strpnew('a_loadaddr_ref_cgpara: PEA')));
  357. cgpara.check_simple_location;
  358. tmpref:=r;
  359. fixref(list,tmpref,false);
  360. list.concat(taicpu.op_ref(A_PEA,S_NO,tmpref));
  361. end
  362. else
  363. inherited a_loadaddr_ref_cgpara(list,r,cgpara);
  364. end;
  365. function tcg68k.fixref(list: TAsmList; var ref: treference; fullyresolve: boolean): boolean;
  366. var
  367. hreg : tregister;
  368. href : treference;
  369. instr : taicpu;
  370. begin
  371. result:=false;
  372. hreg:=NR_NO;
  373. { NOTE: we don't have to fixup scaling in this function, because the memnode
  374. won't generate scaling on CPUs which don't support it }
  375. if (tf_static_reg_based in target_info.flags) and assigned(ref.symbol) and (ref.base=NR_NO) then
  376. fullyresolve:=true;
  377. { first, deal with the symbol, if we have an index or base register.
  378. in theory, the '020+ could deal with these, but it's better to avoid
  379. long displacements on most members of the 68k family anyway }
  380. if assigned(ref.symbol) and ((ref.base<>NR_NO) or (ref.index<>NR_NO)) then
  381. begin
  382. //list.concat(tai_comment.create(strpnew('fixref: symbol with base or index')));
  383. hreg:=getaddressregister(list);
  384. reference_reset_symbol(href,ref.symbol,ref.offset,ref.alignment,ref.volatility);
  385. if (tf_static_reg_based in target_info.flags) and (ref.base=NR_NO) then
  386. begin
  387. if ref.symbol.typ in [AT_DATA,AT_DATA_FORCEINDIRECT,AT_DATA_NOINDIRECT] then
  388. href.base:=NR_PIC_OFFSET_REG
  389. else
  390. href.base:=NR_PC;
  391. end;
  392. list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,hreg));
  393. ref.offset:=0;
  394. ref.symbol:=nil;
  395. { if we have unused base or index, try to use it, otherwise fold the existing base,
  396. also handle the case where the base might be a data register. }
  397. if ref.base=NR_NO then
  398. ref.base:=hreg
  399. else
  400. if (ref.index=NR_NO) and not isintregister(ref.base) then
  401. ref.index:=hreg
  402. else
  403. begin
  404. list.concat(taicpu.op_reg_reg(A_ADD,S_L,ref.base,hreg));
  405. ref.base:=hreg;
  406. end;
  407. { at this point we have base + (optional) index * scale }
  408. end;
  409. { deal with the case if our base is a dataregister }
  410. if (ref.base<>NR_NO) and not isaddressregister(ref.base) then
  411. begin
  412. hreg:=getaddressregister(list);
  413. if isaddressregister(ref.index) and (ref.scalefactor < 2) then
  414. begin
  415. //list.concat(tai_comment.create(strpnew('fixref: base is dX, resolving with reverse regs')));
  416. reference_reset_base(href,ref.index,0,ref.temppos,ref.alignment,ref.volatility);
  417. href.index:=ref.base;
  418. { we can fold in an 8 bit offset "for free" }
  419. if isvalue8bit(ref.offset) then
  420. begin
  421. href.offset:=ref.offset;
  422. ref.offset:=0;
  423. end;
  424. list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,hreg));
  425. ref.base:=hreg;
  426. ref.index:=NR_NO;
  427. result:=true;
  428. end
  429. else
  430. begin
  431. //list.concat(tai_comment.create(strpnew('fixref: base is dX, can''t resolve with reverse regs')));
  432. instr:=taicpu.op_reg_reg(A_MOVE,S_L,ref.base,hreg);
  433. add_move_instruction(instr);
  434. list.concat(instr);
  435. ref.base:=hreg;
  436. result:=true;
  437. end;
  438. end;
  439. { deal with large offsets on non-020+ }
  440. if not (CPUM68K_HAS_BASEDISP in cpu_capabilities[current_settings.cputype]) then
  441. begin
  442. if ((ref.index<>NR_NO) and not isvalue8bit(ref.offset)) or
  443. ((ref.base<>NR_NO) and not isvalue16bit(ref.offset)) then
  444. begin
  445. //list.concat(tai_comment.create(strpnew('fixref: handling large offsets')));
  446. { if we have a temp register from above, we can just add to it }
  447. if hreg=NR_NO then
  448. hreg:=getaddressregister(list);
  449. if isvalue16bit(ref.offset) then
  450. begin
  451. reference_reset_base(href,ref.base,ref.offset,ref.temppos,ref.alignment,ref.volatility);
  452. list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,hreg));
  453. end
  454. else
  455. begin
  456. instr:=taicpu.op_reg_reg(A_MOVE,S_L,ref.base,hreg);
  457. add_move_instruction(instr);
  458. list.concat(instr);
  459. list.concat(taicpu.op_const_reg(A_ADD,S_L,ref.offset,hreg));
  460. end;
  461. ref.offset:=0;
  462. ref.base:=hreg;
  463. result:=true;
  464. end;
  465. end;
  466. { fully resolve the reference to an address register, if we're told to do so
  467. and there's a reason to do so }
  468. if fullyresolve and
  469. ((ref.index<>NR_NO) or assigned(ref.symbol) or (ref.offset<>0)) then
  470. begin
  471. //list.concat(tai_comment.create(strpnew('fixref: fully resolve to register')));
  472. if hreg=NR_NO then
  473. hreg:=getaddressregister(list);
  474. if (tf_static_reg_based in target_info.flags) and (ref.base=NR_NO) then
  475. begin
  476. if ref.symbol.typ in [AT_DATA,AT_DATA_FORCEINDIRECT,AT_DATA_NOINDIRECT] then
  477. ref.base:=NR_PIC_OFFSET_REG
  478. else
  479. ref.base:=NR_PC;
  480. end;
  481. list.concat(taicpu.op_ref_reg(A_LEA,S_L,ref,hreg));
  482. ref.base:=hreg;
  483. ref.index:=NR_NO;
  484. ref.scalefactor:=1;
  485. ref.symbol:=nil;
  486. ref.offset:=0;
  487. result:=true;
  488. end;
  489. end;
  490. procedure tcg68k.call_rtl_mul_const_reg(list:tasmlist;size:tcgsize;a:tcgint;reg:tregister;const name:string);
  491. var
  492. paraloc1,paraloc2: tcgpara;
  493. pd : tprocdef;
  494. begin
  495. pd:=search_system_proc(name);
  496. paraloc1.init;
  497. paraloc2.init;
  498. paramanager.getintparaloc(list,pd,1,paraloc1);
  499. paramanager.getintparaloc(list,pd,2,paraloc2);
  500. a_load_const_cgpara(list,size,a,paraloc2);
  501. a_load_reg_cgpara(list,OS_32,reg,paraloc1);
  502. paramanager.freecgpara(list,paraloc2);
  503. paramanager.freecgpara(list,paraloc1);
  504. g_call(list,name);
  505. cg.a_reg_alloc(list,NR_FUNCTION_RESULT_REG);
  506. cg.a_load_reg_reg(list,OS_32,OS_32,NR_FUNCTION_RESULT_REG,reg);
  507. paraloc2.done;
  508. paraloc1.done;
  509. end;
  510. procedure tcg68k.call_rtl_mul_reg_reg(list:tasmlist;reg1,reg2:tregister;const name:string);
  511. var
  512. paraloc1,paraloc2: tcgpara;
  513. pd : tprocdef;
  514. begin
  515. pd:=search_system_proc(name);
  516. paraloc1.init;
  517. paraloc2.init;
  518. paramanager.getintparaloc(list,pd,1,paraloc1);
  519. paramanager.getintparaloc(list,pd,2,paraloc2);
  520. a_load_reg_cgpara(list,OS_32,reg1,paraloc2);
  521. a_load_reg_cgpara(list,OS_32,reg2,paraloc1);
  522. paramanager.freecgpara(list,paraloc2);
  523. paramanager.freecgpara(list,paraloc1);
  524. g_call(list,name);
  525. cg.a_reg_alloc(list,NR_FUNCTION_RESULT_REG);
  526. cg.a_load_reg_reg(list,OS_32,OS_32,NR_FUNCTION_RESULT_REG,reg2);
  527. paraloc2.done;
  528. paraloc1.done;
  529. end;
  530. procedure tcg68k.a_call_name(list : TAsmList;const s : string; weak: boolean);
  531. var
  532. sym: tasmsymbol;
  533. const
  534. jmp_inst: array[boolean] of tasmop = ( A_JSR, A_BSR );
  535. begin
  536. if not(weak) then
  537. sym:=current_asmdata.RefAsmSymbol(s,AT_FUNCTION)
  538. else
  539. sym:=current_asmdata.WeakRefAsmSymbol(s,AT_FUNCTION);
  540. list.concat(taicpu.op_sym(jmp_inst[tf_code_small in target_info.flags],S_NO,sym));
  541. end;
  542. procedure tcg68k.a_call_reg(list : TAsmList;reg: tregister);
  543. var
  544. tmpref : treference;
  545. tmpreg : tregister;
  546. instr : taicpu;
  547. begin
  548. if isaddressregister(reg) then
  549. begin
  550. { if we have an address register, we can jump to the address directly }
  551. reference_reset_base(tmpref,reg,0,ctempposinvalid,4,[]);
  552. end
  553. else
  554. begin
  555. { if we have a data register, we need to move it to an address register first }
  556. tmpreg:=getaddressregister(list);
  557. reference_reset_base(tmpref,tmpreg,0,ctempposinvalid,4,[]);
  558. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg,tmpreg);
  559. add_move_instruction(instr);
  560. list.concat(instr);
  561. end;
  562. list.concat(taicpu.op_ref(A_JSR,S_NO,tmpref));
  563. end;
  564. procedure tcg68k.a_load_const_reg(list : TAsmList;size : tcgsize;a : tcgint;register : tregister);
  565. var
  566. opsize: topsize;
  567. begin
  568. opsize:=tcgsize2opsize[size];
  569. if isaddressregister(register) then
  570. begin
  571. { an m68k manual I have recommends SUB Ax,Ax to be used instead of CLR for address regs }
  572. { Premature optimization is the root of all evil - this code breaks spilling if the
  573. register contains a spilled regvar, eg. a Pointer which is set to nil, then random
  574. havoc happens... This is kept here for reference now, to allow fixing of the spilling
  575. later. Most of the optimizations below here could be moved to the optimizer. (KB) }
  576. {if a = 0 then
  577. list.concat(taicpu.op_reg_reg(A_SUB,S_L,register,register))
  578. else}
  579. { ISA B/C Coldfire has MOV3Q which can move -1 or 1..7 to any reg }
  580. if (current_settings.cputype in [cpu_isa_b,cpu_isa_c,cpu_cfv4e]) and
  581. ((longint(a) = -1) or ((longint(a) > 0) and (longint(a) < 8))) then
  582. list.concat(taicpu.op_const_reg(A_MOV3Q,S_L,longint(a),register))
  583. else
  584. { MOVEA.W will sign extend the value in the dest. reg to full 32 bits
  585. (specific to Ax regs only) }
  586. if isvalue16bit(a) then
  587. list.concat(taicpu.op_const_reg(A_MOVEA,S_W,longint(a),register))
  588. else
  589. list.concat(taicpu.op_const_reg(A_MOVEA,S_L,longint(a),register));
  590. end
  591. else
  592. if a = 0 then
  593. list.concat(taicpu.op_reg(A_CLR,S_L,register))
  594. else
  595. begin
  596. { Prefer MOV3Q if applicable, it allows replacement spilling for register }
  597. if (current_settings.cputype in [cpu_isa_b,cpu_isa_c,cpu_cfv4e]) and
  598. ((longint(a)=-1) or ((longint(a)>0) and (longint(a)<8))) then
  599. list.concat(taicpu.op_const_reg(A_MOV3Q,S_L,longint(a),register))
  600. else if (longint(a) >= low(shortint)) and (longint(a) <= high(shortint)) then
  601. list.concat(taicpu.op_const_reg(A_MOVEQ,S_L,longint(a),register))
  602. else
  603. begin
  604. { ISA B/C Coldfire has sign extend/zero extend moves }
  605. if (current_settings.cputype in [cpu_isa_b,cpu_isa_c,cpu_cfv4e]) and
  606. (size in [OS_16, OS_8, OS_S16, OS_S8]) and
  607. ((longint(a) >= low(smallint)) and (longint(a) <= high(smallint))) then
  608. begin
  609. if size in [OS_16, OS_8] then
  610. list.concat(taicpu.op_const_reg(A_MVZ,opsize,longint(a),register))
  611. else
  612. list.concat(taicpu.op_const_reg(A_MVS,opsize,longint(a),register));
  613. end
  614. else
  615. begin
  616. { clear the register first, for unsigned and positive values, so
  617. we don't need to zero extend after }
  618. if (size in [OS_16,OS_8]) or
  619. ((size in [OS_S16,OS_S8]) and (a > 0)) then
  620. list.concat(taicpu.op_reg(A_CLR,S_L,register));
  621. list.concat(taicpu.op_const_reg(A_MOVE,opsize,longint(a),register));
  622. { only sign extend if we need to, zero extension is not necessary because the CLR.L above }
  623. if (size in [OS_S16,OS_S8]) and (a < 0) then
  624. sign_extend(list,size,register);
  625. end;
  626. end;
  627. end;
  628. end;
  629. procedure tcg68k.a_load_const_ref(list : TAsmList; tosize: tcgsize; a : tcgint;const ref : treference);
  630. var
  631. hreg : tregister;
  632. href : treference;
  633. begin
  634. if needs_unaligned(ref.alignment,tosize) then
  635. begin
  636. inherited;
  637. exit;
  638. end;
  639. a:=longint(a);
  640. href:=ref;
  641. fixref(list,href,false);
  642. if (a=0) and not (current_settings.cputype = cpu_mc68000) then
  643. list.concat(taicpu.op_ref(A_CLR,tcgsize2opsize[tosize],href))
  644. else if (tcgsize2opsize[tosize]=S_L) and
  645. (current_settings.cputype in [cpu_isa_b,cpu_isa_c,cpu_cfv4e]) and
  646. ((a=-1) or ((a>0) and (a<8))) then
  647. list.concat(taicpu.op_const_ref(A_MOV3Q,S_L,a,href))
  648. { for coldfire we need to go through a temporary register if we have a
  649. offset, index or symbol given }
  650. else if (current_settings.cputype in cpu_coldfire) and
  651. (
  652. (href.offset<>0) or
  653. { TODO : check whether we really need this second condition }
  654. (href.index<>NR_NO) or
  655. assigned(href.symbol)
  656. ) then
  657. begin
  658. hreg:=getintregister(list,tosize);
  659. a_load_const_reg(list,tosize,a,hreg);
  660. list.concat(taicpu.op_reg_ref(A_MOVE,tcgsize2opsize[tosize],hreg,href));
  661. end
  662. else
  663. { loading via a register is almost always faster if the value is small.
  664. (with the 68040 being the only notable exception, so maybe disable
  665. this on a '040? but the difference is minor) it also results in shorter
  666. code. (KB) }
  667. if isvalue8bit(a) and (tcgsize2opsize[tosize] = S_L) then
  668. begin
  669. hreg:=getintregister(list,OS_INT);
  670. a_load_const_reg(list,OS_INT,a,hreg); // this will use moveq et.al.
  671. list.concat(taicpu.op_reg_ref(A_MOVE,tcgsize2opsize[tosize],hreg,href));
  672. end
  673. else
  674. list.concat(taicpu.op_const_ref(A_MOVE,tcgsize2opsize[tosize],longint(a),href));
  675. end;
  676. procedure tcg68k.a_load_reg_ref(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);
  677. var
  678. href : treference;
  679. hreg : tregister;
  680. begin
  681. if needs_unaligned(ref.alignment,tosize) then
  682. begin
  683. //list.concat(tai_comment.create(strpnew('a_load_reg_ref calling unaligned')));
  684. a_load_reg_ref_unaligned(list,fromsize,tosize,register,ref);
  685. exit;
  686. end;
  687. href := ref;
  688. hreg := register;
  689. fixref(list,href,false);
  690. if tcgsize2size[fromsize]<tcgsize2size[tosize] then
  691. begin
  692. hreg:=getintregister(list,tosize);
  693. a_load_reg_reg(list,fromsize,tosize,register,hreg);
  694. end;
  695. { move to destination reference }
  696. list.concat(taicpu.op_reg_ref(A_MOVE,TCGSize2OpSize[tosize],hreg,href));
  697. end;
  698. procedure tcg68k.a_load_reg_ref_unaligned(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);
  699. var
  700. tmpref : treference;
  701. tmpreg,
  702. tmpreg2 : tregister;
  703. begin
  704. if not needs_unaligned(ref.alignment,tosize) then
  705. begin
  706. a_load_reg_ref(list,fromsize,tosize,register,ref);
  707. exit;
  708. end;
  709. list.concat(tai_comment.create(strpnew('a_load_reg_ref_unaligned: generating unaligned store')));
  710. tmpreg2:=getaddressregister(list);
  711. tmpref:=ref;
  712. inc(tmpref.offset,tcgsize2size[tosize]-1);
  713. a_loadaddr_ref_reg(list,tmpref,tmpreg2);
  714. reference_reset_base(tmpref,tmpreg2,0,ctempposinvalid,1,ref.volatility);
  715. tmpref.direction:=dir_none;
  716. tmpreg:=getintregister(list,tosize);
  717. a_load_reg_reg(list,fromsize,tosize,register,tmpreg);
  718. case tosize of
  719. OS_16,OS_S16:
  720. begin
  721. list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref));
  722. list.concat(taicpu.op_const_reg(A_LSR,S_W,8,tmpreg));
  723. tmpref.direction:=dir_dec;
  724. list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref));
  725. end;
  726. OS_32,OS_S32:
  727. begin
  728. list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref));
  729. list.concat(taicpu.op_const_reg(A_LSR,S_W,8,tmpreg));
  730. tmpref.direction:=dir_dec;
  731. list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref));
  732. list.concat(taicpu.op_reg(A_SWAP,S_L,tmpreg));
  733. list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref));
  734. list.concat(taicpu.op_const_reg(A_LSR,S_W,8,tmpreg));
  735. list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref));
  736. end
  737. else
  738. internalerror(2016052201);
  739. end;
  740. end;
  741. procedure tcg68k.a_load_ref_ref(list : TAsmList;fromsize,tosize : tcgsize;const sref : treference;const dref : treference);
  742. var
  743. aref: treference;
  744. bref: treference;
  745. usetemp: boolean;
  746. hreg: TRegister;
  747. begin
  748. usetemp:=TCGSize2OpSize[fromsize]<>TCGSize2OpSize[tosize];
  749. usetemp:=usetemp or (needs_unaligned(sref.alignment,fromsize) or needs_unaligned(dref.alignment,tosize));
  750. aref := sref;
  751. bref := dref;
  752. if usetemp then
  753. begin
  754. { if we need to change the size then always use a temporary register }
  755. hreg:=getintregister(list,fromsize);
  756. if needs_unaligned(sref.alignment,fromsize) then
  757. a_load_ref_reg_unaligned(list,fromsize,tosize,sref,hreg)
  758. else
  759. begin
  760. fixref(list,aref,false);
  761. list.concat(taicpu.op_ref_reg(A_MOVE,TCGSize2OpSize[fromsize],aref,hreg));
  762. sign_extend(list,fromsize,tosize,hreg);
  763. end;
  764. if needs_unaligned(dref.alignment,tosize) then
  765. a_load_reg_ref_unaligned(list,tosize,tosize,hreg,dref)
  766. else
  767. begin
  768. { if we use a temp register, we don't need to fully resolve
  769. the dest ref, not even on coldfire }
  770. fixref(list,bref,false);
  771. list.concat(taicpu.op_reg_ref(A_MOVE,TCGSize2OpSize[tosize],hreg,bref));
  772. end;
  773. end
  774. else
  775. begin
  776. fixref(list,aref,false);
  777. fixref(list,bref,current_settings.cputype in cpu_coldfire);
  778. list.concat(taicpu.op_ref_ref(A_MOVE,TCGSize2OpSize[fromsize],aref,bref));
  779. end;
  780. end;
  781. procedure tcg68k.a_load_reg_reg(list : TAsmList;fromsize,tosize : tcgsize;reg1,reg2 : tregister);
  782. var
  783. instr : taicpu;
  784. hreg : tregister;
  785. opsize : topsize;
  786. begin
  787. { move to destination register }
  788. opsize:=TCGSize2OpSize[fromsize];
  789. if isaddressregister(reg2) and not (opsize in [S_L]) then
  790. begin
  791. hreg:=cg.getintregister(list,OS_ADDR);
  792. instr:=taicpu.op_reg_reg(A_MOVE,TCGSize2OpSize[fromsize],reg1,hreg);
  793. add_move_instruction(instr);
  794. list.concat(instr);
  795. sign_extend(list,fromsize,hreg);
  796. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg,reg2));
  797. end
  798. else
  799. begin
  800. if not isregoverlap(reg1,reg2) then
  801. begin
  802. instr:=taicpu.op_reg_reg(A_MOVE,opsize,reg1,reg2);
  803. add_move_instruction(instr);
  804. list.concat(instr);
  805. end;
  806. sign_extend(list,fromsize,tosize,reg2);
  807. end;
  808. end;
  809. procedure tcg68k.a_load_ref_reg(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);
  810. var
  811. href : treference;
  812. hreg : tregister;
  813. size : tcgsize;
  814. opsize: topsize;
  815. needsext: boolean;
  816. begin
  817. if needs_unaligned(ref.alignment,fromsize) then
  818. begin
  819. //list.concat(tai_comment.create(strpnew('a_load_ref_reg calling unaligned')));
  820. a_load_ref_reg_unaligned(list,fromsize,tosize,ref,register);
  821. exit;
  822. end;
  823. href:=ref;
  824. fixref(list,href,false);
  825. needsext:=tcgsize2size[fromsize]<tcgsize2size[tosize];
  826. if needsext then
  827. size:=fromsize
  828. else
  829. size:=tosize;
  830. opsize:=TCGSize2OpSize[size];
  831. if isaddressregister(register) and not (opsize in [S_L]) then
  832. hreg:=getintregister(list,OS_ADDR)
  833. else
  834. hreg:=register;
  835. if needsext and (CPUM68K_HAS_MVSMVZ in cpu_capabilities[current_settings.cputype]) and not (opsize in [S_L]) then
  836. begin
  837. if fromsize in [OS_S8,OS_S16] then
  838. list.concat(taicpu.op_ref_reg(A_MVS,opsize,href,hreg))
  839. else if fromsize in [OS_8,OS_16] then
  840. list.concat(taicpu.op_ref_reg(A_MVZ,opsize,href,hreg))
  841. else
  842. internalerror(2016050502);
  843. end
  844. else
  845. begin
  846. if needsext and (fromsize in [OS_8,OS_16]) then
  847. begin
  848. //list.concat(tai_comment.create(strpnew('a_load_ref_reg: zero ext')));
  849. a_load_const_reg(list,OS_32,0,hreg);
  850. needsext:=false;
  851. end;
  852. list.concat(taicpu.op_ref_reg(A_MOVE,opsize,href,hreg));
  853. if needsext then
  854. sign_extend(list,size,hreg);
  855. end;
  856. if hreg<>register then
  857. a_load_reg_reg(list,OS_ADDR,OS_ADDR,hreg,register);
  858. end;
  859. procedure tcg68k.a_load_ref_reg_unaligned(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);
  860. var
  861. tmpref : treference;
  862. tmpreg,
  863. tmpreg2 : tregister;
  864. begin
  865. if not needs_unaligned(ref.alignment,fromsize) then
  866. begin
  867. a_load_ref_reg(list,fromsize,tosize,ref,register);
  868. exit;
  869. end;
  870. list.concat(tai_comment.create(strpnew('a_load_ref_reg_unaligned: generating unaligned load')));
  871. tmpreg2:=getaddressregister(list);
  872. a_loadaddr_ref_reg(list,ref,tmpreg2);
  873. reference_reset_base(tmpref,tmpreg2,0,ctempposinvalid,1,ref.volatility);
  874. tmpref.direction:=dir_inc;
  875. if isaddressregister(register) then
  876. tmpreg:=getintregister(list,OS_ADDR)
  877. else
  878. tmpreg:=register;
  879. case fromsize of
  880. OS_16,OS_S16:
  881. begin
  882. list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg));
  883. list.concat(taicpu.op_const_reg(A_LSL,S_W,8,tmpreg));
  884. tmpref.direction:=dir_none;
  885. list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg));
  886. sign_extend(list,fromsize,tmpreg);
  887. end;
  888. OS_32,OS_S32:
  889. begin
  890. list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg));
  891. list.concat(taicpu.op_const_reg(A_LSL,S_W,8,tmpreg));
  892. list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg));
  893. list.concat(taicpu.op_reg(A_SWAP,S_L,tmpreg));
  894. list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg));
  895. list.concat(taicpu.op_const_reg(A_LSL,S_W,8,tmpreg));
  896. tmpref.direction:=dir_none;
  897. list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg));
  898. end
  899. else
  900. internalerror(2016052103);
  901. end;
  902. if tmpreg<>register then
  903. a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpreg,register);
  904. end;
  905. procedure tcg68k.a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);
  906. var
  907. href : treference;
  908. hreg : tregister;
  909. begin
  910. href:=ref;
  911. fixref(list, href, false);
  912. if not isaddressregister(r) then
  913. begin
  914. hreg:=getaddressregister(list);
  915. list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,hreg));
  916. a_load_reg_reg(list, OS_ADDR, OS_ADDR, hreg, r);
  917. end
  918. else
  919. list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,r));
  920. end;
  921. procedure tcg68k.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister);
  922. var
  923. instr : taicpu;
  924. begin
  925. instr:=taicpu.op_reg_reg(A_FMOVE,fpuregopsize,reg1,reg2);
  926. add_move_instruction(instr);
  927. list.concat(instr);
  928. end;
  929. procedure tcg68k.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister);
  930. var
  931. opsize : topsize;
  932. href : treference;
  933. begin
  934. opsize := tcgsize2opsize[fromsize];
  935. href := ref;
  936. fixref(list,href,current_settings.fputype = fpu_coldfire);
  937. list.concat(taicpu.op_ref_reg(A_FMOVE,opsize,href,reg));
  938. end;
  939. procedure tcg68k.a_loadfpu_reg_ref(list: TAsmList; fromsize,tosize: tcgsize; reg: tregister; const ref: treference);
  940. var
  941. opsize : topsize;
  942. href : treference;
  943. begin
  944. opsize := tcgsize2opsize[tosize];
  945. href := ref;
  946. fixref(list,href,current_settings.fputype = fpu_coldfire);
  947. list.concat(taicpu.op_reg_ref(A_FMOVE,opsize,reg,href));
  948. end;
  949. procedure tcg68k.a_loadfpu_reg_cgpara(list : TAsmList;size : tcgsize;const reg : tregister;const cgpara : tcgpara);
  950. var
  951. ref : treference;
  952. begin
  953. if use_push(cgpara) and (FPUM68K_HAS_HARDWARE in fpu_capabilities[current_settings.fputype]) then
  954. begin
  955. cgpara.check_simple_location;
  956. reference_reset_base(ref, NR_STACK_POINTER_REG, 0, ctempposinvalid, cgpara.alignment, []);
  957. ref.direction := dir_dec;
  958. list.concat(taicpu.op_reg_ref(A_FMOVE,tcgsize2opsize[cgpara.location^.size],reg,ref));
  959. end
  960. else
  961. inherited a_loadfpu_reg_cgpara(list,size,reg,cgpara);
  962. end;
  963. procedure tcg68k.a_loadfpu_ref_cgpara(list : TAsmList; size : tcgsize;const ref : treference;const cgpara : TCGPara);
  964. var
  965. href, href2 : treference;
  966. freg : tregister;
  967. begin
  968. if current_settings.fputype = fpu_soft then
  969. case cgpara.location^.loc of
  970. LOC_REFERENCE,LOC_CREFERENCE:
  971. begin
  972. case size of
  973. OS_F64:
  974. cg64.a_load64_ref_cgpara(list,ref,cgpara);
  975. OS_F32:
  976. a_load_ref_cgpara(list,size,ref,cgpara);
  977. else
  978. internalerror(2013021201);
  979. end;
  980. end;
  981. else
  982. inherited a_loadfpu_ref_cgpara(list,size,ref,cgpara);
  983. end
  984. else
  985. if use_push(cgpara) and (FPUM68K_HAS_HARDWARE in fpu_capabilities[current_settings.fputype]) then
  986. begin
  987. //list.concat(tai_comment.create(strpnew('a_loadfpu_ref_cgpara copy')));
  988. cgpara.check_simple_location;
  989. reference_reset_base(href, NR_STACK_POINTER_REG, 0, ctempposinvalid, cgpara.alignment, []);
  990. href.direction := dir_dec;
  991. case size of
  992. OS_F64:
  993. begin
  994. href2:=ref;
  995. inc(href2.offset,8);
  996. fixref(list,href2,true);
  997. href2.direction := dir_dec;
  998. cg.a_load_ref_ref(list,OS_32,OS_32,href2,href);
  999. cg.a_load_ref_ref(list,OS_32,OS_32,href2,href);
  1000. end;
  1001. OS_F32:
  1002. cg.a_load_ref_ref(list,OS_32,OS_32,ref,href);
  1003. else
  1004. internalerror(2017052110);
  1005. end;
  1006. end
  1007. else
  1008. begin
  1009. //list.concat(tai_comment.create(strpnew('a_loadfpu_ref_cgpara inherited')));
  1010. inherited a_loadfpu_ref_cgpara(list,size,ref,cgpara);
  1011. end;
  1012. end;
  1013. procedure tcg68k.a_op_const_reg(list : TAsmList; Op: TOpCG; size: tcgsize; a: tcgint; reg: TRegister);
  1014. var
  1015. scratch_reg : tregister;
  1016. scratch_reg2: tregister;
  1017. opcode : tasmop;
  1018. begin
  1019. optimize_op_const(size, op, a);
  1020. opcode := topcg2tasmop[op];
  1021. if (a >0) and (a<=high(dword)) then
  1022. a:=longint(dword(a))
  1023. else if (a>=low(longint)) then
  1024. a:=longint(a)
  1025. else
  1026. internalerror(201810201);
  1027. case op of
  1028. OP_NONE :
  1029. begin
  1030. { Opcode is optimized away }
  1031. end;
  1032. OP_MOVE :
  1033. begin
  1034. { Optimized, replaced with a simple load }
  1035. a_load_const_reg(list,size,a,reg);
  1036. end;
  1037. OP_ADD,
  1038. OP_SUB:
  1039. begin
  1040. { add/sub works the same way, so have it unified here }
  1041. if (a >= 1) and (a <= 8) then
  1042. if (op = OP_ADD) then
  1043. opcode:=A_ADDQ
  1044. else
  1045. opcode:=A_SUBQ;
  1046. list.concat(taicpu.op_const_reg(opcode, S_L, a, reg));
  1047. end;
  1048. OP_AND,
  1049. OP_OR,
  1050. OP_XOR:
  1051. begin
  1052. scratch_reg := force_to_dataregister(list, size, reg);
  1053. list.concat(taicpu.op_const_reg(opcode, S_L, a, scratch_reg));
  1054. move_if_needed(list, size, scratch_reg, reg);
  1055. end;
  1056. OP_DIV,
  1057. OP_IDIV:
  1058. begin
  1059. internalerror(20020816);
  1060. end;
  1061. OP_MUL,
  1062. OP_IMUL:
  1063. begin
  1064. { NOTE: better have this as fast as possible on every CPU in all cases,
  1065. because the compiler uses OP_IMUL for array indexing... (KB) }
  1066. { ColdFire doesn't support MULS/MULU <imm>,dX }
  1067. if not (CPUM68K_HAS_MULIMM in cpu_capabilities[current_settings.cputype]) then
  1068. begin
  1069. { move const to a register first }
  1070. scratch_reg := getintregister(list,OS_INT);
  1071. a_load_const_reg(list, size, a, scratch_reg);
  1072. { do the multiplication }
  1073. scratch_reg2 := force_to_dataregister(list, size, reg);
  1074. sign_extend(list, size, scratch_reg2);
  1075. list.concat(taicpu.op_reg_reg(opcode,S_L,scratch_reg,scratch_reg2));
  1076. { move the value back to the original register }
  1077. move_if_needed(list, size, scratch_reg2, reg);
  1078. end
  1079. else
  1080. begin
  1081. if CPUM68K_HAS_32BITMUL in cpu_capabilities[current_settings.cputype] then
  1082. begin
  1083. { do the multiplication }
  1084. scratch_reg := force_to_dataregister(list, size, reg);
  1085. sign_extend(list, size, scratch_reg);
  1086. list.concat(taicpu.op_const_reg(opcode,S_L,a,scratch_reg));
  1087. { move the value back to the original register }
  1088. move_if_needed(list, size, scratch_reg, reg);
  1089. end
  1090. else
  1091. { Fallback branch, plain 68000 for now }
  1092. if not optimize_const_mul_to_shift_sub_add(list, 5, a, size, reg) then
  1093. { FIX ME: this is slow as hell, but original 68000 doesn't have 32x32 -> 32bit MUL (KB) }
  1094. if op = OP_MUL then
  1095. call_rtl_mul_const_reg(list, size, a, reg,'fpc_mul_dword')
  1096. else
  1097. call_rtl_mul_const_reg(list, size, a, reg,'fpc_mul_longint');
  1098. end;
  1099. end;
  1100. OP_ROL,
  1101. OP_ROR,
  1102. OP_SAR,
  1103. OP_SHL,
  1104. OP_SHR :
  1105. begin
  1106. scratch_reg := force_to_dataregister(list, size, reg);
  1107. sign_extend(list, size, scratch_reg);
  1108. { some special cases which can generate smarter code
  1109. using the SWAP instruction }
  1110. if (a = 16) then
  1111. begin
  1112. if (op = OP_SHL) then
  1113. begin
  1114. list.concat(taicpu.op_reg(A_SWAP,S_NO,scratch_reg));
  1115. list.concat(taicpu.op_reg(A_CLR,S_W,scratch_reg));
  1116. end
  1117. else if (op = OP_SHR) then
  1118. begin
  1119. list.concat(taicpu.op_reg(A_CLR,S_W,scratch_reg));
  1120. list.concat(taicpu.op_reg(A_SWAP,S_NO,scratch_reg));
  1121. end
  1122. else if (op = OP_SAR) then
  1123. begin
  1124. list.concat(taicpu.op_reg(A_SWAP,S_NO,scratch_reg));
  1125. list.concat(taicpu.op_reg(A_EXT,S_L,scratch_reg));
  1126. end
  1127. else if (op = OP_ROR) or (op = OP_ROL) then
  1128. list.concat(taicpu.op_reg(A_SWAP,S_NO,scratch_reg))
  1129. end
  1130. else if (a >= 1) and (a <= 8) then
  1131. begin
  1132. list.concat(taicpu.op_const_reg(opcode, S_L, a, scratch_reg));
  1133. end
  1134. else if (a >= 9) and (a < 16) then
  1135. begin
  1136. { Use two ops instead of const -> reg + shift with reg, because
  1137. this way is the same in length and speed but has less register
  1138. pressure }
  1139. list.concat(taicpu.op_const_reg(opcode, S_L, 8, scratch_reg));
  1140. list.concat(taicpu.op_const_reg(opcode, S_L, a-8, scratch_reg));
  1141. end
  1142. else
  1143. begin
  1144. { move const to a register first }
  1145. scratch_reg2 := getintregister(list,OS_INT);
  1146. a_load_const_reg(list, size, a, scratch_reg2);
  1147. { do the operation }
  1148. list.concat(taicpu.op_reg_reg(opcode, S_L, scratch_reg2, scratch_reg));
  1149. end;
  1150. { move the value back to the original register }
  1151. move_if_needed(list, size, scratch_reg, reg);
  1152. end;
  1153. else
  1154. internalerror(20020729);
  1155. end;
  1156. end;
  1157. procedure tcg68k.a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference);
  1158. var
  1159. opcode: tasmop;
  1160. opsize: topsize;
  1161. href : treference;
  1162. hreg : tregister;
  1163. begin
  1164. optimize_op_const(size, op, a);
  1165. opcode := topcg2tasmop[op];
  1166. opsize := TCGSize2OpSize[size];
  1167. { on ColdFire all arithmetic operations are only possible on 32bit }
  1168. if needs_unaligned(ref.alignment,size) or
  1169. ((current_settings.cputype in cpu_coldfire) and (opsize <> S_L)
  1170. and not (op in [OP_NONE,OP_MOVE])) then
  1171. begin
  1172. inherited;
  1173. exit;
  1174. end;
  1175. case op of
  1176. OP_NONE :
  1177. begin
  1178. { opcode was optimized away }
  1179. end;
  1180. OP_MOVE :
  1181. begin
  1182. { Optimized, replaced with a simple load }
  1183. a_load_const_ref(list,size,a,ref);
  1184. end;
  1185. OP_AND,
  1186. OP_OR,
  1187. OP_XOR :
  1188. begin
  1189. //list.concat(tai_comment.create(strpnew('a_op_const_ref: bitwise')));
  1190. hreg:=getintregister(list,size);
  1191. a_load_const_reg(list,size,a,hreg);
  1192. href:=ref;
  1193. fixref(list,href,false);
  1194. list.concat(taicpu.op_reg_ref(opcode, opsize, hreg, href));
  1195. end;
  1196. OP_ADD,
  1197. OP_SUB :
  1198. begin
  1199. href:=ref;
  1200. { add/sub works the same way, so have it unified here }
  1201. if (a >= 1) and (a <= 8) then
  1202. begin
  1203. fixref(list,href,false);
  1204. if (op = OP_ADD) then
  1205. opcode:=A_ADDQ
  1206. else
  1207. opcode:=A_SUBQ;
  1208. list.concat(taicpu.op_const_ref(opcode, opsize, a, href));
  1209. end
  1210. else
  1211. if not(current_settings.cputype in cpu_coldfire) then
  1212. begin
  1213. fixref(list,href,false);
  1214. list.concat(taicpu.op_const_ref(opcode, opsize, a, href));
  1215. end
  1216. else
  1217. { on ColdFire, ADDI/SUBI cannot act on memory
  1218. so we can only go through a register }
  1219. inherited;
  1220. end;
  1221. else begin
  1222. // list.concat(tai_comment.create(strpnew('a_op_const_ref inherited')));
  1223. inherited;
  1224. end;
  1225. end;
  1226. end;
  1227. procedure tcg68k.a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; src, dst: TRegister);
  1228. var
  1229. hreg1, hreg2: tregister;
  1230. opcode : tasmop;
  1231. opsize : topsize;
  1232. begin
  1233. opcode := topcg2tasmop[op];
  1234. if current_settings.cputype in cpu_coldfire then
  1235. opsize := S_L
  1236. else
  1237. opsize := TCGSize2OpSize[size];
  1238. case op of
  1239. OP_ADD,
  1240. OP_SUB:
  1241. begin
  1242. if current_settings.cputype in cpu_coldfire then
  1243. begin
  1244. { operation only allowed only a longword }
  1245. sign_extend(list, size, src);
  1246. sign_extend(list, size, dst);
  1247. end;
  1248. list.concat(taicpu.op_reg_reg(opcode, opsize, src, dst));
  1249. end;
  1250. OP_AND,OP_OR,
  1251. OP_SAR,OP_SHL,
  1252. OP_SHR,OP_XOR:
  1253. begin
  1254. { load to data registers }
  1255. hreg1 := force_to_dataregister(list, size, src);
  1256. hreg2 := force_to_dataregister(list, size, dst);
  1257. if current_settings.cputype in cpu_coldfire then
  1258. begin
  1259. { operation only allowed only a longword }
  1260. {!***************************************
  1261. in the case of shifts, the value to
  1262. shift by, should already be valid, so
  1263. no need to sign extend the value
  1264. !
  1265. }
  1266. if op in [OP_AND,OP_OR,OP_XOR] then
  1267. sign_extend(list, size, hreg1);
  1268. sign_extend(list, size, hreg2);
  1269. end;
  1270. list.concat(taicpu.op_reg_reg(opcode, opsize, hreg1, hreg2));
  1271. { move back result into destination register }
  1272. move_if_needed(list, size, hreg2, dst);
  1273. end;
  1274. OP_DIV,
  1275. OP_IDIV :
  1276. begin
  1277. internalerror(20020816);
  1278. end;
  1279. OP_MUL,
  1280. OP_IMUL:
  1281. begin
  1282. if not (CPUM68K_HAS_32BITMUL in cpu_capabilities[current_settings.cputype]) then
  1283. if op = OP_MUL then
  1284. call_rtl_mul_reg_reg(list,src,dst,'fpc_mul_dword')
  1285. else
  1286. call_rtl_mul_reg_reg(list,src,dst,'fpc_mul_longint')
  1287. else
  1288. begin
  1289. { 68020+ and ColdFire codepath, probably could be improved }
  1290. hreg1 := force_to_dataregister(list, size, src);
  1291. hreg2 := force_to_dataregister(list, size, dst);
  1292. sign_extend(list, size, hreg1);
  1293. sign_extend(list, size, hreg2);
  1294. list.concat(taicpu.op_reg_reg(opcode, opsize, hreg1, hreg2));
  1295. { move back result into destination register }
  1296. move_if_needed(list, size, hreg2, dst);
  1297. end;
  1298. end;
  1299. OP_NEG,
  1300. OP_NOT :
  1301. begin
  1302. { if there are two operands, move the register,
  1303. since the operation will only be done on the result
  1304. register. }
  1305. if (src<>dst) then
  1306. a_load_reg_reg(list,size,size,src,dst);
  1307. hreg2 := force_to_dataregister(list, size, dst);
  1308. { coldfire only supports long version }
  1309. if current_settings.cputype in cpu_ColdFire then
  1310. sign_extend(list, size, hreg2);
  1311. list.concat(taicpu.op_reg(opcode, opsize, hreg2));
  1312. { move back the result to the result register if needed }
  1313. move_if_needed(list, size, hreg2, dst);
  1314. end;
  1315. else
  1316. internalerror(20020729);
  1317. end;
  1318. end;
  1319. procedure tcg68k.a_op_reg_ref(list : TAsmList; Op: TOpCG; size: TCGSize; reg: TRegister; const ref: TReference);
  1320. var
  1321. opcode : tasmop;
  1322. opsize : topsize;
  1323. href : treference;
  1324. hreg : tregister;
  1325. begin
  1326. opcode := topcg2tasmop[op];
  1327. opsize := TCGSize2OpSize[size];
  1328. { on ColdFire all arithmetic operations are only possible on 32bit
  1329. and addressing modes are limited }
  1330. if needs_unaligned(ref.alignment,size) or
  1331. ((current_settings.cputype in cpu_coldfire) and (opsize <> S_L)) then
  1332. begin
  1333. //list.concat(tai_comment.create(strpnew('a_op_reg_ref: inherited #1')));
  1334. inherited;
  1335. exit;
  1336. end;
  1337. case op of
  1338. OP_ADD,
  1339. OP_SUB,
  1340. OP_OR,
  1341. OP_XOR,
  1342. OP_AND:
  1343. begin
  1344. //list.concat(tai_comment.create(strpnew('a_op_reg_ref: normal op')));
  1345. href:=ref;
  1346. fixref(list,href,false);
  1347. { areg -> ref arithmetic operations are impossible on 68k }
  1348. hreg:=force_to_dataregister(list,size,reg);
  1349. { add/sub works the same way, so have it unified here }
  1350. list.concat(taicpu.op_reg_ref(opcode, opsize, hreg, href));
  1351. end;
  1352. else begin
  1353. //list.concat(tai_comment.create(strpnew('a_op_reg_ref inherited #2')));
  1354. inherited;
  1355. end;
  1356. end;
  1357. end;
  1358. procedure tcg68k.a_op_ref_reg(list : TAsmList; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister);
  1359. var
  1360. opcode : tasmop;
  1361. opsize : topsize;
  1362. href : treference;
  1363. hreg : tregister;
  1364. begin
  1365. opcode := topcg2tasmop[op];
  1366. opsize := TCGSize2OpSize[size];
  1367. { on ColdFire all arithmetic operations are only possible on 32bit
  1368. and addressing modes are limited }
  1369. if needs_unaligned(ref.alignment,size) or
  1370. ((current_settings.cputype in cpu_coldfire) and (opsize <> S_L)) then
  1371. begin
  1372. //list.concat(tai_comment.create(strpnew('a_op_ref_reg: inherited #1')));
  1373. inherited;
  1374. exit;
  1375. end;
  1376. case op of
  1377. OP_ADD,
  1378. OP_SUB,
  1379. OP_OR,
  1380. OP_AND,
  1381. OP_MUL,
  1382. OP_IMUL:
  1383. begin
  1384. //list.concat(tai_comment.create(strpnew('a_op_ref_reg: normal op')));
  1385. href:=ref;
  1386. { Coldfire doesn't support d(Ax,Dx) for long MULx... }
  1387. fixref(list,href,(op in [OP_MUL,OP_IMUL]) and
  1388. (current_settings.cputype in cpu_coldfire));
  1389. list.concat(taicpu.op_ref_reg(opcode, opsize, href, reg));
  1390. end;
  1391. else begin
  1392. //list.concat(tai_comment.create(strpnew('a_op_ref_reg inherited #2')));
  1393. inherited;
  1394. end;
  1395. end;
  1396. end;
  1397. procedure tcg68k.a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister;
  1398. l : tasmlabel);
  1399. var
  1400. hregister : tregister;
  1401. instr : taicpu;
  1402. need_temp_reg : boolean;
  1403. temp_size: topsize;
  1404. begin
  1405. need_temp_reg := false;
  1406. { plain 68000 doesn't support address registers for TST }
  1407. need_temp_reg := (current_settings.cputype = cpu_mc68000) and
  1408. (a = 0) and isaddressregister(reg);
  1409. { ColdFire doesn't support address registers for CMPI }
  1410. need_temp_reg := need_temp_reg or ((current_settings.cputype in cpu_coldfire)
  1411. and (a <> 0) and isaddressregister(reg));
  1412. if need_temp_reg then
  1413. begin
  1414. hregister := getintregister(list,OS_INT);
  1415. temp_size := TCGSize2OpSize[size];
  1416. if temp_size < S_W then
  1417. temp_size := S_W;
  1418. instr:=taicpu.op_reg_reg(A_MOVE,temp_size,reg,hregister);
  1419. add_move_instruction(instr);
  1420. list.concat(instr);
  1421. reg := hregister;
  1422. { do sign extension if size had to be modified }
  1423. if temp_size <> TCGSize2OpSize[size] then
  1424. begin
  1425. sign_extend(list, size, reg);
  1426. size:=OS_INT;
  1427. end;
  1428. end;
  1429. if a = 0 then
  1430. list.concat(taicpu.op_reg(A_TST,TCGSize2OpSize[size],reg))
  1431. else
  1432. begin
  1433. { ColdFire ISA A also needs S_L for CMPI }
  1434. { Note: older QEMU pukes from CMPI sizes <> .L even on ISA B/C, but
  1435. it's actually *LEGAL*, see CFPRM, page 4-30, the bug also seems
  1436. fixed in recent QEMU, but only when CPU cfv4e is forced, not by
  1437. default. (KB) }
  1438. if current_settings.cputype in cpu_coldfire{-[cpu_isa_b,cpu_isa_c,cpu_cfv4e]} then
  1439. begin
  1440. sign_extend(list, size, reg);
  1441. size:=OS_INT;
  1442. end;
  1443. list.concat(taicpu.op_const_reg(A_CMPI,TCGSize2OpSize[size],a,reg));
  1444. end;
  1445. { emit the actual jump to the label }
  1446. a_jmp_cond(list,cmp_op,l);
  1447. end;
  1448. procedure tcg68k.a_cmp_const_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;const ref : treference; l : tasmlabel);
  1449. var
  1450. tmpref: treference;
  1451. begin
  1452. { optimize for usage of TST here, so ref compares against zero, which is the
  1453. most common case by far in the RTL code at least (KB) }
  1454. if not needs_unaligned(ref.alignment,size) and (a = 0) then
  1455. begin
  1456. //list.concat(tai_comment.create(strpnew('a_cmp_const_ref_label with TST')));
  1457. tmpref:=ref;
  1458. fixref(list,tmpref,false);
  1459. list.concat(taicpu.op_ref(A_TST,tcgsize2opsize[size],tmpref));
  1460. a_jmp_cond(list,cmp_op,l);
  1461. end
  1462. else
  1463. begin
  1464. //list.concat(tai_comment.create(strpnew('a_cmp_const_ref_label inherited')));
  1465. inherited;
  1466. end;
  1467. end;
  1468. procedure tcg68k.a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
  1469. begin
  1470. if (current_settings.cputype in cpu_coldfire-[cpu_isa_b,cpu_isa_c,cpu_cfv4e]) then
  1471. begin
  1472. sign_extend(list,size,reg1);
  1473. sign_extend(list,size,reg2);
  1474. size:=OS_INT;
  1475. end;
  1476. list.concat(taicpu.op_reg_reg(A_CMP,tcgsize2opsize[size],reg1,reg2));
  1477. { emit the actual jump to the label }
  1478. a_jmp_cond(list,cmp_op,l);
  1479. end;
  1480. procedure tcg68k.a_jmp_name(list: TAsmList; const s: string);
  1481. var
  1482. ai: taicpu;
  1483. begin
  1484. ai := Taicpu.op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(s,AT_FUNCTION));
  1485. ai.is_jmp := true;
  1486. list.concat(ai);
  1487. end;
  1488. procedure tcg68k.a_jmp_always(list : TAsmList;l: tasmlabel);
  1489. var
  1490. ai: taicpu;
  1491. begin
  1492. ai := Taicpu.op_sym(A_JMP,S_NO,l);
  1493. ai.is_jmp := true;
  1494. list.concat(ai);
  1495. end;
  1496. procedure tcg68k.a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel);
  1497. var
  1498. ai : taicpu;
  1499. begin
  1500. if not (f in FloatResFlags) then
  1501. ai := Taicpu.op_sym(A_BXX,S_NO,l)
  1502. else
  1503. ai := Taicpu.op_sym(A_FBXX,S_NO,l);
  1504. ai.SetCondition(flags_to_cond(f));
  1505. ai.is_jmp := true;
  1506. list.concat(ai);
  1507. end;
  1508. procedure tcg68k.g_flags2reg(list: TAsmList; size: TCgSize; const f: tresflags; reg: TRegister);
  1509. var
  1510. ai : taicpu;
  1511. htrue: tasmlabel;
  1512. begin
  1513. if isaddressregister(reg) then
  1514. internalerror(2017051701);
  1515. if (f in FloatResFlags) then
  1516. begin
  1517. //list.concat(tai_comment.create(strpnew('flags2reg: float resflags')));
  1518. current_asmdata.getjumplabel(htrue);
  1519. a_load_const_reg(current_asmdata.CurrAsmList,OS_32,1,reg);
  1520. a_jmp_flags(list, f, htrue);
  1521. a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,reg);
  1522. a_label(current_asmdata.CurrAsmList,htrue);
  1523. exit;
  1524. end;
  1525. ai:=Taicpu.Op_reg(A_Sxx,S_B,reg);
  1526. ai.SetCondition(flags_to_cond(f));
  1527. list.concat(ai);
  1528. { Scc stores a complete byte of 1s, but the compiler expects only one
  1529. bit set, so ensure this is the case }
  1530. if not (current_settings.cputype in cpu_coldfire) then
  1531. begin
  1532. if size in [OS_S8,OS_8] then
  1533. list.concat(taicpu.op_reg(A_NEG,S_B,reg))
  1534. else
  1535. list.concat(taicpu.op_const_reg(A_AND,TCgSize2OpSize[size],1,reg));
  1536. end
  1537. else
  1538. list.concat(taicpu.op_const_reg(A_AND,S_L,1,reg));
  1539. end;
  1540. procedure tcg68k.g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);
  1541. const
  1542. lentocgsize: array[1..4] of tcgsize = (OS_8,OS_16,OS_NO,OS_32);
  1543. var
  1544. helpsize : longint;
  1545. i : byte;
  1546. hregister : tregister;
  1547. iregister : tregister;
  1548. jregister : tregister;
  1549. hl : tasmlabel;
  1550. srcrefp,dstrefp : treference;
  1551. srcref,dstref : treference;
  1552. begin
  1553. if (len = 1) or ((len in [2,4]) and (current_settings.cputype <> cpu_mc68000)) then
  1554. begin
  1555. //list.concat(tai_comment.create(strpnew('g_concatcopy: small')));
  1556. a_load_ref_ref(list,lentocgsize[len],lentocgsize[len],source,dest);
  1557. exit;
  1558. end;
  1559. //list.concat(tai_comment.create(strpnew('g_concatcopy')));
  1560. hregister := getintregister(list,OS_INT);
  1561. iregister:=getaddressregister(list);
  1562. reference_reset_base(srcref,iregister,0,source.temppos,source.alignment,source.volatility);
  1563. srcrefp:=srcref;
  1564. srcrefp.direction := dir_inc;
  1565. jregister:=getaddressregister(list);
  1566. reference_reset_base(dstref,jregister,0,dest.temppos,dest.alignment,dest.volatility);
  1567. dstrefp:=dstref;
  1568. dstrefp.direction := dir_inc;
  1569. { iregister = source }
  1570. { jregister = destination }
  1571. a_loadaddr_ref_reg(list,source,iregister);
  1572. a_loadaddr_ref_reg(list,dest,jregister);
  1573. if not (needs_unaligned(source.alignment,OS_INT) or needs_unaligned(dest.alignment,OS_INT)) then
  1574. begin
  1575. if not ((len<=8) or (not(cs_opt_size in current_settings.optimizerswitches) and (len<=16))) then
  1576. begin
  1577. //list.concat(tai_comment.create(strpnew('g_concatcopy tight copy loop 020+')));
  1578. helpsize := len - len mod 4;
  1579. len := len mod 4;
  1580. a_load_const_reg(list,OS_INT,(helpsize div 4)-1,hregister);
  1581. current_asmdata.getjumplabel(hl);
  1582. a_label(list,hl);
  1583. list.concat(taicpu.op_ref_ref(A_MOVE,S_L,srcrefp,dstrefp));
  1584. if (current_settings.cputype in cpu_coldfire) or ((helpsize div 4)-1 > high(smallint)) then
  1585. begin
  1586. { Coldfire does not support DBRA, also it is word only }
  1587. list.concat(taicpu.op_const_reg(A_SUBQ,S_L,1,hregister));
  1588. list.concat(taicpu.op_sym(A_BPL,S_NO,hl));
  1589. end
  1590. else
  1591. list.concat(taicpu.op_reg_sym(A_DBRA,S_NO,hregister,hl));
  1592. end;
  1593. helpsize:=len div 4;
  1594. { move a dword x times }
  1595. for i:=1 to helpsize do
  1596. begin
  1597. dec(len,4);
  1598. if (len > 0) then
  1599. list.concat(taicpu.op_ref_ref(A_MOVE,S_L,srcrefp,dstrefp))
  1600. else
  1601. list.concat(taicpu.op_ref_ref(A_MOVE,S_L,srcref,dstref));
  1602. end;
  1603. { move a word }
  1604. if len>1 then
  1605. begin
  1606. dec(len,2);
  1607. if (len > 0) then
  1608. list.concat(taicpu.op_ref_ref(A_MOVE,S_W,srcrefp,dstrefp))
  1609. else
  1610. list.concat(taicpu.op_ref_ref(A_MOVE,S_W,srcref,dstref));
  1611. end;
  1612. { move a single byte }
  1613. if len>0 then
  1614. list.concat(taicpu.op_ref_ref(A_MOVE,S_B,srcref,dstref));
  1615. end
  1616. else
  1617. begin
  1618. { Fast 68010 loop mode with no possible alignment problems }
  1619. //list.concat(tai_comment.create(strpnew('g_concatcopy tight byte copy loop')));
  1620. a_load_const_reg(list,OS_INT,len - 1,hregister);
  1621. current_asmdata.getjumplabel(hl);
  1622. a_label(list,hl);
  1623. list.concat(taicpu.op_ref_ref(A_MOVE,S_B,srcrefp,dstrefp));
  1624. if (len - 1) > high(smallint) then
  1625. begin
  1626. list.concat(taicpu.op_const_reg(A_SUBQ,S_L,1,hregister));
  1627. list.concat(taicpu.op_sym(A_BPL,S_NO,hl));
  1628. end
  1629. else
  1630. list.concat(taicpu.op_reg_sym(A_DBRA,S_NO,hregister,hl));
  1631. end;
  1632. end;
  1633. procedure tcg68k.g_overflowcheck(list: TAsmList; const l:tlocation; def:tdef);
  1634. var
  1635. hl : tasmlabel;
  1636. ai : taicpu;
  1637. cond : TAsmCond;
  1638. begin
  1639. if not(cs_check_overflow in current_settings.localswitches) then
  1640. exit;
  1641. current_asmdata.getjumplabel(hl);
  1642. if not ((def.typ=pointerdef) or
  1643. ((def.typ=orddef) and
  1644. (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
  1645. pasbool1,pasbool8,pasbool16,pasbool32,pasbool64]))) then
  1646. cond:=C_VC
  1647. else
  1648. begin
  1649. { MUL/DIV always sets the overflow flag, and never the carry flag }
  1650. { Note/Fixme: This still doesn't cover the ColdFire, where none of these opcodes
  1651. set either the overflow or the carry flag. So CF must be handled in other ways. }
  1652. if taicpu(list.last).opcode in [A_MULU,A_MULS,A_DIVS,A_DIVU,A_DIVUL,A_DIVSL] then
  1653. cond:=C_VC
  1654. else
  1655. cond:=C_CC;
  1656. end;
  1657. ai:=Taicpu.Op_Sym(A_Bxx,S_NO,hl);
  1658. ai.SetCondition(cond);
  1659. ai.is_jmp:=true;
  1660. list.concat(ai);
  1661. a_call_name(list,'FPC_OVERFLOW',false);
  1662. a_label(list,hl);
  1663. end;
  1664. procedure tcg68k.g_proc_entry(list: TAsmList; localsize: longint; nostackframe:boolean);
  1665. begin
  1666. { Carl's original code used 2x MOVE instead of LINK when localsize = 0.
  1667. However, a LINK seems faster than two moves on everything from 68000
  1668. to '060, so the two move branch here was dropped. (KB) }
  1669. if not nostackframe then
  1670. begin
  1671. localsize:=align(localsize,4);
  1672. if (localsize > high(smallint)) then
  1673. begin
  1674. list.concat(taicpu.op_reg_const(A_LINK,S_W,NR_FRAME_POINTER_REG,0));
  1675. list.concat(taicpu.op_const_reg(A_SUBA,S_L,localsize,NR_STACK_POINTER_REG));
  1676. end
  1677. else
  1678. list.concat(taicpu.op_reg_const(A_LINK,S_W,NR_FRAME_POINTER_REG,-localsize));
  1679. end;
  1680. end;
  1681. procedure tcg68k.g_proc_exit(list : TAsmList; parasize: longint; nostackframe: boolean);
  1682. var
  1683. r,hregister : TRegister;
  1684. ref : TReference;
  1685. ref2: TReference;
  1686. begin
  1687. if not nostackframe then
  1688. begin
  1689. list.concat(taicpu.op_reg(A_UNLK,S_NO,NR_FRAME_POINTER_REG));
  1690. { if parasize is less than zero here, we probably have a cdecl function.
  1691. According to the info here: http://www.makestuff.eu/wordpress/gcc-68000-abi/
  1692. 68k GCC uses two different methods to free the stack, depending if the target
  1693. architecture supports RTD or not, and one does callee side, the other does
  1694. caller side free, which looks like a PITA to support. We have to figure this
  1695. out later. More info welcomed. (KB) }
  1696. if (parasize > 0) and not (current_procinfo.procdef.proccalloption in clearstack_pocalls) then
  1697. begin
  1698. if CPUM68K_HAS_RTD in cpu_capabilities[current_settings.cputype] then
  1699. list.concat(taicpu.op_const(A_RTD,S_NO,parasize))
  1700. else
  1701. begin
  1702. { We must pull the PC Counter from the stack, before }
  1703. { restoring the stack pointer, otherwise the PC would }
  1704. { point to nowhere! }
  1705. { Instead of doing a slow copy of the return address while trying }
  1706. { to feed it to the RTS instruction, load the PC to A1 (scratch reg) }
  1707. { then free up the stack allocated for paras, then use a JMP (A1) to }
  1708. { return to the caller with the paras freed. (KB) }
  1709. hregister:=NR_A1;
  1710. cg.a_reg_alloc(list,hregister);
  1711. reference_reset_base(ref,NR_STACK_POINTER_REG,0,ctempposinvalid,4,[]);
  1712. list.concat(taicpu.op_ref_reg(A_MOVE,S_L,ref,hregister));
  1713. { instead of using a postincrement above (which also writes the }
  1714. { stackpointer reg) simply add 4 to the parasize, the instructions }
  1715. { below then take that size into account as well, so SP reg is only }
  1716. { written once (KB) }
  1717. parasize:=parasize+4;
  1718. r:=NR_SP;
  1719. { can we do a quick addition ... }
  1720. if (parasize < 9) then
  1721. list.concat(taicpu.op_const_reg(A_ADDQ,S_L,parasize,r))
  1722. else { nope ... }
  1723. begin
  1724. reference_reset_base(ref2,NR_STACK_POINTER_REG,parasize,ctempposinvalid,4,[]);
  1725. list.concat(taicpu.op_ref_reg(A_LEA,S_NO,ref2,r));
  1726. end;
  1727. reference_reset_base(ref,hregister,0,ctempposinvalid,4,[]);
  1728. list.concat(taicpu.op_ref(A_JMP,S_NO,ref));
  1729. end;
  1730. end
  1731. else
  1732. list.concat(taicpu.op_none(A_RTS,S_NO));
  1733. end
  1734. else
  1735. begin
  1736. list.concat(taicpu.op_none(A_RTS,S_NO));
  1737. end;
  1738. { Routines with the poclearstack flag set use only a ret.
  1739. also routines with parasize=0 }
  1740. { TODO: figure out if these are still relevant to us (KB) }
  1741. (*
  1742. if current_procinfo.procdef.proccalloption in clearstack_pocalls then
  1743. begin
  1744. { complex return values are removed from stack in C code PM }
  1745. if paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then
  1746. list.concat(taicpu.op_const(A_RTD,S_NO,4))
  1747. else
  1748. list.concat(taicpu.op_none(A_RTS,S_NO));
  1749. end
  1750. else if (parasize=0) then
  1751. begin
  1752. list.concat(taicpu.op_none(A_RTS,S_NO));
  1753. end
  1754. else
  1755. *)
  1756. end;
  1757. procedure tcg68k.g_save_registers(list:TAsmList);
  1758. var
  1759. dataregs: tcpuregisterset;
  1760. addrregs: tcpuregisterset;
  1761. fpuregs: tcpuregisterset;
  1762. href : treference;
  1763. hreg : tregister;
  1764. hfreg : tregister;
  1765. size : longint;
  1766. fsize : longint;
  1767. r : integer;
  1768. regs_to_save_int,
  1769. regs_to_save_address,
  1770. regs_to_save_fpu: tcpuregisterarray;
  1771. begin
  1772. { The code generated by the section below, particularly the movem.l
  1773. instruction is known to cause an issue when compiled by some GNU
  1774. assembler versions (I had it with 2.17, while 2.24 seems OK.)
  1775. when you run into this problem, just call inherited here instead
  1776. to skip the movem.l generation. But better just use working GNU
  1777. AS version instead. (KB) }
  1778. dataregs:=[];
  1779. addrregs:=[];
  1780. fpuregs:=[];
  1781. regs_to_save_int:=paramanager.get_saved_registers_int(current_procinfo.procdef.proccalloption);
  1782. regs_to_save_address:=paramanager.get_saved_registers_address(current_procinfo.procdef.proccalloption);
  1783. regs_to_save_fpu:=paramanager.get_saved_registers_fpu(current_procinfo.procdef.proccalloption);
  1784. { calculate temp. size }
  1785. size:=0;
  1786. fsize:=0;
  1787. hreg:=NR_NO;
  1788. hfreg:=NR_NO;
  1789. for r:=low(regs_to_save_int) to high(regs_to_save_int) do
  1790. if regs_to_save_int[r] in rg[R_INTREGISTER].used_in_proc then
  1791. begin
  1792. hreg:=newreg(R_INTREGISTER,regs_to_save_int[r],R_SUBWHOLE);
  1793. inc(size,sizeof(aint));
  1794. dataregs:=dataregs + [regs_to_save_int[r]];
  1795. end;
  1796. if uses_registers(R_ADDRESSREGISTER) then
  1797. for r:=low(regs_to_save_address) to high(regs_to_save_address) do
  1798. if regs_to_save_address[r] in rg[R_ADDRESSREGISTER].used_in_proc then
  1799. begin
  1800. hreg:=newreg(R_ADDRESSREGISTER,regs_to_save_address[r],R_SUBWHOLE);
  1801. inc(size,sizeof(aint));
  1802. addrregs:=addrregs + [regs_to_save_address[r]];
  1803. end;
  1804. if uses_registers(R_FPUREGISTER) then
  1805. for r:=low(regs_to_save_fpu) to high(regs_to_save_fpu) do
  1806. if regs_to_save_fpu[r] in rg[R_FPUREGISTER].used_in_proc then
  1807. begin
  1808. hfreg:=newreg(R_FPUREGISTER,regs_to_save_fpu[r],R_SUBNONE);
  1809. inc(fsize,fpuregsize);
  1810. fpuregs:=fpuregs + [regs_to_save_fpu[r]];
  1811. end;
  1812. { 68k has no MM registers }
  1813. if uses_registers(R_MMREGISTER) then
  1814. internalerror(2014030201);
  1815. if (size+fsize) > 0 then
  1816. begin
  1817. tg.GetTemp(list,size+fsize,sizeof(aint),tt_noreuse,current_procinfo.save_regs_ref);
  1818. include(current_procinfo.flags,pi_has_saved_regs);
  1819. { Copy registers to temp }
  1820. { NOTE: virtual registers allocated here won't be translated --> no higher-level stuff. }
  1821. href:=current_procinfo.save_regs_ref;
  1822. if (href.offset<low(smallint)) and (current_settings.cputype in cpu_coldfire+[cpu_mc68000]) then
  1823. begin
  1824. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,href.base,NR_A0));
  1825. list.concat(taicpu.op_const_reg(A_ADDA,S_L,href.offset,NR_A0));
  1826. reference_reset_base(href,NR_A0,0,ctempposinvalid,sizeof(pint),[]);
  1827. end;
  1828. if size > 0 then
  1829. if size = sizeof(aint) then
  1830. list.concat(taicpu.op_reg_ref(A_MOVE,S_L,hreg,href))
  1831. else
  1832. list.concat(taicpu.op_regset_ref(A_MOVEM,S_L,dataregs,addrregs,[],href));
  1833. if fsize > 0 then
  1834. begin
  1835. { size is always longword aligned, while fsize is not }
  1836. inc(href.offset,size);
  1837. if fsize = fpuregsize then
  1838. list.concat(taicpu.op_reg_ref(A_FMOVE,fpuregopsize,hfreg,href))
  1839. else
  1840. list.concat(taicpu.op_regset_ref(A_FMOVEM,fpuregopsize,[],[],fpuregs,href));
  1841. end;
  1842. end;
  1843. end;
  1844. procedure tcg68k.g_restore_registers(list:TAsmList);
  1845. var
  1846. dataregs: tcpuregisterset;
  1847. addrregs: tcpuregisterset;
  1848. fpuregs : tcpuregisterset;
  1849. href : treference;
  1850. r : integer;
  1851. hreg : tregister;
  1852. hfreg : tregister;
  1853. size : longint;
  1854. fsize : longint;
  1855. regs_to_save_int,
  1856. regs_to_save_address,
  1857. regs_to_save_fpu: tcpuregisterarray;
  1858. begin
  1859. { see the remark about buggy GNU AS versions in g_save_registers() (KB) }
  1860. dataregs:=[];
  1861. addrregs:=[];
  1862. fpuregs:=[];
  1863. if not(pi_has_saved_regs in current_procinfo.flags) then
  1864. exit;
  1865. regs_to_save_int:=paramanager.get_saved_registers_int(current_procinfo.procdef.proccalloption);
  1866. regs_to_save_address:=paramanager.get_saved_registers_address(current_procinfo.procdef.proccalloption);
  1867. regs_to_save_fpu:=paramanager.get_saved_registers_fpu(current_procinfo.procdef.proccalloption);
  1868. { Copy registers from temp }
  1869. size:=0;
  1870. fsize:=0;
  1871. hreg:=NR_NO;
  1872. hfreg:=NR_NO;
  1873. for r:=low(regs_to_save_int) to high(regs_to_save_int) do
  1874. if regs_to_save_int[r] in rg[R_INTREGISTER].used_in_proc then
  1875. begin
  1876. inc(size,sizeof(aint));
  1877. hreg:=newreg(R_INTREGISTER,regs_to_save_int[r],R_SUBWHOLE);
  1878. { Allocate register so the optimizer does not remove the load }
  1879. a_reg_alloc(list,hreg);
  1880. dataregs:=dataregs + [regs_to_save_int[r]];
  1881. end;
  1882. if uses_registers(R_ADDRESSREGISTER) then
  1883. for r:=low(regs_to_save_address) to high(regs_to_save_address) do
  1884. if regs_to_save_address[r] in rg[R_ADDRESSREGISTER].used_in_proc then
  1885. begin
  1886. inc(size,sizeof(aint));
  1887. hreg:=newreg(R_ADDRESSREGISTER,regs_to_save_address[r],R_SUBWHOLE);
  1888. { Allocate register so the optimizer does not remove the load }
  1889. a_reg_alloc(list,hreg);
  1890. addrregs:=addrregs + [regs_to_save_address[r]];
  1891. end;
  1892. if uses_registers(R_FPUREGISTER) then
  1893. for r:=low(regs_to_save_fpu) to high(regs_to_save_fpu) do
  1894. if regs_to_save_fpu[r] in rg[R_FPUREGISTER].used_in_proc then
  1895. begin
  1896. inc(fsize,fpuregsize);
  1897. hfreg:=newreg(R_FPUREGISTER,regs_to_save_fpu[r],R_SUBNONE);
  1898. { Allocate register so the optimizer does not remove the load }
  1899. a_reg_alloc(list,hfreg);
  1900. fpuregs:=fpuregs + [regs_to_save_fpu[r]];
  1901. end;
  1902. { 68k has no MM registers }
  1903. if uses_registers(R_MMREGISTER) then
  1904. internalerror(2014030202);
  1905. { Restore registers from temp }
  1906. href:=current_procinfo.save_regs_ref;
  1907. if (href.offset<low(smallint)) and (current_settings.cputype in cpu_coldfire+[cpu_mc68000]) then
  1908. begin
  1909. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,href.base,NR_A0));
  1910. list.concat(taicpu.op_const_reg(A_ADDA,S_L,href.offset,NR_A0));
  1911. reference_reset_base(href,NR_A0,0,ctempposinvalid,sizeof(pint),[]);
  1912. end;
  1913. if size > 0 then
  1914. if size = sizeof(aint) then
  1915. list.concat(taicpu.op_ref_reg(A_MOVE,S_L,href,hreg))
  1916. else
  1917. list.concat(taicpu.op_ref_regset(A_MOVEM,S_L,href,dataregs,addrregs,[]));
  1918. if fsize > 0 then
  1919. begin
  1920. { size is always longword aligned, while fsize is not }
  1921. inc(href.offset,size);
  1922. if fsize = fpuregsize then
  1923. list.concat(taicpu.op_ref_reg(A_FMOVE,fpuregopsize,href,hfreg))
  1924. else
  1925. list.concat(taicpu.op_ref_regset(A_FMOVEM,fpuregopsize,href,[],[],fpuregs));
  1926. end;
  1927. tg.UnGetTemp(list,current_procinfo.save_regs_ref);
  1928. end;
  1929. procedure tcg68k.sign_extend(list: TAsmList;_oldsize : tcgsize; _newsize : tcgsize; reg: tregister);
  1930. begin
  1931. case _newsize of
  1932. OS_S16, OS_16:
  1933. case _oldsize of
  1934. OS_S8:
  1935. begin { 8 -> 16 bit sign extend }
  1936. if (isaddressregister(reg)) then
  1937. internalerror(2014031201);
  1938. list.concat(taicpu.op_reg(A_EXT,S_W,reg));
  1939. end;
  1940. OS_8: { 8 -> 16 bit zero extend }
  1941. begin
  1942. if (current_settings.cputype in cpu_coldfire) then
  1943. { ColdFire has no ANDI.W }
  1944. list.concat(taicpu.op_const_reg(A_AND,S_L,$FF,reg))
  1945. else
  1946. list.concat(taicpu.op_const_reg(A_AND,S_W,$FF,reg));
  1947. end;
  1948. end;
  1949. OS_S32, OS_32:
  1950. case _oldsize of
  1951. OS_S8:
  1952. begin { 8 -> 32 bit sign extend }
  1953. if (isaddressregister(reg)) then
  1954. internalerror(2014031202);
  1955. if (current_settings.cputype = cpu_MC68000) then
  1956. begin
  1957. list.concat(taicpu.op_reg(A_EXT,S_W,reg));
  1958. list.concat(taicpu.op_reg(A_EXT,S_L,reg));
  1959. end
  1960. else
  1961. begin
  1962. //list.concat(tai_comment.create(strpnew('sign extend byte')));
  1963. list.concat(taicpu.op_reg(A_EXTB,S_L,reg));
  1964. end;
  1965. end;
  1966. OS_8: { 8 -> 32 bit zero extend }
  1967. begin
  1968. if (isaddressregister(reg)) then
  1969. internalerror(2015031501);
  1970. //list.concat(tai_comment.create(strpnew('zero extend byte')));
  1971. list.concat(taicpu.op_const_reg(A_AND,S_L,$FF,reg));
  1972. end;
  1973. OS_S16: { 16 -> 32 bit sign extend }
  1974. begin
  1975. { address registers are sign-extended from 16->32 bit anyway
  1976. automagically on every W operation by the CPU, so this is a NOP }
  1977. if not isaddressregister(reg) then
  1978. begin
  1979. //list.concat(tai_comment.create(strpnew('sign extend word')));
  1980. list.concat(taicpu.op_reg(A_EXT,S_L,reg));
  1981. end;
  1982. end;
  1983. OS_16:
  1984. begin
  1985. if (isaddressregister(reg)) then
  1986. internalerror(2015031502);
  1987. //list.concat(tai_comment.create(strpnew('zero extend word')));
  1988. list.concat(taicpu.op_const_reg(A_AND,S_L,$FFFF,reg));
  1989. end;
  1990. end;
  1991. end; { otherwise the size is already correct }
  1992. end;
  1993. procedure tcg68k.sign_extend(list: TAsmList;_oldsize : tcgsize; reg: tregister);
  1994. begin
  1995. sign_extend(list, _oldsize, OS_INT, reg);
  1996. end;
  1997. procedure tcg68k.a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel);
  1998. var
  1999. ai : taicpu;
  2000. begin
  2001. if cond=OC_None then
  2002. ai := Taicpu.Op_sym(A_JMP,S_NO,l)
  2003. else
  2004. begin
  2005. ai:=Taicpu.Op_sym(A_Bxx,S_NO,l);
  2006. ai.SetCondition(TOpCmp2AsmCond[cond]);
  2007. end;
  2008. ai.is_jmp:=true;
  2009. list.concat(ai);
  2010. end;
  2011. { ensures a register is a dataregister. this is often used, as 68k can't do lots of
  2012. operations on an address register. if the register is a dataregister anyway, it
  2013. just returns it untouched.}
  2014. function tcg68k.force_to_dataregister(list: TAsmList; size: TCGSize; reg: TRegister): TRegister;
  2015. var
  2016. scratch_reg: TRegister;
  2017. instr: Taicpu;
  2018. begin
  2019. if isaddressregister(reg) then
  2020. begin
  2021. scratch_reg:=getintregister(list,OS_INT);
  2022. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg,scratch_reg);
  2023. add_move_instruction(instr);
  2024. list.concat(instr);
  2025. result:=scratch_reg;
  2026. end
  2027. else
  2028. result:=reg;
  2029. end;
  2030. { moves source register to destination register, if the two are not the same. can be used in pair
  2031. with force_to_dataregister() }
  2032. procedure tcg68k.move_if_needed(list: TAsmList; size: TCGSize; src: TRegister; dest: TRegister);
  2033. var
  2034. instr: Taicpu;
  2035. begin
  2036. if (src <> dest) then
  2037. begin
  2038. instr:=taicpu.op_reg_reg(A_MOVE,S_L,src,dest);
  2039. add_move_instruction(instr);
  2040. list.concat(instr);
  2041. end;
  2042. end;
  2043. procedure tcg68k.g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: tcgint);
  2044. var
  2045. hsym : tsym;
  2046. href : treference;
  2047. paraloc : Pcgparalocation;
  2048. begin
  2049. { calculate the parameter info for the procdef }
  2050. procdef.init_paraloc_info(callerside);
  2051. hsym:=tsym(procdef.parast.Find('self'));
  2052. if not(assigned(hsym) and
  2053. (hsym.typ=paravarsym)) then
  2054. internalerror(2013100702);
  2055. paraloc:=tparavarsym(hsym).paraloc[callerside].location;
  2056. while paraloc<>nil do
  2057. with paraloc^ do
  2058. begin
  2059. case loc of
  2060. LOC_REGISTER:
  2061. a_op_const_reg(list,OP_SUB,size,ioffset,register);
  2062. LOC_REFERENCE:
  2063. begin
  2064. { offset in the wrapper needs to be adjusted for the stored
  2065. return address }
  2066. reference_reset_base(href,reference.index,reference.offset+sizeof(pint),ctempposinvalid,sizeof(pint),[]);
  2067. { plain 68k could use SUBI on href directly, but this way it works on Coldfire too
  2068. and it's probably smaller code for the majority of cases (if ioffset small, the
  2069. load will use MOVEQ) (KB) }
  2070. a_load_const_reg(list,OS_ADDR,ioffset,NR_D0);
  2071. list.concat(taicpu.op_reg_ref(A_SUB,S_L,NR_D0,href));
  2072. end
  2073. else
  2074. internalerror(2013100703);
  2075. end;
  2076. paraloc:=next;
  2077. end;
  2078. end;
  2079. procedure tcg68k.g_stackpointer_alloc(list : TAsmList;localsize : longint);
  2080. begin
  2081. list.concat(taicpu.op_const_reg(A_SUB,S_L,localsize,NR_STACK_POINTER_REG));
  2082. end;
  2083. procedure tcg68k.check_register_size(size:tcgsize;reg:tregister);
  2084. begin
  2085. if TCGSize2OpSize[size]<>TCGSize2OpSize[reg_cgsize(reg)] then
  2086. internalerror(201512131);
  2087. end;
  2088. function tcg68k.optimize_const_mul_to_shift_sub_add(list: TAsmList; maxops: longint; a: tcgint; size: tcgsize; reg: TRegister): boolean;
  2089. var
  2090. i: longint;
  2091. nextpower: tcgint;
  2092. powerbit: longint;
  2093. submask: tcgint;
  2094. lastshift: longint;
  2095. hreg: tregister;
  2096. firstmov: boolean;
  2097. begin
  2098. nextpower:=nextpowerof2(a,powerbit);
  2099. submask:=nextpower-a;
  2100. result:=not ((popcnt(qword(a)) > maxops) and ((popcnt(qword(submask))+1) > maxops));
  2101. if not result then
  2102. exit;
  2103. list.concat(tai_comment.create(strpnew('optimize_const_mul_to_shift_sub_add, multiplier: '+tostr(a))));
  2104. lastshift:=0;
  2105. hreg:=getintregister(list,OS_INT);
  2106. if (popcnt(qword(a)) < (popcnt(qword(submask))+1)) then
  2107. begin
  2108. { doing additions }
  2109. firstmov:=(a and 1) = 0;
  2110. if not firstmov then
  2111. a_load_reg_reg(list,size,OS_INT,reg,hreg);
  2112. for i:=1 to bsrqword(a) do
  2113. if ((a shr i) and 1) = 1 then
  2114. begin
  2115. if firstmov then
  2116. begin
  2117. a_op_const_reg(list,OP_SHL,OS_INT,i-lastshift,reg);
  2118. a_load_reg_reg(list,OS_INT,OS_INT,reg,hreg);
  2119. firstmov:=false;
  2120. end
  2121. else
  2122. begin
  2123. a_op_const_reg(list,OP_SHL,OS_INT,i-lastshift,hreg);
  2124. a_op_reg_reg(list,OP_ADD,OS_INT,hreg,reg);
  2125. end;
  2126. lastshift:=i;
  2127. end;
  2128. end
  2129. else
  2130. begin
  2131. { doing subtractions }
  2132. a_load_const_reg(list,OS_INT,0,hreg);
  2133. for i:=0 to bsrqword(submask) do
  2134. if ((submask shr i) and 1) = 1 then
  2135. begin
  2136. a_op_const_reg(list,OP_SHL,OS_INT,i-lastshift,reg);
  2137. a_op_reg_reg(list,OP_SUB,OS_INT,reg,hreg);
  2138. lastshift:=i;
  2139. end;
  2140. a_op_const_reg(list,OP_SHL,OS_INT,powerbit-lastshift,reg);
  2141. a_op_reg_reg(list,OP_ADD,OS_INT,hreg,reg);
  2142. end;
  2143. result:=true;
  2144. end;
  2145. {****************************************************************************}
  2146. { TCG64F68K }
  2147. {****************************************************************************}
  2148. procedure tcg64f68k.a_op64_reg_reg(list : TAsmList;op:TOpCG;size: tcgsize; regsrc,regdst : tregister64);
  2149. var
  2150. opcode : tasmop;
  2151. xopcode : tasmop;
  2152. instr : taicpu;
  2153. begin
  2154. opcode := topcg2tasmop[op];
  2155. xopcode := topcg2tasmopx[op];
  2156. case op of
  2157. OP_ADD,OP_SUB:
  2158. begin
  2159. { if one of these three registers is an address
  2160. register, we'll really get into problems! }
  2161. if isaddressregister(regdst.reglo) or
  2162. isaddressregister(regdst.reghi) or
  2163. isaddressregister(regsrc.reghi) then
  2164. internalerror(2014030101);
  2165. list.concat(taicpu.op_reg_reg(opcode,S_L,regsrc.reglo,regdst.reglo));
  2166. list.concat(taicpu.op_reg_reg(xopcode,S_L,regsrc.reghi,regdst.reghi));
  2167. end;
  2168. OP_AND,OP_OR:
  2169. begin
  2170. { at least one of the registers must be a data register }
  2171. if (isaddressregister(regdst.reglo) and
  2172. isaddressregister(regsrc.reglo)) or
  2173. (isaddressregister(regsrc.reghi) and
  2174. isaddressregister(regdst.reghi)) then
  2175. internalerror(2014030102);
  2176. cg.a_op_reg_reg(list,op,OS_32,regsrc.reglo,regdst.reglo);
  2177. cg.a_op_reg_reg(list,op,OS_32,regsrc.reghi,regdst.reghi);
  2178. end;
  2179. { this is handled in 1st pass for 32-bit cpu's (helper call) }
  2180. OP_IDIV,OP_DIV,
  2181. OP_IMUL,OP_MUL:
  2182. internalerror(2002081701);
  2183. { this is also handled in 1st pass for 32-bit cpu's (helper call) }
  2184. OP_SAR,OP_SHL,OP_SHR:
  2185. internalerror(2002081702);
  2186. OP_XOR:
  2187. begin
  2188. if isaddressregister(regdst.reglo) or
  2189. isaddressregister(regsrc.reglo) or
  2190. isaddressregister(regsrc.reghi) or
  2191. isaddressregister(regdst.reghi) then
  2192. internalerror(2014030103);
  2193. cg.a_op_reg_reg(list,op,OS_32,regsrc.reglo,regdst.reglo);
  2194. cg.a_op_reg_reg(list,op,OS_32,regsrc.reghi,regdst.reghi);
  2195. end;
  2196. OP_NEG,OP_NOT:
  2197. begin
  2198. if isaddressregister(regdst.reglo) or
  2199. isaddressregister(regdst.reghi) then
  2200. internalerror(2014030104);
  2201. instr:=taicpu.op_reg_reg(A_MOVE,S_L,regsrc.reglo,regdst.reglo);
  2202. cg.add_move_instruction(instr);
  2203. list.concat(instr);
  2204. instr:=taicpu.op_reg_reg(A_MOVE,S_L,regsrc.reghi,regdst.reghi);
  2205. cg.add_move_instruction(instr);
  2206. list.concat(instr);
  2207. if (op = OP_NOT) then
  2208. xopcode:=opcode;
  2209. list.concat(taicpu.op_reg(opcode,S_L,regdst.reglo));
  2210. list.concat(taicpu.op_reg(xopcode,S_L,regdst.reghi));
  2211. end;
  2212. end; { end case }
  2213. end;
  2214. procedure tcg64f68k.a_op64_ref_reg(list : TAsmList;op:TOpCG;size : tcgsize;const ref : treference;reg : tregister64);
  2215. var
  2216. href : treference;
  2217. hreg: tregister;
  2218. begin
  2219. case op of
  2220. OP_NEG,OP_NOT:
  2221. begin
  2222. a_load64_ref_reg(list,ref,reg);
  2223. a_op64_reg_reg(list,op,size,reg,reg);
  2224. end;
  2225. OP_AND,OP_OR:
  2226. begin
  2227. href:=ref;
  2228. tcg68k(cg).fixref(list,href,false);
  2229. list.concat(taicpu.op_ref_reg(topcg2tasmop[op],S_L,href,reg.reghi));
  2230. inc(href.offset,4);
  2231. list.concat(taicpu.op_ref_reg(topcg2tasmop[op],S_L,href,reg.reglo));
  2232. end;
  2233. OP_ADD,OP_SUB:
  2234. begin
  2235. href:=ref;
  2236. tcg68k(cg).fixref(list,href,false);
  2237. hreg:=cg.getintregister(list,OS_32);
  2238. cg.a_load_ref_reg(list,OS_32,OS_32,href,hreg);
  2239. inc(href.offset,4);
  2240. list.concat(taicpu.op_ref_reg(topcg2tasmop[op],S_L,href,reg.reglo));
  2241. list.concat(taicpu.op_reg_reg(topcg2tasmopx[op],S_L,hreg,reg.reghi));
  2242. end;
  2243. else
  2244. { XOR does not allow reference for source; ADD/SUB do not allow reference for
  2245. high dword, although low dword can still be handled directly. }
  2246. inherited a_op64_ref_reg(list,op,size,ref,reg);
  2247. end;
  2248. end;
  2249. procedure tcg64f68k.a_op64_reg_ref(list : TAsmList;op:TOpCG;size : tcgsize;reg : tregister64;const ref : treference);
  2250. var
  2251. href: treference;
  2252. hreg: tregister;
  2253. begin
  2254. case op of
  2255. OP_AND,OP_OR,OP_XOR:
  2256. begin
  2257. href:=ref;
  2258. tcg68k(cg).fixref(list,href,false);
  2259. list.concat(taicpu.op_reg_ref(topcg2tasmop[op],S_L,reg.reghi,href));
  2260. inc(href.offset,4);
  2261. list.concat(taicpu.op_reg_ref(topcg2tasmop[op],S_L,reg.reglo,href));
  2262. end;
  2263. OP_ADD,OP_SUB:
  2264. begin
  2265. href:=ref;
  2266. tcg68k(cg).fixref(list,href,false);
  2267. hreg:=cg.getintregister(list,OS_32);
  2268. cg.a_load_ref_reg(list,OS_32,OS_32,href,hreg);
  2269. inc(href.offset,4);
  2270. list.concat(taicpu.op_reg_ref(topcg2tasmop[op],S_L,reg.reglo,href));
  2271. list.concat(taicpu.op_reg_reg(topcg2tasmopx[op],S_L,reg.reghi,hreg));
  2272. dec(href.offset,4);
  2273. cg.a_load_reg_ref(list,OS_32,OS_32,hreg,href);
  2274. end;
  2275. else
  2276. inherited a_op64_reg_ref(list,op,size,reg,ref);
  2277. end;
  2278. end;
  2279. procedure tcg64f68k.a_op64_const_reg(list : TAsmList;op:TOpCG;size: tcgsize; value : int64;regdst : tregister64);
  2280. var
  2281. lowvalue : cardinal;
  2282. highvalue : cardinal;
  2283. opcode : tasmop;
  2284. xopcode : tasmop;
  2285. hreg : tregister;
  2286. begin
  2287. { is it optimized out ? }
  2288. { optimize64_op_const_reg doesn't seem to be used in any cg64f32 right now. why? (KB) }
  2289. { if cg.optimize64_op_const_reg(list,op,value,reg) then
  2290. exit; }
  2291. lowvalue := cardinal(value);
  2292. highvalue := value shr 32;
  2293. opcode := topcg2tasmop[op];
  2294. xopcode := topcg2tasmopx[op];
  2295. { the destination registers must be data registers }
  2296. if isaddressregister(regdst.reglo) or
  2297. isaddressregister(regdst.reghi) then
  2298. internalerror(2014030105);
  2299. case op of
  2300. OP_ADD,OP_SUB:
  2301. begin
  2302. hreg:=cg.getintregister(list,OS_INT);
  2303. { cg.a_load_const_reg provides optimized loading to register for special cases }
  2304. cg.a_load_const_reg(list,OS_S32,tcgint(highvalue),hreg);
  2305. { don't use cg.a_op_const_reg() here, because a possible optimized
  2306. ADDQ/SUBQ wouldn't set the eXtend bit }
  2307. list.concat(taicpu.op_const_reg(opcode,S_L,tcgint(lowvalue),regdst.reglo));
  2308. list.concat(taicpu.op_reg_reg(xopcode,S_L,hreg,regdst.reghi));
  2309. end;
  2310. OP_AND,OP_OR,OP_XOR:
  2311. begin
  2312. cg.a_op_const_reg(list,op,OS_S32,tcgint(lowvalue),regdst.reglo);
  2313. cg.a_op_const_reg(list,op,OS_S32,tcgint(highvalue),regdst.reghi);
  2314. end;
  2315. { this is handled in 1st pass for 32-bit cpus (helper call) }
  2316. OP_IDIV,OP_DIV,
  2317. OP_IMUL,OP_MUL:
  2318. internalerror(2002081701);
  2319. { this is also handled in 1st pass for 32-bit cpus (helper call) }
  2320. OP_SAR,OP_SHL,OP_SHR:
  2321. internalerror(2002081702);
  2322. { these should have been handled already by earlier passes }
  2323. OP_NOT,OP_NEG:
  2324. internalerror(2012110403);
  2325. end; { end case }
  2326. end;
  2327. procedure tcg64f68k.a_load64_reg_ref(list : TAsmList;reg : tregister64;const ref : treference);
  2328. var
  2329. tmpref: treference;
  2330. begin
  2331. tmpref:=ref;
  2332. tcg68k(cg).fixref(list,tmpref,false);
  2333. cg.a_load_reg_ref(list,OS_32,OS_32,reg.reghi,tmpref);
  2334. inc(tmpref.offset,4);
  2335. cg.a_load_reg_ref(list,OS_32,OS_32,reg.reglo,tmpref);
  2336. end;
  2337. procedure tcg64f68k.a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64);
  2338. var
  2339. tmpref: treference;
  2340. begin
  2341. { do not allow 64bit values to be loaded to address registers }
  2342. if isaddressregister(reg.reglo) or
  2343. isaddressregister(reg.reghi) then
  2344. internalerror(2016050501);
  2345. tmpref:=ref;
  2346. tcg68k(cg).fixref(list,tmpref,false);
  2347. cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reghi);
  2348. inc(tmpref.offset,4);
  2349. cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reglo);
  2350. end;
  2351. procedure create_codegen;
  2352. begin
  2353. cg := tcg68k.create;
  2354. cg64 :=tcg64f68k.create;
  2355. end;
  2356. end.