cgcpu.pas 52 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by the FPC team
  4. This unit implements the code generator for the 680x0
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit cgcpu;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. cginfo,cgbase,cgobj,
  23. aasmbase,aasmtai,aasmcpu,
  24. cpubase,cpuinfo,cpupara,
  25. node,symconst,cg64f32;
  26. type
  27. tcg68k = class(tcg)
  28. procedure a_call_name(list : taasmoutput;const s : string);override;
  29. procedure a_call_ref(list : taasmoutput;const ref : treference);override;
  30. procedure a_call_reg(list : taasmoutput;reg : tregister);override;
  31. procedure a_load_const_reg(list : taasmoutput;size : tcgsize;a : aword;register : tregister);override;
  32. procedure a_load_reg_ref(list : taasmoutput;size : tcgsize;register : tregister;const ref : treference);override;
  33. procedure a_load_reg_reg(list : taasmoutput;fromsize,tosize : tcgsize;reg1,reg2 : tregister);override;
  34. procedure a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;register : tregister);override;
  35. procedure a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);override;
  36. procedure a_loadfpu_reg_reg(list: taasmoutput; reg1, reg2: tregister); override;
  37. procedure a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister); override;
  38. procedure a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); override;
  39. procedure a_loadmm_reg_reg(list: taasmoutput; reg1, reg2: tregister); override;
  40. procedure a_loadmm_ref_reg(list: taasmoutput; const ref: treference; reg: tregister); override;
  41. procedure a_loadmm_reg_ref(list: taasmoutput; reg: tregister; const ref: treference); override;
  42. procedure a_parammm_reg(list: taasmoutput; reg: tregister); override;
  43. procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister); override;
  44. procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); override;
  45. procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
  46. l : tasmlabel);override;
  47. procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override;
  48. procedure a_jmp_always(list : taasmoutput;l: tasmlabel); override;
  49. procedure a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel); override;
  50. procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: tresflags; reg: TRegister); override;
  51. procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword;delsource,loadref : boolean);override;
  52. { generates overflow checking code for a node }
  53. procedure g_overflowcheck(list: taasmoutput; const p: tnode); override;
  54. procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;elesize:integer); override;
  55. procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
  56. procedure g_restore_frame_pointer(list : taasmoutput);override;
  57. procedure g_return_from_proc(list : taasmoutput;parasize : aword);override;
  58. procedure g_save_standard_registers(list : taasmoutput; usedinproc : tregisterset);override;
  59. procedure g_restore_standard_registers(list : taasmoutput; usedinproc : tregisterset);override;
  60. procedure g_save_all_registers(list : taasmoutput);override;
  61. procedure g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);override;
  62. { for address register allocation }
  63. function get_scratch_reg_address(list : taasmoutput) : tregister;override;
  64. function get_scratch_reg_int(list : taasmoutput) : tregister; override;
  65. protected
  66. function fixref(list: taasmoutput; var ref: treference): boolean;
  67. private
  68. { # Sign or zero extend the register to a full 32-bit value.
  69. The new value is left in the same register.
  70. }
  71. procedure sign_extend(list: taasmoutput;_oldsize : tcgsize; reg: tregister);
  72. procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
  73. end;
  74. tcg64f68k = class(tcg64f32)
  75. procedure a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64);override;
  76. procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;value : qword;reg : tregister64);override;
  77. end;
  78. { This function returns true if the reference+offset is valid.
  79. Otherwise extra code must be generated to solve the reference.
  80. On the m68k, this verifies that the reference is valid
  81. (e.g : if index register is used, then the max displacement
  82. is 256 bytes, if only base is used, then max displacement
  83. is 32K
  84. }
  85. function isvalidrefoffset(const ref: treference): boolean;
  86. const
  87. TCGSize2OpSize: Array[tcgsize] of topsize =
  88. (S_NO,S_B,S_W,S_L,S_L,S_B,S_W,S_L,S_L,
  89. S_FS,S_FD,S_FX,S_NO,S_NO,
  90. S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO);
  91. Implementation
  92. uses
  93. globtype,globals,verbose,systems,cutils,
  94. symdef,symsym,defutil,paramgr,
  95. rgobj,tgobj,rgcpu;
  96. const
  97. { opcode table lookup }
  98. topcg2tasmop: Array[topcg] of tasmop =
  99. (
  100. A_NONE,
  101. A_ADD,
  102. A_AND,
  103. A_DIVU,
  104. A_DIVS,
  105. A_MULS,
  106. A_MULU,
  107. A_NEG,
  108. A_NOT,
  109. A_OR,
  110. A_ASR,
  111. A_LSL,
  112. A_LSR,
  113. A_SUB,
  114. A_EOR
  115. );
  116. TOpCmp2AsmCond: Array[topcmp] of TAsmCond =
  117. (
  118. C_NONE,
  119. C_EQ,
  120. C_GT,
  121. C_LT,
  122. C_GE,
  123. C_LE,
  124. C_NE,
  125. C_LS,
  126. C_CS,
  127. C_CC,
  128. C_HI
  129. );
  130. function isvalidrefoffset(const ref: treference): boolean;
  131. begin
  132. isvalidrefoffset := true;
  133. if ref.index.enum <> R_NO then
  134. begin
  135. if ref.base.enum <> R_NO then
  136. internalerror(20020814);
  137. if (ref.offset < low(shortint)) or (ref.offset > high(shortint)) then
  138. isvalidrefoffset := false
  139. end
  140. else
  141. begin
  142. if (ref.offset < low(smallint)) or (ref.offset > high(smallint)) then
  143. isvalidrefoffset := false;
  144. end;
  145. end;
  146. function tcg68k.get_scratch_reg_int(list : taasmoutput) : tregister;
  147. var
  148. r : tregister;
  149. i : longint;
  150. begin
  151. if unusedscratchregisters=[] then
  152. internalerror(68996);
  153. if R_D0 in unusedscratchregisters then
  154. begin
  155. r.enum := R_D0;
  156. end
  157. else if R_D1 in unusedscratchregisters then
  158. begin
  159. r.enum := R_D1;
  160. end
  161. else
  162. internalerror(10);
  163. exclude(unusedscratchregisters,r.enum);
  164. a_reg_alloc(list,r);
  165. get_scratch_reg_int:=r;
  166. end;
  167. function tcg68k.get_scratch_reg_address(list : taasmoutput) : tregister;
  168. var
  169. r : tregister;
  170. i : longint;
  171. begin
  172. if unusedscratchregisters=[] then
  173. internalerror(68996);
  174. if R_A0 in unusedscratchregisters then
  175. begin
  176. r.enum := R_A0;
  177. end
  178. else if R_A1 in unusedscratchregisters then
  179. begin
  180. r.enum := R_A1;
  181. end
  182. else
  183. internalerror(10);
  184. exclude(unusedscratchregisters,r.enum);
  185. a_reg_alloc(list,r);
  186. get_scratch_reg_address:=r;
  187. end;
  188. {****************************************************************************}
  189. { TCG68K }
  190. {****************************************************************************}
  191. function tcg68k.fixref(list: taasmoutput; var ref: treference): boolean;
  192. var
  193. tmpreg: tregister;
  194. begin
  195. result := false;
  196. { The Coldfire and MC68020+ have extended
  197. addressing capabilities with a 32-bit
  198. displacement.
  199. }
  200. if (aktoptprocessor <> MC68000) then
  201. exit;
  202. if (ref.base.enum <> R_NO) then
  203. begin
  204. if (ref.index.enum <> R_NO) and assigned(ref.symbol) then
  205. internalerror(20020814);
  206. { base + reg }
  207. if ref.index.enum <> R_NO then
  208. begin
  209. { base + reg + offset }
  210. if (ref.offset < low(shortint)) or (ref.offset > high(shortint)) then
  211. begin
  212. list.concat(taicpu.op_const_reg(A_ADD,S_L,ref.offset,ref.base));
  213. fixref := true;
  214. ref.offset := 0;
  215. exit;
  216. end;
  217. end
  218. else
  219. { base + offset }
  220. if (ref.offset < low(smallint)) or (ref.offset > high(smallint)) then
  221. begin
  222. list.concat(taicpu.op_const_reg(A_ADD,S_L,ref.offset,ref.base));
  223. fixref := true;
  224. ref.offset := 0;
  225. exit;
  226. end;
  227. end;
  228. end;
  229. procedure tcg68k.a_call_name(list : taasmoutput;const s : string);
  230. begin
  231. list.concat(taicpu.op_sym(A_JSR,S_NO,objectlibrary.newasmsymbol(s)));
  232. end;
  233. procedure tcg68k.a_call_ref(list : taasmoutput;const ref : treference);
  234. var
  235. href : treference;
  236. begin
  237. href := ref;
  238. fixref(list,href);
  239. list.concat(taicpu.op_ref(A_JSR,S_NO,href));
  240. end;
  241. procedure tcg68k.a_call_reg(list : taasmoutput;reg : tregister);
  242. var
  243. href : treference;
  244. begin
  245. reference_reset_base(href, reg, 0);
  246. a_call_ref(list,href);
  247. end;
  248. procedure tcg68k.a_load_const_reg(list : taasmoutput;size : tcgsize;a : aword;register : tregister);
  249. begin
  250. if (rg.isaddressregister(register)) then
  251. begin
  252. list.concat(taicpu.op_const_reg(A_MOVE,S_L,longint(a),register))
  253. end
  254. else
  255. if a = 0 then
  256. list.concat(taicpu.op_reg(A_CLR,S_L,register))
  257. else
  258. begin
  259. if (longint(a) >= low(shortint)) and (longint(a) <= high(shortint)) then
  260. list.concat(taicpu.op_const_reg(A_MOVEQ,S_L,longint(a),register))
  261. else
  262. list.concat(taicpu.op_const_reg(A_MOVE,S_L,longint(a),register))
  263. end;
  264. end;
  265. procedure tcg68k.a_load_reg_ref(list : taasmoutput;size : tcgsize;register : tregister;const ref : treference);
  266. var
  267. href : treference;
  268. begin
  269. href := ref;
  270. fixref(list,href);
  271. { move to destination reference }
  272. list.concat(taicpu.op_reg_ref(A_MOVE,TCGSize2OpSize[size],register,href));
  273. end;
  274. procedure tcg68k.a_load_reg_reg(list : taasmoutput;fromsize,tosize : tcgsize;reg1,reg2 : tregister);
  275. begin
  276. { move to destination register }
  277. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,reg2));
  278. { zero/sign extend register to 32-bit }
  279. sign_extend(list, fromsize, reg2);
  280. end;
  281. procedure tcg68k.a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;register : tregister);
  282. var
  283. href : treference;
  284. begin
  285. href := ref;
  286. fixref(list,href);
  287. list.concat(taicpu.op_ref_reg(A_MOVE,TCGSize2OpSize[size],href,register));
  288. { extend the value in the register }
  289. sign_extend(list, size, register);
  290. end;
  291. procedure tcg68k.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);
  292. var
  293. href : treference;
  294. begin
  295. if (not rg.isaddressregister(r)) then
  296. begin
  297. internalerror(2002072901);
  298. end;
  299. href:=ref;
  300. fixref(list, href);
  301. list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,r));
  302. end;
  303. procedure tcg68k.a_loadfpu_reg_reg(list: taasmoutput; reg1, reg2: tregister);
  304. begin
  305. { in emulation mode, only 32-bit single is supported }
  306. if cs_fp_emulation in aktmoduleswitches then
  307. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,reg2))
  308. else
  309. list.concat(taicpu.op_reg_reg(A_FMOVE,S_FD,reg1,reg2));
  310. end;
  311. procedure tcg68k.a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister);
  312. var
  313. opsize : topsize;
  314. href : treference;
  315. begin
  316. opsize := tcgsize2opsize[size];
  317. { extended is not supported, since it is not available on Coldfire }
  318. if opsize = S_FX then
  319. internalerror(20020729);
  320. href := ref;
  321. fixref(list,href);
  322. { in emulation mode, only 32-bit single is supported }
  323. if cs_fp_emulation in aktmoduleswitches then
  324. list.concat(taicpu.op_ref_reg(A_MOVE,S_L,href,reg))
  325. else
  326. list.concat(taicpu.op_ref_reg(A_FMOVE,opsize,href,reg));
  327. end;
  328. procedure tcg68k.a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference);
  329. var
  330. opsize : topsize;
  331. begin
  332. opsize := tcgsize2opsize[size];
  333. { extended is not supported, since it is not available on Coldfire }
  334. if opsize = S_FX then
  335. internalerror(20020729);
  336. { in emulation mode, only 32-bit single is supported }
  337. if cs_fp_emulation in aktmoduleswitches then
  338. list.concat(taicpu.op_reg_ref(A_MOVE,S_L,reg, ref))
  339. else
  340. list.concat(taicpu.op_reg_ref(A_FMOVE,opsize,reg, ref));
  341. end;
  342. procedure tcg68k.a_loadmm_reg_reg(list: taasmoutput; reg1, reg2: tregister);
  343. begin
  344. internalerror(20020729);
  345. end;
  346. procedure tcg68k.a_loadmm_ref_reg(list: taasmoutput; const ref: treference; reg: tregister);
  347. begin
  348. internalerror(20020729);
  349. end;
  350. procedure tcg68k.a_loadmm_reg_ref(list: taasmoutput; reg: tregister; const ref: treference);
  351. begin
  352. internalerror(20020729);
  353. end;
  354. procedure tcg68k.a_parammm_reg(list: taasmoutput; reg: tregister);
  355. begin
  356. internalerror(20020729);
  357. end;
  358. procedure tcg68k.a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister);
  359. var
  360. scratch_reg : tregister;
  361. scratch_reg2: tregister;
  362. opcode : tasmop;
  363. r,r2 : Tregister;
  364. begin
  365. { need to emit opcode? }
  366. if optimize_op_const_reg(list, op, a, reg) then
  367. exit;
  368. opcode := topcg2tasmop[op];
  369. case op of
  370. OP_ADD :
  371. Begin
  372. if (a >= 1) and (a <= 8) then
  373. list.concat(taicpu.op_const_reg(A_ADDQ,S_L,a, reg))
  374. else
  375. begin
  376. { all others, including coldfire }
  377. list.concat(taicpu.op_const_reg(A_ADD,S_L,a, reg));
  378. end;
  379. end;
  380. OP_AND,
  381. OP_OR:
  382. Begin
  383. list.concat(taicpu.op_const_reg(topcg2tasmop[op],S_L,longint(a), reg));
  384. end;
  385. OP_DIV :
  386. Begin
  387. internalerror(20020816);
  388. end;
  389. OP_IDIV :
  390. Begin
  391. internalerror(20020816);
  392. end;
  393. OP_IMUL :
  394. Begin
  395. if aktoptprocessor = MC68000 then
  396. begin
  397. r.enum:=R_D0;
  398. r2.enum:=R_D1;
  399. rg.getexplicitregisterint(list,R_D0);
  400. rg.getexplicitregisterint(list,R_D1);
  401. list.concat(taicpu.op_const_reg(A_MOVE,S_L,a, r));
  402. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, r2));
  403. cg.a_call_name(list,'FPC_MUL_LONGINT');
  404. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,r, reg));
  405. rg.ungetregisterint(list,r);
  406. rg.ungetregisterint(list,r2);
  407. end
  408. else
  409. begin
  410. if (rg.isaddressregister(reg)) then
  411. begin
  412. scratch_reg := cg.get_scratch_reg_int(list);
  413. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg));
  414. list.concat(taicpu.op_const_reg(A_MULS,S_L,a,scratch_reg));
  415. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg,reg));
  416. cg.free_scratch_reg(list,scratch_reg);
  417. end
  418. else
  419. list.concat(taicpu.op_const_reg(A_MULS,S_L,a,reg));
  420. end;
  421. end;
  422. OP_MUL :
  423. Begin
  424. if aktoptprocessor = MC68000 then
  425. begin
  426. r.enum:=R_D0;
  427. r2.enum:=R_D1;
  428. rg.getexplicitregisterint(list,R_D0);
  429. rg.getexplicitregisterint(list,R_D1);
  430. list.concat(taicpu.op_const_reg(A_MOVE,S_L,a, r));
  431. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, r2));
  432. cg.a_call_name(list,'FPC_MUL_LONGWORD');
  433. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,r, reg));
  434. rg.ungetregisterint(list,r);
  435. rg.ungetregisterint(list,r2);
  436. end
  437. else
  438. begin
  439. if (rg.isaddressregister(reg)) then
  440. begin
  441. scratch_reg := cg.get_scratch_reg_int(list);
  442. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg));
  443. list.concat(taicpu.op_const_reg(A_MULU,S_L,a,scratch_reg));
  444. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg,reg));
  445. cg.free_scratch_reg(list,scratch_reg);
  446. end
  447. else
  448. list.concat(taicpu.op_const_reg(A_MULU,S_L,a,reg));
  449. end;
  450. end;
  451. OP_SAR,
  452. OP_SHL,
  453. OP_SHR :
  454. Begin
  455. if (a >= 1) and (a <= 8) then
  456. begin
  457. { now allowed to shift an address register }
  458. if (rg.isaddressregister(reg)) then
  459. begin
  460. scratch_reg := cg.get_scratch_reg_int(list);
  461. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg));
  462. list.concat(taicpu.op_const_reg(opcode,S_L,a, scratch_reg));
  463. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg,reg));
  464. cg.free_scratch_reg(list,scratch_reg);
  465. end
  466. else
  467. list.concat(taicpu.op_const_reg(opcode,S_L,a, reg));
  468. end
  469. else
  470. begin
  471. { we must load the data into a register ... :() }
  472. scratch_reg := cg.get_scratch_reg_int(list);
  473. list.concat(taicpu.op_const_reg(A_MOVE,S_L,a, scratch_reg));
  474. { again... since shifting with address register is not allowed }
  475. if (rg.isaddressregister(reg)) then
  476. begin
  477. scratch_reg2 := cg.get_scratch_reg_int(list);
  478. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg2));
  479. list.concat(taicpu.op_reg_reg(opcode,S_L,scratch_reg, scratch_reg2));
  480. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg2,reg));
  481. cg.free_scratch_reg(list,scratch_reg2);
  482. end
  483. else
  484. list.concat(taicpu.op_reg_reg(opcode,S_L,scratch_reg, reg));
  485. cg.free_scratch_reg(list,scratch_reg);
  486. end;
  487. end;
  488. OP_SUB :
  489. Begin
  490. if (a >= 1) and (a <= 8) then
  491. list.concat(taicpu.op_const_reg(A_SUBQ,S_L,a,reg))
  492. else
  493. begin
  494. { all others, including coldfire }
  495. list.concat(taicpu.op_const_reg(A_SUB,S_L,a, reg));
  496. end;
  497. end;
  498. OP_XOR :
  499. Begin
  500. list.concat(taicpu.op_const_reg(A_EORI,S_L,a, reg));
  501. end;
  502. else
  503. internalerror(20020729);
  504. end;
  505. end;
  506. procedure tcg68k.a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister);
  507. var
  508. hreg1,hreg2,r,r2: tregister;
  509. begin
  510. case op of
  511. OP_ADD :
  512. Begin
  513. if aktoptprocessor = ColdFire then
  514. begin
  515. { operation only allowed only a longword }
  516. sign_extend(list, size, reg1);
  517. sign_extend(list, size, reg2);
  518. list.concat(taicpu.op_reg_reg(A_ADD,S_L,reg1, reg2));
  519. end
  520. else
  521. begin
  522. list.concat(taicpu.op_reg_reg(A_ADD,TCGSize2OpSize[size],reg1, reg2));
  523. end;
  524. end;
  525. OP_AND,OP_OR,
  526. OP_SAR,OP_SHL,
  527. OP_SHR,OP_SUB,OP_XOR :
  528. Begin
  529. { load to data registers }
  530. if (rg.isaddressregister(reg1)) then
  531. begin
  532. hreg1 := cg.get_scratch_reg_int(list);
  533. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,hreg1));
  534. end
  535. else
  536. hreg1 := reg1;
  537. if (rg.isaddressregister(reg2)) then
  538. begin
  539. hreg2:= cg.get_scratch_reg_int(list);
  540. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2));
  541. end
  542. else
  543. hreg2 := reg2;
  544. if aktoptprocessor = ColdFire then
  545. begin
  546. { operation only allowed only a longword }
  547. {!***************************************
  548. in the case of shifts, the value to
  549. shift by, should already be valid, so
  550. no need to sign extend the value
  551. !
  552. }
  553. if op in [OP_AND,OP_OR,OP_SUB,OP_XOR] then
  554. sign_extend(list, size, hreg1);
  555. sign_extend(list, size, hreg2);
  556. list.concat(taicpu.op_reg_reg(topcg2tasmop[op],S_L,hreg1, hreg2));
  557. end
  558. else
  559. begin
  560. list.concat(taicpu.op_reg_reg(topcg2tasmop[op],TCGSize2OpSize[size],hreg1, hreg2));
  561. end;
  562. if reg1.enum <> hreg1.enum then
  563. cg.free_scratch_reg(list,hreg1);
  564. { move back result into destination register }
  565. if reg2.enum <> hreg2.enum then
  566. begin
  567. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2));
  568. cg.free_scratch_reg(list,hreg2);
  569. end;
  570. end;
  571. OP_DIV :
  572. Begin
  573. internalerror(20020816);
  574. end;
  575. OP_IDIV :
  576. Begin
  577. internalerror(20020816);
  578. end;
  579. OP_IMUL :
  580. Begin
  581. sign_extend(list, size,reg1);
  582. sign_extend(list, size,reg2);
  583. if aktoptprocessor = MC68000 then
  584. begin
  585. r.enum:=R_D0;
  586. r2.enum:=R_D1;
  587. rg.getexplicitregisterint(list,R_D0);
  588. rg.getexplicitregisterint(list,R_D1);
  589. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1, r));
  590. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2, r2));
  591. cg.a_call_name(list,'FPC_MUL_LONGINT');
  592. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,r, reg2));
  593. rg.ungetregisterint(list,r);
  594. rg.ungetregisterint(list,r2);
  595. end
  596. else
  597. begin
  598. if (rg.isaddressregister(reg1)) then
  599. hreg1 := cg.get_scratch_reg_int(list)
  600. else
  601. hreg1 := reg1;
  602. if (rg.isaddressregister(reg2)) then
  603. hreg2:= cg.get_scratch_reg_int(list)
  604. else
  605. hreg2 := reg2;
  606. if reg1.enum <> hreg1.enum then
  607. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,hreg1));
  608. if reg2.enum <> hreg2.enum then
  609. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2));
  610. list.concat(taicpu.op_reg_reg(A_MULS,S_L,reg1,reg2));
  611. if reg1.enum <> hreg1.enum then
  612. cg.free_scratch_reg(list,hreg1);
  613. { move back result into destination register }
  614. if reg2.enum <> hreg2.enum then
  615. begin
  616. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2));
  617. cg.free_scratch_reg(list,hreg2);
  618. end;
  619. end;
  620. end;
  621. OP_MUL :
  622. Begin
  623. sign_extend(list, size,reg1);
  624. sign_extend(list, size,reg2);
  625. if aktoptprocessor = MC68000 then
  626. begin
  627. r.enum:=R_D0;
  628. r2.enum:=R_D1;
  629. rg.getexplicitregisterint(list,R_D0);
  630. rg.getexplicitregisterint(list,R_D1);
  631. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1, r));
  632. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2, r2));
  633. cg.a_call_name(list,'FPC_MUL_LONGWORD');
  634. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,r, reg2));
  635. rg.ungetregisterint(list,r);
  636. rg.ungetregisterint(list,r2);
  637. end
  638. else
  639. begin
  640. if (rg.isaddressregister(reg1)) then
  641. begin
  642. hreg1 := cg.get_scratch_reg_int(list);
  643. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,hreg1));
  644. end
  645. else
  646. hreg1 := reg1;
  647. if (rg.isaddressregister(reg2)) then
  648. begin
  649. hreg2:= cg.get_scratch_reg_int(list);
  650. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2));
  651. end
  652. else
  653. hreg2 := reg2;
  654. list.concat(taicpu.op_reg_reg(A_MULU,S_L,reg1,reg2));
  655. if reg1.enum <> hreg1.enum then
  656. cg.free_scratch_reg(list,hreg1);
  657. { move back result into destination register }
  658. if reg2.enum <> hreg2.enum then
  659. begin
  660. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2));
  661. cg.free_scratch_reg(list,hreg2);
  662. end;
  663. end;
  664. end;
  665. OP_NEG,
  666. OP_NOT :
  667. Begin
  668. { if there are two operands, move the register,
  669. since the operation will only be done on the result
  670. register.
  671. }
  672. if reg1.enum <> R_NO then
  673. cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,reg1,reg2);
  674. if (rg.isaddressregister(reg2)) then
  675. begin
  676. hreg2 := cg.get_scratch_reg_int(list);
  677. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2));
  678. end
  679. else
  680. hreg2 := reg2;
  681. { coldfire only supports long version }
  682. if aktoptprocessor = ColdFire then
  683. begin
  684. sign_extend(list, size,hreg2);
  685. list.concat(taicpu.op_reg(topcg2tasmop[op],S_L,hreg2));
  686. end
  687. else
  688. begin
  689. list.concat(taicpu.op_reg(topcg2tasmop[op],TCGSize2OpSize[size],hreg2));
  690. end;
  691. if reg2.enum <> hreg2.enum then
  692. begin
  693. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2));
  694. cg.free_scratch_reg(list,hreg2);
  695. end;
  696. end;
  697. else
  698. internalerror(20020729);
  699. end;
  700. end;
  701. procedure tcg68k.a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
  702. l : tasmlabel);
  703. var
  704. hregister : tregister;
  705. begin
  706. if a = 0 then
  707. begin
  708. list.concat(taicpu.op_reg(A_TST,TCGSize2OpSize[size],reg));
  709. end
  710. else
  711. begin
  712. if (aktoptprocessor = ColdFire) then
  713. begin
  714. {
  715. only longword comparison is supported,
  716. and only on data registers.
  717. }
  718. hregister := cg.get_scratch_reg_int(list);
  719. { always move to a data register }
  720. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg,hregister));
  721. { sign/zero extend the register }
  722. sign_extend(list, size,hregister);
  723. list.concat(taicpu.op_const_reg(A_CMPI,S_L,a,hregister));
  724. cg.free_scratch_reg(list,hregister);
  725. end
  726. else
  727. begin
  728. list.concat(taicpu.op_const_reg(A_CMPI,TCGSize2OpSize[size],a,reg));
  729. end;
  730. end;
  731. { emit the actual jump to the label }
  732. a_jmp_cond(list,cmp_op,l);
  733. end;
  734. procedure tcg68k.a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
  735. begin
  736. list.concat(taicpu.op_reg_reg(A_CMP,tcgsize2opsize[size],reg1,reg2));
  737. { emit the actual jump to the label }
  738. a_jmp_cond(list,cmp_op,l);
  739. end;
  740. procedure tcg68k.a_jmp_always(list : taasmoutput;l: tasmlabel);
  741. var
  742. ai: taicpu;
  743. begin
  744. ai := Taicpu.op_sym(A_JMP,S_NO,l);
  745. ai.is_jmp := true;
  746. list.concat(ai);
  747. end;
  748. procedure tcg68k.a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel);
  749. var
  750. ai : taicpu;
  751. begin
  752. ai := Taicpu.op_sym(A_BXX,S_NO,l);
  753. ai.SetCondition(flags_to_cond(f));
  754. ai.is_jmp := true;
  755. list.concat(ai);
  756. end;
  757. procedure tcg68k.g_flags2reg(list: taasmoutput; size: TCgSize; const f: tresflags; reg: TRegister);
  758. var
  759. ai : taicpu;
  760. hreg : tregister;
  761. begin
  762. { move to a Dx register? }
  763. if (rg.isaddressregister(reg)) then
  764. begin
  765. hreg := get_scratch_reg_int(list);
  766. a_load_const_reg(list,size,0,hreg);
  767. ai:=Taicpu.Op_reg(A_Sxx,S_B,hreg);
  768. ai.SetCondition(flags_to_cond(f));
  769. list.concat(ai);
  770. if (aktoptprocessor = ColdFire) then
  771. begin
  772. { neg.b does not exist on the Coldfire
  773. so we need to sign extend the value
  774. before doing a neg.l
  775. }
  776. list.concat(taicpu.op_reg(A_EXTB,S_L,hreg));
  777. list.concat(taicpu.op_reg(A_NEG,S_L,hreg));
  778. end
  779. else
  780. begin
  781. list.concat(taicpu.op_reg(A_NEG,S_B,hreg));
  782. end;
  783. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg,reg));
  784. free_scratch_reg(list,hreg);
  785. end
  786. else
  787. begin
  788. a_load_const_reg(list,size,0,reg);
  789. ai:=Taicpu.Op_reg(A_Sxx,S_B,reg);
  790. ai.SetCondition(flags_to_cond(f));
  791. list.concat(ai);
  792. if (aktoptprocessor = ColdFire) then
  793. begin
  794. { neg.b does not exist on the Coldfire
  795. so we need to sign extend the value
  796. before doing a neg.l
  797. }
  798. list.concat(taicpu.op_reg(A_EXTB,S_L,reg));
  799. list.concat(taicpu.op_reg(A_NEG,S_L,reg));
  800. end
  801. else
  802. begin
  803. list.concat(taicpu.op_reg(A_NEG,S_B,reg));
  804. end;
  805. end;
  806. end;
  807. procedure tcg68k.g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword;delsource,loadref : boolean);
  808. var
  809. helpsize : longint;
  810. i : byte;
  811. reg8,reg32 : tregister;
  812. swap : boolean;
  813. hregister : tregister;
  814. iregister : tregister;
  815. jregister : tregister;
  816. hp1 : treference;
  817. hp2 : treference;
  818. hl : tasmlabel;
  819. hl2: tasmlabel;
  820. popaddress : boolean;
  821. srcref,dstref : treference;
  822. begin
  823. popaddress := false;
  824. { this should never occur }
  825. if len > 65535 then
  826. internalerror(0);
  827. hregister := get_scratch_reg_int(list);
  828. if delsource then
  829. reference_release(list,source);
  830. { from 12 bytes movs is being used }
  831. if (not loadref) and ((len<=8) or (not(cs_littlesize in aktglobalswitches) and (len<=12))) then
  832. begin
  833. srcref := source;
  834. dstref := dest;
  835. helpsize:=len div 4;
  836. { move a dword x times }
  837. for i:=1 to helpsize do
  838. begin
  839. a_load_ref_reg(list,OS_INT,srcref,hregister);
  840. a_load_reg_ref(list,OS_INT,hregister,dstref);
  841. inc(srcref.offset,4);
  842. inc(dstref.offset,4);
  843. dec(len,4);
  844. end;
  845. { move a word }
  846. if len>1 then
  847. begin
  848. a_load_ref_reg(list,OS_16,srcref,hregister);
  849. a_load_reg_ref(list,OS_16,hregister,dstref);
  850. inc(srcref.offset,2);
  851. inc(dstref.offset,2);
  852. dec(len,2);
  853. end;
  854. { move a single byte }
  855. if len>0 then
  856. begin
  857. a_load_ref_reg(list,OS_8,srcref,hregister);
  858. a_load_reg_ref(list,OS_8,hregister,dstref);
  859. end
  860. end
  861. else
  862. begin
  863. iregister := get_scratch_reg_address(list);
  864. jregister := get_scratch_reg_address(list);
  865. { reference for move (An)+,(An)+ }
  866. reference_reset(hp1);
  867. hp1.base := iregister; { source register }
  868. hp1.direction := dir_inc;
  869. reference_reset(hp2);
  870. hp2.base := jregister;
  871. hp2.direction := dir_inc;
  872. { iregister = source }
  873. { jregister = destination }
  874. if loadref then
  875. a_load_ref_reg(list,OS_INT,source,iregister)
  876. else
  877. a_loadaddr_ref_reg(list,source,iregister);
  878. a_loadaddr_ref_reg(list,dest,jregister);
  879. { double word move only on 68020+ machines }
  880. { because of possible alignment problems }
  881. { use fast loop mode }
  882. if (aktoptprocessor=MC68020) then
  883. begin
  884. helpsize := len - len mod 4;
  885. len := len mod 4;
  886. list.concat(taicpu.op_const_reg(A_MOVE,S_L,helpsize div 4,hregister));
  887. objectlibrary.getlabel(hl2);
  888. a_jmp_always(list,hl2);
  889. objectlibrary.getlabel(hl);
  890. a_label(list,hl);
  891. list.concat(taicpu.op_ref_ref(A_MOVE,S_L,hp1,hp2));
  892. cg.a_label(list,hl2);
  893. list.concat(taicpu.op_reg_sym(A_DBRA,S_L,hregister,hl));
  894. if len > 1 then
  895. begin
  896. dec(len,2);
  897. list.concat(taicpu.op_ref_ref(A_MOVE,S_W,hp1,hp2));
  898. end;
  899. if len = 1 then
  900. list.concat(taicpu.op_ref_ref(A_MOVE,S_B,hp1,hp2));
  901. end
  902. else
  903. begin
  904. { Fast 68010 loop mode with no possible alignment problems }
  905. helpsize := len;
  906. list.concat(taicpu.op_const_reg(A_MOVE,S_L,helpsize,hregister));
  907. objectlibrary.getlabel(hl2);
  908. a_jmp_always(list,hl2);
  909. objectlibrary.getlabel(hl);
  910. a_label(list,hl);
  911. list.concat(taicpu.op_ref_ref(A_MOVE,S_B,hp1,hp2));
  912. a_label(list,hl2);
  913. list.concat(taicpu.op_reg_sym(A_DBRA,S_L,hregister,hl));
  914. end;
  915. { restore the registers that we have just used olny if they are used! }
  916. free_scratch_reg(list, iregister);
  917. free_scratch_reg(list, jregister);
  918. if jregister.enum = R_A1 then
  919. hp2.base.enum := R_NO;
  920. if iregister.enum = R_A0 then
  921. hp1.base.enum := R_NO;
  922. reference_release(list,hp1);
  923. reference_release(list,hp2);
  924. end;
  925. { loading SELF-reference again }
  926. g_maybe_loadself(list);
  927. if delsource then
  928. tg.ungetiftemp(list,source);
  929. free_scratch_reg(list,hregister);
  930. end;
  931. procedure tcg68k.g_overflowcheck(list: taasmoutput; const p: tnode);
  932. begin
  933. end;
  934. procedure tcg68k.g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;elesize:integer);
  935. begin
  936. end;
  937. procedure tcg68k.g_stackframe_entry(list : taasmoutput;localsize : longint);
  938. var r,r2,rsp:Tregister;
  939. begin
  940. r.enum:=frame_pointer_reg;
  941. rsp.enum:=stack_pointer_reg;
  942. if localsize<>0 then
  943. begin
  944. { Not to complicate the code generator too much, and since some }
  945. { of the systems only support this format, the localsize cannot }
  946. { exceed 32K in size. }
  947. if (localsize < low(smallint)) or (localsize > high(smallint)) then
  948. CGMessage(cg_e_localsize_too_big);
  949. list.concat(taicpu.op_reg_const(A_LINK,S_W,r,-localsize));
  950. end { endif localsize <> 0 }
  951. else
  952. begin
  953. r2.enum:=R_SPPUSH;
  954. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,r,r2));
  955. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,rsp,r));
  956. end;
  957. end;
  958. procedure tcg68k.g_restore_frame_pointer(list : taasmoutput);
  959. var r:Tregister;
  960. begin
  961. r.enum:=frame_pointer_reg;
  962. list.concat(taicpu.op_reg(A_UNLK,S_NO,r));
  963. end;
  964. procedure tcg68k.g_return_from_proc(list : taasmoutput;parasize : aword);
  965. var
  966. r,hregister : tregister;
  967. begin
  968. {Routines with the poclearstack flag set use only a ret.}
  969. { also routines with parasize=0 }
  970. if (po_clearstack in aktprocdef.procoptions) then
  971. begin
  972. { complex return values are removed from stack in C code PM }
  973. if paramanager.ret_in_param(aktprocdef.rettype.def,aktprocdef.proccalloption) then
  974. list.concat(taicpu.op_const(A_RTD,S_NO,4))
  975. else
  976. list.concat(taicpu.op_none(A_RTS,S_NO));
  977. end
  978. else if (parasize=0) then
  979. begin
  980. list.concat(taicpu.op_none(A_RTS,S_NO));
  981. end
  982. else
  983. begin
  984. { return with immediate size possible here }
  985. { signed! }
  986. { RTD is not supported on the coldfire }
  987. if (aktoptprocessor = MC68020) and (parasize < $7FFF) then
  988. list.concat(taicpu.op_const(A_RTD,S_NO,parasize))
  989. { manually restore the stack }
  990. else
  991. begin
  992. { We must pull the PC Counter from the stack, before }
  993. { restoring the stack pointer, otherwise the PC would }
  994. { point to nowhere! }
  995. { save the PC counter (pop it from the stack) }
  996. hregister := get_scratch_reg_address(list);
  997. r.enum:=R_SPPULL;
  998. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,r,hregister));
  999. { can we do a quick addition ... }
  1000. r.enum:=R_SP;
  1001. if (parasize > 0) and (parasize < 9) then
  1002. list.concat(taicpu.op_const_reg(A_ADDQ,S_L,parasize,r))
  1003. else { nope ... }
  1004. list.concat(taicpu.op_const_reg(A_ADD,S_L,parasize,r));
  1005. { restore the PC counter (push it on the stack) }
  1006. r.enum:=R_SPPUSH;
  1007. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hregister,r));
  1008. list.concat(taicpu.op_none(A_RTS,S_NO));
  1009. free_scratch_reg(list,hregister);
  1010. end;
  1011. end;
  1012. end;
  1013. procedure tcg68k.g_save_standard_registers(list : taasmoutput; usedinproc : tregisterset);
  1014. var
  1015. tosave : tregisterlist;
  1016. r:Tregister;
  1017. begin
  1018. tosave:=std_saved_registers;
  1019. { only save the registers which are not used and must be saved }
  1020. tosave:=tosave*usedinproc;
  1021. r.enum:=R_SPPUSH;
  1022. if tosave<>[] then
  1023. list.concat(taicpu.op_reglist_reg(A_MOVEM,S_L,tosave,r));
  1024. end;
  1025. procedure tcg68k.g_restore_standard_registers(list : taasmoutput; usedinproc : tregisterset);
  1026. var
  1027. torestore : tregisterset;
  1028. r:Tregister;
  1029. begin
  1030. torestore:=std_saved_registers;
  1031. { should be intersected with used regs, no ? }
  1032. torestore:=torestore*usedinproc;
  1033. r.enum:=R_SPPULL;
  1034. if torestore<>[] then
  1035. list.concat(taicpu.op_reg_reglist(A_MOVEM,S_L,r,torestore));
  1036. end;
  1037. procedure tcg68k.g_save_all_registers(list : taasmoutput);
  1038. begin
  1039. end;
  1040. procedure tcg68k.g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);
  1041. begin
  1042. end;
  1043. procedure tcg68k.sign_extend(list: taasmoutput;_oldsize : tcgsize; reg: tregister);
  1044. begin
  1045. case _oldsize of
  1046. { sign extend }
  1047. OS_S8:
  1048. begin
  1049. if (rg.isaddressregister(reg)) then
  1050. internalerror(20020729);
  1051. if (aktoptprocessor = MC68000) then
  1052. begin
  1053. list.concat(taicpu.op_reg(A_EXT,S_W,reg));
  1054. list.concat(taicpu.op_reg(A_EXT,S_L,reg));
  1055. end
  1056. else
  1057. begin
  1058. list.concat(taicpu.op_reg(A_EXTB,S_L,reg));
  1059. end;
  1060. end;
  1061. OS_S16:
  1062. begin
  1063. if (rg.isaddressregister(reg)) then
  1064. internalerror(20020729);
  1065. list.concat(taicpu.op_reg(A_EXT,S_L,reg));
  1066. end;
  1067. { zero extend }
  1068. OS_8:
  1069. begin
  1070. list.concat(taicpu.op_const_reg(A_AND,S_L,$FF,reg));
  1071. end;
  1072. OS_16:
  1073. begin
  1074. list.concat(taicpu.op_const_reg(A_AND,S_L,$FFFF,reg));
  1075. end;
  1076. end; { otherwise the size is already correct }
  1077. end;
  1078. procedure tcg68k.a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
  1079. var
  1080. ai : taicpu;
  1081. begin
  1082. if cond=OC_None then
  1083. ai := Taicpu.Op_sym(A_JMP,S_NO,l)
  1084. else
  1085. begin
  1086. ai:=Taicpu.Op_sym(A_Bxx,S_NO,l);
  1087. ai.SetCondition(TOpCmp2AsmCond[cond]);
  1088. end;
  1089. ai.is_jmp:=true;
  1090. list.concat(ai);
  1091. end;
  1092. {****************************************************************************}
  1093. { TCG64F68K }
  1094. {****************************************************************************}
  1095. procedure tcg64f68k.a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64);
  1096. var
  1097. hreg1, hreg2 : tregister;
  1098. opcode : tasmop;
  1099. begin
  1100. opcode := topcg2tasmop[op];
  1101. case op of
  1102. OP_ADD :
  1103. begin
  1104. { if one of these three registers is an address
  1105. register, we'll really get into problems!
  1106. }
  1107. if rg.isaddressregister(regdst.reglo) or
  1108. rg.isaddressregister(regdst.reghi) or
  1109. rg.isaddressregister(regsrc.reghi) then
  1110. internalerror(20020817);
  1111. list.concat(taicpu.op_reg_reg(A_ADD,S_L,regsrc.reglo,regdst.reglo));
  1112. list.concat(taicpu.op_reg_reg(A_ADDX,S_L,regsrc.reghi,regdst.reghi));
  1113. end;
  1114. OP_AND,OP_OR :
  1115. begin
  1116. { at least one of the registers must be a data register }
  1117. if (rg.isaddressregister(regdst.reglo) and
  1118. rg.isaddressregister(regsrc.reglo)) or
  1119. (rg.isaddressregister(regsrc.reghi) and
  1120. rg.isaddressregister(regdst.reghi))
  1121. then
  1122. internalerror(20020817);
  1123. cg.a_op_reg_reg(list,op,OS_32,regsrc.reglo,regdst.reglo);
  1124. cg.a_op_reg_reg(list,op,OS_32,regsrc.reghi,regdst.reghi);
  1125. end;
  1126. { this is handled in 1st pass for 32-bit cpu's (helper call) }
  1127. OP_IDIV,OP_DIV,
  1128. OP_IMUL,OP_MUL: internalerror(2002081701);
  1129. { this is also handled in 1st pass for 32-bit cpu's (helper call) }
  1130. OP_SAR,OP_SHL,OP_SHR: internalerror(2002081702);
  1131. OP_SUB:
  1132. begin
  1133. { if one of these three registers is an address
  1134. register, we'll really get into problems!
  1135. }
  1136. if rg.isaddressregister(regdst.reglo) or
  1137. rg.isaddressregister(regdst.reghi) or
  1138. rg.isaddressregister(regsrc.reghi) then
  1139. internalerror(20020817);
  1140. list.concat(taicpu.op_reg_reg(A_SUB,S_L,regsrc.reglo,regdst.reglo));
  1141. list.concat(taicpu.op_reg_reg(A_SUBX,S_L,regsrc.reghi,regdst.reghi));
  1142. end;
  1143. OP_XOR:
  1144. begin
  1145. if rg.isaddressregister(regdst.reglo) or
  1146. rg.isaddressregister(regsrc.reglo) or
  1147. rg.isaddressregister(regsrc.reghi) or
  1148. rg.isaddressregister(regdst.reghi) then
  1149. internalerror(20020817);
  1150. list.concat(taicpu.op_reg_reg(A_EOR,S_L,regsrc.reglo,regdst.reglo));
  1151. list.concat(taicpu.op_reg_reg(A_EOR,S_L,regsrc.reghi,regdst.reghi));
  1152. end;
  1153. end; { end case }
  1154. end;
  1155. procedure tcg64f68k.a_op64_const_reg(list : taasmoutput;op:TOpCG;value : qword;reg : tregister64);
  1156. var
  1157. lowvalue : cardinal;
  1158. highvalue : cardinal;
  1159. begin
  1160. { is it optimized out ? }
  1161. if optimize64_op_const_reg(list,op,value,reg) then
  1162. exit;
  1163. lowvalue := cardinal(value);
  1164. highvalue:= value shr 32;
  1165. { the destination registers must be data registers }
  1166. if rg.isaddressregister(reg.reglo) or
  1167. rg.isaddressregister(reg.reghi) then
  1168. internalerror(20020817);
  1169. case op of
  1170. OP_ADD :
  1171. begin
  1172. list.concat(taicpu.op_const_reg(A_ADD,S_L,lowvalue,reg.reglo));
  1173. list.concat(taicpu.op_const_reg(A_ADDX,S_L,highvalue,reg.reglo));
  1174. end;
  1175. OP_AND :
  1176. begin
  1177. { should already be optimized out }
  1178. internalerror(2002081801);
  1179. end;
  1180. OP_OR :
  1181. begin
  1182. { should already be optimized out }
  1183. internalerror(2002081802);
  1184. end;
  1185. { this is handled in 1st pass for 32-bit cpu's (helper call) }
  1186. OP_IDIV,OP_DIV,
  1187. OP_IMUL,OP_MUL: internalerror(2002081701);
  1188. { this is also handled in 1st pass for 32-bit cpu's (helper call) }
  1189. OP_SAR,OP_SHL,OP_SHR: internalerror(2002081702);
  1190. OP_SUB:
  1191. begin
  1192. list.concat(taicpu.op_const_reg(A_SUB,S_L,lowvalue,reg.reglo));
  1193. list.concat(taicpu.op_const_reg(A_SUBX,S_L,highvalue,reg.reglo));
  1194. end;
  1195. OP_XOR:
  1196. begin
  1197. list.concat(taicpu.op_const_reg(A_EOR,S_L,lowvalue,reg.reglo));
  1198. list.concat(taicpu.op_const_reg(A_EOR,S_L,highvalue,reg.reglo));
  1199. end;
  1200. end; { end case }
  1201. end;
  1202. begin
  1203. cg := tcg68k.create;
  1204. cg64 :=tcg64f68k.create;
  1205. end.
  1206. {
  1207. $Log$
  1208. Revision 1.17 2003-02-12 22:11:13 carl
  1209. * some small m68k bugfixes
  1210. Revision 1.16 2003/02/02 19:25:54 carl
  1211. * Several bugfixes for m68k target (register alloc., opcode emission)
  1212. + VIS target
  1213. + Generic add more complete (still not verified)
  1214. Revision 1.15 2003/01/08 18:43:57 daniel
  1215. * Tregister changed into a record
  1216. Revision 1.14 2003/01/05 13:36:53 florian
  1217. * x86-64 compiles
  1218. + very basic support for float128 type (x86-64 only)
  1219. Revision 1.13 2002/12/01 22:12:36 carl
  1220. * rename an error message
  1221. Revision 1.12 2002/11/25 17:43:27 peter
  1222. * splitted defbase in defutil,symutil,defcmp
  1223. * merged isconvertable and is_equal into compare_defs(_ext)
  1224. * made operator search faster by walking the list only once
  1225. Revision 1.11 2002/11/18 17:32:00 peter
  1226. * pass proccalloption to ret_in_xxx and push_xxx functions
  1227. Revision 1.10 2002/09/22 14:15:31 carl
  1228. + a_call_reg
  1229. Revision 1.9 2002/09/17 18:54:05 jonas
  1230. * a_load_reg_reg() now has two size parameters: source and dest. This
  1231. allows some optimizations on architectures that don't encode the
  1232. register size in the register name.
  1233. Revision 1.8 2002/09/08 15:12:45 carl
  1234. + a_call_reg
  1235. Revision 1.7 2002/09/07 20:53:28 carl
  1236. * cardinal -> longword
  1237. Revision 1.6 2002/09/07 15:25:12 peter
  1238. * old logs removed and tabs fixed
  1239. Revision 1.5 2002/08/19 18:17:48 carl
  1240. + optimize64_op_const_reg implemented (optimizes 64-bit constant opcodes)
  1241. * more fixes to m68k for 64-bit operations
  1242. Revision 1.4 2002/08/16 14:24:59 carl
  1243. * issameref() to test if two references are the same (then emit no opcodes)
  1244. + ret_in_reg to replace ret_in_acc
  1245. (fix some register allocation bugs at the same time)
  1246. + save_std_register now has an extra parameter which is the
  1247. usedinproc registers
  1248. Revision 1.3 2002/08/15 08:13:54 carl
  1249. - a_load_sym_ofs_reg removed
  1250. * loadvmt now calls loadaddr_ref_reg instead
  1251. Revision 1.2 2002/08/14 19:16:34 carl
  1252. + m68k type conversion nodes
  1253. + started some mathematical nodes
  1254. * out of bound references should now be handled correctly
  1255. Revision 1.1 2002/08/13 18:30:22 carl
  1256. * rename swatoperands to swapoperands
  1257. + m68k first compilable version (still needs a lot of testing):
  1258. assembler generator, system information , inline
  1259. assembler reader.
  1260. Revision 1.5 2002/08/12 15:08:43 carl
  1261. + stab register indexes for powerpc (moved from gdb to cpubase)
  1262. + tprocessor enumeration moved to cpuinfo
  1263. + linker in target_info is now a class
  1264. * many many updates for m68k (will soon start to compile)
  1265. - removed some ifdef or correct them for correct cpu
  1266. Revision 1.2 2002/08/05 17:27:52 carl
  1267. + updated m68k
  1268. Revision 1.1 2002/07/29 17:51:32 carl
  1269. + restart m68k support
  1270. }