cgcpu.pas 52 KB

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