cgcpu.pas 79 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105
  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. {DEFINE DEBUG_CHARLIE}
  18. {$IFNDEF DEBUG_CHARLIE}
  19. {$WARNINGS OFF}
  20. {$ENDIF}
  21. unit cgcpu;
  22. {$i fpcdefs.inc}
  23. interface
  24. uses
  25. cgbase,cgobj,globtype,
  26. aasmbase,aasmtai,aasmdata,aasmcpu,
  27. cpubase,cpuinfo,
  28. parabase,cpupara,
  29. node,symconst,symtype,symdef,
  30. cgutils,cg64f32;
  31. type
  32. tcg68k = class(tcg)
  33. procedure init_register_allocators;override;
  34. procedure done_register_allocators;override;
  35. procedure a_load_reg_cgpara(list : TAsmList;size : tcgsize;r : tregister;const cgpara : tcgpara);override;
  36. procedure a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const cgpara : tcgpara);override;
  37. procedure a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : tcgpara);override;
  38. procedure a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const cgpara : tcgpara);override;
  39. procedure a_call_name(list : TAsmList;const s : string; weak: boolean);override;
  40. procedure a_call_reg(list : TAsmList;reg : tregister);override;
  41. procedure a_load_const_reg(list : TAsmList;size : tcgsize;a : tcgint;register : tregister);override;
  42. procedure a_load_const_ref(list : TAsmList; tosize: tcgsize; a : tcgint;const ref : treference);override;
  43. procedure a_load_reg_ref(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);override;
  44. procedure a_load_reg_reg(list : TAsmList;fromsize,tosize : tcgsize;reg1,reg2 : tregister);override;
  45. procedure a_load_ref_reg(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);override;
  46. procedure a_load_ref_ref(list : TAsmList;fromsize,tosize : tcgsize;const sref : treference;const dref : treference);override;
  47. procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);override;
  48. procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); override;
  49. procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); override;
  50. procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); override;
  51. procedure a_loadmm_reg_reg(list: TAsmList;fromsize,tosize : tcgsize; reg1, reg2: tregister;shuffle : pmmshuffle); override;
  52. procedure a_loadmm_ref_reg(list: TAsmList;fromsize,tosize : tcgsize; const ref: treference; reg: tregister;shuffle : pmmshuffle); override;
  53. procedure a_loadmm_reg_ref(list: TAsmList;fromsize,tosize : tcgsize; reg: tregister; const ref: treference;shuffle : pmmshuffle); override;
  54. procedure a_loadmm_reg_cgpara(list: TAsmList; size: tcgsize; reg: tregister;const locpara : TCGPara;shuffle : pmmshuffle); override;
  55. procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: tcgsize; a: tcgint; reg: TRegister); override;
  56. // procedure a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference); override;
  57. procedure a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); override;
  58. procedure a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister;
  59. l : tasmlabel);override;
  60. procedure a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override;
  61. procedure a_jmp_name(list : TAsmList;const s : string); override;
  62. procedure a_jmp_always(list : TAsmList;l: tasmlabel); override;
  63. procedure a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel); override;
  64. procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: tresflags; reg: TRegister); override;
  65. procedure g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);override;
  66. { generates overflow checking code for a node }
  67. procedure g_overflowcheck(list: TAsmList; const l:tlocation; def:tdef); override;
  68. procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);override;
  69. procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);override;
  70. // procedure g_restore_frame_pointer(list : TAsmList);override;
  71. // procedure g_return_from_proc(list : TAsmList;parasize : tcgint);override;
  72. procedure g_restore_registers(list:TAsmList);override;
  73. procedure g_save_registers(list:TAsmList);override;
  74. // procedure g_save_all_registers(list : TAsmList);override;
  75. // procedure g_restore_all_registers(list : TAsmList;const funcretparaloc:TCGPara);override;
  76. procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
  77. protected
  78. function fixref(list: TAsmList; var ref: treference): boolean;
  79. private
  80. { # Sign or zero extend the register to a full 32-bit value.
  81. The new value is left in the same register.
  82. }
  83. procedure sign_extend(list: TAsmList;_oldsize : tcgsize; reg: tregister);
  84. procedure a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel);
  85. end;
  86. tcg64f68k = class(tcg64f32)
  87. procedure a_op64_reg_reg(list : TAsmList;op:TOpCG; size: tcgsize; regsrc,regdst : tregister64);override;
  88. procedure a_op64_const_reg(list : TAsmList;op:TOpCG; size: tcgsize; value : int64;regdst : tregister64);override;
  89. end;
  90. { This function returns true if the reference+offset is valid.
  91. Otherwise extra code must be generated to solve the reference.
  92. On the m68k, this verifies that the reference is valid
  93. (e.g : if index register is used, then the max displacement
  94. is 256 bytes, if only base is used, then max displacement
  95. is 32K
  96. }
  97. function isvalidrefoffset(const ref: treference): boolean;
  98. const
  99. TCGSize2OpSize: Array[tcgsize] of topsize =
  100. (S_NO,S_B,S_W,S_L,S_L,S_NO,S_B,S_W,S_L,S_L,S_NO,
  101. S_FS,S_FD,S_FX,S_NO,S_NO,
  102. S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,
  103. S_NO,S_NO,S_NO,S_NO,S_NO,S_NO);
  104. procedure create_codegen;
  105. implementation
  106. uses
  107. globals,verbose,systems,cutils,
  108. symsym,defutil,paramgr,procinfo,
  109. rgobj,tgobj,rgcpu,fmodule;
  110. const
  111. { opcode table lookup }
  112. topcg2tasmop: Array[topcg] of tasmop =
  113. (
  114. A_NONE,
  115. A_MOVE,
  116. A_ADD,
  117. A_AND,
  118. A_DIVU,
  119. A_DIVS,
  120. A_MULS,
  121. A_MULU,
  122. A_NEG,
  123. A_NOT,
  124. A_OR,
  125. A_ASR,
  126. A_LSL,
  127. A_LSR,
  128. A_SUB,
  129. A_EOR,
  130. A_NONE,
  131. A_NONE
  132. );
  133. TOpCmp2AsmCond: Array[topcmp] of TAsmCond =
  134. (
  135. C_NONE,
  136. C_EQ,
  137. C_GT,
  138. C_LT,
  139. C_GE,
  140. C_LE,
  141. C_NE,
  142. C_LS,
  143. C_CS,
  144. C_CC,
  145. C_HI
  146. );
  147. function isvalidrefoffset(const ref: treference): boolean;
  148. begin
  149. isvalidrefoffset := true;
  150. if ref.index <> NR_NO then
  151. begin
  152. if ref.base <> NR_NO then
  153. internalerror(2002081401);
  154. if (ref.offset < low(shortint)) or (ref.offset > high(shortint)) then
  155. isvalidrefoffset := false
  156. end
  157. else
  158. begin
  159. if (ref.offset < low(smallint)) or (ref.offset > high(smallint)) then
  160. isvalidrefoffset := false;
  161. end;
  162. end;
  163. {****************************************************************************}
  164. { TCG68K }
  165. {****************************************************************************}
  166. function use_push(const cgpara:tcgpara):boolean;
  167. begin
  168. result:=(not paramanager.use_fixed_stack) and
  169. assigned(cgpara.location) and
  170. (cgpara.location^.loc=LOC_REFERENCE) and
  171. (cgpara.location^.reference.index=NR_STACK_POINTER_REG);
  172. end;
  173. procedure tcg68k.init_register_allocators;
  174. begin
  175. inherited init_register_allocators;
  176. rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,
  177. [RS_D0,RS_D1,RS_D2,RS_D3,RS_D4,RS_D5,RS_D6,RS_D7],
  178. first_int_imreg,[]);
  179. rg[R_ADDRESSREGISTER]:=trgcpu.create(R_ADDRESSREGISTER,R_SUBWHOLE,
  180. [RS_A0,RS_A1,RS_A2,RS_A3,RS_A4,RS_A5,RS_A6],
  181. first_addr_imreg,[]);
  182. rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBNONE,
  183. [RS_FP0,RS_FP1,RS_FP2,RS_FP3,RS_FP4,RS_FP5,RS_FP6,RS_FP7],
  184. first_fpu_imreg,[]);
  185. end;
  186. procedure tcg68k.done_register_allocators;
  187. begin
  188. rg[R_INTREGISTER].free;
  189. rg[R_FPUREGISTER].free;
  190. rg[R_ADDRESSREGISTER].free;
  191. inherited done_register_allocators;
  192. end;
  193. procedure tcg68k.a_load_reg_cgpara(list : TAsmList;size : tcgsize;r : tregister;const cgpara : tcgpara);
  194. var
  195. pushsize : tcgsize;
  196. ref : treference;
  197. begin
  198. {$ifdef DEBUG_CHARLIE}
  199. // writeln('a_load_reg');_cgpara
  200. {$endif DEBUG_CHARLIE}
  201. { it's probably necessary to port this from x86 later, or provide an m68k solution (KB) }
  202. { TODO: FIX ME! check_register_size()}
  203. // check_register_size(size,r);
  204. if use_push(cgpara) then
  205. begin
  206. cgpara.check_simple_location;
  207. if tcgsize2size[cgpara.location^.size]>cgpara.alignment then
  208. pushsize:=cgpara.location^.size
  209. else
  210. pushsize:=int_cgsize(cgpara.alignment);
  211. reference_reset_base(ref, NR_STACK_POINTER_REG, 0, cgpara.alignment);
  212. ref.direction := dir_dec;
  213. list.concat(taicpu.op_reg_ref(A_MOVE,tcgsize2opsize[pushsize],makeregsize(list,r,pushsize),ref));
  214. end
  215. else
  216. inherited a_load_reg_cgpara(list,size,r,cgpara);
  217. end;
  218. procedure tcg68k.a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const cgpara : tcgpara);
  219. var
  220. pushsize : tcgsize;
  221. ref : treference;
  222. begin
  223. {$ifdef DEBUG_CHARLIE}
  224. // writeln('a_load_const');_cgpara
  225. {$endif DEBUG_CHARLIE}
  226. if use_push(cgpara) then
  227. begin
  228. cgpara.check_simple_location;
  229. if tcgsize2size[cgpara.location^.size]>cgpara.alignment then
  230. pushsize:=cgpara.location^.size
  231. else
  232. pushsize:=int_cgsize(cgpara.alignment);
  233. reference_reset_base(ref, NR_STACK_POINTER_REG, 0, cgpara.alignment);
  234. ref.direction := dir_dec;
  235. list.concat(taicpu.op_const_ref(A_MOVE,tcgsize2opsize[pushsize],a,ref));
  236. end
  237. else
  238. inherited a_load_const_cgpara(list,size,a,cgpara);
  239. end;
  240. procedure tcg68k.a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : tcgpara);
  241. procedure pushdata(paraloc:pcgparalocation;ofs:tcgint);
  242. var
  243. pushsize : tcgsize;
  244. tmpreg : tregister;
  245. href : treference;
  246. ref : treference;
  247. begin
  248. if not assigned(paraloc) then
  249. exit;
  250. { TODO: FIX ME!!! this also triggers location bug }
  251. {if (paraloc^.loc<>LOC_REFERENCE) or
  252. (paraloc^.reference.index<>NR_STACK_POINTER_REG) or
  253. (tcgsize2size[paraloc^.size]>sizeof(tcgint)) then
  254. internalerror(200501162);}
  255. { Pushes are needed in reverse order, add the size of the
  256. current location to the offset where to load from. This
  257. prevents wrong calculations for the last location when
  258. the size is not a power of 2 }
  259. if assigned(paraloc^.next) then
  260. pushdata(paraloc^.next,ofs+tcgsize2size[paraloc^.size]);
  261. { Push the data starting at ofs }
  262. href:=r;
  263. inc(href.offset,ofs);
  264. fixref(list,href);
  265. if tcgsize2size[paraloc^.size]>cgpara.alignment then
  266. pushsize:=paraloc^.size
  267. else
  268. pushsize:=int_cgsize(cgpara.alignment);
  269. reference_reset_base(ref, NR_STACK_POINTER_REG, 0, tcgsize2size[paraloc^.size]);
  270. ref.direction := dir_dec;
  271. if tcgsize2size[paraloc^.size]<cgpara.alignment then
  272. begin
  273. tmpreg:=getintregister(list,pushsize);
  274. a_load_ref_reg(list,paraloc^.size,pushsize,href,tmpreg);
  275. list.concat(taicpu.op_reg_ref(A_MOVE,tcgsize2opsize[pushsize],tmpreg,ref));
  276. end
  277. else
  278. list.concat(taicpu.op_ref_ref(A_MOVE,tcgsize2opsize[pushsize],href,ref));
  279. end;
  280. var
  281. len : tcgint;
  282. href : treference;
  283. begin
  284. {$ifdef DEBUG_CHARLIE}
  285. // writeln('a_load_ref');_cgpara
  286. {$endif DEBUG_CHARLIE}
  287. { cgpara.size=OS_NO requires a copy on the stack }
  288. if use_push(cgpara) then
  289. begin
  290. { Record copy? }
  291. if (cgpara.size in [OS_NO,OS_F64]) or (size=OS_NO) then
  292. begin
  293. cgpara.check_simple_location;
  294. len:=align(cgpara.intsize,cgpara.alignment);
  295. g_stackpointer_alloc(list,len);
  296. reference_reset_base(href,NR_STACK_POINTER_REG,0,cgpara.alignment);
  297. g_concatcopy(list,r,href,len);
  298. end
  299. else
  300. begin
  301. if tcgsize2size[cgpara.size]<>tcgsize2size[size] then
  302. internalerror(200501161);
  303. { We need to push the data in reverse order,
  304. therefor we use a recursive algorithm }
  305. pushdata(cgpara.location,0);
  306. end
  307. end
  308. else
  309. inherited a_load_ref_cgpara(list,size,r,cgpara);
  310. end;
  311. procedure tcg68k.a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const cgpara : tcgpara);
  312. var
  313. tmpreg : tregister;
  314. opsize : topsize;
  315. begin
  316. {$ifdef DEBUG_CHARLIE}
  317. // writeln('a_loadaddr_ref');_cgpara
  318. {$endif DEBUG_CHARLIE}
  319. with r do
  320. begin
  321. { i suppose this is not required for m68k (KB) }
  322. // if (segment<>NR_NO) then
  323. // cgmessage(cg_e_cant_use_far_pointer_there);
  324. if not use_push(cgpara) then
  325. begin
  326. cgpara.check_simple_location;
  327. opsize:=tcgsize2opsize[OS_ADDR];
  328. if (segment=NR_NO) and (base=NR_NO) and (index=NR_NO) then
  329. begin
  330. if assigned(symbol) then
  331. // list.concat(Taicpu.Op_sym_ofs(A_PUSH,opsize,symbol,offset))
  332. else;
  333. // list.concat(Taicpu.Op_const(A_PUSH,opsize,offset));
  334. end
  335. else if (segment=NR_NO) and (base=NR_NO) and (index<>NR_NO) and
  336. (offset=0) and (scalefactor=0) and (symbol=nil) then
  337. // list.concat(Taicpu.Op_reg(A_PUSH,opsize,index))
  338. else if (segment=NR_NO) and (base<>NR_NO) and (index=NR_NO) and
  339. (offset=0) and (symbol=nil) then
  340. // list.concat(Taicpu.Op_reg(A_PUSH,opsize,base))
  341. else
  342. begin
  343. tmpreg:=getaddressregister(list);
  344. a_loadaddr_ref_reg(list,r,tmpreg);
  345. // list.concat(taicpu.op_reg(A_PUSH,opsize,tmpreg));
  346. end;
  347. end
  348. else
  349. inherited a_loadaddr_ref_cgpara(list,r,cgpara);
  350. end;
  351. end;
  352. function tcg68k.fixref(list: TAsmList; var ref: treference): boolean;
  353. var
  354. hreg,idxreg,hreg2 : tregister;
  355. href : treference;
  356. instr : taicpu;
  357. begin
  358. result:=false;
  359. { The MC68020+ has extended
  360. addressing capabilities with a 32-bit
  361. displacement.
  362. }
  363. { first ensure that base is an address register }
  364. if (not assigned (ref.symbol) and (current_settings.cputype<>cpu_MC68000)) and
  365. (ref.base<>NR_NO) and not isaddressregister(ref.base) then
  366. begin
  367. hreg:=getaddressregister(list);
  368. instr:=taicpu.op_reg_reg(A_MOVE,S_L,ref.base,hreg);
  369. add_move_instruction(instr);
  370. list.concat(instr);
  371. fixref:=true;
  372. ref.base:=hreg;
  373. end;
  374. if (current_settings.cputype=cpu_MC68020) then
  375. exit;
  376. { ToDo: check which constraints of Coldfire also apply to MC68000 }
  377. case current_settings.cputype of
  378. cpu_MC68000:
  379. begin
  380. if (ref.base<>NR_NO) then
  381. begin
  382. if (ref.index<>NR_NO) and assigned(ref.symbol) then
  383. begin
  384. hreg:=getaddressregister(list);
  385. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,ref.base,hreg));
  386. list.concat(taicpu.op_reg_reg(A_ADD,S_L,ref.index,hreg));
  387. ref.index:=NR_NO;
  388. ref.base:=hreg;
  389. end;
  390. { base + reg }
  391. if ref.index <> NR_NO then
  392. begin
  393. { base + reg + offset }
  394. if (ref.offset < low(shortint)) or (ref.offset > high(shortint)) then
  395. begin
  396. hreg:=getaddressregister(list);
  397. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,ref.base,hreg));
  398. list.concat(taicpu.op_const_reg(A_ADD,S_L,ref.offset,hreg));
  399. fixref:=true;
  400. ref.offset:=0;
  401. ref.base:=hreg;
  402. exit;
  403. end;
  404. end
  405. else
  406. { base + offset }
  407. if (ref.offset < low(smallint)) or (ref.offset > high(smallint)) then
  408. begin
  409. hreg:=getaddressregister(list);
  410. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,ref.base,hreg));
  411. list.concat(taicpu.op_const_reg(A_ADD,S_L,ref.offset,hreg));
  412. fixref:=true;
  413. ref.offset:=0;
  414. ref.base:=hreg;
  415. exit;
  416. end;
  417. if assigned(ref.symbol) then
  418. begin
  419. hreg:=getaddressregister(list);
  420. idxreg:=ref.base;
  421. ref.base:=NR_NO;
  422. list.concat(taicpu.op_ref_reg(A_LEA,S_L,ref,hreg));
  423. reference_reset_base(ref,hreg,0,ref.alignment);
  424. fixref:=true;
  425. ref.index:=idxreg;
  426. end
  427. else if not isaddressregister(ref.base) then
  428. begin
  429. hreg:=getaddressregister(list);
  430. instr:=taicpu.op_reg_reg(A_MOVE,S_L,ref.base,hreg);
  431. add_move_instruction(instr);
  432. list.concat(instr);
  433. fixref:=true;
  434. ref.base:=hreg;
  435. end;
  436. end
  437. else
  438. { Note: symbol -> ref would be supported as long as ref does not
  439. contain a offset or index... (maybe something for the
  440. optimizer) }
  441. if Assigned(ref.symbol) and (ref.index<>NR_NO) then
  442. begin
  443. hreg:=cg.getaddressregister(list);
  444. idxreg:=ref.index;
  445. ref.index:=NR_NO;
  446. list.concat(taicpu.op_ref_reg(A_LEA,S_L,ref,hreg));
  447. reference_reset_base(ref,hreg,0,ref.alignment);
  448. ref.index:=idxreg;
  449. fixref:=true;
  450. end;
  451. end;
  452. cpu_Coldfire:
  453. begin
  454. if (ref.base<>NR_NO) then
  455. begin
  456. { base + symbol is not good }
  457. if assigned(ref.symbol) then
  458. begin
  459. hreg:=cg.getaddressregister(list);
  460. reference_reset_symbol(href,ref.symbol,0,ref.alignment);
  461. list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,hreg));
  462. if ref.index=NR_NO then
  463. ref.index:=ref.base
  464. else
  465. begin
  466. hreg2:=getaddressregister(list);
  467. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,ref.base,hreg2));
  468. list.concat(taicpu.op_reg_reg(A_ADD,S_L,hreg,ref.index));
  469. ref.index:=hreg2;
  470. end;
  471. ref.base:=hreg;
  472. ref.symbol:=nil;
  473. end;
  474. { base + reg }
  475. if ref.index <> NR_NO then
  476. begin
  477. { base + reg + offset }
  478. if (ref.offset < low(shortint)) or (ref.offset > high(shortint)) then
  479. begin
  480. hreg:=getaddressregister(list);
  481. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,ref.base,hreg));
  482. list.concat(taicpu.op_const_reg(A_ADD,S_L,ref.offset,hreg));
  483. fixref:=true;
  484. ref.base:=hreg;
  485. ref.offset:=0;
  486. exit;
  487. end;
  488. end
  489. else
  490. { base + offset }
  491. if (ref.offset < low(smallint)) or (ref.offset > high(smallint)) then
  492. begin
  493. hreg:=getaddressregister(list);
  494. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,ref.base,hreg));
  495. list.concat(taicpu.op_const_reg(A_ADD,S_L,ref.offset,hreg));
  496. fixref:=true;
  497. ref.offset:=0;
  498. ref.base:=hreg;
  499. exit;
  500. end;
  501. end
  502. else
  503. { Note: symbol -> ref would be supported as long as ref does not
  504. contain a offset or index... (maybe something for the
  505. optimizer) }
  506. if Assigned(ref.symbol) {and (ref.index<>NR_NO)} then
  507. begin
  508. hreg:=cg.getaddressregister(list);
  509. idxreg:=ref.index;
  510. ref.index:=NR_NO;
  511. list.concat(taicpu.op_ref_reg(A_LEA,S_L,ref,hreg));
  512. reference_reset_base(ref,hreg,0,ref.alignment);
  513. ref.index:=idxreg;
  514. fixref:=true;
  515. end;
  516. end;
  517. end;
  518. end;
  519. procedure tcg68k.a_call_name(list : TAsmList;const s : string; weak: boolean);
  520. var
  521. sym: tasmsymbol;
  522. begin
  523. if not(weak) then
  524. sym:=current_asmdata.RefAsmSymbol(s)
  525. else
  526. sym:=current_asmdata.WeakRefAsmSymbol(s);
  527. list.concat(taicpu.op_sym(A_JSR,S_NO,current_asmdata.RefAsmSymbol(s)));
  528. end;
  529. procedure tcg68k.a_call_reg(list : TAsmList;reg: tregister);
  530. var
  531. tmpref : treference;
  532. tmpreg : tregister;
  533. instr : taicpu;
  534. begin
  535. {$ifdef DEBUG_CHARLIE}
  536. list.concat(tai_comment.create(strpnew('a_call_reg')));
  537. {$endif}
  538. if isaddressregister(reg) then
  539. begin
  540. { if we have an address register, we can jump to the address directly }
  541. reference_reset_base(tmpref,reg,0,4);
  542. end
  543. else
  544. begin
  545. { if we have a data register, we need to move it to an address register first }
  546. tmpreg:=getaddressregister(list);
  547. reference_reset_base(tmpref,tmpreg,0,4);
  548. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg,tmpreg);
  549. add_move_instruction(instr);
  550. list.concat(instr);
  551. end;
  552. list.concat(taicpu.op_ref(A_JSR,S_NO,tmpref));
  553. end;
  554. procedure tcg68k.a_load_const_reg(list : TAsmList;size : tcgsize;a : tcgint;register : tregister);
  555. begin
  556. {$ifdef DEBUG_CHARLIE}
  557. // writeln('a_load_const_reg');
  558. {$endif DEBUG_CHARLIE}
  559. if isaddressregister(register) then
  560. begin
  561. list.concat(taicpu.op_const_reg(A_MOVE,S_L,longint(a),register))
  562. end
  563. else
  564. if a = 0 then
  565. list.concat(taicpu.op_reg(A_CLR,S_L,register))
  566. else
  567. begin
  568. if (longint(a) >= low(shortint)) and (longint(a) <= high(shortint)) then
  569. list.concat(taicpu.op_const_reg(A_MOVEQ,S_L,longint(a),register))
  570. else
  571. list.concat(taicpu.op_const_reg(A_MOVE,S_L,longint(a),register))
  572. end;
  573. end;
  574. procedure tcg68k.a_load_const_ref(list : TAsmList; tosize: tcgsize; a : tcgint;const ref : treference);
  575. var
  576. hreg : tregister;
  577. href : treference;
  578. begin
  579. {$ifdef DEBUG_CHARLIE}
  580. list.concat(tai_comment.create(strpnew('a_load_const_ref')));
  581. {$endif DEBUG_CHARLIE}
  582. href:=ref;
  583. fixref(list,href);
  584. { for coldfire we need to go through a temporary register if we have a
  585. offset, index or symbol given }
  586. if (current_settings.cputype=cpu_coldfire) and
  587. (
  588. (href.offset<>0) or
  589. { TODO : check whether we really need this second condition }
  590. (href.index<>NR_NO) or
  591. assigned(href.symbol)
  592. ) then
  593. begin
  594. hreg:=getintregister(list,tosize);
  595. list.concat(taicpu.op_const_reg(A_MOVE,S_L,longint(a),hreg));
  596. list.concat(taicpu.op_reg_ref(A_MOVE,S_L,hreg,href));
  597. end
  598. else
  599. list.concat(taicpu.op_const_ref(A_MOVE,S_L,longint(a),href));
  600. end;
  601. procedure tcg68k.a_load_reg_ref(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);
  602. var
  603. href : treference;
  604. begin
  605. href := ref;
  606. fixref(list,href);
  607. {$ifdef DEBUG_CHARLIE}
  608. list.concat(tai_comment.create(strpnew('a_load_reg_ref')));
  609. {$endif DEBUG_CHARLIE}
  610. { move to destination reference }
  611. list.concat(taicpu.op_reg_ref(A_MOVE,TCGSize2OpSize[fromsize],register,href));
  612. end;
  613. procedure tcg68k.a_load_ref_ref(list : TAsmList;fromsize,tosize : tcgsize;const sref : treference;const dref : treference);
  614. var
  615. aref: treference;
  616. bref: treference;
  617. dofix : boolean;
  618. hreg: TRegister;
  619. begin
  620. aref := sref;
  621. bref := dref;
  622. fixref(list,aref);
  623. fixref(list,bref);
  624. {$ifdef DEBUG_CHARLIE}
  625. // writeln('a_load_ref_ref');
  626. {$endif DEBUG_CHARLIE}
  627. { Coldfire dislikes certain move combinations }
  628. if current_settings.cputype=cpu_coldfire then
  629. begin
  630. { TODO : move.b/w only allowed in newer coldfires... (ISA_B+) }
  631. dofix:=false;
  632. if { (d16,Ax) and (d8,Ax,Xi) }
  633. (
  634. (aref.base<>NR_NO) and
  635. (
  636. (aref.index<>NR_NO) or
  637. (aref.offset<>0)
  638. )
  639. ) or
  640. { (xxx) }
  641. assigned(aref.symbol) then
  642. begin
  643. if aref.index<>NR_NO then
  644. begin
  645. dofix:={ (d16,Ax) and (d8,Ax,Xi) }
  646. (
  647. (bref.base<>NR_NO) and
  648. (
  649. (bref.index<>NR_NO) or
  650. (bref.offset<>0)
  651. )
  652. ) or
  653. { (xxx) }
  654. assigned(bref.symbol);
  655. end
  656. else
  657. { offset <> 0, but no index }
  658. begin
  659. dofix:={ (d8,Ax,Xi) }
  660. (
  661. (bref.base<>NR_NO) and
  662. (bref.index<>NR_NO)
  663. ) or
  664. { (xxx) }
  665. assigned(bref.symbol);
  666. end;
  667. end;
  668. if dofix then
  669. begin
  670. hreg:=getaddressregister(list);
  671. list.concat(taicpu.op_ref_reg(A_LEA,S_L,bref,hreg));
  672. list.concat(taicpu.op_reg_ref(A_MOVE,S_L{TCGSize2OpSize[fromsize]},hreg,bref));
  673. exit;
  674. end;
  675. end;
  676. list.concat(taicpu.op_ref_ref(A_MOVE,TCGSize2OpSize[fromsize],aref,bref));
  677. end;
  678. procedure tcg68k.a_load_reg_reg(list : TAsmList;fromsize,tosize : tcgsize;reg1,reg2 : tregister);
  679. var
  680. instr : taicpu;
  681. begin
  682. { move to destination register }
  683. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg1,reg2);
  684. add_move_instruction(instr);
  685. list.concat(instr);
  686. { zero/sign extend register to 32-bit }
  687. sign_extend(list, fromsize, reg2);
  688. end;
  689. procedure tcg68k.a_load_ref_reg(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);
  690. var
  691. href : treference;
  692. begin
  693. href:=ref;
  694. fixref(list,href);
  695. list.concat(taicpu.op_ref_reg(A_MOVE,TCGSize2OpSize[fromsize],href,register));
  696. { extend the value in the register }
  697. sign_extend(list, tosize, register);
  698. end;
  699. procedure tcg68k.a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);
  700. var
  701. href : treference;
  702. // p: pointer;
  703. begin
  704. { TODO: FIX ME!!! take a look on this mess again...}
  705. // if getregtype(r)=R_ADDRESSREGISTER then
  706. // begin
  707. // writeln('address reg?!?');
  708. // p:=nil; dword(p^):=0; {DEBUG CODE... :D )
  709. // internalerror(2002072901);
  710. // end;
  711. href:=ref;
  712. fixref(list, href);
  713. list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,r));
  714. end;
  715. procedure tcg68k.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister);
  716. var
  717. instr : taicpu;
  718. begin
  719. { in emulation mode, only 32-bit single is supported }
  720. if cs_fp_emulation in current_settings.moduleswitches then
  721. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg1,reg2)
  722. else
  723. instr:=taicpu.op_reg_reg(A_FMOVE,tcgsize2opsize[tosize],reg1,reg2);
  724. add_move_instruction(instr);
  725. list.concat(instr);
  726. end;
  727. procedure tcg68k.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister);
  728. var
  729. opsize : topsize;
  730. href : treference;
  731. tmpreg : tregister;
  732. begin
  733. opsize := tcgsize2opsize[fromsize];
  734. { extended is not supported, since it is not available on Coldfire }
  735. if opsize = S_FX then
  736. internalerror(20020729);
  737. href := ref;
  738. fixref(list,href);
  739. { in emulation mode, only 32-bit single is supported }
  740. if cs_fp_emulation in current_settings.moduleswitches then
  741. list.concat(taicpu.op_ref_reg(A_MOVE,S_L,href,reg))
  742. else
  743. begin
  744. list.concat(taicpu.op_ref_reg(A_FMOVE,opsize,href,reg));
  745. if (tosize < fromsize) then
  746. a_loadfpu_reg_reg(list,fromsize,tosize,reg,reg);
  747. end;
  748. end;
  749. procedure tcg68k.a_loadfpu_reg_ref(list: TAsmList; fromsize,tosize: tcgsize; reg: tregister; const ref: treference);
  750. var
  751. opsize : topsize;
  752. begin
  753. opsize := tcgsize2opsize[tosize];
  754. { extended is not supported, since it is not available on Coldfire }
  755. if opsize = S_FX then
  756. internalerror(20020729);
  757. { in emulation mode, only 32-bit single is supported }
  758. if cs_fp_emulation in current_settings.moduleswitches then
  759. list.concat(taicpu.op_reg_ref(A_MOVE,S_L,reg, ref))
  760. else
  761. list.concat(taicpu.op_reg_ref(A_FMOVE,opsize,reg, ref));
  762. end;
  763. procedure tcg68k.a_loadmm_reg_reg(list: TAsmList;fromsize,tosize : tcgsize; reg1, reg2: tregister;shuffle : pmmshuffle);
  764. begin
  765. internalerror(20020729);
  766. end;
  767. procedure tcg68k.a_loadmm_ref_reg(list: TAsmList;fromsize,tosize : tcgsize; const ref: treference; reg: tregister;shuffle : pmmshuffle);
  768. begin
  769. internalerror(20020729);
  770. end;
  771. procedure tcg68k.a_loadmm_reg_ref(list: TAsmList;fromsize,tosize : tcgsize; reg: tregister; const ref: treference;shuffle : pmmshuffle);
  772. begin
  773. internalerror(20020729);
  774. end;
  775. procedure tcg68k.a_loadmm_reg_cgpara(list: TAsmList; size: tcgsize; reg: tregister;const locpara : TCGPara;shuffle : pmmshuffle);
  776. begin
  777. internalerror(20020729);
  778. end;
  779. procedure tcg68k.a_op_const_reg(list : TAsmList; Op: TOpCG; size: tcgsize; a: tcgint; reg: TRegister);
  780. var
  781. scratch_reg : tregister;
  782. scratch_reg2: tregister;
  783. opcode : tasmop;
  784. r,r2 : Tregister;
  785. instr : taicpu;
  786. begin
  787. optimize_op_const(op, a);
  788. opcode := topcg2tasmop[op];
  789. case op of
  790. OP_NONE :
  791. begin
  792. { Opcode is optimized away }
  793. end;
  794. OP_MOVE :
  795. begin
  796. { Optimized, replaced with a simple load }
  797. a_load_const_reg(list,size,a,reg);
  798. end;
  799. OP_ADD :
  800. begin
  801. if (a >= 1) and (a <= 8) then
  802. list.concat(taicpu.op_const_reg(A_ADDQ,S_L,a, reg))
  803. else
  804. begin
  805. { all others, including coldfire }
  806. list.concat(taicpu.op_const_reg(A_ADD,S_L,a, reg));
  807. end;
  808. end;
  809. OP_AND,
  810. OP_OR:
  811. begin
  812. if isaddressregister(reg) then
  813. begin
  814. { use scratch register (there is a anda/ora though...) }
  815. scratch_reg:=getintregister(list,OS_INT);
  816. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg,scratch_reg);
  817. add_move_instruction(instr);
  818. list.concat(instr);
  819. list.concat(taicpu.op_const_reg(opcode,S_L,longint(a),scratch_reg));
  820. instr:=taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg,reg);
  821. add_move_instruction(instr);
  822. list.concat(instr);
  823. end
  824. else
  825. list.concat(taicpu.op_const_reg(topcg2tasmop[op],S_L,longint(a), reg));
  826. end;
  827. OP_DIV :
  828. begin
  829. internalerror(20020816);
  830. end;
  831. OP_IDIV :
  832. begin
  833. internalerror(20020816);
  834. end;
  835. OP_IMUL :
  836. begin
  837. if current_settings.cputype<>cpu_MC68020 then
  838. begin
  839. r:=NR_D0;
  840. r2:=NR_D1;
  841. cg.getcpuregister(list,NR_D0);
  842. cg.getcpuregister(list,NR_D1);
  843. list.concat(taicpu.op_const_reg(A_MOVE,S_L,a, r));
  844. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg, r2);
  845. add_move_instruction(instr);
  846. list.concat(instr);
  847. cg.a_call_name(list,'FPC_MUL_LONGINT',false);
  848. instr:=taicpu.op_reg_reg(A_MOVE,S_L,r, reg);
  849. add_move_instruction(instr);
  850. list.concat(instr);
  851. cg.ungetcpuregister(list,r);
  852. cg.ungetcpuregister(list,r2);
  853. end
  854. else
  855. begin
  856. if (isaddressregister(reg)) then
  857. begin
  858. scratch_reg := getintregister(list,OS_INT);
  859. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg);
  860. add_move_instruction(instr);
  861. list.concat(instr);
  862. list.concat(taicpu.op_const_reg(A_MULS,S_L,a,scratch_reg));
  863. instr:=taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg,reg);
  864. add_move_instruction(instr);
  865. list.concat(instr);
  866. end
  867. else
  868. list.concat(taicpu.op_const_reg(A_MULS,S_L,a,reg));
  869. end;
  870. end;
  871. OP_MUL :
  872. begin
  873. if current_settings.cputype<>cpu_MC68020 then
  874. begin
  875. r:=NR_D0;
  876. r2:=NR_D1;
  877. cg.getcpuregister(list,NR_D0);
  878. cg.getcpuregister(list,NR_D1);
  879. list.concat(taicpu.op_const_reg(A_MOVE,S_L,a, r));
  880. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg, r2);
  881. add_move_instruction(instr);
  882. list.concat(instr);
  883. cg.a_call_name(list,'FPC_MUL_DWORD',false);
  884. instr:=taicpu.op_reg_reg(A_MOVE,S_L,r, reg);
  885. add_move_instruction(instr);
  886. list.concat(instr);
  887. cg.ungetcpuregister(list,r);
  888. cg.ungetcpuregister(list,r2);
  889. end
  890. else
  891. begin
  892. if (isaddressregister(reg)) then
  893. begin
  894. scratch_reg := getintregister(list,OS_INT);
  895. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg);
  896. add_move_instruction(instr);
  897. list.concat(instr);
  898. list.concat(taicpu.op_const_reg(A_MULU,S_L,a,scratch_reg));
  899. instr:=taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg,reg);
  900. add_move_instruction(instr);
  901. list.concat(instr);
  902. end
  903. else
  904. list.concat(taicpu.op_const_reg(A_MULU,S_L,a,reg));
  905. end;
  906. end;
  907. OP_SAR,
  908. OP_SHL,
  909. OP_SHR :
  910. begin
  911. if (a >= 1) and (a <= 8) then
  912. begin
  913. { not allowed to shift an address register }
  914. if (isaddressregister(reg)) then
  915. begin
  916. scratch_reg := getintregister(list,OS_INT);
  917. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg);
  918. add_move_instruction(instr);
  919. list.concat(instr);
  920. list.concat(taicpu.op_const_reg(opcode,S_L,a, scratch_reg));
  921. instr:=taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg,reg);
  922. add_move_instruction(instr);
  923. list.concat(instr);
  924. end
  925. else
  926. list.concat(taicpu.op_const_reg(opcode,S_L,a, reg));
  927. end
  928. else
  929. begin
  930. { we must load the data into a register ... :() }
  931. scratch_reg := cg.getintregister(list,OS_INT);
  932. list.concat(taicpu.op_const_reg(A_MOVE,S_L,a, scratch_reg));
  933. { again... since shifting with address register is not allowed }
  934. if (isaddressregister(reg)) then
  935. begin
  936. scratch_reg2 := cg.getintregister(list,OS_INT);
  937. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg2);
  938. add_move_instruction(instr);
  939. list.concat(instr);
  940. list.concat(taicpu.op_reg_reg(opcode,S_L,scratch_reg, scratch_reg2));
  941. instr:=taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg2,reg);
  942. add_move_instruction(instr);
  943. list.concat(instr);
  944. end
  945. else
  946. list.concat(taicpu.op_reg_reg(opcode,S_L,scratch_reg, reg));
  947. end;
  948. end;
  949. OP_SUB :
  950. begin
  951. if (a >= 1) and (a <= 8) then
  952. list.concat(taicpu.op_const_reg(A_SUBQ,S_L,a,reg))
  953. else
  954. begin
  955. { all others, including coldfire }
  956. list.concat(taicpu.op_const_reg(A_SUB,S_L,a, reg));
  957. end;
  958. end;
  959. OP_XOR :
  960. begin
  961. list.concat(taicpu.op_const_reg(A_EORI,S_L,a, reg));
  962. end;
  963. else
  964. internalerror(20020729);
  965. end;
  966. end;
  967. {
  968. procedure tcg68k.a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference);
  969. var
  970. opcode: tasmop;
  971. begin
  972. writeln('a_op_const_ref');
  973. optimize_op_const(op, a);
  974. opcode := topcg2tasmop[op];
  975. case op of
  976. OP_NONE :
  977. begin
  978. { opcode was optimized away }
  979. end;
  980. OP_MOVE :
  981. begin
  982. { Optimized, replaced with a simple load }
  983. a_load_const_ref(list,size,a,ref);
  984. end;
  985. else
  986. begin
  987. internalerror(2007010101);
  988. end;
  989. end;
  990. end;
  991. }
  992. procedure tcg68k.a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister);
  993. var
  994. hreg1,hreg2,r,r2: tregister;
  995. instr : taicpu;
  996. begin
  997. case op of
  998. OP_ADD :
  999. begin
  1000. if current_settings.cputype = cpu_ColdFire then
  1001. begin
  1002. { operation only allowed only a longword }
  1003. sign_extend(list, size, reg1);
  1004. sign_extend(list, size, reg2);
  1005. list.concat(taicpu.op_reg_reg(A_ADD,S_L,reg1, reg2));
  1006. end
  1007. else
  1008. begin
  1009. list.concat(taicpu.op_reg_reg(A_ADD,TCGSize2OpSize[size],reg1, reg2));
  1010. end;
  1011. end;
  1012. OP_AND,OP_OR,
  1013. OP_SAR,OP_SHL,
  1014. OP_SHR,OP_SUB,OP_XOR :
  1015. begin
  1016. { load to data registers }
  1017. if (isaddressregister(reg1)) then
  1018. begin
  1019. hreg1 := getintregister(list,OS_INT);
  1020. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg1,hreg1);
  1021. add_move_instruction(instr);
  1022. list.concat(instr);
  1023. end
  1024. else
  1025. hreg1 := reg1;
  1026. if (isaddressregister(reg2)) then
  1027. begin
  1028. hreg2:= getintregister(list,OS_INT);
  1029. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2);
  1030. add_move_instruction(instr);
  1031. list.concat(instr);
  1032. end
  1033. else
  1034. hreg2 := reg2;
  1035. if current_settings.cputype = cpu_ColdFire then
  1036. begin
  1037. { operation only allowed only a longword }
  1038. {!***************************************
  1039. in the case of shifts, the value to
  1040. shift by, should already be valid, so
  1041. no need to sign extend the value
  1042. !
  1043. }
  1044. if op in [OP_AND,OP_OR,OP_SUB,OP_XOR] then
  1045. sign_extend(list, size, hreg1);
  1046. sign_extend(list, size, hreg2);
  1047. instr:=taicpu.op_reg_reg(topcg2tasmop[op],S_L,hreg1, hreg2);
  1048. add_move_instruction(instr);
  1049. list.concat(instr);
  1050. end
  1051. else
  1052. begin
  1053. list.concat(taicpu.op_reg_reg(topcg2tasmop[op],TCGSize2OpSize[size],hreg1, hreg2));
  1054. end;
  1055. { move back result into destination register }
  1056. if reg2 <> hreg2 then
  1057. begin
  1058. instr:=taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2);
  1059. add_move_instruction(instr);
  1060. list.concat(instr);
  1061. end;
  1062. end;
  1063. OP_DIV :
  1064. begin
  1065. internalerror(20020816);
  1066. end;
  1067. OP_IDIV :
  1068. begin
  1069. internalerror(20020816);
  1070. end;
  1071. OP_IMUL :
  1072. begin
  1073. sign_extend(list, size,reg1);
  1074. sign_extend(list, size,reg2);
  1075. if current_settings.cputype = cpu_MC68000 then
  1076. begin
  1077. r:=NR_D0;
  1078. r2:=NR_D1;
  1079. cg.getcpuregister(list,NR_D0);
  1080. cg.getcpuregister(list,NR_D1);
  1081. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg1, r);
  1082. add_move_instruction(instr);
  1083. list.concat(instr);
  1084. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg2, r2);
  1085. add_move_instruction(instr);
  1086. list.concat(instr);
  1087. cg.a_call_name(list,'FPC_MUL_LONGINT',false);
  1088. instr:=taicpu.op_reg_reg(A_MOVE,S_L,r, reg2);
  1089. add_move_instruction(instr);
  1090. list.concat(instr);
  1091. cg.ungetcpuregister(list,r);
  1092. cg.ungetcpuregister(list,r2);
  1093. end
  1094. else
  1095. begin
  1096. // writeln('doing 68020');
  1097. if (isaddressregister(reg1)) then
  1098. hreg1 := getintregister(list,OS_INT)
  1099. else
  1100. hreg1 := reg1;
  1101. if (isaddressregister(reg2)) then
  1102. hreg2:= getintregister(list,OS_INT)
  1103. else
  1104. hreg2 := reg2;
  1105. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg1,hreg1);
  1106. add_move_instruction(instr);
  1107. list.concat(instr);
  1108. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2);
  1109. add_move_instruction(instr);
  1110. list.concat(instr);
  1111. list.concat(taicpu.op_reg_reg(A_MULS,S_L,reg1,reg2));
  1112. { move back result into destination register }
  1113. if reg2 <> hreg2 then
  1114. begin
  1115. instr:=taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2);
  1116. add_move_instruction(instr);
  1117. list.concat(instr);
  1118. end;
  1119. end;
  1120. end;
  1121. OP_MUL :
  1122. begin
  1123. sign_extend(list, size,reg1);
  1124. sign_extend(list, size,reg2);
  1125. if current_settings.cputype <> cpu_MC68020 then
  1126. begin
  1127. r:=NR_D0;
  1128. r2:=NR_D1;
  1129. cg.getcpuregister(list,NR_D0);
  1130. cg.getcpuregister(list,NR_D1);
  1131. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg1, r);
  1132. add_move_instruction(instr);
  1133. list.concat(instr);
  1134. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg2, r2);
  1135. add_move_instruction(instr);
  1136. list.concat(instr);
  1137. cg.a_call_name(list,'FPC_MUL_DWORD',false);
  1138. instr:=taicpu.op_reg_reg(A_MOVE,S_L,r, reg2);
  1139. add_move_instruction(instr);
  1140. list.concat(instr);
  1141. cg.ungetcpuregister(list,r);
  1142. cg.ungetcpuregister(list,r2);
  1143. end
  1144. else
  1145. begin
  1146. if (isaddressregister(reg1)) then
  1147. begin
  1148. hreg1 := cg.getintregister(list,OS_INT);
  1149. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg1,hreg1);
  1150. add_move_instruction(instr);
  1151. list.concat(instr);
  1152. end
  1153. else
  1154. hreg1 := reg1;
  1155. if (isaddressregister(reg2)) then
  1156. begin
  1157. hreg2:= cg.getintregister(list,OS_INT);
  1158. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2);
  1159. add_move_instruction(instr);
  1160. list.concat(instr);
  1161. end
  1162. else
  1163. hreg2 := reg2;
  1164. list.concat(taicpu.op_reg_reg(A_MULU,S_L,reg1,reg2));
  1165. { move back result into destination register }
  1166. if reg2<>hreg2 then
  1167. begin
  1168. instr:=taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2);
  1169. add_move_instruction(instr);
  1170. list.concat(instr);
  1171. end;
  1172. end;
  1173. end;
  1174. OP_NEG,
  1175. OP_NOT :
  1176. Begin
  1177. { if there are two operands, move the register,
  1178. since the operation will only be done on the result
  1179. register.
  1180. }
  1181. if reg1 <> NR_NO then
  1182. cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,reg1,reg2);
  1183. if (isaddressregister(reg2)) then
  1184. begin
  1185. hreg2 := getintregister(list,OS_INT);
  1186. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2);
  1187. add_move_instruction(instr);
  1188. list.concat(instr);
  1189. end
  1190. else
  1191. hreg2 := reg2;
  1192. { coldfire only supports long version }
  1193. if current_settings.cputype = cpu_ColdFire then
  1194. begin
  1195. sign_extend(list, size,hreg2);
  1196. list.concat(taicpu.op_reg(topcg2tasmop[op],S_L,hreg2));
  1197. end
  1198. else
  1199. begin
  1200. list.concat(taicpu.op_reg(topcg2tasmop[op],TCGSize2OpSize[size],hreg2));
  1201. end;
  1202. if reg2 <> hreg2 then
  1203. begin
  1204. instr:=taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2);
  1205. add_move_instruction(instr);
  1206. list.concat(instr);
  1207. end;
  1208. end;
  1209. else
  1210. internalerror(20020729);
  1211. end;
  1212. end;
  1213. procedure tcg68k.a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister;
  1214. l : tasmlabel);
  1215. var
  1216. hregister : tregister;
  1217. instr : taicpu;
  1218. begin
  1219. if a = 0 then
  1220. begin
  1221. if (current_settings.cputype = cpu_MC68000) and isaddressregister(reg) then
  1222. begin
  1223. {
  1224. 68000 does not seem to like address register for TST instruction
  1225. }
  1226. { always move to a data register }
  1227. hregister := getintregister(list,OS_INT);
  1228. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg,hregister);
  1229. add_move_instruction(instr);
  1230. list.concat(instr);
  1231. { sign/zero extend the register }
  1232. sign_extend(list, size,hregister);
  1233. reg:=hregister;
  1234. end;
  1235. list.concat(taicpu.op_reg(A_TST,TCGSize2OpSize[size],reg));
  1236. end
  1237. else
  1238. begin
  1239. if (current_settings.cputype = cpu_ColdFire) then
  1240. begin
  1241. {
  1242. only longword comparison is supported,
  1243. and only on data registers.
  1244. }
  1245. hregister := getintregister(list,OS_INT);
  1246. { always move to a data register }
  1247. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg,hregister);
  1248. add_move_instruction(instr);
  1249. list.concat(instr);
  1250. { sign/zero extend the register }
  1251. sign_extend(list, size,hregister);
  1252. list.concat(taicpu.op_const_reg(A_CMPI,S_L,a,hregister));
  1253. end
  1254. else
  1255. begin
  1256. list.concat(taicpu.op_const_reg(A_CMPI,TCGSize2OpSize[size],a,reg));
  1257. end;
  1258. end;
  1259. { emit the actual jump to the label }
  1260. a_jmp_cond(list,cmp_op,l);
  1261. end;
  1262. procedure tcg68k.a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
  1263. begin
  1264. list.concat(taicpu.op_reg_reg(A_CMP,tcgsize2opsize[size],reg1,reg2));
  1265. { emit the actual jump to the label }
  1266. a_jmp_cond(list,cmp_op,l);
  1267. end;
  1268. procedure tcg68k.a_jmp_name(list: TAsmList; const s: string);
  1269. var
  1270. ai: taicpu;
  1271. begin
  1272. ai := Taicpu.op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(s));
  1273. ai.is_jmp := true;
  1274. list.concat(ai);
  1275. end;
  1276. procedure tcg68k.a_jmp_always(list : TAsmList;l: tasmlabel);
  1277. var
  1278. ai: taicpu;
  1279. begin
  1280. ai := Taicpu.op_sym(A_JMP,S_NO,l);
  1281. ai.is_jmp := true;
  1282. list.concat(ai);
  1283. end;
  1284. procedure tcg68k.a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel);
  1285. var
  1286. ai : taicpu;
  1287. begin
  1288. ai := Taicpu.op_sym(A_BXX,S_NO,l);
  1289. ai.SetCondition(flags_to_cond(f));
  1290. ai.is_jmp := true;
  1291. list.concat(ai);
  1292. end;
  1293. procedure tcg68k.g_flags2reg(list: TAsmList; size: TCgSize; const f: tresflags; reg: TRegister);
  1294. var
  1295. ai : taicpu;
  1296. hreg : tregister;
  1297. instr : taicpu;
  1298. begin
  1299. { move to a Dx register? }
  1300. if (isaddressregister(reg)) then
  1301. begin
  1302. hreg := getintregister(list,OS_INT);
  1303. a_load_const_reg(list,size,0,hreg);
  1304. ai:=Taicpu.Op_reg(A_Sxx,S_B,hreg);
  1305. ai.SetCondition(flags_to_cond(f));
  1306. list.concat(ai);
  1307. if (current_settings.cputype = cpu_ColdFire) then
  1308. begin
  1309. { neg.b does not exist on the Coldfire
  1310. so we need to sign extend the value
  1311. before doing a neg.l
  1312. }
  1313. list.concat(taicpu.op_reg(A_EXTB,S_L,hreg));
  1314. list.concat(taicpu.op_reg(A_NEG,S_L,hreg));
  1315. end
  1316. else
  1317. begin
  1318. list.concat(taicpu.op_reg(A_NEG,S_B,hreg));
  1319. end;
  1320. instr:=taicpu.op_reg_reg(A_MOVE,S_L,hreg,reg);
  1321. add_move_instruction(instr);
  1322. list.concat(instr);
  1323. end
  1324. else
  1325. begin
  1326. a_load_const_reg(list,size,0,reg);
  1327. ai:=Taicpu.Op_reg(A_Sxx,S_B,reg);
  1328. ai.SetCondition(flags_to_cond(f));
  1329. list.concat(ai);
  1330. if (current_settings.cputype = cpu_ColdFire) then
  1331. begin
  1332. { neg.b does not exist on the Coldfire
  1333. so we need to sign extend the value
  1334. before doing a neg.l
  1335. }
  1336. list.concat(taicpu.op_reg(A_EXTB,S_L,reg));
  1337. list.concat(taicpu.op_reg(A_NEG,S_L,reg));
  1338. end
  1339. else
  1340. begin
  1341. list.concat(taicpu.op_reg(A_NEG,S_B,reg));
  1342. end;
  1343. end;
  1344. end;
  1345. procedure tcg68k.g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);
  1346. var
  1347. helpsize : longint;
  1348. i : byte;
  1349. reg8,reg32 : tregister;
  1350. swap : boolean;
  1351. hregister : tregister;
  1352. iregister : tregister;
  1353. jregister : tregister;
  1354. hp1 : treference;
  1355. hp2 : treference;
  1356. hl : tasmlabel;
  1357. hl2: tasmlabel;
  1358. popaddress : boolean;
  1359. srcref,dstref : treference;
  1360. begin
  1361. popaddress := false;
  1362. // writeln('concatcopy:',len);
  1363. { this should never occur }
  1364. if len > 65535 then
  1365. internalerror(0);
  1366. hregister := getintregister(list,OS_INT);
  1367. // if delsource then
  1368. // reference_release(list,source);
  1369. { from 12 bytes movs is being used }
  1370. if {(not loadref) and} ((len<=8) or (not(cs_opt_size in current_settings.optimizerswitches) and (len<=12))) then
  1371. begin
  1372. srcref := source;
  1373. dstref := dest;
  1374. helpsize:=len div 4;
  1375. { move a dword x times }
  1376. for i:=1 to helpsize do
  1377. begin
  1378. a_load_ref_reg(list,OS_INT,OS_INT,srcref,hregister);
  1379. a_load_reg_ref(list,OS_INT,OS_INT,hregister,dstref);
  1380. inc(srcref.offset,4);
  1381. inc(dstref.offset,4);
  1382. dec(len,4);
  1383. end;
  1384. { move a word }
  1385. if len>1 then
  1386. begin
  1387. a_load_ref_reg(list,OS_16,OS_16,srcref,hregister);
  1388. a_load_reg_ref(list,OS_16,OS_16,hregister,dstref);
  1389. inc(srcref.offset,2);
  1390. inc(dstref.offset,2);
  1391. dec(len,2);
  1392. end;
  1393. { move a single byte }
  1394. if len>0 then
  1395. begin
  1396. a_load_ref_reg(list,OS_8,OS_8,srcref,hregister);
  1397. a_load_reg_ref(list,OS_8,OS_8,hregister,dstref);
  1398. end
  1399. end
  1400. else
  1401. begin
  1402. iregister:=getaddressregister(list);
  1403. jregister:=getaddressregister(list);
  1404. { reference for move (An)+,(An)+ }
  1405. reference_reset(hp1,source.alignment);
  1406. hp1.base := iregister; { source register }
  1407. hp1.direction := dir_inc;
  1408. reference_reset(hp2,dest.alignment);
  1409. hp2.base := jregister;
  1410. hp2.direction := dir_inc;
  1411. { iregister = source }
  1412. { jregister = destination }
  1413. { if loadref then
  1414. cg.a_load_ref_reg(list,OS_INT,OS_INT,source,iregister)
  1415. else}
  1416. a_loadaddr_ref_reg(list,source,iregister);
  1417. a_loadaddr_ref_reg(list,dest,jregister);
  1418. { double word move only on 68020+ machines }
  1419. { because of possible alignment problems }
  1420. { use fast loop mode }
  1421. if (current_settings.cputype=cpu_MC68020) then
  1422. begin
  1423. helpsize := len - len mod 4;
  1424. len := len mod 4;
  1425. list.concat(taicpu.op_const_reg(A_MOVE,S_L,helpsize div 4,hregister));
  1426. current_asmdata.getjumplabel(hl2);
  1427. a_jmp_always(list,hl2);
  1428. current_asmdata.getjumplabel(hl);
  1429. a_label(list,hl);
  1430. list.concat(taicpu.op_ref_ref(A_MOVE,S_L,hp1,hp2));
  1431. a_label(list,hl2);
  1432. list.concat(taicpu.op_reg_sym(A_DBRA,S_L,hregister,hl));
  1433. if len > 1 then
  1434. begin
  1435. dec(len,2);
  1436. list.concat(taicpu.op_ref_ref(A_MOVE,S_W,hp1,hp2));
  1437. end;
  1438. if len = 1 then
  1439. list.concat(taicpu.op_ref_ref(A_MOVE,S_B,hp1,hp2));
  1440. end
  1441. else
  1442. begin
  1443. { Fast 68010 loop mode with no possible alignment problems }
  1444. helpsize := len;
  1445. list.concat(taicpu.op_const_reg(A_MOVE,S_L,helpsize,hregister));
  1446. current_asmdata.getjumplabel(hl2);
  1447. a_jmp_always(list,hl2);
  1448. current_asmdata.getjumplabel(hl);
  1449. a_label(list,hl);
  1450. list.concat(taicpu.op_ref_ref(A_MOVE,S_B,hp1,hp2));
  1451. a_label(list,hl2);
  1452. if current_settings.cputype=cpu_coldfire then
  1453. begin
  1454. { Coldfire does not support DBRA }
  1455. list.concat(taicpu.op_const_reg(A_SUB,S_L,1,hregister));
  1456. list.concat(taicpu.op_sym(A_BMI,S_L,hl));
  1457. end
  1458. else
  1459. list.concat(taicpu.op_reg_sym(A_DBRA,S_L,hregister,hl));
  1460. end;
  1461. { restore the registers that we have just used olny if they are used! }
  1462. if jregister = NR_A1 then
  1463. hp2.base := NR_NO;
  1464. if iregister = NR_A0 then
  1465. hp1.base := NR_NO;
  1466. // reference_release(list,hp1);
  1467. // reference_release(list,hp2);
  1468. end;
  1469. // if delsource then
  1470. // tg.ungetiftemp(list,source);
  1471. end;
  1472. procedure tcg68k.g_overflowcheck(list: TAsmList; const l:tlocation; def:tdef);
  1473. begin
  1474. end;
  1475. procedure tcg68k.g_proc_entry(list: TAsmList; localsize: longint; nostackframe:boolean);
  1476. var
  1477. r,rsp: TRegister;
  1478. ref : TReference;
  1479. begin
  1480. {$ifdef DEBUG_CHARLIE}
  1481. // writeln('proc entry, localsize:',localsize);
  1482. {$endif DEBUG_CHARLIE}
  1483. if not nostackframe then
  1484. begin
  1485. if localsize<>0 then
  1486. begin
  1487. { size can't be negative }
  1488. if (localsize < 0) then
  1489. internalerror(2006122601);
  1490. { Not to complicate the code generator too much, and since some }
  1491. { of the systems only support this format, the localsize cannot }
  1492. { exceed 32K in size. }
  1493. if (localsize > high(smallint)) then
  1494. CGMessage(cg_e_localsize_too_big);
  1495. list.concat(taicpu.op_reg_const(A_LINK,S_W,NR_FRAME_POINTER_REG,-localsize));
  1496. end
  1497. else
  1498. begin
  1499. list.concat(taicpu.op_reg_const(A_LINK,S_W,NR_FRAME_POINTER_REG,0));
  1500. (*
  1501. { FIXME! - Carl's original code uses this method. However,
  1502. according to the 68060 users manual, a LINK is faster than
  1503. two moves. So, use a link in #0 case too, for now. I'm not
  1504. really sure tho', that LINK supports #0 disposition, but i
  1505. see no reason why it shouldn't support it. (KB) }
  1506. { when localsize = 0, use two moves, instead of link }
  1507. r:=NR_FRAME_POINTER_REG;
  1508. rsp:=NR_STACK_POINTER_REG;
  1509. reference_reset_base(ref,NR_STACK_POINTER_REG,0);
  1510. ref.direction:=dir_dec;
  1511. list.concat(taicpu.op_reg_ref(A_MOVE,S_L,r,ref));
  1512. instr:=taicpu.op_reg_reg(A_MOVE,S_L,rsp,r);
  1513. add_move_instruction(instr); mwould also be needed
  1514. list.concat(instr);
  1515. *)
  1516. end;
  1517. end;
  1518. end;
  1519. { procedure tcg68k.g_restore_frame_pointer(list : TAsmList);
  1520. var
  1521. r:Tregister;
  1522. begin
  1523. r:=NR_FRAME_POINTER_REG;
  1524. list.concat(taicpu.op_reg(A_UNLK,S_NO,r));
  1525. end;
  1526. }
  1527. procedure tcg68k.g_proc_exit(list : TAsmList; parasize: longint; nostackframe: boolean);
  1528. var
  1529. r,hregister : TRegister;
  1530. localsize: tcgint;
  1531. spr : TRegister;
  1532. fpr : TRegister;
  1533. ref : TReference;
  1534. begin
  1535. if not nostackframe then
  1536. begin
  1537. localsize := current_procinfo.calc_stackframe_size;
  1538. {$ifdef DEBUG_CHARLIE}
  1539. // writeln('proc exit with stackframe, size:',localsize,' parasize:',parasize);
  1540. {$endif DEBUG_CHARLIE}
  1541. list.concat(taicpu.op_reg(A_UNLK,S_NO,NR_FRAME_POINTER_REG));
  1542. parasize := parasize - target_info.first_parm_offset; { i'm still not 100% confident that this is
  1543. correct here, but at least it looks less
  1544. hacky, and makes some sense (KB) }
  1545. if (parasize<>0) then
  1546. begin
  1547. { only 68020+ supports RTD, so this needs another code path
  1548. for 68000 and Coldfire (KB) }
  1549. { TODO: 68020+ only code generation, without fallback}
  1550. if current_settings.cputype=cpu_mc68020 then
  1551. list.concat(taicpu.op_const(A_RTD,S_NO,parasize))
  1552. else
  1553. begin
  1554. { We must pull the PC Counter from the stack, before }
  1555. { restoring the stack pointer, otherwise the PC would }
  1556. { point to nowhere! }
  1557. { save the PC counter (pop it from the stack) }
  1558. //hregister:=cg.getaddressregister(list);
  1559. hregister:=NR_A3;
  1560. cg.a_reg_alloc(list,hregister);
  1561. reference_reset_base(ref,NR_STACK_POINTER_REG,0,4);
  1562. ref.direction:=dir_inc;
  1563. list.concat(taicpu.op_ref_reg(A_MOVE,S_L,ref,hregister));
  1564. { can we do a quick addition ... }
  1565. r:=NR_SP;
  1566. if (parasize > 0) and (parasize < 9) then
  1567. list.concat(taicpu.op_const_reg(A_ADDQ,S_L,parasize,r))
  1568. else { nope ... }
  1569. list.concat(taicpu.op_const_reg(A_ADD,S_L,parasize,r));
  1570. { restore the PC counter (push it on the stack) }
  1571. reference_reset_base(ref,NR_STACK_POINTER_REG,0,4);
  1572. ref.direction:=dir_dec;
  1573. cg.a_reg_alloc(list,hregister);
  1574. list.concat(taicpu.op_reg_ref(A_MOVE,S_L,hregister,ref));
  1575. list.concat(taicpu.op_none(A_RTS,S_NO));
  1576. end;
  1577. end
  1578. else
  1579. list.concat(taicpu.op_none(A_RTS,S_NO));
  1580. end
  1581. else
  1582. begin
  1583. {$ifdef DEBUG_CHARLIE}
  1584. // writeln('proc exit, no stackframe');
  1585. {$endif DEBUG_CHARLIE}
  1586. list.concat(taicpu.op_none(A_RTS,S_NO));
  1587. end;
  1588. // writeln('g_proc_exit');
  1589. { Routines with the poclearstack flag set use only a ret.
  1590. also routines with parasize=0 }
  1591. (*
  1592. if current_procinfo.procdef.proccalloption in clearstack_pocalls then
  1593. begin
  1594. { complex return values are removed from stack in C code PM }
  1595. if paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef.proccalloption) then
  1596. list.concat(taicpu.op_const(A_RTD,S_NO,4))
  1597. else
  1598. list.concat(taicpu.op_none(A_RTS,S_NO));
  1599. end
  1600. else if (parasize=0) then
  1601. begin
  1602. list.concat(taicpu.op_none(A_RTS,S_NO));
  1603. end
  1604. else
  1605. begin
  1606. { return with immediate size possible here
  1607. signed!
  1608. RTD is not supported on the coldfire }
  1609. if (current_settings.cputype=cpu_MC68020) and (parasize<$7FFF) then
  1610. list.concat(taicpu.op_const(A_RTD,S_NO,parasize))
  1611. { manually restore the stack }
  1612. else
  1613. begin
  1614. { We must pull the PC Counter from the stack, before }
  1615. { restoring the stack pointer, otherwise the PC would }
  1616. { point to nowhere! }
  1617. { save the PC counter (pop it from the stack) }
  1618. hregister:=NR_A3;
  1619. cg.a_reg_alloc(list,hregister);
  1620. reference_reset_base(ref,NR_STACK_POINTER_REG,0);
  1621. ref.direction:=dir_inc;
  1622. list.concat(taicpu.op_ref_reg(A_MOVE,S_L,ref,hregister));
  1623. { can we do a quick addition ... }
  1624. r:=NR_SP;
  1625. if (parasize > 0) and (parasize < 9) then
  1626. list.concat(taicpu.op_const_reg(A_ADDQ,S_L,parasize,r))
  1627. else { nope ... }
  1628. list.concat(taicpu.op_const_reg(A_ADD,S_L,parasize,r));
  1629. { restore the PC counter (push it on the stack) }
  1630. reference_reset_base(ref,NR_STACK_POINTER_REG,0);
  1631. ref.direction:=dir_dec;
  1632. cg.a_reg_alloc(list,hregister);
  1633. list.concat(taicpu.op_reg_ref(A_MOVE,S_L,hregister,ref));
  1634. list.concat(taicpu.op_none(A_RTS,S_NO));
  1635. end;
  1636. end;
  1637. *)
  1638. end;
  1639. procedure Tcg68k.g_save_registers(list:TAsmList);
  1640. var
  1641. tosave : tcpuregisterset;
  1642. ref : treference;
  1643. begin
  1644. {!!!!!
  1645. tosave:=std_saved_registers;
  1646. { only save the registers which are not used and must be saved }
  1647. tosave:=tosave*(rg[R_INTREGISTER].used_in_proc+rg[R_ADDRESSREGISTER].used_in_proc);
  1648. reference_reset_base(ref,NR_STACK_POINTER_REG,0);
  1649. ref.direction:=dir_dec;
  1650. if tosave<>[] then
  1651. list.concat(taicpu.op_regset_ref(A_MOVEM,S_L,tosave,ref));
  1652. }
  1653. end;
  1654. procedure Tcg68k.g_restore_registers(list:TAsmList);
  1655. var
  1656. torestore : tcpuregisterset;
  1657. r:Tregister;
  1658. ref : treference;
  1659. begin
  1660. {!!!!!!!!
  1661. torestore:=std_saved_registers;
  1662. { should be intersected with used regs, no ? }
  1663. torestore:=torestore*(rg[R_INTREGISTER].used_in_proc+rg[R_ADDRESSREGISTER].used_in_proc);
  1664. reference_reset_base(ref,NR_STACK_POINTER_REG,0);
  1665. ref.direction:=dir_inc;
  1666. if torestore<>[] then
  1667. list.concat(taicpu.op_ref_regset(A_MOVEM,S_L,ref,torestore));
  1668. }
  1669. end;
  1670. {
  1671. procedure tcg68k.g_save_all_registers(list : TAsmList);
  1672. begin
  1673. end;
  1674. procedure tcg68k.g_restore_all_registers(list : TAsmList;const funcretparaloc:TCGPara);
  1675. begin
  1676. end;
  1677. }
  1678. procedure tcg68k.sign_extend(list: TAsmList;_oldsize : tcgsize; reg: tregister);
  1679. begin
  1680. case _oldsize of
  1681. { sign extend }
  1682. OS_S8:
  1683. begin
  1684. if (isaddressregister(reg)) then
  1685. internalerror(20020729);
  1686. if (current_settings.cputype = cpu_MC68000) then
  1687. begin
  1688. list.concat(taicpu.op_reg(A_EXT,S_W,reg));
  1689. list.concat(taicpu.op_reg(A_EXT,S_L,reg));
  1690. end
  1691. else
  1692. begin
  1693. // list.concat(tai_comment.create(strpnew('sign extend byte')));
  1694. list.concat(taicpu.op_reg(A_EXTB,S_L,reg));
  1695. end;
  1696. end;
  1697. OS_S16:
  1698. begin
  1699. if (isaddressregister(reg)) then
  1700. internalerror(20020729);
  1701. // list.concat(tai_comment.create(strpnew('sign extend word')));
  1702. list.concat(taicpu.op_reg(A_EXT,S_L,reg));
  1703. end;
  1704. { zero extend }
  1705. OS_8:
  1706. begin
  1707. // list.concat(tai_comment.create(strpnew('zero extend byte')));
  1708. list.concat(taicpu.op_const_reg(A_AND,S_L,$FF,reg));
  1709. end;
  1710. OS_16:
  1711. begin
  1712. // list.concat(tai_comment.create(strpnew('zero extend word')));
  1713. list.concat(taicpu.op_const_reg(A_AND,S_L,$FFFF,reg));
  1714. end;
  1715. end; { otherwise the size is already correct }
  1716. end;
  1717. procedure tcg68k.a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel);
  1718. var
  1719. ai : taicpu;
  1720. begin
  1721. if cond=OC_None then
  1722. ai := Taicpu.Op_sym(A_JMP,S_NO,l)
  1723. else
  1724. begin
  1725. ai:=Taicpu.Op_sym(A_Bxx,S_NO,l);
  1726. ai.SetCondition(TOpCmp2AsmCond[cond]);
  1727. end;
  1728. ai.is_jmp:=true;
  1729. list.concat(ai);
  1730. end;
  1731. procedure tcg68k.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
  1732. {
  1733. procedure loadvmttor11;
  1734. var
  1735. href : treference;
  1736. begin
  1737. reference_reset_base(href,NR_R3,0);
  1738. cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R11);
  1739. end;
  1740. procedure op_onr11methodaddr;
  1741. var
  1742. href : treference;
  1743. begin
  1744. if (procdef.extnumber=$ffff) then
  1745. Internalerror(200006139);
  1746. { call/jmp vmtoffs(%eax) ; method offs }
  1747. reference_reset_base(href,NR_R11,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber));
  1748. if not((longint(href.offset) >= low(smallint)) and
  1749. (longint(href.offset) <= high(smallint))) then
  1750. begin
  1751. list.concat(taicpu.op_reg_reg_const(A_ADDIS,NR_R11,NR_R11,
  1752. smallint((href.offset shr 16)+ord(smallint(href.offset and $ffff) < 0))));
  1753. href.offset := smallint(href.offset and $ffff);
  1754. end;
  1755. list.concat(taicpu.op_reg_ref(A_LWZ,NR_R11,href));
  1756. list.concat(taicpu.op_reg(A_MTCTR,NR_R11));
  1757. list.concat(taicpu.op_none(A_BCTR));
  1758. end;
  1759. }
  1760. var
  1761. make_global : boolean;
  1762. begin
  1763. if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
  1764. Internalerror(200006137);
  1765. if not assigned(procdef.struct) or
  1766. (procdef.procoptions*[po_classmethod, po_staticmethod,
  1767. po_methodpointer, po_interrupt, po_iocheck]<>[]) then
  1768. Internalerror(200006138);
  1769. if procdef.owner.symtabletype<>ObjectSymtable then
  1770. Internalerror(200109191);
  1771. make_global:=false;
  1772. if (not current_module.is_unit) or
  1773. create_smartlink or
  1774. (procdef.owner.defowner.owner.symtabletype=globalsymtable) then
  1775. make_global:=true;
  1776. if make_global then
  1777. List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
  1778. else
  1779. List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
  1780. { set param1 interface to self }
  1781. // g_adjust_self_value(list,procdef,ioffset);
  1782. { case 4 }
  1783. if (po_virtualmethod in procdef.procoptions) and
  1784. not is_objectpascal_helper(procdef.struct) then
  1785. begin
  1786. // loadvmttor11;
  1787. // op_onr11methodaddr;
  1788. end
  1789. { case 0 }
  1790. else
  1791. // list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(procdef.mangledname)));
  1792. List.concat(Tai_symbol_end.Createname(labelname));
  1793. end;
  1794. {****************************************************************************}
  1795. { TCG64F68K }
  1796. {****************************************************************************}
  1797. procedure tcg64f68k.a_op64_reg_reg(list : TAsmList;op:TOpCG;size: tcgsize; regsrc,regdst : tregister64);
  1798. var
  1799. hreg1, hreg2 : tregister;
  1800. opcode : tasmop;
  1801. begin
  1802. // writeln('a_op64_reg_reg');
  1803. opcode := topcg2tasmop[op];
  1804. case op of
  1805. OP_ADD :
  1806. begin
  1807. { if one of these three registers is an address
  1808. register, we'll really get into problems!
  1809. }
  1810. if isaddressregister(regdst.reglo) or
  1811. isaddressregister(regdst.reghi) or
  1812. isaddressregister(regsrc.reghi) then
  1813. internalerror(20020817);
  1814. list.concat(taicpu.op_reg_reg(A_ADD,S_L,regsrc.reglo,regdst.reglo));
  1815. list.concat(taicpu.op_reg_reg(A_ADDX,S_L,regsrc.reghi,regdst.reghi));
  1816. end;
  1817. OP_AND,OP_OR :
  1818. begin
  1819. { at least one of the registers must be a data register }
  1820. if (isaddressregister(regdst.reglo) and
  1821. isaddressregister(regsrc.reglo)) or
  1822. (isaddressregister(regsrc.reghi) and
  1823. isaddressregister(regdst.reghi))
  1824. then
  1825. internalerror(20020817);
  1826. cg.a_op_reg_reg(list,op,OS_32,regsrc.reglo,regdst.reglo);
  1827. cg.a_op_reg_reg(list,op,OS_32,regsrc.reghi,regdst.reghi);
  1828. end;
  1829. { this is handled in 1st pass for 32-bit cpu's (helper call) }
  1830. OP_IDIV,OP_DIV,
  1831. OP_IMUL,OP_MUL: internalerror(2002081701);
  1832. { this is also handled in 1st pass for 32-bit cpu's (helper call) }
  1833. OP_SAR,OP_SHL,OP_SHR: internalerror(2002081702);
  1834. OP_SUB:
  1835. begin
  1836. { if one of these three registers is an address
  1837. register, we'll really get into problems!
  1838. }
  1839. if isaddressregister(regdst.reglo) or
  1840. isaddressregister(regdst.reghi) or
  1841. isaddressregister(regsrc.reghi) then
  1842. internalerror(20020817);
  1843. list.concat(taicpu.op_reg_reg(A_SUB,S_L,regsrc.reglo,regdst.reglo));
  1844. list.concat(taicpu.op_reg_reg(A_SUBX,S_L,regsrc.reghi,regdst.reghi));
  1845. end;
  1846. OP_XOR:
  1847. begin
  1848. if isaddressregister(regdst.reglo) or
  1849. isaddressregister(regsrc.reglo) or
  1850. isaddressregister(regsrc.reghi) or
  1851. isaddressregister(regdst.reghi) then
  1852. internalerror(20020817);
  1853. list.concat(taicpu.op_reg_reg(A_EOR,S_L,regsrc.reglo,regdst.reglo));
  1854. list.concat(taicpu.op_reg_reg(A_EOR,S_L,regsrc.reghi,regdst.reghi));
  1855. end;
  1856. end; { end case }
  1857. end;
  1858. procedure tcg64f68k.a_op64_const_reg(list : TAsmList;op:TOpCG;size: tcgsize; value : int64;regdst : tregister64);
  1859. var
  1860. lowvalue : cardinal;
  1861. highvalue : cardinal;
  1862. hreg : tregister;
  1863. begin
  1864. // writeln('a_op64_const_reg');
  1865. { is it optimized out ? }
  1866. // if cg.optimize64_op_const_reg(list,op,value,reg) then
  1867. // exit;
  1868. lowvalue := cardinal(value);
  1869. highvalue:= value shr 32;
  1870. { the destination registers must be data registers }
  1871. if isaddressregister(regdst.reglo) or
  1872. isaddressregister(regdst.reghi) then
  1873. internalerror(20020817);
  1874. case op of
  1875. OP_ADD :
  1876. begin
  1877. hreg:=cg.getintregister(list,OS_INT);
  1878. list.concat(taicpu.op_const_reg(A_MOVE,S_L,highvalue,hreg));
  1879. list.concat(taicpu.op_const_reg(A_ADD,S_L,lowvalue,regdst.reglo));
  1880. list.concat(taicpu.op_reg_reg(A_ADDX,S_L,hreg,regdst.reglo));
  1881. end;
  1882. OP_AND :
  1883. begin
  1884. list.concat(taicpu.op_const_reg(A_AND,S_L,lowvalue,regdst.reglo));
  1885. list.concat(taicpu.op_const_reg(A_AND,S_L,highvalue,regdst.reglo));
  1886. end;
  1887. OP_OR :
  1888. begin
  1889. list.concat(taicpu.op_const_reg(A_OR,S_L,lowvalue,regdst.reglo));
  1890. list.concat(taicpu.op_const_reg(A_OR,S_L,highvalue,regdst.reglo));
  1891. end;
  1892. { this is handled in 1st pass for 32-bit cpus (helper call) }
  1893. OP_IDIV,OP_DIV,
  1894. OP_IMUL,OP_MUL: internalerror(2002081701);
  1895. { this is also handled in 1st pass for 32-bit cpus (helper call) }
  1896. OP_SAR,OP_SHL,OP_SHR: internalerror(2002081702);
  1897. OP_SUB:
  1898. begin
  1899. hreg:=cg.getintregister(list,OS_INT);
  1900. list.concat(taicpu.op_const_reg(A_MOVE,S_L,highvalue,hreg));
  1901. list.concat(taicpu.op_const_reg(A_SUB,S_L,lowvalue,regdst.reglo));
  1902. list.concat(taicpu.op_reg_reg(A_SUBX,S_L,hreg,regdst.reglo));
  1903. end;
  1904. OP_XOR:
  1905. begin
  1906. list.concat(taicpu.op_const_reg(A_EOR,S_L,lowvalue,regdst.reglo));
  1907. list.concat(taicpu.op_const_reg(A_EOR,S_L,highvalue,regdst.reglo));
  1908. end;
  1909. end; { end case }
  1910. end;
  1911. procedure create_codegen;
  1912. begin
  1913. cg := tcg68k.create;
  1914. cg64 :=tcg64f68k.create;
  1915. end;
  1916. end.