cgcpu.pas 51 KB

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