cgcpu.pas 52 KB

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