cgcpu.pas 79 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107
  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. {DEFINE DEBUG_CHARLIE}
  18. {$IFNDEF DEBUG_CHARLIE}
  19. {$WARNINGS OFF}
  20. {$ENDIF}
  21. unit cgcpu;
  22. {$i fpcdefs.inc}
  23. interface
  24. uses
  25. cgbase,cgobj,globtype,
  26. aasmbase,aasmtai,aasmdata,aasmcpu,
  27. cpubase,cpuinfo,
  28. parabase,cpupara,
  29. node,symconst,symtype,symdef,
  30. cgutils,cg64f32;
  31. type
  32. tcg68k = class(tcg)
  33. procedure init_register_allocators;override;
  34. procedure done_register_allocators;override;
  35. procedure a_load_reg_cgpara(list : TAsmList;size : tcgsize;r : tregister;const cgpara : tcgpara);override;
  36. procedure a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const cgpara : tcgpara);override;
  37. procedure a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : tcgpara);override;
  38. procedure a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const cgpara : tcgpara);override;
  39. procedure a_call_name(list : TAsmList;const s : string; weak: boolean);override;
  40. procedure a_call_reg(list : TAsmList;reg : tregister);override;
  41. procedure a_load_const_reg(list : TAsmList;size : tcgsize;a : tcgint;register : tregister);override;
  42. procedure a_load_const_ref(list : TAsmList; tosize: tcgsize; a : tcgint;const ref : treference);override;
  43. procedure a_load_reg_ref(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);override;
  44. procedure a_load_reg_reg(list : TAsmList;fromsize,tosize : tcgsize;reg1,reg2 : tregister);override;
  45. procedure a_load_ref_reg(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);override;
  46. procedure a_load_ref_ref(list : TAsmList;fromsize,tosize : tcgsize;const sref : treference;const dref : treference);override;
  47. procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);override;
  48. procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); override;
  49. procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); override;
  50. procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); override;
  51. procedure a_loadmm_reg_reg(list: TAsmList;fromsize,tosize : tcgsize; reg1, reg2: tregister;shuffle : pmmshuffle); override;
  52. procedure a_loadmm_ref_reg(list: TAsmList;fromsize,tosize : tcgsize; const ref: treference; reg: tregister;shuffle : pmmshuffle); override;
  53. procedure a_loadmm_reg_ref(list: TAsmList;fromsize,tosize : tcgsize; reg: tregister; const ref: treference;shuffle : pmmshuffle); override;
  54. procedure a_loadmm_reg_cgpara(list: TAsmList; size: tcgsize; reg: tregister;const locpara : TCGPara;shuffle : pmmshuffle); override;
  55. procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: tcgsize; a: tcgint; reg: TRegister); override;
  56. // procedure a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference); override;
  57. procedure a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); override;
  58. procedure a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister;
  59. l : tasmlabel);override;
  60. procedure a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override;
  61. procedure a_jmp_name(list : TAsmList;const s : string); override;
  62. procedure a_jmp_always(list : TAsmList;l: tasmlabel); override;
  63. procedure a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel); override;
  64. procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: tresflags; reg: TRegister); override;
  65. procedure g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);override;
  66. { generates overflow checking code for a node }
  67. procedure g_overflowcheck(list: TAsmList; const l:tlocation; def:tdef); override;
  68. procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);override;
  69. procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);override;
  70. // procedure g_restore_frame_pointer(list : TAsmList);override;
  71. // procedure g_return_from_proc(list : TAsmList;parasize : tcgint);override;
  72. procedure g_restore_registers(list:TAsmList);override;
  73. procedure g_save_registers(list:TAsmList);override;
  74. // procedure g_save_all_registers(list : TAsmList);override;
  75. // procedure g_restore_all_registers(list : TAsmList;const funcretparaloc:TCGPara);override;
  76. procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
  77. protected
  78. function fixref(list: TAsmList; var ref: treference): boolean;
  79. private
  80. { # Sign or zero extend the register to a full 32-bit value.
  81. The new value is left in the same register.
  82. }
  83. procedure sign_extend(list: TAsmList;_oldsize : tcgsize; reg: tregister);
  84. procedure a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel);
  85. end;
  86. tcg64f68k = class(tcg64f32)
  87. procedure a_op64_reg_reg(list : TAsmList;op:TOpCG; size: tcgsize; regsrc,regdst : tregister64);override;
  88. procedure a_op64_const_reg(list : TAsmList;op:TOpCG; size: tcgsize; value : int64;regdst : tregister64);override;
  89. end;
  90. { This function returns true if the reference+offset is valid.
  91. Otherwise extra code must be generated to solve the reference.
  92. On the m68k, this verifies that the reference is valid
  93. (e.g : if index register is used, then the max displacement
  94. is 256 bytes, if only base is used, then max displacement
  95. is 32K
  96. }
  97. function isvalidrefoffset(const ref: treference): boolean;
  98. const
  99. TCGSize2OpSize: Array[tcgsize] of topsize =
  100. (S_NO,S_B,S_W,S_L,S_L,S_NO,S_B,S_W,S_L,S_L,S_NO,
  101. S_FS,S_FD,S_FX,S_NO,S_NO,
  102. S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,
  103. S_NO,S_NO,S_NO,S_NO,S_NO,S_NO);
  104. procedure create_codegen;
  105. implementation
  106. uses
  107. globals,verbose,systems,cutils,
  108. symsym,defutil,paramgr,procinfo,
  109. rgobj,tgobj,rgcpu,fmodule;
  110. const
  111. { opcode table lookup }
  112. topcg2tasmop: Array[topcg] of tasmop =
  113. (
  114. A_NONE,
  115. A_MOVE,
  116. A_ADD,
  117. A_AND,
  118. A_DIVU,
  119. A_DIVS,
  120. A_MULS,
  121. A_MULU,
  122. A_NEG,
  123. A_NOT,
  124. A_OR,
  125. A_ASR,
  126. A_LSL,
  127. A_LSR,
  128. A_SUB,
  129. A_EOR,
  130. A_NONE,
  131. A_NONE
  132. );
  133. TOpCmp2AsmCond: Array[topcmp] of TAsmCond =
  134. (
  135. C_NONE,
  136. C_EQ,
  137. C_GT,
  138. C_LT,
  139. C_GE,
  140. C_LE,
  141. C_NE,
  142. C_LS,
  143. C_CS,
  144. C_CC,
  145. C_HI
  146. );
  147. function isvalidrefoffset(const ref: treference): boolean;
  148. begin
  149. isvalidrefoffset := true;
  150. if ref.index <> NR_NO then
  151. begin
  152. if ref.base <> NR_NO then
  153. internalerror(2002081401);
  154. if (ref.offset < low(shortint)) or (ref.offset > high(shortint)) then
  155. isvalidrefoffset := false
  156. end
  157. else
  158. begin
  159. if (ref.offset < low(smallint)) or (ref.offset > high(smallint)) then
  160. isvalidrefoffset := false;
  161. end;
  162. end;
  163. {****************************************************************************}
  164. { TCG68K }
  165. {****************************************************************************}
  166. function use_push(const cgpara:tcgpara):boolean;
  167. begin
  168. result:=(not paramanager.use_fixed_stack) and
  169. assigned(cgpara.location) and
  170. (cgpara.location^.loc=LOC_REFERENCE) and
  171. (cgpara.location^.reference.index=NR_STACK_POINTER_REG);
  172. end;
  173. procedure tcg68k.init_register_allocators;
  174. begin
  175. inherited init_register_allocators;
  176. rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,
  177. [RS_D0,RS_D1,RS_D2,RS_D3,RS_D4,RS_D5,RS_D6,RS_D7],
  178. first_int_imreg,[]);
  179. rg[R_ADDRESSREGISTER]:=trgcpu.create(R_ADDRESSREGISTER,R_SUBWHOLE,
  180. [RS_A0,RS_A1,RS_A2,RS_A3,RS_A4,RS_A5,RS_A6],
  181. first_addr_imreg,[]);
  182. rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBNONE,
  183. [RS_FP0,RS_FP1,RS_FP2,RS_FP3,RS_FP4,RS_FP5,RS_FP6,RS_FP7],
  184. first_fpu_imreg,[]);
  185. end;
  186. procedure tcg68k.done_register_allocators;
  187. begin
  188. rg[R_INTREGISTER].free;
  189. rg[R_FPUREGISTER].free;
  190. rg[R_ADDRESSREGISTER].free;
  191. inherited done_register_allocators;
  192. end;
  193. procedure tcg68k.a_load_reg_cgpara(list : TAsmList;size : tcgsize;r : tregister;const cgpara : tcgpara);
  194. var
  195. pushsize : tcgsize;
  196. ref : treference;
  197. begin
  198. {$ifdef DEBUG_CHARLIE}
  199. // writeln('a_load_reg');_cgpara
  200. {$endif DEBUG_CHARLIE}
  201. { it's probably necessary to port this from x86 later, or provide an m68k solution (KB) }
  202. { TODO: FIX ME! check_register_size()}
  203. // check_register_size(size,r);
  204. if use_push(cgpara) then
  205. begin
  206. cgpara.check_simple_location;
  207. if tcgsize2size[cgpara.location^.size]>cgpara.alignment then
  208. pushsize:=cgpara.location^.size
  209. else
  210. pushsize:=int_cgsize(cgpara.alignment);
  211. reference_reset_base(ref, NR_STACK_POINTER_REG, 0, cgpara.alignment);
  212. ref.direction := dir_dec;
  213. list.concat(taicpu.op_reg_ref(A_MOVE,tcgsize2opsize[pushsize],makeregsize(list,r,pushsize),ref));
  214. end
  215. else
  216. inherited a_load_reg_cgpara(list,size,r,cgpara);
  217. end;
  218. procedure tcg68k.a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const cgpara : tcgpara);
  219. var
  220. pushsize : tcgsize;
  221. ref : treference;
  222. begin
  223. {$ifdef DEBUG_CHARLIE}
  224. // writeln('a_load_const');_cgpara
  225. {$endif DEBUG_CHARLIE}
  226. if use_push(cgpara) then
  227. begin
  228. cgpara.check_simple_location;
  229. if tcgsize2size[cgpara.location^.size]>cgpara.alignment then
  230. pushsize:=cgpara.location^.size
  231. else
  232. pushsize:=int_cgsize(cgpara.alignment);
  233. reference_reset_base(ref, NR_STACK_POINTER_REG, 0, cgpara.alignment);
  234. ref.direction := dir_dec;
  235. list.concat(taicpu.op_const_ref(A_MOVE,tcgsize2opsize[pushsize],a,ref));
  236. end
  237. else
  238. inherited a_load_const_cgpara(list,size,a,cgpara);
  239. end;
  240. procedure tcg68k.a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : tcgpara);
  241. procedure pushdata(paraloc:pcgparalocation;ofs:tcgint);
  242. var
  243. pushsize : tcgsize;
  244. tmpreg : tregister;
  245. href : treference;
  246. ref : treference;
  247. begin
  248. if not assigned(paraloc) then
  249. exit;
  250. { TODO: FIX ME!!! this also triggers location bug }
  251. {if (paraloc^.loc<>LOC_REFERENCE) or
  252. (paraloc^.reference.index<>NR_STACK_POINTER_REG) or
  253. (tcgsize2size[paraloc^.size]>sizeof(tcgint)) then
  254. internalerror(200501162);}
  255. { Pushes are needed in reverse order, add the size of the
  256. current location to the offset where to load from. This
  257. prevents wrong calculations for the last location when
  258. the size is not a power of 2 }
  259. if assigned(paraloc^.next) then
  260. pushdata(paraloc^.next,ofs+tcgsize2size[paraloc^.size]);
  261. { Push the data starting at ofs }
  262. href:=r;
  263. inc(href.offset,ofs);
  264. fixref(list,href);
  265. if tcgsize2size[paraloc^.size]>cgpara.alignment then
  266. pushsize:=paraloc^.size
  267. else
  268. pushsize:=int_cgsize(cgpara.alignment);
  269. reference_reset_base(ref, NR_STACK_POINTER_REG, 0, tcgsize2size[paraloc^.size]);
  270. ref.direction := dir_dec;
  271. if tcgsize2size[paraloc^.size]<cgpara.alignment then
  272. begin
  273. tmpreg:=getintregister(list,pushsize);
  274. a_load_ref_reg(list,paraloc^.size,pushsize,href,tmpreg);
  275. list.concat(taicpu.op_reg_ref(A_MOVE,tcgsize2opsize[pushsize],tmpreg,ref));
  276. end
  277. else
  278. list.concat(taicpu.op_ref_ref(A_MOVE,tcgsize2opsize[pushsize],href,ref));
  279. end;
  280. var
  281. len : tcgint;
  282. href : treference;
  283. begin
  284. {$ifdef DEBUG_CHARLIE}
  285. // writeln('a_load_ref');_cgpara
  286. {$endif DEBUG_CHARLIE}
  287. { cgpara.size=OS_NO requires a copy on the stack }
  288. if use_push(cgpara) then
  289. begin
  290. { Record copy? }
  291. if (cgpara.size in [OS_NO,OS_F64]) or (size=OS_NO) then
  292. begin
  293. cgpara.check_simple_location;
  294. len:=align(cgpara.intsize,cgpara.alignment);
  295. g_stackpointer_alloc(list,len);
  296. reference_reset_base(href,NR_STACK_POINTER_REG,0,cgpara.alignment);
  297. g_concatcopy(list,r,href,len);
  298. end
  299. else
  300. begin
  301. if tcgsize2size[cgpara.size]<>tcgsize2size[size] then
  302. internalerror(200501161);
  303. { We need to push the data in reverse order,
  304. therefor we use a recursive algorithm }
  305. pushdata(cgpara.location,0);
  306. end
  307. end
  308. else
  309. inherited a_load_ref_cgpara(list,size,r,cgpara);
  310. end;
  311. procedure tcg68k.a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const cgpara : tcgpara);
  312. var
  313. tmpreg : tregister;
  314. opsize : topsize;
  315. begin
  316. {$ifdef DEBUG_CHARLIE}
  317. // writeln('a_loadaddr_ref');_cgpara
  318. {$endif DEBUG_CHARLIE}
  319. with r do
  320. begin
  321. { i suppose this is not required for m68k (KB) }
  322. // if (segment<>NR_NO) then
  323. // cgmessage(cg_e_cant_use_far_pointer_there);
  324. if not use_push(cgpara) then
  325. begin
  326. cgpara.check_simple_location;
  327. opsize:=tcgsize2opsize[OS_ADDR];
  328. if (segment=NR_NO) and (base=NR_NO) and (index=NR_NO) then
  329. begin
  330. if assigned(symbol) then
  331. // list.concat(Taicpu.Op_sym_ofs(A_PUSH,opsize,symbol,offset))
  332. else;
  333. // list.concat(Taicpu.Op_const(A_PUSH,opsize,offset));
  334. end
  335. else if (segment=NR_NO) and (base=NR_NO) and (index<>NR_NO) and
  336. (offset=0) and (scalefactor=0) and (symbol=nil) then
  337. // list.concat(Taicpu.Op_reg(A_PUSH,opsize,index))
  338. else if (segment=NR_NO) and (base<>NR_NO) and (index=NR_NO) and
  339. (offset=0) and (symbol=nil) then
  340. // list.concat(Taicpu.Op_reg(A_PUSH,opsize,base))
  341. else
  342. begin
  343. tmpreg:=getaddressregister(list);
  344. a_loadaddr_ref_reg(list,r,tmpreg);
  345. // list.concat(taicpu.op_reg(A_PUSH,opsize,tmpreg));
  346. end;
  347. end
  348. else
  349. inherited a_loadaddr_ref_cgpara(list,r,cgpara);
  350. end;
  351. end;
  352. function tcg68k.fixref(list: TAsmList; var ref: treference): boolean;
  353. var
  354. hreg,idxreg : tregister;
  355. href : treference;
  356. instr : taicpu;
  357. begin
  358. result:=false;
  359. { The MC68020+ has extended
  360. addressing capabilities with a 32-bit
  361. displacement.
  362. }
  363. { first ensure that base is an address register }
  364. if (not assigned (ref.symbol) and (current_settings.cputype<>cpu_MC68000)) and
  365. (ref.base<>NR_NO) and not isaddressregister(ref.base) then
  366. begin
  367. hreg:=getaddressregister(list);
  368. instr:=taicpu.op_reg_reg(A_MOVE,S_L,ref.base,hreg);
  369. add_move_instruction(instr);
  370. list.concat(instr);
  371. fixref:=true;
  372. ref.base:=hreg;
  373. end;
  374. if (current_settings.cputype=cpu_MC68020) then
  375. exit;
  376. { ToDo: check which constraints of Coldfire also apply to MC68000 }
  377. case current_settings.cputype of
  378. cpu_MC68000:
  379. begin
  380. if (ref.base<>NR_NO) then
  381. begin
  382. if (ref.index<>NR_NO) and assigned(ref.symbol) then
  383. begin
  384. hreg:=getaddressregister(list);
  385. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,ref.base,hreg));
  386. list.concat(taicpu.op_reg_reg(A_ADD,S_L,ref.index,hreg));
  387. ref.index:=NR_NO;
  388. ref.base:=hreg;
  389. end;
  390. { base + reg }
  391. if ref.index <> NR_NO then
  392. begin
  393. { base + reg + offset }
  394. if (ref.offset < low(shortint)) or (ref.offset > high(shortint)) then
  395. begin
  396. hreg:=getaddressregister(list);
  397. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,ref.base,hreg));
  398. list.concat(taicpu.op_const_reg(A_ADD,S_L,ref.offset,hreg));
  399. fixref:=true;
  400. ref.offset:=0;
  401. ref.base:=hreg;
  402. exit;
  403. end;
  404. end
  405. else
  406. { base + offset }
  407. if (ref.offset < low(smallint)) or (ref.offset > high(smallint)) then
  408. begin
  409. hreg:=getaddressregister(list);
  410. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,ref.base,hreg));
  411. list.concat(taicpu.op_const_reg(A_ADD,S_L,ref.offset,hreg));
  412. fixref:=true;
  413. ref.offset:=0;
  414. ref.base:=hreg;
  415. exit;
  416. end;
  417. if assigned(ref.symbol) then
  418. begin
  419. hreg:=getaddressregister(list);
  420. idxreg:=ref.base;
  421. ref.base:=NR_NO;
  422. list.concat(taicpu.op_ref_reg(A_LEA,S_L,ref,hreg));
  423. reference_reset_base(ref,hreg,0,ref.alignment);
  424. fixref:=true;
  425. ref.index:=idxreg;
  426. end
  427. else if not isaddressregister(ref.base) then
  428. begin
  429. hreg:=getaddressregister(list);
  430. instr:=taicpu.op_reg_reg(A_MOVE,S_L,ref.base,hreg);
  431. add_move_instruction(instr);
  432. list.concat(instr);
  433. fixref:=true;
  434. ref.base:=hreg;
  435. end;
  436. end
  437. else
  438. { Note: symbol -> ref would be supported as long as ref does not
  439. contain a offset or index... (maybe something for the
  440. optimizer) }
  441. if Assigned(ref.symbol) and (ref.index<>NR_NO) then
  442. begin
  443. hreg:=cg.getaddressregister(list);
  444. idxreg:=ref.index;
  445. ref.index:=NR_NO;
  446. list.concat(taicpu.op_ref_reg(A_LEA,S_L,ref,hreg));
  447. reference_reset_base(ref,hreg,0,ref.alignment);
  448. ref.index:=idxreg;
  449. fixref:=true;
  450. end;
  451. end;
  452. cpu_Coldfire:
  453. begin
  454. if (ref.base<>NR_NO) then
  455. begin
  456. if assigned(ref.symbol) and (ref.index=NR_NO) then
  457. begin
  458. hreg:=cg.getaddressregister(list);
  459. reference_reset_symbol(href,ref.symbol,0,ref.alignment);
  460. list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,hreg));
  461. ref.index:=ref.base;
  462. ref.base:=hreg;
  463. ref.symbol:=nil;
  464. end;
  465. if (ref.index<>NR_NO) and assigned(ref.symbol) then
  466. begin
  467. hreg:=getaddressregister(list);
  468. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,ref.base,hreg));
  469. list.concat(taicpu.op_reg_reg(A_ADD,S_L,hreg,ref.index));
  470. ref.base:=hreg;
  471. ref.index:=NR_NO;
  472. end;
  473. {if (ref.index <> NR_NO) and assigned(ref.symbol) then
  474. internalerror(2002081403);}
  475. { base + reg }
  476. if ref.index <> NR_NO then
  477. begin
  478. { base + reg + offset }
  479. if (ref.offset < low(shortint)) or (ref.offset > high(shortint)) then
  480. begin
  481. hreg:=getaddressregister(list);
  482. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,ref.base,hreg));
  483. list.concat(taicpu.op_const_reg(A_ADD,S_L,ref.offset,hreg));
  484. fixref:=true;
  485. ref.base:=hreg;
  486. ref.offset:=0;
  487. exit;
  488. end;
  489. end
  490. else
  491. { base + offset }
  492. if (ref.offset < low(smallint)) or (ref.offset > high(smallint)) then
  493. begin
  494. hreg:=getaddressregister(list);
  495. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,ref.base,hreg));
  496. list.concat(taicpu.op_const_reg(A_ADD,S_L,ref.offset,hreg));
  497. fixref:=true;
  498. ref.offset:=0;
  499. ref.base:=hreg;
  500. exit;
  501. end;
  502. end
  503. else
  504. { Note: symbol -> ref would be supported as long as ref does not
  505. contain a offset or index... (maybe something for the
  506. optimizer) }
  507. if Assigned(ref.symbol) {and (ref.index<>NR_NO)} then
  508. begin
  509. hreg:=cg.getaddressregister(list);
  510. idxreg:=ref.index;
  511. ref.index:=NR_NO;
  512. list.concat(taicpu.op_ref_reg(A_LEA,S_L,ref,hreg));
  513. reference_reset_base(ref,hreg,0,ref.alignment);
  514. ref.index:=idxreg;
  515. fixref:=true;
  516. end;
  517. end;
  518. end;
  519. end;
  520. procedure tcg68k.a_call_name(list : TAsmList;const s : string; weak: boolean);
  521. var
  522. sym: tasmsymbol;
  523. begin
  524. if not(weak) then
  525. sym:=current_asmdata.RefAsmSymbol(s)
  526. else
  527. sym:=current_asmdata.WeakRefAsmSymbol(s);
  528. list.concat(taicpu.op_sym(A_JSR,S_NO,current_asmdata.RefAsmSymbol(s)));
  529. end;
  530. procedure tcg68k.a_call_reg(list : TAsmList;reg: tregister);
  531. var
  532. tmpref : treference;
  533. tmpreg : tregister;
  534. instr : taicpu;
  535. begin
  536. {$ifdef DEBUG_CHARLIE}
  537. list.concat(tai_comment.create(strpnew('a_call_reg')));
  538. {$endif}
  539. if isaddressregister(reg) then
  540. begin
  541. { if we have an address register, we can jump to the address directly }
  542. reference_reset_base(tmpref,reg,0,4);
  543. end
  544. else
  545. begin
  546. { if we have a data register, we need to move it to an address register first }
  547. tmpreg:=getaddressregister(list);
  548. reference_reset_base(tmpref,tmpreg,0,4);
  549. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg,tmpreg);
  550. add_move_instruction(instr);
  551. list.concat(instr);
  552. end;
  553. list.concat(taicpu.op_ref(A_JSR,S_NO,tmpref));
  554. end;
  555. procedure tcg68k.a_load_const_reg(list : TAsmList;size : tcgsize;a : tcgint;register : tregister);
  556. begin
  557. {$ifdef DEBUG_CHARLIE}
  558. // writeln('a_load_const_reg');
  559. {$endif DEBUG_CHARLIE}
  560. if isaddressregister(register) then
  561. begin
  562. list.concat(taicpu.op_const_reg(A_MOVE,S_L,longint(a),register))
  563. end
  564. else
  565. if a = 0 then
  566. list.concat(taicpu.op_reg(A_CLR,S_L,register))
  567. else
  568. begin
  569. if (longint(a) >= low(shortint)) and (longint(a) <= high(shortint)) then
  570. list.concat(taicpu.op_const_reg(A_MOVEQ,S_L,longint(a),register))
  571. else
  572. list.concat(taicpu.op_const_reg(A_MOVE,tcgsize2opsize[size],longint(a),register));
  573. sign_extend(list,size,register);
  574. end;
  575. end;
  576. procedure tcg68k.a_load_const_ref(list : TAsmList; tosize: tcgsize; a : tcgint;const ref : treference);
  577. var
  578. hreg : tregister;
  579. href : treference;
  580. begin
  581. {$ifdef DEBUG_CHARLIE}
  582. list.concat(tai_comment.create(strpnew('a_load_const_ref')));
  583. {$endif DEBUG_CHARLIE}
  584. href:=ref;
  585. fixref(list,href);
  586. { for coldfire we need to go through a temporary register if we have a
  587. offset, index or symbol given }
  588. if (current_settings.cputype=cpu_coldfire) and
  589. (
  590. (href.offset<>0) or
  591. { TODO : check whether we really need this second condition }
  592. (href.index<>NR_NO) or
  593. assigned(href.symbol)
  594. ) then
  595. begin
  596. hreg:=getintregister(list,tosize);
  597. list.concat(taicpu.op_const_reg(A_MOVE,tcgsize2opsize[tosize],longint(a),hreg));
  598. list.concat(taicpu.op_reg_ref(A_MOVE,tcgsize2opsize[tosize],hreg,href));
  599. end
  600. else
  601. list.concat(taicpu.op_const_ref(A_MOVE,tcgsize2opsize[tosize],longint(a),href));
  602. end;
  603. procedure tcg68k.a_load_reg_ref(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);
  604. var
  605. href : treference;
  606. begin
  607. href := ref;
  608. fixref(list,href);
  609. {$ifdef DEBUG_CHARLIE}
  610. list.concat(tai_comment.create(strpnew('a_load_reg_ref')));
  611. {$endif DEBUG_CHARLIE}
  612. { move to destination reference }
  613. list.concat(taicpu.op_reg_ref(A_MOVE,TCGSize2OpSize[fromsize],register,href));
  614. end;
  615. procedure tcg68k.a_load_ref_ref(list : TAsmList;fromsize,tosize : tcgsize;const sref : treference;const dref : treference);
  616. var
  617. aref: treference;
  618. bref: treference;
  619. dofix : boolean;
  620. hreg: TRegister;
  621. begin
  622. aref := sref;
  623. bref := dref;
  624. fixref(list,aref);
  625. fixref(list,bref);
  626. {$ifdef DEBUG_CHARLIE}
  627. // writeln('a_load_ref_ref');
  628. {$endif DEBUG_CHARLIE}
  629. { Coldfire dislikes certain move combinations }
  630. if current_settings.cputype=cpu_coldfire then
  631. begin
  632. { TODO : move.b/w only allowed in newer coldfires... (ISA_B+) }
  633. dofix:=false;
  634. if { (d16,Ax) and (d8,Ax,Xi) }
  635. (
  636. (aref.base<>NR_NO) and
  637. (
  638. (aref.index<>NR_NO) or
  639. (aref.offset<>0)
  640. )
  641. ) or
  642. { (xxx) }
  643. assigned(aref.symbol) then
  644. begin
  645. if aref.index<>NR_NO then
  646. begin
  647. dofix:={ (d16,Ax) and (d8,Ax,Xi) }
  648. (
  649. (bref.base<>NR_NO) and
  650. (
  651. (bref.index<>NR_NO) or
  652. (bref.offset<>0)
  653. )
  654. ) or
  655. { (xxx) }
  656. assigned(bref.symbol);
  657. end
  658. else
  659. { offset <> 0, but no index }
  660. begin
  661. dofix:={ (d8,Ax,Xi) }
  662. (
  663. (bref.base<>NR_NO) and
  664. (bref.index<>NR_NO)
  665. ) or
  666. { (xxx) }
  667. assigned(bref.symbol);
  668. end;
  669. end;
  670. if dofix then
  671. begin
  672. hreg:=getaddressregister(list);
  673. list.concat(taicpu.op_ref_reg(A_LEA,S_L,bref,hreg));
  674. list.concat(taicpu.op_reg_ref(A_MOVE,S_L{TCGSize2OpSize[fromsize]},hreg,bref));
  675. exit;
  676. end;
  677. end;
  678. list.concat(taicpu.op_ref_ref(A_MOVE,TCGSize2OpSize[fromsize],aref,bref));
  679. end;
  680. procedure tcg68k.a_load_reg_reg(list : TAsmList;fromsize,tosize : tcgsize;reg1,reg2 : tregister);
  681. var
  682. instr : taicpu;
  683. begin
  684. { move to destination register }
  685. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg1,reg2);
  686. add_move_instruction(instr);
  687. list.concat(instr);
  688. { zero/sign extend register to 32-bit }
  689. sign_extend(list, fromsize, reg2);
  690. end;
  691. procedure tcg68k.a_load_ref_reg(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);
  692. var
  693. href : treference;
  694. begin
  695. href:=ref;
  696. fixref(list,href);
  697. list.concat(taicpu.op_ref_reg(A_MOVE,TCGSize2OpSize[fromsize],href,register));
  698. { extend the value in the register }
  699. sign_extend(list, fromsize, register);
  700. end;
  701. procedure tcg68k.a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);
  702. var
  703. href : treference;
  704. // p: pointer;
  705. begin
  706. { TODO: FIX ME!!! take a look on this mess again...}
  707. // if getregtype(r)=R_ADDRESSREGISTER then
  708. // begin
  709. // writeln('address reg?!?');
  710. // p:=nil; dword(p^):=0; {DEBUG CODE... :D )
  711. // internalerror(2002072901);
  712. // end;
  713. href:=ref;
  714. fixref(list, href);
  715. list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,r));
  716. end;
  717. procedure tcg68k.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister);
  718. var
  719. instr : taicpu;
  720. begin
  721. { in emulation mode, only 32-bit single is supported }
  722. if cs_fp_emulation in current_settings.moduleswitches then
  723. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg1,reg2)
  724. else
  725. instr:=taicpu.op_reg_reg(A_FMOVE,tcgsize2opsize[tosize],reg1,reg2);
  726. add_move_instruction(instr);
  727. list.concat(instr);
  728. end;
  729. procedure tcg68k.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister);
  730. var
  731. opsize : topsize;
  732. href : treference;
  733. tmpreg : tregister;
  734. begin
  735. opsize := tcgsize2opsize[fromsize];
  736. { extended is not supported, since it is not available on Coldfire }
  737. if opsize = S_FX then
  738. internalerror(20020729);
  739. href := ref;
  740. fixref(list,href);
  741. { in emulation mode, only 32-bit single is supported }
  742. if cs_fp_emulation in current_settings.moduleswitches then
  743. list.concat(taicpu.op_ref_reg(A_MOVE,S_L,href,reg))
  744. else
  745. begin
  746. list.concat(taicpu.op_ref_reg(A_FMOVE,opsize,href,reg));
  747. if (tosize < fromsize) then
  748. a_loadfpu_reg_reg(list,fromsize,tosize,reg,reg);
  749. end;
  750. end;
  751. procedure tcg68k.a_loadfpu_reg_ref(list: TAsmList; fromsize,tosize: tcgsize; reg: tregister; const ref: treference);
  752. var
  753. opsize : topsize;
  754. begin
  755. opsize := tcgsize2opsize[tosize];
  756. { extended is not supported, since it is not available on Coldfire }
  757. if opsize = S_FX then
  758. internalerror(20020729);
  759. { in emulation mode, only 32-bit single is supported }
  760. if cs_fp_emulation in current_settings.moduleswitches then
  761. list.concat(taicpu.op_reg_ref(A_MOVE,S_L,reg, ref))
  762. else
  763. list.concat(taicpu.op_reg_ref(A_FMOVE,opsize,reg, ref));
  764. end;
  765. procedure tcg68k.a_loadmm_reg_reg(list: TAsmList;fromsize,tosize : tcgsize; reg1, reg2: tregister;shuffle : pmmshuffle);
  766. begin
  767. internalerror(20020729);
  768. end;
  769. procedure tcg68k.a_loadmm_ref_reg(list: TAsmList;fromsize,tosize : tcgsize; const ref: treference; reg: tregister;shuffle : pmmshuffle);
  770. begin
  771. internalerror(20020729);
  772. end;
  773. procedure tcg68k.a_loadmm_reg_ref(list: TAsmList;fromsize,tosize : tcgsize; reg: tregister; const ref: treference;shuffle : pmmshuffle);
  774. begin
  775. internalerror(20020729);
  776. end;
  777. procedure tcg68k.a_loadmm_reg_cgpara(list: TAsmList; size: tcgsize; reg: tregister;const locpara : TCGPara;shuffle : pmmshuffle);
  778. begin
  779. internalerror(20020729);
  780. end;
  781. procedure tcg68k.a_op_const_reg(list : TAsmList; Op: TOpCG; size: tcgsize; a: tcgint; reg: TRegister);
  782. var
  783. scratch_reg : tregister;
  784. scratch_reg2: tregister;
  785. opcode : tasmop;
  786. r,r2 : Tregister;
  787. instr : taicpu;
  788. begin
  789. optimize_op_const(op, a);
  790. opcode := topcg2tasmop[op];
  791. case op of
  792. OP_NONE :
  793. begin
  794. { Opcode is optimized away }
  795. end;
  796. OP_MOVE :
  797. begin
  798. { Optimized, replaced with a simple load }
  799. a_load_const_reg(list,size,a,reg);
  800. end;
  801. OP_ADD :
  802. begin
  803. if (a >= 1) and (a <= 8) then
  804. list.concat(taicpu.op_const_reg(A_ADDQ,S_L,a, reg))
  805. else
  806. begin
  807. { all others, including coldfire }
  808. list.concat(taicpu.op_const_reg(A_ADD,S_L,a, reg));
  809. end;
  810. end;
  811. OP_AND,
  812. OP_OR:
  813. begin
  814. if isaddressregister(reg) then
  815. begin
  816. { use scratch register (there is a anda/ora though...) }
  817. scratch_reg:=getintregister(list,OS_INT);
  818. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg,scratch_reg);
  819. add_move_instruction(instr);
  820. list.concat(instr);
  821. list.concat(taicpu.op_const_reg(opcode,S_L,longint(a),scratch_reg));
  822. instr:=taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg,reg);
  823. add_move_instruction(instr);
  824. list.concat(instr);
  825. end
  826. else
  827. list.concat(taicpu.op_const_reg(topcg2tasmop[op],S_L,longint(a), reg));
  828. end;
  829. OP_DIV :
  830. begin
  831. internalerror(20020816);
  832. end;
  833. OP_IDIV :
  834. begin
  835. internalerror(20020816);
  836. end;
  837. OP_IMUL :
  838. begin
  839. if current_settings.cputype<>cpu_MC68020 then
  840. begin
  841. r:=NR_D0;
  842. r2:=NR_D1;
  843. cg.getcpuregister(list,NR_D0);
  844. cg.getcpuregister(list,NR_D1);
  845. list.concat(taicpu.op_const_reg(A_MOVE,S_L,a, r));
  846. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg, r2);
  847. add_move_instruction(instr);
  848. list.concat(instr);
  849. cg.a_call_name(list,'FPC_MUL_LONGINT',false);
  850. instr:=taicpu.op_reg_reg(A_MOVE,S_L,r, reg);
  851. add_move_instruction(instr);
  852. list.concat(instr);
  853. cg.ungetcpuregister(list,r);
  854. cg.ungetcpuregister(list,r2);
  855. end
  856. else
  857. begin
  858. if (isaddressregister(reg)) then
  859. begin
  860. scratch_reg := getintregister(list,OS_INT);
  861. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg);
  862. add_move_instruction(instr);
  863. list.concat(instr);
  864. list.concat(taicpu.op_const_reg(A_MULS,S_L,a,scratch_reg));
  865. instr:=taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg,reg);
  866. add_move_instruction(instr);
  867. list.concat(instr);
  868. end
  869. else
  870. list.concat(taicpu.op_const_reg(A_MULS,S_L,a,reg));
  871. end;
  872. end;
  873. OP_MUL :
  874. begin
  875. if current_settings.cputype<>cpu_MC68020 then
  876. begin
  877. r:=NR_D0;
  878. r2:=NR_D1;
  879. cg.getcpuregister(list,NR_D0);
  880. cg.getcpuregister(list,NR_D1);
  881. list.concat(taicpu.op_const_reg(A_MOVE,S_L,a, r));
  882. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg, r2);
  883. add_move_instruction(instr);
  884. list.concat(instr);
  885. cg.a_call_name(list,'FPC_MUL_DWORD',false);
  886. instr:=taicpu.op_reg_reg(A_MOVE,S_L,r, reg);
  887. add_move_instruction(instr);
  888. list.concat(instr);
  889. cg.ungetcpuregister(list,r);
  890. cg.ungetcpuregister(list,r2);
  891. end
  892. else
  893. begin
  894. if (isaddressregister(reg)) then
  895. begin
  896. scratch_reg := getintregister(list,OS_INT);
  897. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg);
  898. add_move_instruction(instr);
  899. list.concat(instr);
  900. list.concat(taicpu.op_const_reg(A_MULU,S_L,a,scratch_reg));
  901. instr:=taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg,reg);
  902. add_move_instruction(instr);
  903. list.concat(instr);
  904. end
  905. else
  906. list.concat(taicpu.op_const_reg(A_MULU,S_L,a,reg));
  907. end;
  908. end;
  909. OP_SAR,
  910. OP_SHL,
  911. OP_SHR :
  912. begin
  913. if (a >= 1) and (a <= 8) then
  914. begin
  915. { not allowed to shift an address register }
  916. if (isaddressregister(reg)) then
  917. begin
  918. scratch_reg := getintregister(list,OS_INT);
  919. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg);
  920. add_move_instruction(instr);
  921. list.concat(instr);
  922. list.concat(taicpu.op_const_reg(opcode,S_L,a, scratch_reg));
  923. instr:=taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg,reg);
  924. add_move_instruction(instr);
  925. list.concat(instr);
  926. end
  927. else
  928. list.concat(taicpu.op_const_reg(opcode,S_L,a, reg));
  929. end
  930. else
  931. begin
  932. { we must load the data into a register ... :() }
  933. scratch_reg := cg.getintregister(list,OS_INT);
  934. list.concat(taicpu.op_const_reg(A_MOVE,S_L,a, scratch_reg));
  935. { again... since shifting with address register is not allowed }
  936. if (isaddressregister(reg)) then
  937. begin
  938. scratch_reg2 := cg.getintregister(list,OS_INT);
  939. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg2);
  940. add_move_instruction(instr);
  941. list.concat(instr);
  942. list.concat(taicpu.op_reg_reg(opcode,S_L,scratch_reg, scratch_reg2));
  943. instr:=taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg2,reg);
  944. add_move_instruction(instr);
  945. list.concat(instr);
  946. end
  947. else
  948. list.concat(taicpu.op_reg_reg(opcode,S_L,scratch_reg, reg));
  949. end;
  950. end;
  951. OP_SUB :
  952. begin
  953. if (a >= 1) and (a <= 8) then
  954. list.concat(taicpu.op_const_reg(A_SUBQ,S_L,a,reg))
  955. else
  956. begin
  957. { all others, including coldfire }
  958. list.concat(taicpu.op_const_reg(A_SUB,S_L,a, reg));
  959. end;
  960. end;
  961. OP_XOR :
  962. begin
  963. list.concat(taicpu.op_const_reg(A_EORI,S_L,a, reg));
  964. end;
  965. else
  966. internalerror(20020729);
  967. end;
  968. end;
  969. {
  970. procedure tcg68k.a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference);
  971. var
  972. opcode: tasmop;
  973. begin
  974. writeln('a_op_const_ref');
  975. optimize_op_const(op, a);
  976. opcode := topcg2tasmop[op];
  977. case op of
  978. OP_NONE :
  979. begin
  980. { opcode was optimized away }
  981. end;
  982. OP_MOVE :
  983. begin
  984. { Optimized, replaced with a simple load }
  985. a_load_const_ref(list,size,a,ref);
  986. end;
  987. else
  988. begin
  989. internalerror(2007010101);
  990. end;
  991. end;
  992. end;
  993. }
  994. procedure tcg68k.a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister);
  995. var
  996. hreg1,hreg2,r,r2: tregister;
  997. instr : taicpu;
  998. begin
  999. case op of
  1000. OP_ADD :
  1001. begin
  1002. if current_settings.cputype = cpu_ColdFire then
  1003. begin
  1004. { operation only allowed only a longword }
  1005. sign_extend(list, size, reg1);
  1006. sign_extend(list, size, reg2);
  1007. list.concat(taicpu.op_reg_reg(A_ADD,S_L,reg1, reg2));
  1008. end
  1009. else
  1010. begin
  1011. list.concat(taicpu.op_reg_reg(A_ADD,TCGSize2OpSize[size],reg1, reg2));
  1012. end;
  1013. end;
  1014. OP_AND,OP_OR,
  1015. OP_SAR,OP_SHL,
  1016. OP_SHR,OP_SUB,OP_XOR :
  1017. begin
  1018. { load to data registers }
  1019. if (isaddressregister(reg1)) then
  1020. begin
  1021. hreg1 := getintregister(list,OS_INT);
  1022. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg1,hreg1);
  1023. add_move_instruction(instr);
  1024. list.concat(instr);
  1025. end
  1026. else
  1027. hreg1 := reg1;
  1028. if (isaddressregister(reg2)) then
  1029. begin
  1030. hreg2:= getintregister(list,OS_INT);
  1031. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2);
  1032. add_move_instruction(instr);
  1033. list.concat(instr);
  1034. end
  1035. else
  1036. hreg2 := reg2;
  1037. if current_settings.cputype = cpu_ColdFire then
  1038. begin
  1039. { operation only allowed only a longword }
  1040. {!***************************************
  1041. in the case of shifts, the value to
  1042. shift by, should already be valid, so
  1043. no need to sign extend the value
  1044. !
  1045. }
  1046. if op in [OP_AND,OP_OR,OP_SUB,OP_XOR] then
  1047. sign_extend(list, size, hreg1);
  1048. sign_extend(list, size, hreg2);
  1049. instr:=taicpu.op_reg_reg(topcg2tasmop[op],S_L,hreg1, hreg2);
  1050. add_move_instruction(instr);
  1051. list.concat(instr);
  1052. end
  1053. else
  1054. begin
  1055. list.concat(taicpu.op_reg_reg(topcg2tasmop[op],TCGSize2OpSize[size],hreg1, hreg2));
  1056. end;
  1057. { move back result into destination register }
  1058. if reg2 <> hreg2 then
  1059. begin
  1060. instr:=taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2);
  1061. add_move_instruction(instr);
  1062. list.concat(instr);
  1063. end;
  1064. end;
  1065. OP_DIV :
  1066. begin
  1067. internalerror(20020816);
  1068. end;
  1069. OP_IDIV :
  1070. begin
  1071. internalerror(20020816);
  1072. end;
  1073. OP_IMUL :
  1074. begin
  1075. sign_extend(list, size,reg1);
  1076. sign_extend(list, size,reg2);
  1077. if current_settings.cputype = cpu_MC68000 then
  1078. begin
  1079. r:=NR_D0;
  1080. r2:=NR_D1;
  1081. cg.getcpuregister(list,NR_D0);
  1082. cg.getcpuregister(list,NR_D1);
  1083. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg1, r);
  1084. add_move_instruction(instr);
  1085. list.concat(instr);
  1086. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg2, r2);
  1087. add_move_instruction(instr);
  1088. list.concat(instr);
  1089. cg.a_call_name(list,'FPC_MUL_LONGINT',false);
  1090. instr:=taicpu.op_reg_reg(A_MOVE,S_L,r, reg2);
  1091. add_move_instruction(instr);
  1092. list.concat(instr);
  1093. cg.ungetcpuregister(list,r);
  1094. cg.ungetcpuregister(list,r2);
  1095. end
  1096. else
  1097. begin
  1098. // writeln('doing 68020');
  1099. if (isaddressregister(reg1)) then
  1100. hreg1 := getintregister(list,OS_INT)
  1101. else
  1102. hreg1 := reg1;
  1103. if (isaddressregister(reg2)) then
  1104. hreg2:= getintregister(list,OS_INT)
  1105. else
  1106. hreg2 := reg2;
  1107. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg1,hreg1);
  1108. add_move_instruction(instr);
  1109. list.concat(instr);
  1110. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2);
  1111. add_move_instruction(instr);
  1112. list.concat(instr);
  1113. list.concat(taicpu.op_reg_reg(A_MULS,S_L,reg1,reg2));
  1114. { move back result into destination register }
  1115. if reg2 <> hreg2 then
  1116. begin
  1117. instr:=taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2);
  1118. add_move_instruction(instr);
  1119. list.concat(instr);
  1120. end;
  1121. end;
  1122. end;
  1123. OP_MUL :
  1124. begin
  1125. sign_extend(list, size,reg1);
  1126. sign_extend(list, size,reg2);
  1127. if current_settings.cputype <> cpu_MC68020 then
  1128. begin
  1129. r:=NR_D0;
  1130. r2:=NR_D1;
  1131. cg.getcpuregister(list,NR_D0);
  1132. cg.getcpuregister(list,NR_D1);
  1133. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg1, r);
  1134. add_move_instruction(instr);
  1135. list.concat(instr);
  1136. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg2, r2);
  1137. add_move_instruction(instr);
  1138. list.concat(instr);
  1139. cg.a_call_name(list,'FPC_MUL_DWORD',false);
  1140. instr:=taicpu.op_reg_reg(A_MOVE,S_L,r, reg2);
  1141. add_move_instruction(instr);
  1142. list.concat(instr);
  1143. cg.ungetcpuregister(list,r);
  1144. cg.ungetcpuregister(list,r2);
  1145. end
  1146. else
  1147. begin
  1148. if (isaddressregister(reg1)) then
  1149. begin
  1150. hreg1 := cg.getintregister(list,OS_INT);
  1151. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg1,hreg1);
  1152. add_move_instruction(instr);
  1153. list.concat(instr);
  1154. end
  1155. else
  1156. hreg1 := reg1;
  1157. if (isaddressregister(reg2)) then
  1158. begin
  1159. hreg2:= cg.getintregister(list,OS_INT);
  1160. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2);
  1161. add_move_instruction(instr);
  1162. list.concat(instr);
  1163. end
  1164. else
  1165. hreg2 := reg2;
  1166. list.concat(taicpu.op_reg_reg(A_MULU,S_L,reg1,reg2));
  1167. { move back result into destination register }
  1168. if reg2<>hreg2 then
  1169. begin
  1170. instr:=taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2);
  1171. add_move_instruction(instr);
  1172. list.concat(instr);
  1173. end;
  1174. end;
  1175. end;
  1176. OP_NEG,
  1177. OP_NOT :
  1178. Begin
  1179. { if there are two operands, move the register,
  1180. since the operation will only be done on the result
  1181. register.
  1182. }
  1183. if reg1 <> NR_NO then
  1184. cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,reg1,reg2);
  1185. if (isaddressregister(reg2)) then
  1186. begin
  1187. hreg2 := getintregister(list,OS_INT);
  1188. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2);
  1189. add_move_instruction(instr);
  1190. list.concat(instr);
  1191. end
  1192. else
  1193. hreg2 := reg2;
  1194. { coldfire only supports long version }
  1195. if current_settings.cputype = cpu_ColdFire then
  1196. begin
  1197. sign_extend(list, size,hreg2);
  1198. list.concat(taicpu.op_reg(topcg2tasmop[op],S_L,hreg2));
  1199. end
  1200. else
  1201. begin
  1202. list.concat(taicpu.op_reg(topcg2tasmop[op],TCGSize2OpSize[size],hreg2));
  1203. end;
  1204. if reg2 <> hreg2 then
  1205. begin
  1206. instr:=taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2);
  1207. add_move_instruction(instr);
  1208. list.concat(instr);
  1209. end;
  1210. end;
  1211. else
  1212. internalerror(20020729);
  1213. end;
  1214. end;
  1215. procedure tcg68k.a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister;
  1216. l : tasmlabel);
  1217. var
  1218. hregister : tregister;
  1219. instr : taicpu;
  1220. begin
  1221. if a = 0 then
  1222. begin
  1223. if (current_settings.cputype = cpu_MC68000) and isaddressregister(reg) then
  1224. begin
  1225. {
  1226. 68000 does not seem to like address register for TST instruction
  1227. }
  1228. { always move to a data register }
  1229. hregister := getintregister(list,OS_INT);
  1230. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg,hregister);
  1231. add_move_instruction(instr);
  1232. list.concat(instr);
  1233. { sign/zero extend the register }
  1234. sign_extend(list, size,hregister);
  1235. reg:=hregister;
  1236. end;
  1237. list.concat(taicpu.op_reg(A_TST,TCGSize2OpSize[size],reg));
  1238. end
  1239. else
  1240. begin
  1241. if (current_settings.cputype = cpu_ColdFire) then
  1242. begin
  1243. {
  1244. only longword comparison is supported,
  1245. and only on data registers.
  1246. }
  1247. hregister := getintregister(list,OS_INT);
  1248. { always move to a data register }
  1249. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg,hregister);
  1250. add_move_instruction(instr);
  1251. list.concat(instr);
  1252. { sign/zero extend the register }
  1253. sign_extend(list, size,hregister);
  1254. list.concat(taicpu.op_const_reg(A_CMPI,S_L,a,hregister));
  1255. end
  1256. else
  1257. begin
  1258. list.concat(taicpu.op_const_reg(A_CMPI,TCGSize2OpSize[size],a,reg));
  1259. end;
  1260. end;
  1261. { emit the actual jump to the label }
  1262. a_jmp_cond(list,cmp_op,l);
  1263. end;
  1264. procedure tcg68k.a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
  1265. begin
  1266. list.concat(taicpu.op_reg_reg(A_CMP,tcgsize2opsize[size],reg1,reg2));
  1267. { emit the actual jump to the label }
  1268. a_jmp_cond(list,cmp_op,l);
  1269. end;
  1270. procedure tcg68k.a_jmp_name(list: TAsmList; const s: string);
  1271. var
  1272. ai: taicpu;
  1273. begin
  1274. ai := Taicpu.op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(s));
  1275. ai.is_jmp := true;
  1276. list.concat(ai);
  1277. end;
  1278. procedure tcg68k.a_jmp_always(list : TAsmList;l: tasmlabel);
  1279. var
  1280. ai: taicpu;
  1281. begin
  1282. ai := Taicpu.op_sym(A_JMP,S_NO,l);
  1283. ai.is_jmp := true;
  1284. list.concat(ai);
  1285. end;
  1286. procedure tcg68k.a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel);
  1287. var
  1288. ai : taicpu;
  1289. begin
  1290. ai := Taicpu.op_sym(A_BXX,S_NO,l);
  1291. ai.SetCondition(flags_to_cond(f));
  1292. ai.is_jmp := true;
  1293. list.concat(ai);
  1294. end;
  1295. procedure tcg68k.g_flags2reg(list: TAsmList; size: TCgSize; const f: tresflags; reg: TRegister);
  1296. var
  1297. ai : taicpu;
  1298. hreg : tregister;
  1299. instr : taicpu;
  1300. begin
  1301. { move to a Dx register? }
  1302. if (isaddressregister(reg)) then
  1303. begin
  1304. hreg := getintregister(list,OS_INT);
  1305. a_load_const_reg(list,size,0,hreg);
  1306. ai:=Taicpu.Op_reg(A_Sxx,S_B,hreg);
  1307. ai.SetCondition(flags_to_cond(f));
  1308. list.concat(ai);
  1309. if (current_settings.cputype = cpu_ColdFire) then
  1310. begin
  1311. { neg.b does not exist on the Coldfire
  1312. so we need to sign extend the value
  1313. before doing a neg.l
  1314. }
  1315. list.concat(taicpu.op_reg(A_EXTB,S_L,hreg));
  1316. list.concat(taicpu.op_reg(A_NEG,S_L,hreg));
  1317. end
  1318. else
  1319. begin
  1320. list.concat(taicpu.op_reg(A_NEG,S_B,hreg));
  1321. end;
  1322. instr:=taicpu.op_reg_reg(A_MOVE,S_L,hreg,reg);
  1323. add_move_instruction(instr);
  1324. list.concat(instr);
  1325. end
  1326. else
  1327. begin
  1328. a_load_const_reg(list,size,0,reg);
  1329. ai:=Taicpu.Op_reg(A_Sxx,S_B,reg);
  1330. ai.SetCondition(flags_to_cond(f));
  1331. list.concat(ai);
  1332. if (current_settings.cputype = cpu_ColdFire) then
  1333. begin
  1334. { neg.b does not exist on the Coldfire
  1335. so we need to sign extend the value
  1336. before doing a neg.l
  1337. }
  1338. list.concat(taicpu.op_reg(A_EXTB,S_L,reg));
  1339. list.concat(taicpu.op_reg(A_NEG,S_L,reg));
  1340. end
  1341. else
  1342. begin
  1343. list.concat(taicpu.op_reg(A_NEG,S_B,reg));
  1344. end;
  1345. end;
  1346. end;
  1347. procedure tcg68k.g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);
  1348. var
  1349. helpsize : longint;
  1350. i : byte;
  1351. reg8,reg32 : tregister;
  1352. swap : boolean;
  1353. hregister : tregister;
  1354. iregister : tregister;
  1355. jregister : tregister;
  1356. hp1 : treference;
  1357. hp2 : treference;
  1358. hl : tasmlabel;
  1359. hl2: tasmlabel;
  1360. popaddress : boolean;
  1361. srcref,dstref : treference;
  1362. begin
  1363. popaddress := false;
  1364. // writeln('concatcopy:',len);
  1365. { this should never occur }
  1366. if len > 65535 then
  1367. internalerror(0);
  1368. hregister := getintregister(list,OS_INT);
  1369. // if delsource then
  1370. // reference_release(list,source);
  1371. { from 12 bytes movs is being used }
  1372. if {(not loadref) and} ((len<=8) or (not(cs_opt_size in current_settings.optimizerswitches) and (len<=12))) then
  1373. begin
  1374. srcref := source;
  1375. dstref := dest;
  1376. helpsize:=len div 4;
  1377. { move a dword x times }
  1378. for i:=1 to helpsize do
  1379. begin
  1380. a_load_ref_reg(list,OS_INT,OS_INT,srcref,hregister);
  1381. a_load_reg_ref(list,OS_INT,OS_INT,hregister,dstref);
  1382. inc(srcref.offset,4);
  1383. inc(dstref.offset,4);
  1384. dec(len,4);
  1385. end;
  1386. { move a word }
  1387. if len>1 then
  1388. begin
  1389. a_load_ref_reg(list,OS_16,OS_16,srcref,hregister);
  1390. a_load_reg_ref(list,OS_16,OS_16,hregister,dstref);
  1391. inc(srcref.offset,2);
  1392. inc(dstref.offset,2);
  1393. dec(len,2);
  1394. end;
  1395. { move a single byte }
  1396. if len>0 then
  1397. begin
  1398. a_load_ref_reg(list,OS_8,OS_8,srcref,hregister);
  1399. a_load_reg_ref(list,OS_8,OS_8,hregister,dstref);
  1400. end
  1401. end
  1402. else
  1403. begin
  1404. iregister:=getaddressregister(list);
  1405. jregister:=getaddressregister(list);
  1406. { reference for move (An)+,(An)+ }
  1407. reference_reset(hp1,source.alignment);
  1408. hp1.base := iregister; { source register }
  1409. hp1.direction := dir_inc;
  1410. reference_reset(hp2,dest.alignment);
  1411. hp2.base := jregister;
  1412. hp2.direction := dir_inc;
  1413. { iregister = source }
  1414. { jregister = destination }
  1415. { if loadref then
  1416. cg.a_load_ref_reg(list,OS_INT,OS_INT,source,iregister)
  1417. else}
  1418. a_loadaddr_ref_reg(list,source,iregister);
  1419. a_loadaddr_ref_reg(list,dest,jregister);
  1420. { double word move only on 68020+ machines }
  1421. { because of possible alignment problems }
  1422. { use fast loop mode }
  1423. if (current_settings.cputype=cpu_MC68020) then
  1424. begin
  1425. helpsize := len - len mod 4;
  1426. len := len mod 4;
  1427. list.concat(taicpu.op_const_reg(A_MOVE,S_L,helpsize div 4,hregister));
  1428. current_asmdata.getjumplabel(hl2);
  1429. a_jmp_always(list,hl2);
  1430. current_asmdata.getjumplabel(hl);
  1431. a_label(list,hl);
  1432. list.concat(taicpu.op_ref_ref(A_MOVE,S_L,hp1,hp2));
  1433. a_label(list,hl2);
  1434. list.concat(taicpu.op_reg_sym(A_DBRA,S_L,hregister,hl));
  1435. if len > 1 then
  1436. begin
  1437. dec(len,2);
  1438. list.concat(taicpu.op_ref_ref(A_MOVE,S_W,hp1,hp2));
  1439. end;
  1440. if len = 1 then
  1441. list.concat(taicpu.op_ref_ref(A_MOVE,S_B,hp1,hp2));
  1442. end
  1443. else
  1444. begin
  1445. { Fast 68010 loop mode with no possible alignment problems }
  1446. helpsize := len;
  1447. list.concat(taicpu.op_const_reg(A_MOVE,S_L,helpsize,hregister));
  1448. current_asmdata.getjumplabel(hl2);
  1449. a_jmp_always(list,hl2);
  1450. current_asmdata.getjumplabel(hl);
  1451. a_label(list,hl);
  1452. list.concat(taicpu.op_ref_ref(A_MOVE,S_B,hp1,hp2));
  1453. a_label(list,hl2);
  1454. if current_settings.cputype=cpu_coldfire then
  1455. begin
  1456. { Coldfire does not support DBRA }
  1457. list.concat(taicpu.op_const_reg(A_SUB,S_L,1,hregister));
  1458. list.concat(taicpu.op_sym(A_BMI,S_L,hl));
  1459. end
  1460. else
  1461. list.concat(taicpu.op_reg_sym(A_DBRA,S_L,hregister,hl));
  1462. end;
  1463. { restore the registers that we have just used olny if they are used! }
  1464. if jregister = NR_A1 then
  1465. hp2.base := NR_NO;
  1466. if iregister = NR_A0 then
  1467. hp1.base := NR_NO;
  1468. // reference_release(list,hp1);
  1469. // reference_release(list,hp2);
  1470. end;
  1471. // if delsource then
  1472. // tg.ungetiftemp(list,source);
  1473. end;
  1474. procedure tcg68k.g_overflowcheck(list: TAsmList; const l:tlocation; def:tdef);
  1475. begin
  1476. end;
  1477. procedure tcg68k.g_proc_entry(list: TAsmList; localsize: longint; nostackframe:boolean);
  1478. var
  1479. r,rsp: TRegister;
  1480. ref : TReference;
  1481. begin
  1482. {$ifdef DEBUG_CHARLIE}
  1483. // writeln('proc entry, localsize:',localsize);
  1484. {$endif DEBUG_CHARLIE}
  1485. if not nostackframe then
  1486. begin
  1487. if localsize<>0 then
  1488. begin
  1489. { size can't be negative }
  1490. if (localsize < 0) then
  1491. internalerror(2006122601);
  1492. { Not to complicate the code generator too much, and since some }
  1493. { of the systems only support this format, the localsize cannot }
  1494. { exceed 32K in size. }
  1495. if (localsize > high(smallint)) then
  1496. CGMessage(cg_e_localsize_too_big);
  1497. list.concat(taicpu.op_reg_const(A_LINK,S_W,NR_FRAME_POINTER_REG,-localsize));
  1498. end
  1499. else
  1500. begin
  1501. list.concat(taicpu.op_reg_const(A_LINK,S_W,NR_FRAME_POINTER_REG,0));
  1502. (*
  1503. { FIXME! - Carl's original code uses this method. However,
  1504. according to the 68060 users manual, a LINK is faster than
  1505. two moves. So, use a link in #0 case too, for now. I'm not
  1506. really sure tho', that LINK supports #0 disposition, but i
  1507. see no reason why it shouldn't support it. (KB) }
  1508. { when localsize = 0, use two moves, instead of link }
  1509. r:=NR_FRAME_POINTER_REG;
  1510. rsp:=NR_STACK_POINTER_REG;
  1511. reference_reset_base(ref,NR_STACK_POINTER_REG,0);
  1512. ref.direction:=dir_dec;
  1513. list.concat(taicpu.op_reg_ref(A_MOVE,S_L,r,ref));
  1514. instr:=taicpu.op_reg_reg(A_MOVE,S_L,rsp,r);
  1515. add_move_instruction(instr); mwould also be needed
  1516. list.concat(instr);
  1517. *)
  1518. end;
  1519. end;
  1520. end;
  1521. { procedure tcg68k.g_restore_frame_pointer(list : TAsmList);
  1522. var
  1523. r:Tregister;
  1524. begin
  1525. r:=NR_FRAME_POINTER_REG;
  1526. list.concat(taicpu.op_reg(A_UNLK,S_NO,r));
  1527. end;
  1528. }
  1529. procedure tcg68k.g_proc_exit(list : TAsmList; parasize: longint; nostackframe: boolean);
  1530. var
  1531. r,hregister : TRegister;
  1532. localsize: tcgint;
  1533. spr : TRegister;
  1534. fpr : TRegister;
  1535. ref : TReference;
  1536. begin
  1537. if not nostackframe then
  1538. begin
  1539. localsize := current_procinfo.calc_stackframe_size;
  1540. {$ifdef DEBUG_CHARLIE}
  1541. // writeln('proc exit with stackframe, size:',localsize,' parasize:',parasize);
  1542. {$endif DEBUG_CHARLIE}
  1543. list.concat(taicpu.op_reg(A_UNLK,S_NO,NR_FRAME_POINTER_REG));
  1544. parasize := parasize - target_info.first_parm_offset; { i'm still not 100% confident that this is
  1545. correct here, but at least it looks less
  1546. hacky, and makes some sense (KB) }
  1547. if (parasize<>0) then
  1548. begin
  1549. { only 68020+ supports RTD, so this needs another code path
  1550. for 68000 and Coldfire (KB) }
  1551. { TODO: 68020+ only code generation, without fallback}
  1552. if current_settings.cputype=cpu_mc68020 then
  1553. list.concat(taicpu.op_const(A_RTD,S_NO,parasize))
  1554. else
  1555. begin
  1556. { We must pull the PC Counter from the stack, before }
  1557. { restoring the stack pointer, otherwise the PC would }
  1558. { point to nowhere! }
  1559. { save the PC counter (pop it from the stack) }
  1560. //hregister:=cg.getaddressregister(list);
  1561. hregister:=NR_A3;
  1562. cg.a_reg_alloc(list,hregister);
  1563. reference_reset_base(ref,NR_STACK_POINTER_REG,0,4);
  1564. ref.direction:=dir_inc;
  1565. list.concat(taicpu.op_ref_reg(A_MOVE,S_L,ref,hregister));
  1566. { can we do a quick addition ... }
  1567. r:=NR_SP;
  1568. if (parasize > 0) and (parasize < 9) then
  1569. list.concat(taicpu.op_const_reg(A_ADDQ,S_L,parasize,r))
  1570. else { nope ... }
  1571. list.concat(taicpu.op_const_reg(A_ADD,S_L,parasize,r));
  1572. { restore the PC counter (push it on the stack) }
  1573. reference_reset_base(ref,NR_STACK_POINTER_REG,0,4);
  1574. ref.direction:=dir_dec;
  1575. cg.a_reg_alloc(list,hregister);
  1576. list.concat(taicpu.op_reg_ref(A_MOVE,S_L,hregister,ref));
  1577. list.concat(taicpu.op_none(A_RTS,S_NO));
  1578. end;
  1579. end
  1580. else
  1581. list.concat(taicpu.op_none(A_RTS,S_NO));
  1582. end
  1583. else
  1584. begin
  1585. {$ifdef DEBUG_CHARLIE}
  1586. // writeln('proc exit, no stackframe');
  1587. {$endif DEBUG_CHARLIE}
  1588. list.concat(taicpu.op_none(A_RTS,S_NO));
  1589. end;
  1590. // writeln('g_proc_exit');
  1591. { Routines with the poclearstack flag set use only a ret.
  1592. also routines with parasize=0 }
  1593. (*
  1594. if current_procinfo.procdef.proccalloption in clearstack_pocalls then
  1595. begin
  1596. { complex return values are removed from stack in C code PM }
  1597. if paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef.proccalloption) then
  1598. list.concat(taicpu.op_const(A_RTD,S_NO,4))
  1599. else
  1600. list.concat(taicpu.op_none(A_RTS,S_NO));
  1601. end
  1602. else if (parasize=0) then
  1603. begin
  1604. list.concat(taicpu.op_none(A_RTS,S_NO));
  1605. end
  1606. else
  1607. begin
  1608. { return with immediate size possible here
  1609. signed!
  1610. RTD is not supported on the coldfire }
  1611. if (current_settings.cputype=cpu_MC68020) and (parasize<$7FFF) then
  1612. list.concat(taicpu.op_const(A_RTD,S_NO,parasize))
  1613. { manually restore the stack }
  1614. else
  1615. begin
  1616. { We must pull the PC Counter from the stack, before }
  1617. { restoring the stack pointer, otherwise the PC would }
  1618. { point to nowhere! }
  1619. { save the PC counter (pop it from the stack) }
  1620. hregister:=NR_A3;
  1621. cg.a_reg_alloc(list,hregister);
  1622. reference_reset_base(ref,NR_STACK_POINTER_REG,0);
  1623. ref.direction:=dir_inc;
  1624. list.concat(taicpu.op_ref_reg(A_MOVE,S_L,ref,hregister));
  1625. { can we do a quick addition ... }
  1626. r:=NR_SP;
  1627. if (parasize > 0) and (parasize < 9) then
  1628. list.concat(taicpu.op_const_reg(A_ADDQ,S_L,parasize,r))
  1629. else { nope ... }
  1630. list.concat(taicpu.op_const_reg(A_ADD,S_L,parasize,r));
  1631. { restore the PC counter (push it on the stack) }
  1632. reference_reset_base(ref,NR_STACK_POINTER_REG,0);
  1633. ref.direction:=dir_dec;
  1634. cg.a_reg_alloc(list,hregister);
  1635. list.concat(taicpu.op_reg_ref(A_MOVE,S_L,hregister,ref));
  1636. list.concat(taicpu.op_none(A_RTS,S_NO));
  1637. end;
  1638. end;
  1639. *)
  1640. end;
  1641. procedure Tcg68k.g_save_registers(list:TAsmList);
  1642. var
  1643. tosave : tcpuregisterset;
  1644. ref : treference;
  1645. begin
  1646. {!!!!!
  1647. tosave:=std_saved_registers;
  1648. { only save the registers which are not used and must be saved }
  1649. tosave:=tosave*(rg[R_INTREGISTER].used_in_proc+rg[R_ADDRESSREGISTER].used_in_proc);
  1650. reference_reset_base(ref,NR_STACK_POINTER_REG,0);
  1651. ref.direction:=dir_dec;
  1652. if tosave<>[] then
  1653. list.concat(taicpu.op_regset_ref(A_MOVEM,S_L,tosave,ref));
  1654. }
  1655. end;
  1656. procedure Tcg68k.g_restore_registers(list:TAsmList);
  1657. var
  1658. torestore : tcpuregisterset;
  1659. r:Tregister;
  1660. ref : treference;
  1661. begin
  1662. {!!!!!!!!
  1663. torestore:=std_saved_registers;
  1664. { should be intersected with used regs, no ? }
  1665. torestore:=torestore*(rg[R_INTREGISTER].used_in_proc+rg[R_ADDRESSREGISTER].used_in_proc);
  1666. reference_reset_base(ref,NR_STACK_POINTER_REG,0);
  1667. ref.direction:=dir_inc;
  1668. if torestore<>[] then
  1669. list.concat(taicpu.op_ref_regset(A_MOVEM,S_L,ref,torestore));
  1670. }
  1671. end;
  1672. {
  1673. procedure tcg68k.g_save_all_registers(list : TAsmList);
  1674. begin
  1675. end;
  1676. procedure tcg68k.g_restore_all_registers(list : TAsmList;const funcretparaloc:TCGPara);
  1677. begin
  1678. end;
  1679. }
  1680. procedure tcg68k.sign_extend(list: TAsmList;_oldsize : tcgsize; reg: tregister);
  1681. begin
  1682. case _oldsize of
  1683. { sign extend }
  1684. OS_S8:
  1685. begin
  1686. if (isaddressregister(reg)) then
  1687. internalerror(20020729);
  1688. if (current_settings.cputype = cpu_MC68000) then
  1689. begin
  1690. list.concat(taicpu.op_reg(A_EXT,S_W,reg));
  1691. list.concat(taicpu.op_reg(A_EXT,S_L,reg));
  1692. end
  1693. else
  1694. begin
  1695. // list.concat(tai_comment.create(strpnew('sign extend byte')));
  1696. list.concat(taicpu.op_reg(A_EXTB,S_L,reg));
  1697. end;
  1698. end;
  1699. OS_S16:
  1700. begin
  1701. if (isaddressregister(reg)) then
  1702. internalerror(20020729);
  1703. // list.concat(tai_comment.create(strpnew('sign extend word')));
  1704. list.concat(taicpu.op_reg(A_EXT,S_L,reg));
  1705. end;
  1706. { zero extend }
  1707. OS_8:
  1708. begin
  1709. // list.concat(tai_comment.create(strpnew('zero extend byte')));
  1710. list.concat(taicpu.op_const_reg(A_AND,S_L,$FF,reg));
  1711. end;
  1712. OS_16:
  1713. begin
  1714. // list.concat(tai_comment.create(strpnew('zero extend word')));
  1715. list.concat(taicpu.op_const_reg(A_AND,S_L,$FFFF,reg));
  1716. end;
  1717. end; { otherwise the size is already correct }
  1718. end;
  1719. procedure tcg68k.a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel);
  1720. var
  1721. ai : taicpu;
  1722. begin
  1723. if cond=OC_None then
  1724. ai := Taicpu.Op_sym(A_JMP,S_NO,l)
  1725. else
  1726. begin
  1727. ai:=Taicpu.Op_sym(A_Bxx,S_NO,l);
  1728. ai.SetCondition(TOpCmp2AsmCond[cond]);
  1729. end;
  1730. ai.is_jmp:=true;
  1731. list.concat(ai);
  1732. end;
  1733. procedure tcg68k.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
  1734. {
  1735. procedure loadvmttor11;
  1736. var
  1737. href : treference;
  1738. begin
  1739. reference_reset_base(href,NR_R3,0);
  1740. cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R11);
  1741. end;
  1742. procedure op_onr11methodaddr;
  1743. var
  1744. href : treference;
  1745. begin
  1746. if (procdef.extnumber=$ffff) then
  1747. Internalerror(200006139);
  1748. { call/jmp vmtoffs(%eax) ; method offs }
  1749. reference_reset_base(href,NR_R11,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber));
  1750. if not((longint(href.offset) >= low(smallint)) and
  1751. (longint(href.offset) <= high(smallint))) then
  1752. begin
  1753. list.concat(taicpu.op_reg_reg_const(A_ADDIS,NR_R11,NR_R11,
  1754. smallint((href.offset shr 16)+ord(smallint(href.offset and $ffff) < 0))));
  1755. href.offset := smallint(href.offset and $ffff);
  1756. end;
  1757. list.concat(taicpu.op_reg_ref(A_LWZ,NR_R11,href));
  1758. list.concat(taicpu.op_reg(A_MTCTR,NR_R11));
  1759. list.concat(taicpu.op_none(A_BCTR));
  1760. end;
  1761. }
  1762. var
  1763. make_global : boolean;
  1764. begin
  1765. if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
  1766. Internalerror(200006137);
  1767. if not assigned(procdef.struct) or
  1768. (procdef.procoptions*[po_classmethod, po_staticmethod,
  1769. po_methodpointer, po_interrupt, po_iocheck]<>[]) then
  1770. Internalerror(200006138);
  1771. if procdef.owner.symtabletype<>ObjectSymtable then
  1772. Internalerror(200109191);
  1773. make_global:=false;
  1774. if (not current_module.is_unit) or
  1775. create_smartlink or
  1776. (procdef.owner.defowner.owner.symtabletype=globalsymtable) then
  1777. make_global:=true;
  1778. if make_global then
  1779. List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
  1780. else
  1781. List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
  1782. { set param1 interface to self }
  1783. // g_adjust_self_value(list,procdef,ioffset);
  1784. { case 4 }
  1785. if (po_virtualmethod in procdef.procoptions) and
  1786. not is_objectpascal_helper(procdef.struct) then
  1787. begin
  1788. // loadvmttor11;
  1789. // op_onr11methodaddr;
  1790. end
  1791. { case 0 }
  1792. else
  1793. // list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(procdef.mangledname)));
  1794. List.concat(Tai_symbol_end.Createname(labelname));
  1795. end;
  1796. {****************************************************************************}
  1797. { TCG64F68K }
  1798. {****************************************************************************}
  1799. procedure tcg64f68k.a_op64_reg_reg(list : TAsmList;op:TOpCG;size: tcgsize; regsrc,regdst : tregister64);
  1800. var
  1801. hreg1, hreg2 : tregister;
  1802. opcode : tasmop;
  1803. begin
  1804. // writeln('a_op64_reg_reg');
  1805. opcode := topcg2tasmop[op];
  1806. case op of
  1807. OP_ADD :
  1808. begin
  1809. { if one of these three registers is an address
  1810. register, we'll really get into problems!
  1811. }
  1812. if isaddressregister(regdst.reglo) or
  1813. isaddressregister(regdst.reghi) or
  1814. isaddressregister(regsrc.reghi) then
  1815. internalerror(20020817);
  1816. list.concat(taicpu.op_reg_reg(A_ADD,S_L,regsrc.reglo,regdst.reglo));
  1817. list.concat(taicpu.op_reg_reg(A_ADDX,S_L,regsrc.reghi,regdst.reghi));
  1818. end;
  1819. OP_AND,OP_OR :
  1820. begin
  1821. { at least one of the registers must be a data register }
  1822. if (isaddressregister(regdst.reglo) and
  1823. isaddressregister(regsrc.reglo)) or
  1824. (isaddressregister(regsrc.reghi) and
  1825. isaddressregister(regdst.reghi))
  1826. then
  1827. internalerror(20020817);
  1828. cg.a_op_reg_reg(list,op,OS_32,regsrc.reglo,regdst.reglo);
  1829. cg.a_op_reg_reg(list,op,OS_32,regsrc.reghi,regdst.reghi);
  1830. end;
  1831. { this is handled in 1st pass for 32-bit cpu's (helper call) }
  1832. OP_IDIV,OP_DIV,
  1833. OP_IMUL,OP_MUL: internalerror(2002081701);
  1834. { this is also handled in 1st pass for 32-bit cpu's (helper call) }
  1835. OP_SAR,OP_SHL,OP_SHR: internalerror(2002081702);
  1836. OP_SUB:
  1837. begin
  1838. { if one of these three registers is an address
  1839. register, we'll really get into problems!
  1840. }
  1841. if isaddressregister(regdst.reglo) or
  1842. isaddressregister(regdst.reghi) or
  1843. isaddressregister(regsrc.reghi) then
  1844. internalerror(20020817);
  1845. list.concat(taicpu.op_reg_reg(A_SUB,S_L,regsrc.reglo,regdst.reglo));
  1846. list.concat(taicpu.op_reg_reg(A_SUBX,S_L,regsrc.reghi,regdst.reghi));
  1847. end;
  1848. OP_XOR:
  1849. begin
  1850. if isaddressregister(regdst.reglo) or
  1851. isaddressregister(regsrc.reglo) or
  1852. isaddressregister(regsrc.reghi) or
  1853. isaddressregister(regdst.reghi) then
  1854. internalerror(20020817);
  1855. list.concat(taicpu.op_reg_reg(A_EOR,S_L,regsrc.reglo,regdst.reglo));
  1856. list.concat(taicpu.op_reg_reg(A_EOR,S_L,regsrc.reghi,regdst.reghi));
  1857. end;
  1858. end; { end case }
  1859. end;
  1860. procedure tcg64f68k.a_op64_const_reg(list : TAsmList;op:TOpCG;size: tcgsize; value : int64;regdst : tregister64);
  1861. var
  1862. lowvalue : cardinal;
  1863. highvalue : cardinal;
  1864. hreg : tregister;
  1865. begin
  1866. // writeln('a_op64_const_reg');
  1867. { is it optimized out ? }
  1868. // if cg.optimize64_op_const_reg(list,op,value,reg) then
  1869. // exit;
  1870. lowvalue := cardinal(value);
  1871. highvalue:= value shr 32;
  1872. { the destination registers must be data registers }
  1873. if isaddressregister(regdst.reglo) or
  1874. isaddressregister(regdst.reghi) then
  1875. internalerror(20020817);
  1876. case op of
  1877. OP_ADD :
  1878. begin
  1879. hreg:=cg.getintregister(list,OS_INT);
  1880. list.concat(taicpu.op_const_reg(A_MOVE,S_L,highvalue,hreg));
  1881. list.concat(taicpu.op_const_reg(A_ADD,S_L,lowvalue,regdst.reglo));
  1882. list.concat(taicpu.op_reg_reg(A_ADDX,S_L,hreg,regdst.reglo));
  1883. end;
  1884. OP_AND :
  1885. begin
  1886. list.concat(taicpu.op_const_reg(A_AND,S_L,lowvalue,regdst.reglo));
  1887. list.concat(taicpu.op_const_reg(A_AND,S_L,highvalue,regdst.reglo));
  1888. end;
  1889. OP_OR :
  1890. begin
  1891. list.concat(taicpu.op_const_reg(A_OR,S_L,lowvalue,regdst.reglo));
  1892. list.concat(taicpu.op_const_reg(A_OR,S_L,highvalue,regdst.reglo));
  1893. end;
  1894. { this is handled in 1st pass for 32-bit cpus (helper call) }
  1895. OP_IDIV,OP_DIV,
  1896. OP_IMUL,OP_MUL: internalerror(2002081701);
  1897. { this is also handled in 1st pass for 32-bit cpus (helper call) }
  1898. OP_SAR,OP_SHL,OP_SHR: internalerror(2002081702);
  1899. OP_SUB:
  1900. begin
  1901. hreg:=cg.getintregister(list,OS_INT);
  1902. list.concat(taicpu.op_const_reg(A_MOVE,S_L,highvalue,hreg));
  1903. list.concat(taicpu.op_const_reg(A_SUB,S_L,lowvalue,regdst.reglo));
  1904. list.concat(taicpu.op_reg_reg(A_SUBX,S_L,hreg,regdst.reglo));
  1905. end;
  1906. OP_XOR:
  1907. begin
  1908. list.concat(taicpu.op_const_reg(A_EOR,S_L,lowvalue,regdst.reglo));
  1909. list.concat(taicpu.op_const_reg(A_EOR,S_L,highvalue,regdst.reglo));
  1910. end;
  1911. end; { end case }
  1912. end;
  1913. procedure create_codegen;
  1914. begin
  1915. cg := tcg68k.create;
  1916. cg64 :=tcg64f68k.create;
  1917. end;
  1918. end.