cgcpu.pas 51 KB

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