cgcpu.pas 51 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390
  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 (aktcputype<>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 aktmoduleswitches 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 aktmoduleswitches 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 aktmoduleswitches 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 aktcputype = 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 aktcputype = 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 aktcputype = 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 aktcputype = 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 aktcputype = 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 aktcputype = 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 aktcputype = 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 (aktcputype = 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 (aktcputype = 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 (aktcputype = 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 aktoptimizerswitches) 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 (aktcputype=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 (aktcputype=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 (aktcputype = 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 aktmoduleswitches) 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. begin
  1202. // writeln('a_op64_const_reg');
  1203. { is it optimized out ? }
  1204. // if cg.optimize64_op_const_reg(list,op,value,reg) then
  1205. // exit;
  1206. lowvalue := cardinal(value);
  1207. highvalue:= value shr 32;
  1208. { the destination registers must be data registers }
  1209. if isaddressregister(regdst.reglo) or
  1210. isaddressregister(regdst.reghi) then
  1211. internalerror(20020817);
  1212. case op of
  1213. OP_ADD :
  1214. begin
  1215. list.concat(taicpu.op_const_reg(A_ADD,S_L,lowvalue,regdst.reglo));
  1216. list.concat(taicpu.op_const_reg(A_ADDX,S_L,highvalue,regdst.reglo));
  1217. end;
  1218. OP_AND :
  1219. begin
  1220. { should already be optimized out }
  1221. internalerror(2002081801);
  1222. end;
  1223. OP_OR :
  1224. begin
  1225. { should already be optimized out }
  1226. internalerror(2002081802);
  1227. end;
  1228. { this is handled in 1st pass for 32-bit cpu's (helper call) }
  1229. OP_IDIV,OP_DIV,
  1230. OP_IMUL,OP_MUL: internalerror(2002081701);
  1231. { this is also handled in 1st pass for 32-bit cpu's (helper call) }
  1232. OP_SAR,OP_SHL,OP_SHR: internalerror(2002081702);
  1233. OP_SUB:
  1234. begin
  1235. list.concat(taicpu.op_const_reg(A_SUB,S_L,lowvalue,regdst.reglo));
  1236. list.concat(taicpu.op_const_reg(A_SUBX,S_L,highvalue,regdst.reglo));
  1237. end;
  1238. OP_XOR:
  1239. begin
  1240. list.concat(taicpu.op_const_reg(A_EOR,S_L,lowvalue,regdst.reglo));
  1241. list.concat(taicpu.op_const_reg(A_EOR,S_L,highvalue,regdst.reglo));
  1242. end;
  1243. end; { end case }
  1244. end;
  1245. begin
  1246. cg := tcg68k.create;
  1247. cg64 :=tcg64f68k.create;
  1248. end.