cgcpu.pas 51 KB

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