cgcpu.pas 50 KB

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