cgcpu.pas 52 KB

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