cgcpu.pas 51 KB

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