cgcpu.pas 101 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611
  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. unit cgcpu;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. cgbase,cgobj,globtype,
  22. aasmbase,aasmtai,aasmdata,aasmcpu,
  23. cpubase,cpuinfo,
  24. parabase,cpupara,
  25. node,symconst,symtype,symdef,
  26. cgutils,cg64f32;
  27. type
  28. tcg68k = class(tcg)
  29. procedure init_register_allocators;override;
  30. procedure done_register_allocators;override;
  31. procedure a_load_reg_cgpara(list : TAsmList;size : tcgsize;r : tregister;const cgpara : tcgpara);override;
  32. procedure a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const cgpara : tcgpara);override;
  33. procedure a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : tcgpara);override;
  34. procedure a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const cgpara : tcgpara);override;
  35. procedure a_call_name(list : TAsmList;const s : string; weak: boolean);override;
  36. procedure a_call_reg(list : TAsmList;reg : tregister);override;
  37. procedure a_load_const_reg(list : TAsmList;size : tcgsize;a : tcgint;register : tregister);override;
  38. procedure a_load_const_ref(list : TAsmList; tosize: tcgsize; a : tcgint;const ref : treference);override;
  39. procedure a_load_reg_ref(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);override;
  40. procedure a_load_reg_ref_unaligned(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);override;
  41. procedure a_load_reg_reg(list : TAsmList;fromsize,tosize : tcgsize;reg1,reg2 : tregister);override;
  42. procedure a_load_ref_reg(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);override;
  43. procedure a_load_ref_reg_unaligned(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);override;
  44. procedure a_load_ref_ref(list : TAsmList;fromsize,tosize : tcgsize;const sref : treference;const dref : treference);override;
  45. procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);override;
  46. procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); override;
  47. procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); override;
  48. procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); override;
  49. procedure a_loadfpu_reg_cgpara(list : TAsmList; size : tcgsize;const reg : tregister;const cgpara : TCGPara); override;
  50. procedure a_loadfpu_ref_cgpara(list : TAsmList; size : tcgsize;const ref : treference;const cgpara : TCGPara);override;
  51. procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: tcgsize; a: tcgint; reg: TRegister); override;
  52. procedure a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference); override;
  53. procedure a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; src, dst: TRegister); override;
  54. procedure a_op_reg_ref(list : TAsmList; Op: TOpCG; size: TCGSize; reg: TRegister; const ref: TReference); override;
  55. procedure a_op_ref_reg(list : TAsmList; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); override;
  56. procedure a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister; l : tasmlabel);override;
  57. procedure a_cmp_const_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;const ref : treference; l : tasmlabel); override;
  58. procedure a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override;
  59. procedure a_jmp_name(list : TAsmList;const s : string); override;
  60. procedure a_jmp_always(list : TAsmList;l: tasmlabel); override;
  61. procedure a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel); override;
  62. procedure a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel);
  63. procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: tresflags; reg: TRegister); override;
  64. procedure g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);override;
  65. { generates overflow checking code for a node }
  66. procedure g_overflowcheck(list: TAsmList; const l:tlocation; def:tdef); override;
  67. procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);override;
  68. procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);override;
  69. procedure g_save_registers(list:TAsmList);override;
  70. procedure g_restore_registers(list:TAsmList);override;
  71. procedure g_adjust_self_value(list:TAsmList;procdef:tprocdef;ioffset:tcgint);override;
  72. { # Sign or zero extend the register to a full 32-bit value.
  73. The new value is left in the same register.
  74. }
  75. procedure sign_extend(list: TAsmList;_oldsize : tcgsize; reg: tregister);
  76. procedure sign_extend(list: TAsmList;_oldsize : tcgsize; _newsize : tcgsize; reg: tregister);
  77. procedure g_stackpointer_alloc(list : TAsmList;localsize : longint);override;
  78. function fixref(list: TAsmList; var ref: treference; fullyresolve: boolean): boolean;
  79. function force_to_dataregister(list: TAsmList; size: TCGSize; reg: TRegister): TRegister;
  80. procedure move_if_needed(list: TAsmList; size: TCGSize; src: TRegister; dest: TRegister);
  81. { optimize mul with const to a sequence of shifts and subs/adds, mainly for the '000 to '030 }
  82. function optimize_const_mul_to_shift_sub_add(list: TAsmList; maxops: longint; a: tcgint; size: tcgsize; reg: TRegister): boolean;
  83. protected
  84. procedure call_rtl_mul_const_reg(list:tasmlist;size:tcgsize;a:tcgint;reg:tregister;const name:string);
  85. procedure call_rtl_mul_reg_reg(list:tasmlist;reg1,reg2:tregister;const name:string);
  86. procedure check_register_size(size:tcgsize;reg:tregister);
  87. end;
  88. tcg64f68k = class(tcg64f32)
  89. procedure a_op64_reg_reg(list : TAsmList;op:TOpCG; size: tcgsize; regsrc,regdst : tregister64);override;
  90. procedure a_op64_const_reg(list : TAsmList;op:TOpCG; size: tcgsize; value : int64;regdst : tregister64);override;
  91. procedure a_op64_ref_reg(list : TAsmList;op:TOpCG;size : tcgsize;const ref : treference;reg : tregister64);override;
  92. procedure a_op64_reg_ref(list : TAsmList;op:TOpCG;size : tcgsize;reg : tregister64;const ref : treference);override;
  93. procedure a_load64_reg_ref(list : TAsmList;reg : tregister64;const ref : treference); override;
  94. procedure a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64); override;
  95. end;
  96. { This function returns true if the reference+offset is valid.
  97. Otherwise extra code must be generated to solve the reference.
  98. On the m68k, this verifies that the reference is valid
  99. (e.g : if index register is used, then the max displacement
  100. is 256 bytes, if only base is used, then max displacement
  101. is 32K
  102. }
  103. function isvalidrefoffset(const ref: treference): boolean;
  104. function isvalidreference(const ref: treference): boolean;
  105. procedure create_codegen;
  106. implementation
  107. uses
  108. globals,verbose,systems,cutils,
  109. symsym,symtable,defutil,paramgr,procinfo,
  110. rgobj,tgobj,rgcpu,fmodule;
  111. { Range check must be disabled explicitly as conversions between signed and unsigned
  112. 32-bit values are done without explicit typecasts }
  113. {$R-}
  114. const
  115. { opcode table lookup }
  116. topcg2tasmop: Array[topcg] of tasmop =
  117. (
  118. A_NONE,
  119. A_MOVE,
  120. A_ADD,
  121. A_AND,
  122. A_DIVU,
  123. A_DIVS,
  124. A_MULS,
  125. A_MULU,
  126. A_NEG,
  127. A_NOT,
  128. A_OR,
  129. A_ASR,
  130. A_LSL,
  131. A_LSR,
  132. A_SUB,
  133. A_EOR,
  134. A_ROL,
  135. A_ROR
  136. );
  137. { opcode with extend bits table lookup, used by 64bit cg }
  138. topcg2tasmopx: Array[topcg] of tasmop =
  139. (
  140. A_NONE,
  141. A_NONE,
  142. A_ADDX,
  143. A_NONE,
  144. A_NONE,
  145. A_NONE,
  146. A_NONE,
  147. A_NONE,
  148. A_NEGX,
  149. A_NONE,
  150. A_NONE,
  151. A_NONE,
  152. A_NONE,
  153. A_NONE,
  154. A_SUBX,
  155. A_NONE,
  156. A_NONE,
  157. A_NONE
  158. );
  159. TOpCmp2AsmCond: Array[topcmp] of TAsmCond =
  160. (
  161. C_NONE,
  162. C_EQ,
  163. C_GT,
  164. C_LT,
  165. C_GE,
  166. C_LE,
  167. C_NE,
  168. C_LS,
  169. C_CS,
  170. C_CC,
  171. C_HI
  172. );
  173. function isvalidreference(const ref: treference): boolean;
  174. begin
  175. isvalidreference:=isvalidrefoffset(ref) and
  176. { don't try to generate addressing with symbol and base reg and offset
  177. it might fail in linking stage if the symbol is more than 32k away (KB) }
  178. not (assigned(ref.symbol) and (ref.base <> NR_NO) and (ref.offset <> 0)) and
  179. { coldfire and 68000 cannot handle non-addressregs as bases }
  180. not ((current_settings.cputype in cpu_coldfire+[cpu_mc68000]) and
  181. not isaddressregister(ref.base));
  182. end;
  183. function isvalidrefoffset(const ref: treference): boolean;
  184. begin
  185. isvalidrefoffset := true;
  186. if ref.index <> NR_NO then
  187. begin
  188. // if ref.base <> NR_NO then
  189. // internalerror(2002081401);
  190. if (ref.offset < low(shortint)) or (ref.offset > high(shortint)) then
  191. isvalidrefoffset := false
  192. end
  193. else
  194. begin
  195. if (ref.offset < low(smallint)) or (ref.offset > high(smallint)) then
  196. isvalidrefoffset := false;
  197. end;
  198. end;
  199. {****************************************************************************}
  200. { TCG68K }
  201. {****************************************************************************}
  202. function use_push(const cgpara:tcgpara):boolean;
  203. begin
  204. result:=(not paramanager.use_fixed_stack) and
  205. assigned(cgpara.location) and
  206. (cgpara.location^.loc=LOC_REFERENCE) and
  207. (cgpara.location^.reference.index=NR_STACK_POINTER_REG);
  208. end;
  209. procedure tcg68k.init_register_allocators;
  210. var
  211. reg: TSuperRegister;
  212. address_regs: array of TSuperRegister;
  213. begin
  214. inherited init_register_allocators;
  215. address_regs:=nil;
  216. rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,
  217. [RS_D0,RS_D1,RS_D2,RS_D3,RS_D4,RS_D5,RS_D6,RS_D7],
  218. first_int_imreg,[]);
  219. { set up the array of address registers to use }
  220. for reg:=RS_A0 to RS_A6 do
  221. begin
  222. { don't hardwire the frame pointer register, because it can vary between target OS }
  223. if (assigned(current_procinfo) and (current_procinfo.framepointer = NR_FRAME_POINTER_REG)
  224. and (reg = RS_FRAME_POINTER_REG))
  225. or ((reg = RS_PIC_OFFSET_REG) and (tf_static_reg_based in target_info.flags)) then
  226. continue;
  227. setlength(address_regs,length(address_regs)+1);
  228. address_regs[length(address_regs)-1]:=reg;
  229. end;
  230. rg[R_ADDRESSREGISTER]:=trgcpu.create(R_ADDRESSREGISTER,R_SUBWHOLE,
  231. address_regs, first_addr_imreg, []);
  232. rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBNONE,
  233. [RS_FP0,RS_FP1,RS_FP2,RS_FP3,RS_FP4,RS_FP5,RS_FP6,RS_FP7],
  234. first_fpu_imreg,[]);
  235. end;
  236. procedure tcg68k.done_register_allocators;
  237. begin
  238. rg[R_INTREGISTER].free;
  239. rg[R_FPUREGISTER].free;
  240. rg[R_ADDRESSREGISTER].free;
  241. inherited done_register_allocators;
  242. end;
  243. procedure tcg68k.a_load_reg_cgpara(list : TAsmList;size : tcgsize;r : tregister;const cgpara : tcgpara);
  244. var
  245. pushsize : tcgsize;
  246. ref : treference;
  247. begin
  248. { it's probably necessary to port this from x86 later, or provide an m68k solution (KB) }
  249. { TODO: FIX ME! check_register_size()}
  250. // check_register_size(size,r);
  251. if use_push(cgpara) then
  252. begin
  253. cgpara.check_simple_location;
  254. if tcgsize2size[cgpara.location^.size]>cgpara.alignment then
  255. pushsize:=cgpara.location^.size
  256. else
  257. pushsize:=int_cgsize(cgpara.alignment);
  258. reference_reset_base(ref, NR_STACK_POINTER_REG, 0, ctempposinvalid ,cgpara.alignment, []);
  259. ref.direction := dir_dec;
  260. list.concat(taicpu.op_reg_ref(A_MOVE,tcgsize2opsize[pushsize],makeregsize(list,r,pushsize),ref));
  261. end
  262. else
  263. inherited a_load_reg_cgpara(list,size,r,cgpara);
  264. end;
  265. procedure tcg68k.a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const cgpara : tcgpara);
  266. var
  267. pushsize : tcgsize;
  268. ref : treference;
  269. begin
  270. if use_push(cgpara) then
  271. begin
  272. cgpara.check_simple_location;
  273. if tcgsize2size[cgpara.location^.size]>cgpara.alignment then
  274. pushsize:=cgpara.location^.size
  275. else
  276. pushsize:=int_cgsize(cgpara.alignment);
  277. reference_reset_base(ref, NR_STACK_POINTER_REG, 0, ctempposinvalid, cgpara.alignment, []);
  278. ref.direction := dir_dec;
  279. a_load_const_ref(list, pushsize, a, ref);
  280. end
  281. else
  282. inherited a_load_const_cgpara(list,size,a,cgpara);
  283. end;
  284. procedure tcg68k.a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : tcgpara);
  285. procedure pushdata(paraloc:pcgparalocation;ofs:tcgint);
  286. var
  287. pushsize : tcgsize;
  288. tmpreg : tregister;
  289. href : treference;
  290. ref : treference;
  291. begin
  292. if not assigned(paraloc) then
  293. exit;
  294. if (paraloc^.loc<>LOC_REFERENCE) or
  295. (paraloc^.reference.index<>NR_STACK_POINTER_REG) or
  296. (tcgsize2size[paraloc^.size]>sizeof(tcgint)) then
  297. internalerror(200501162);
  298. { Pushes are needed in reverse order, add the size of the
  299. current location to the offset where to load from. This
  300. prevents wrong calculations for the last location when
  301. the size is not a power of 2 }
  302. if assigned(paraloc^.next) then
  303. pushdata(paraloc^.next,ofs+tcgsize2size[paraloc^.size]);
  304. { Push the data starting at ofs }
  305. href:=r;
  306. inc(href.offset,ofs);
  307. fixref(list,href,false);
  308. if tcgsize2size[paraloc^.size]>cgpara.alignment then
  309. pushsize:=paraloc^.size
  310. else
  311. pushsize:=int_cgsize(cgpara.alignment);
  312. reference_reset_base(ref, NR_STACK_POINTER_REG, 0, ctempposinvalid, tcgsize2size[pushsize], []);
  313. ref.direction := dir_dec;
  314. a_load_ref_ref(list,int_cgsize(tcgsize2size[paraloc^.size]),pushsize,href,ref);
  315. end;
  316. var
  317. len : tcgint;
  318. ofs : tcgint;
  319. href : treference;
  320. begin
  321. { cgpara.size=OS_NO requires a copy on the stack }
  322. if use_push(cgpara) then
  323. begin
  324. { Record copy? }
  325. if (cgpara.size in [OS_NO,OS_F64]) or (size in [OS_NO,OS_F64]) then
  326. begin
  327. //list.concat(tai_comment.create(strpnew('a_load_ref_cgpara: g_concatcopy')));
  328. cgpara.check_simple_location;
  329. len:=align(cgpara.intsize,cgpara.alignment);
  330. g_stackpointer_alloc(list,len);
  331. ofs:=0;
  332. if (cgpara.intsize<cgpara.alignment) then
  333. ofs:=cgpara.alignment-cgpara.intsize;
  334. reference_reset_base(href,NR_STACK_POINTER_REG,ofs,ctempposinvalid,cgpara.alignment,[]);
  335. g_concatcopy(list,r,href,cgpara.intsize);
  336. end
  337. else
  338. begin
  339. if tcgsize2size[cgpara.size]<>tcgsize2size[size] then
  340. internalerror(200501161);
  341. { We need to push the data in reverse order,
  342. therefore we use a recursive algorithm }
  343. pushdata(cgpara.location,0);
  344. end
  345. end
  346. else
  347. inherited a_load_ref_cgpara(list,size,r,cgpara);
  348. end;
  349. procedure tcg68k.a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const cgpara : tcgpara);
  350. var
  351. tmpref : treference;
  352. begin
  353. { 68k always passes arguments on the stack }
  354. if use_push(cgpara) then
  355. begin
  356. //list.concat(tai_comment.create(strpnew('a_loadaddr_ref_cgpara: PEA')));
  357. cgpara.check_simple_location;
  358. tmpref:=r;
  359. fixref(list,tmpref,false);
  360. list.concat(taicpu.op_ref(A_PEA,S_NO,tmpref));
  361. end
  362. else
  363. inherited a_loadaddr_ref_cgpara(list,r,cgpara);
  364. end;
  365. function tcg68k.fixref(list: TAsmList; var ref: treference; fullyresolve: boolean): boolean;
  366. var
  367. hreg : tregister;
  368. href : treference;
  369. instr : taicpu;
  370. begin
  371. result:=false;
  372. hreg:=NR_NO;
  373. { NOTE: we don't have to fixup scaling in this function, because the memnode
  374. won't generate scaling on CPUs which don't support it }
  375. if (tf_static_reg_based in target_info.flags) and assigned(ref.symbol) and (ref.base=NR_NO) then
  376. fullyresolve:=true;
  377. { first, deal with the symbol, if we have an index or base register.
  378. in theory, the '020+ could deal with these, but it's better to avoid
  379. long displacements on most members of the 68k family anyway }
  380. if assigned(ref.symbol) and ((ref.base<>NR_NO) or (ref.index<>NR_NO)) then
  381. begin
  382. //list.concat(tai_comment.create(strpnew('fixref: symbol with base or index')));
  383. hreg:=getaddressregister(list);
  384. reference_reset_symbol(href,ref.symbol,ref.offset,ref.alignment,ref.volatility);
  385. if (tf_static_reg_based in target_info.flags) and (ref.base=NR_NO) then
  386. begin
  387. if ref.symbol.typ in [AT_DATA,AT_DATA_FORCEINDIRECT,AT_DATA_NOINDIRECT] then
  388. href.base:=NR_PIC_OFFSET_REG
  389. else
  390. href.base:=NR_PC;
  391. end;
  392. list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,hreg));
  393. ref.offset:=0;
  394. ref.symbol:=nil;
  395. { if we have unused base or index, try to use it, otherwise fold the existing base,
  396. also handle the case where the base might be a data register. }
  397. if ref.base=NR_NO then
  398. ref.base:=hreg
  399. else
  400. if (ref.index=NR_NO) and not isintregister(ref.base) then
  401. ref.index:=hreg
  402. else
  403. begin
  404. list.concat(taicpu.op_reg_reg(A_ADD,S_L,ref.base,hreg));
  405. ref.base:=hreg;
  406. end;
  407. { at this point we have base + (optional) index * scale }
  408. end;
  409. { deal with the case if our base is a dataregister }
  410. if (ref.base<>NR_NO) and not isaddressregister(ref.base) then
  411. begin
  412. hreg:=getaddressregister(list);
  413. if isaddressregister(ref.index) and (ref.scalefactor < 2) then
  414. begin
  415. //list.concat(tai_comment.create(strpnew('fixref: base is dX, resolving with reverse regs')));
  416. reference_reset_base(href,ref.index,0,ref.temppos,ref.alignment,ref.volatility);
  417. href.index:=ref.base;
  418. { we can fold in an 8 bit offset "for free" }
  419. if isvalue8bit(ref.offset) then
  420. begin
  421. href.offset:=ref.offset;
  422. ref.offset:=0;
  423. end;
  424. list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,hreg));
  425. ref.base:=hreg;
  426. ref.index:=NR_NO;
  427. result:=true;
  428. end
  429. else
  430. begin
  431. //list.concat(tai_comment.create(strpnew('fixref: base is dX, can''t resolve with reverse regs')));
  432. instr:=taicpu.op_reg_reg(A_MOVE,S_L,ref.base,hreg);
  433. add_move_instruction(instr);
  434. list.concat(instr);
  435. ref.base:=hreg;
  436. result:=true;
  437. end;
  438. end;
  439. { deal with large offsets on non-020+ }
  440. if not (current_settings.cputype in cpu_mc68020p) then
  441. begin
  442. if ((ref.index<>NR_NO) and not isvalue8bit(ref.offset)) or
  443. ((ref.base<>NR_NO) and not isvalue16bit(ref.offset)) then
  444. begin
  445. //list.concat(tai_comment.create(strpnew('fixref: handling large offsets')));
  446. { if we have a temp register from above, we can just add to it }
  447. if hreg=NR_NO then
  448. hreg:=getaddressregister(list);
  449. if isvalue16bit(ref.offset) then
  450. begin
  451. reference_reset_base(href,ref.base,ref.offset,ref.temppos,ref.alignment,ref.volatility);
  452. list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,hreg));
  453. end
  454. else
  455. begin
  456. instr:=taicpu.op_reg_reg(A_MOVE,S_L,ref.base,hreg);
  457. add_move_instruction(instr);
  458. list.concat(instr);
  459. list.concat(taicpu.op_const_reg(A_ADD,S_L,ref.offset,hreg));
  460. end;
  461. ref.offset:=0;
  462. ref.base:=hreg;
  463. result:=true;
  464. end;
  465. end;
  466. { fully resolve the reference to an address register, if we're told to do so
  467. and there's a reason to do so }
  468. if fullyresolve and
  469. ((ref.index<>NR_NO) or assigned(ref.symbol) or (ref.offset<>0)) then
  470. begin
  471. //list.concat(tai_comment.create(strpnew('fixref: fully resolve to register')));
  472. if hreg=NR_NO then
  473. hreg:=getaddressregister(list);
  474. if (tf_static_reg_based in target_info.flags) and (ref.base=NR_NO) then
  475. begin
  476. if ref.symbol.typ in [AT_DATA,AT_DATA_FORCEINDIRECT,AT_DATA_NOINDIRECT] then
  477. ref.base:=NR_PIC_OFFSET_REG
  478. else
  479. ref.base:=NR_PC;
  480. end;
  481. list.concat(taicpu.op_ref_reg(A_LEA,S_L,ref,hreg));
  482. ref.base:=hreg;
  483. ref.index:=NR_NO;
  484. ref.scalefactor:=1;
  485. ref.symbol:=nil;
  486. ref.offset:=0;
  487. result:=true;
  488. end;
  489. end;
  490. procedure tcg68k.call_rtl_mul_const_reg(list:tasmlist;size:tcgsize;a:tcgint;reg:tregister;const name:string);
  491. var
  492. paraloc1,paraloc2: tcgpara;
  493. pd : tprocdef;
  494. begin
  495. pd:=search_system_proc(name);
  496. paraloc1.init;
  497. paraloc2.init;
  498. paramanager.getintparaloc(list,pd,1,paraloc1);
  499. paramanager.getintparaloc(list,pd,2,paraloc2);
  500. a_load_const_cgpara(list,size,a,paraloc2);
  501. a_load_reg_cgpara(list,OS_32,reg,paraloc1);
  502. paramanager.freecgpara(list,paraloc2);
  503. paramanager.freecgpara(list,paraloc1);
  504. g_call(list,name);
  505. cg.a_reg_alloc(list,NR_FUNCTION_RESULT_REG);
  506. cg.a_load_reg_reg(list,OS_32,OS_32,NR_FUNCTION_RESULT_REG,reg);
  507. paraloc2.done;
  508. paraloc1.done;
  509. end;
  510. procedure tcg68k.call_rtl_mul_reg_reg(list:tasmlist;reg1,reg2:tregister;const name:string);
  511. var
  512. paraloc1,paraloc2: tcgpara;
  513. pd : tprocdef;
  514. begin
  515. pd:=search_system_proc(name);
  516. paraloc1.init;
  517. paraloc2.init;
  518. paramanager.getintparaloc(list,pd,1,paraloc1);
  519. paramanager.getintparaloc(list,pd,2,paraloc2);
  520. a_load_reg_cgpara(list,OS_32,reg1,paraloc2);
  521. a_load_reg_cgpara(list,OS_32,reg2,paraloc1);
  522. paramanager.freecgpara(list,paraloc2);
  523. paramanager.freecgpara(list,paraloc1);
  524. g_call(list,name);
  525. cg.a_reg_alloc(list,NR_FUNCTION_RESULT_REG);
  526. cg.a_load_reg_reg(list,OS_32,OS_32,NR_FUNCTION_RESULT_REG,reg2);
  527. paraloc2.done;
  528. paraloc1.done;
  529. end;
  530. procedure tcg68k.a_call_name(list : TAsmList;const s : string; weak: boolean);
  531. var
  532. sym: tasmsymbol;
  533. const
  534. jmp_inst: array[boolean] of tasmop = ( A_JSR, A_BSR );
  535. begin
  536. if not(weak) then
  537. sym:=current_asmdata.RefAsmSymbol(s,AT_FUNCTION)
  538. else
  539. sym:=current_asmdata.WeakRefAsmSymbol(s,AT_FUNCTION);
  540. list.concat(taicpu.op_sym(jmp_inst[tf_code_small in target_info.flags],S_NO,sym));
  541. end;
  542. procedure tcg68k.a_call_reg(list : TAsmList;reg: tregister);
  543. var
  544. tmpref : treference;
  545. tmpreg : tregister;
  546. instr : taicpu;
  547. begin
  548. if isaddressregister(reg) then
  549. begin
  550. { if we have an address register, we can jump to the address directly }
  551. reference_reset_base(tmpref,reg,0,ctempposinvalid,4,[]);
  552. end
  553. else
  554. begin
  555. { if we have a data register, we need to move it to an address register first }
  556. tmpreg:=getaddressregister(list);
  557. reference_reset_base(tmpref,tmpreg,0,ctempposinvalid,4,[]);
  558. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg,tmpreg);
  559. add_move_instruction(instr);
  560. list.concat(instr);
  561. end;
  562. list.concat(taicpu.op_ref(A_JSR,S_NO,tmpref));
  563. end;
  564. procedure tcg68k.a_load_const_reg(list : TAsmList;size : tcgsize;a : tcgint;register : tregister);
  565. var
  566. opsize: topsize;
  567. begin
  568. opsize:=tcgsize2opsize[size];
  569. if isaddressregister(register) then
  570. begin
  571. { an m68k manual I have recommends SUB Ax,Ax to be used instead of CLR for address regs }
  572. { Premature optimization is the root of all evil - this code breaks spilling if the
  573. register contains a spilled regvar, eg. a Pointer which is set to nil, then random
  574. havoc happens... This is kept here for reference now, to allow fixing of the spilling
  575. later. Most of the optimizations below here could be moved to the optimizer. (KB) }
  576. {if a = 0 then
  577. list.concat(taicpu.op_reg_reg(A_SUB,S_L,register,register))
  578. else}
  579. { ISA B/C Coldfire has MOV3Q which can move -1 or 1..7 to any reg }
  580. if (current_settings.cputype in [cpu_isa_b,cpu_isa_c,cpu_cfv4e]) and
  581. ((longint(a) = -1) or ((longint(a) > 0) and (longint(a) < 8))) then
  582. list.concat(taicpu.op_const_reg(A_MOV3Q,S_L,longint(a),register))
  583. else
  584. { MOVEA.W will sign extend the value in the dest. reg to full 32 bits
  585. (specific to Ax regs only) }
  586. if isvalue16bit(a) then
  587. list.concat(taicpu.op_const_reg(A_MOVEA,S_W,longint(a),register))
  588. else
  589. list.concat(taicpu.op_const_reg(A_MOVEA,S_L,longint(a),register));
  590. end
  591. else
  592. if a = 0 then
  593. list.concat(taicpu.op_reg(A_CLR,S_L,register))
  594. else
  595. begin
  596. { Prefer MOV3Q if applicable, it allows replacement spilling for register }
  597. if (current_settings.cputype in [cpu_isa_b,cpu_isa_c,cpu_cfv4e]) and
  598. ((longint(a)=-1) or ((longint(a)>0) and (longint(a)<8))) then
  599. list.concat(taicpu.op_const_reg(A_MOV3Q,S_L,longint(a),register))
  600. else if (longint(a) >= low(shortint)) and (longint(a) <= high(shortint)) then
  601. list.concat(taicpu.op_const_reg(A_MOVEQ,S_L,longint(a),register))
  602. else
  603. begin
  604. { ISA B/C Coldfire has sign extend/zero extend moves }
  605. if (current_settings.cputype in [cpu_isa_b,cpu_isa_c,cpu_cfv4e]) and
  606. (size in [OS_16, OS_8, OS_S16, OS_S8]) and
  607. ((longint(a) >= low(smallint)) and (longint(a) <= high(smallint))) then
  608. begin
  609. if size in [OS_16, OS_8] then
  610. list.concat(taicpu.op_const_reg(A_MVZ,opsize,longint(a),register))
  611. else
  612. list.concat(taicpu.op_const_reg(A_MVS,opsize,longint(a),register));
  613. end
  614. else
  615. begin
  616. { clear the register first, for unsigned and positive values, so
  617. we don't need to zero extend after }
  618. if (size in [OS_16,OS_8]) or
  619. ((size in [OS_S16,OS_S8]) and (a > 0)) then
  620. list.concat(taicpu.op_reg(A_CLR,S_L,register));
  621. list.concat(taicpu.op_const_reg(A_MOVE,opsize,longint(a),register));
  622. { only sign extend if we need to, zero extension is not necessary because the CLR.L above }
  623. if (size in [OS_S16,OS_S8]) and (a < 0) then
  624. sign_extend(list,size,register);
  625. end;
  626. end;
  627. end;
  628. end;
  629. procedure tcg68k.a_load_const_ref(list : TAsmList; tosize: tcgsize; a : tcgint;const ref : treference);
  630. var
  631. hreg : tregister;
  632. href : treference;
  633. begin
  634. if needs_unaligned(ref.alignment,tosize) then
  635. begin
  636. inherited;
  637. exit;
  638. end;
  639. a:=longint(a);
  640. href:=ref;
  641. fixref(list,href,false);
  642. if (a=0) and not (current_settings.cputype = cpu_mc68000) then
  643. list.concat(taicpu.op_ref(A_CLR,tcgsize2opsize[tosize],href))
  644. else if (tcgsize2opsize[tosize]=S_L) and
  645. (current_settings.cputype in [cpu_isa_b,cpu_isa_c,cpu_cfv4e]) and
  646. ((a=-1) or ((a>0) and (a<8))) then
  647. list.concat(taicpu.op_const_ref(A_MOV3Q,S_L,a,href))
  648. { for coldfire we need to go through a temporary register if we have a
  649. offset, index or symbol given }
  650. else if (current_settings.cputype in cpu_coldfire) and
  651. (
  652. (href.offset<>0) or
  653. { TODO : check whether we really need this second condition }
  654. (href.index<>NR_NO) or
  655. assigned(href.symbol)
  656. ) then
  657. begin
  658. hreg:=getintregister(list,tosize);
  659. a_load_const_reg(list,tosize,a,hreg);
  660. list.concat(taicpu.op_reg_ref(A_MOVE,tcgsize2opsize[tosize],hreg,href));
  661. end
  662. else
  663. { loading via a register is almost always faster if the value is small.
  664. (with the 68040 being the only notable exception, so maybe disable
  665. this on a '040? but the difference is minor) it also results in shorter
  666. code. (KB) }
  667. if isvalue8bit(a) and (tcgsize2opsize[tosize] = S_L) then
  668. begin
  669. hreg:=getintregister(list,OS_INT);
  670. a_load_const_reg(list,OS_INT,a,hreg); // this will use moveq et.al.
  671. list.concat(taicpu.op_reg_ref(A_MOVE,tcgsize2opsize[tosize],hreg,href));
  672. end
  673. else
  674. list.concat(taicpu.op_const_ref(A_MOVE,tcgsize2opsize[tosize],longint(a),href));
  675. end;
  676. procedure tcg68k.a_load_reg_ref(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);
  677. var
  678. href : treference;
  679. hreg : tregister;
  680. begin
  681. if needs_unaligned(ref.alignment,tosize) then
  682. begin
  683. //list.concat(tai_comment.create(strpnew('a_load_reg_ref calling unaligned')));
  684. a_load_reg_ref_unaligned(list,fromsize,tosize,register,ref);
  685. exit;
  686. end;
  687. href := ref;
  688. hreg := register;
  689. fixref(list,href,false);
  690. if tcgsize2size[fromsize]<tcgsize2size[tosize] then
  691. begin
  692. hreg:=getintregister(list,tosize);
  693. a_load_reg_reg(list,fromsize,tosize,register,hreg);
  694. end;
  695. { move to destination reference }
  696. list.concat(taicpu.op_reg_ref(A_MOVE,TCGSize2OpSize[tosize],hreg,href));
  697. end;
  698. procedure tcg68k.a_load_reg_ref_unaligned(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);
  699. var
  700. tmpref : treference;
  701. tmpreg,
  702. tmpreg2 : tregister;
  703. begin
  704. if not needs_unaligned(ref.alignment,tosize) then
  705. begin
  706. a_load_reg_ref(list,fromsize,tosize,register,ref);
  707. exit;
  708. end;
  709. list.concat(tai_comment.create(strpnew('a_load_reg_ref_unaligned: generating unaligned store')));
  710. tmpreg2:=getaddressregister(list);
  711. tmpref:=ref;
  712. inc(tmpref.offset,tcgsize2size[tosize]-1);
  713. a_loadaddr_ref_reg(list,tmpref,tmpreg2);
  714. reference_reset_base(tmpref,tmpreg2,0,ctempposinvalid,1,ref.volatility);
  715. tmpref.direction:=dir_none;
  716. tmpreg:=getintregister(list,tosize);
  717. a_load_reg_reg(list,fromsize,tosize,register,tmpreg);
  718. case tosize of
  719. OS_16,OS_S16:
  720. begin
  721. list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref));
  722. list.concat(taicpu.op_const_reg(A_LSR,S_W,8,tmpreg));
  723. tmpref.direction:=dir_dec;
  724. list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref));
  725. end;
  726. OS_32,OS_S32:
  727. begin
  728. list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref));
  729. list.concat(taicpu.op_const_reg(A_LSR,S_W,8,tmpreg));
  730. tmpref.direction:=dir_dec;
  731. list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref));
  732. list.concat(taicpu.op_reg(A_SWAP,S_L,tmpreg));
  733. list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref));
  734. list.concat(taicpu.op_const_reg(A_LSR,S_W,8,tmpreg));
  735. list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref));
  736. end
  737. else
  738. internalerror(2016052201);
  739. end;
  740. end;
  741. procedure tcg68k.a_load_ref_ref(list : TAsmList;fromsize,tosize : tcgsize;const sref : treference;const dref : treference);
  742. var
  743. aref: treference;
  744. bref: treference;
  745. usetemp: boolean;
  746. hreg: TRegister;
  747. begin
  748. usetemp:=TCGSize2OpSize[fromsize]<>TCGSize2OpSize[tosize];
  749. usetemp:=usetemp or (needs_unaligned(sref.alignment,fromsize) or needs_unaligned(dref.alignment,tosize));
  750. aref := sref;
  751. bref := dref;
  752. if usetemp then
  753. begin
  754. { if we need to change the size then always use a temporary register }
  755. hreg:=getintregister(list,fromsize);
  756. if needs_unaligned(sref.alignment,fromsize) then
  757. a_load_ref_reg_unaligned(list,fromsize,tosize,sref,hreg)
  758. else
  759. begin
  760. fixref(list,aref,false);
  761. list.concat(taicpu.op_ref_reg(A_MOVE,TCGSize2OpSize[fromsize],aref,hreg));
  762. sign_extend(list,fromsize,tosize,hreg);
  763. end;
  764. if needs_unaligned(dref.alignment,tosize) then
  765. a_load_reg_ref_unaligned(list,tosize,tosize,hreg,dref)
  766. else
  767. begin
  768. { if we use a temp register, we don't need to fully resolve
  769. the dest ref, not even on coldfire }
  770. fixref(list,bref,false);
  771. list.concat(taicpu.op_reg_ref(A_MOVE,TCGSize2OpSize[tosize],hreg,bref));
  772. end;
  773. end
  774. else
  775. begin
  776. fixref(list,aref,false);
  777. fixref(list,bref,current_settings.cputype in cpu_coldfire);
  778. list.concat(taicpu.op_ref_ref(A_MOVE,TCGSize2OpSize[fromsize],aref,bref));
  779. end;
  780. end;
  781. procedure tcg68k.a_load_reg_reg(list : TAsmList;fromsize,tosize : tcgsize;reg1,reg2 : tregister);
  782. var
  783. instr : taicpu;
  784. hreg : tregister;
  785. opsize : topsize;
  786. begin
  787. { move to destination register }
  788. opsize:=TCGSize2OpSize[fromsize];
  789. if isaddressregister(reg2) and not (opsize in [S_L]) then
  790. begin
  791. hreg:=cg.getintregister(list,OS_ADDR);
  792. instr:=taicpu.op_reg_reg(A_MOVE,TCGSize2OpSize[fromsize],reg1,hreg);
  793. add_move_instruction(instr);
  794. list.concat(instr);
  795. sign_extend(list,fromsize,hreg);
  796. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg,reg2));
  797. end
  798. else
  799. begin
  800. if not isregoverlap(reg1,reg2) then
  801. begin
  802. instr:=taicpu.op_reg_reg(A_MOVE,opsize,reg1,reg2);
  803. add_move_instruction(instr);
  804. list.concat(instr);
  805. end;
  806. sign_extend(list,fromsize,tosize,reg2);
  807. end;
  808. end;
  809. procedure tcg68k.a_load_ref_reg(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);
  810. var
  811. href : treference;
  812. hreg : tregister;
  813. size : tcgsize;
  814. opsize: topsize;
  815. needsext: boolean;
  816. begin
  817. if needs_unaligned(ref.alignment,fromsize) then
  818. begin
  819. //list.concat(tai_comment.create(strpnew('a_load_ref_reg calling unaligned')));
  820. a_load_ref_reg_unaligned(list,fromsize,tosize,ref,register);
  821. exit;
  822. end;
  823. href:=ref;
  824. fixref(list,href,false);
  825. needsext:=tcgsize2size[fromsize]<tcgsize2size[tosize];
  826. if needsext then
  827. size:=fromsize
  828. else
  829. size:=tosize;
  830. opsize:=TCGSize2OpSize[size];
  831. if isaddressregister(register) and not (opsize in [S_L]) then
  832. hreg:=getintregister(list,OS_ADDR)
  833. else
  834. hreg:=register;
  835. if needsext and (CPUM68K_HAS_MVSMVZ in cpu_capabilities[current_settings.cputype]) and not (opsize in [S_L]) then
  836. begin
  837. if fromsize in [OS_S8,OS_S16] then
  838. list.concat(taicpu.op_ref_reg(A_MVS,opsize,href,hreg))
  839. else if fromsize in [OS_8,OS_16] then
  840. list.concat(taicpu.op_ref_reg(A_MVZ,opsize,href,hreg))
  841. else
  842. internalerror(2016050502);
  843. end
  844. else
  845. begin
  846. if needsext and (fromsize in [OS_8,OS_16]) then
  847. begin
  848. //list.concat(tai_comment.create(strpnew('a_load_ref_reg: zero ext')));
  849. a_load_const_reg(list,OS_32,0,hreg);
  850. needsext:=false;
  851. end;
  852. list.concat(taicpu.op_ref_reg(A_MOVE,opsize,href,hreg));
  853. if needsext then
  854. sign_extend(list,size,hreg);
  855. end;
  856. if hreg<>register then
  857. a_load_reg_reg(list,OS_ADDR,OS_ADDR,hreg,register);
  858. end;
  859. procedure tcg68k.a_load_ref_reg_unaligned(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);
  860. var
  861. tmpref : treference;
  862. tmpreg,
  863. tmpreg2 : tregister;
  864. begin
  865. if not needs_unaligned(ref.alignment,fromsize) then
  866. begin
  867. a_load_ref_reg(list,fromsize,tosize,ref,register);
  868. exit;
  869. end;
  870. list.concat(tai_comment.create(strpnew('a_load_ref_reg_unaligned: generating unaligned load')));
  871. tmpreg2:=getaddressregister(list);
  872. a_loadaddr_ref_reg(list,ref,tmpreg2);
  873. reference_reset_base(tmpref,tmpreg2,0,ctempposinvalid,1,ref.volatility);
  874. tmpref.direction:=dir_inc;
  875. if isaddressregister(register) then
  876. tmpreg:=getintregister(list,OS_ADDR)
  877. else
  878. tmpreg:=register;
  879. case fromsize of
  880. OS_16,OS_S16:
  881. begin
  882. list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg));
  883. list.concat(taicpu.op_const_reg(A_LSL,S_W,8,tmpreg));
  884. tmpref.direction:=dir_none;
  885. list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg));
  886. sign_extend(list,fromsize,tmpreg);
  887. end;
  888. OS_32,OS_S32:
  889. begin
  890. list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg));
  891. list.concat(taicpu.op_const_reg(A_LSL,S_W,8,tmpreg));
  892. list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg));
  893. list.concat(taicpu.op_reg(A_SWAP,S_L,tmpreg));
  894. list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg));
  895. list.concat(taicpu.op_const_reg(A_LSL,S_W,8,tmpreg));
  896. tmpref.direction:=dir_none;
  897. list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg));
  898. end
  899. else
  900. internalerror(2016052103);
  901. end;
  902. if tmpreg<>register then
  903. a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpreg,register);
  904. end;
  905. procedure tcg68k.a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);
  906. var
  907. href : treference;
  908. hreg : tregister;
  909. begin
  910. href:=ref;
  911. fixref(list, href, false);
  912. if not isaddressregister(r) then
  913. begin
  914. hreg:=getaddressregister(list);
  915. list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,hreg));
  916. a_load_reg_reg(list, OS_ADDR, OS_ADDR, hreg, r);
  917. end
  918. else
  919. list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,r));
  920. end;
  921. procedure tcg68k.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister);
  922. var
  923. instr : taicpu;
  924. begin
  925. instr:=taicpu.op_reg_reg(A_FMOVE,fpuregopsize,reg1,reg2);
  926. add_move_instruction(instr);
  927. list.concat(instr);
  928. end;
  929. procedure tcg68k.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister);
  930. var
  931. opsize : topsize;
  932. href : treference;
  933. begin
  934. opsize := tcgsize2opsize[fromsize];
  935. href := ref;
  936. fixref(list,href,current_settings.fputype = fpu_coldfire);
  937. list.concat(taicpu.op_ref_reg(A_FMOVE,opsize,href,reg));
  938. end;
  939. procedure tcg68k.a_loadfpu_reg_ref(list: TAsmList; fromsize,tosize: tcgsize; reg: tregister; const ref: treference);
  940. var
  941. opsize : topsize;
  942. href : treference;
  943. begin
  944. opsize := tcgsize2opsize[tosize];
  945. href := ref;
  946. fixref(list,href,current_settings.fputype = fpu_coldfire);
  947. list.concat(taicpu.op_reg_ref(A_FMOVE,opsize,reg,href));
  948. end;
  949. procedure tcg68k.a_loadfpu_reg_cgpara(list : TAsmList;size : tcgsize;const reg : tregister;const cgpara : tcgpara);
  950. var
  951. ref : treference;
  952. begin
  953. if use_push(cgpara) and (current_settings.fputype in [fpu_68881,fpu_coldfire]) then
  954. begin
  955. cgpara.check_simple_location;
  956. reference_reset_base(ref, NR_STACK_POINTER_REG, 0, ctempposinvalid, cgpara.alignment, []);
  957. ref.direction := dir_dec;
  958. list.concat(taicpu.op_reg_ref(A_FMOVE,tcgsize2opsize[cgpara.location^.size],reg,ref));
  959. end
  960. else
  961. inherited a_loadfpu_reg_cgpara(list,size,reg,cgpara);
  962. end;
  963. procedure tcg68k.a_loadfpu_ref_cgpara(list : TAsmList; size : tcgsize;const ref : treference;const cgpara : TCGPara);
  964. var
  965. href, href2 : treference;
  966. freg : tregister;
  967. begin
  968. if current_settings.fputype = fpu_soft then
  969. case cgpara.location^.loc of
  970. LOC_REFERENCE,LOC_CREFERENCE:
  971. begin
  972. case size of
  973. OS_F64:
  974. cg64.a_load64_ref_cgpara(list,ref,cgpara);
  975. OS_F32:
  976. a_load_ref_cgpara(list,size,ref,cgpara);
  977. else
  978. internalerror(2013021201);
  979. end;
  980. end;
  981. else
  982. inherited a_loadfpu_ref_cgpara(list,size,ref,cgpara);
  983. end
  984. else
  985. if use_push(cgpara) and (current_settings.fputype in [fpu_68881,fpu_coldfire]) then
  986. begin
  987. //list.concat(tai_comment.create(strpnew('a_loadfpu_ref_cgpara copy')));
  988. cgpara.check_simple_location;
  989. reference_reset_base(href, NR_STACK_POINTER_REG, 0, ctempposinvalid, cgpara.alignment, []);
  990. href.direction := dir_dec;
  991. case size of
  992. OS_F64:
  993. begin
  994. href2:=ref;
  995. inc(href2.offset,8);
  996. fixref(list,href2,true);
  997. href2.direction := dir_dec;
  998. cg.a_load_ref_ref(list,OS_32,OS_32,href2,href);
  999. cg.a_load_ref_ref(list,OS_32,OS_32,href2,href);
  1000. end;
  1001. OS_F32:
  1002. cg.a_load_ref_ref(list,OS_32,OS_32,ref,href);
  1003. else
  1004. internalerror(2017052110);
  1005. end;
  1006. end
  1007. else
  1008. begin
  1009. //list.concat(tai_comment.create(strpnew('a_loadfpu_ref_cgpara inherited')));
  1010. inherited a_loadfpu_ref_cgpara(list,size,ref,cgpara);
  1011. end;
  1012. end;
  1013. procedure tcg68k.a_op_const_reg(list : TAsmList; Op: TOpCG; size: tcgsize; a: tcgint; reg: TRegister);
  1014. var
  1015. scratch_reg : tregister;
  1016. scratch_reg2: tregister;
  1017. opcode : tasmop;
  1018. begin
  1019. optimize_op_const(size, op, a);
  1020. opcode := topcg2tasmop[op];
  1021. case op of
  1022. OP_NONE :
  1023. begin
  1024. { Opcode is optimized away }
  1025. end;
  1026. OP_MOVE :
  1027. begin
  1028. { Optimized, replaced with a simple load }
  1029. a_load_const_reg(list,size,a,reg);
  1030. end;
  1031. OP_ADD,
  1032. OP_SUB:
  1033. begin
  1034. { add/sub works the same way, so have it unified here }
  1035. if (a >= 1) and (a <= 8) then
  1036. if (op = OP_ADD) then
  1037. opcode:=A_ADDQ
  1038. else
  1039. opcode:=A_SUBQ;
  1040. list.concat(taicpu.op_const_reg(opcode, S_L, a, reg));
  1041. end;
  1042. OP_AND,
  1043. OP_OR,
  1044. OP_XOR:
  1045. begin
  1046. scratch_reg := force_to_dataregister(list, size, reg);
  1047. list.concat(taicpu.op_const_reg(opcode, S_L, a, scratch_reg));
  1048. move_if_needed(list, size, scratch_reg, reg);
  1049. end;
  1050. OP_DIV,
  1051. OP_IDIV:
  1052. begin
  1053. internalerror(20020816);
  1054. end;
  1055. OP_MUL,
  1056. OP_IMUL:
  1057. begin
  1058. { NOTE: better have this as fast as possible on every CPU in all cases,
  1059. because the compiler uses OP_IMUL for array indexing... (KB) }
  1060. { ColdFire doesn't support MULS/MULU <imm>,dX }
  1061. if current_settings.cputype in cpu_coldfire then
  1062. begin
  1063. { move const to a register first }
  1064. scratch_reg := getintregister(list,OS_INT);
  1065. a_load_const_reg(list, size, a, scratch_reg);
  1066. { do the multiplication }
  1067. scratch_reg2 := force_to_dataregister(list, size, reg);
  1068. sign_extend(list, size, scratch_reg2);
  1069. list.concat(taicpu.op_reg_reg(opcode,S_L,scratch_reg,scratch_reg2));
  1070. { move the value back to the original register }
  1071. move_if_needed(list, size, scratch_reg2, reg);
  1072. end
  1073. else
  1074. begin
  1075. if current_settings.cputype in cpu_mc68020p then
  1076. begin
  1077. { do the multiplication }
  1078. scratch_reg := force_to_dataregister(list, size, reg);
  1079. sign_extend(list, size, scratch_reg);
  1080. list.concat(taicpu.op_const_reg(opcode,S_L,a,scratch_reg));
  1081. { move the value back to the original register }
  1082. move_if_needed(list, size, scratch_reg, reg);
  1083. end
  1084. else
  1085. { Fallback branch, plain 68000 for now }
  1086. if not optimize_const_mul_to_shift_sub_add(list, 5, a, size, reg) then
  1087. { FIX ME: this is slow as hell, but original 68000 doesn't have 32x32 -> 32bit MUL (KB) }
  1088. if op = OP_MUL then
  1089. call_rtl_mul_const_reg(list, size, a, reg,'fpc_mul_dword')
  1090. else
  1091. call_rtl_mul_const_reg(list, size, a, reg,'fpc_mul_longint');
  1092. end;
  1093. end;
  1094. OP_ROL,
  1095. OP_ROR,
  1096. OP_SAR,
  1097. OP_SHL,
  1098. OP_SHR :
  1099. begin
  1100. scratch_reg := force_to_dataregister(list, size, reg);
  1101. sign_extend(list, size, scratch_reg);
  1102. { some special cases which can generate smarter code
  1103. using the SWAP instruction }
  1104. if (a = 16) then
  1105. begin
  1106. if (op = OP_SHL) then
  1107. begin
  1108. list.concat(taicpu.op_reg(A_SWAP,S_NO,scratch_reg));
  1109. list.concat(taicpu.op_reg(A_CLR,S_W,scratch_reg));
  1110. end
  1111. else if (op = OP_SHR) then
  1112. begin
  1113. list.concat(taicpu.op_reg(A_CLR,S_W,scratch_reg));
  1114. list.concat(taicpu.op_reg(A_SWAP,S_NO,scratch_reg));
  1115. end
  1116. else if (op = OP_SAR) then
  1117. begin
  1118. list.concat(taicpu.op_reg(A_SWAP,S_NO,scratch_reg));
  1119. list.concat(taicpu.op_reg(A_EXT,S_L,scratch_reg));
  1120. end
  1121. else if (op = OP_ROR) or (op = OP_ROL) then
  1122. list.concat(taicpu.op_reg(A_SWAP,S_NO,scratch_reg))
  1123. end
  1124. else if (a >= 1) and (a <= 8) then
  1125. begin
  1126. list.concat(taicpu.op_const_reg(opcode, S_L, a, scratch_reg));
  1127. end
  1128. else if (a >= 9) and (a < 16) then
  1129. begin
  1130. { Use two ops instead of const -> reg + shift with reg, because
  1131. this way is the same in length and speed but has less register
  1132. pressure }
  1133. list.concat(taicpu.op_const_reg(opcode, S_L, 8, scratch_reg));
  1134. list.concat(taicpu.op_const_reg(opcode, S_L, a-8, scratch_reg));
  1135. end
  1136. else
  1137. begin
  1138. { move const to a register first }
  1139. scratch_reg2 := getintregister(list,OS_INT);
  1140. a_load_const_reg(list, size, a, scratch_reg2);
  1141. { do the operation }
  1142. list.concat(taicpu.op_reg_reg(opcode, S_L, scratch_reg2, scratch_reg));
  1143. end;
  1144. { move the value back to the original register }
  1145. move_if_needed(list, size, scratch_reg, reg);
  1146. end;
  1147. else
  1148. internalerror(20020729);
  1149. end;
  1150. end;
  1151. procedure tcg68k.a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference);
  1152. var
  1153. opcode: tasmop;
  1154. opsize: topsize;
  1155. href : treference;
  1156. hreg : tregister;
  1157. begin
  1158. optimize_op_const(size, op, a);
  1159. opcode := topcg2tasmop[op];
  1160. opsize := TCGSize2OpSize[size];
  1161. { on ColdFire all arithmetic operations are only possible on 32bit }
  1162. if needs_unaligned(ref.alignment,size) or
  1163. ((current_settings.cputype in cpu_coldfire) and (opsize <> S_L)
  1164. and not (op in [OP_NONE,OP_MOVE])) then
  1165. begin
  1166. inherited;
  1167. exit;
  1168. end;
  1169. case op of
  1170. OP_NONE :
  1171. begin
  1172. { opcode was optimized away }
  1173. end;
  1174. OP_MOVE :
  1175. begin
  1176. { Optimized, replaced with a simple load }
  1177. a_load_const_ref(list,size,a,ref);
  1178. end;
  1179. OP_AND,
  1180. OP_OR,
  1181. OP_XOR :
  1182. begin
  1183. //list.concat(tai_comment.create(strpnew('a_op_const_ref: bitwise')));
  1184. hreg:=getintregister(list,size);
  1185. a_load_const_reg(list,size,a,hreg);
  1186. href:=ref;
  1187. fixref(list,href,false);
  1188. list.concat(taicpu.op_reg_ref(opcode, opsize, hreg, href));
  1189. end;
  1190. OP_ADD,
  1191. OP_SUB :
  1192. begin
  1193. href:=ref;
  1194. { add/sub works the same way, so have it unified here }
  1195. if (a >= 1) and (a <= 8) then
  1196. begin
  1197. fixref(list,href,false);
  1198. if (op = OP_ADD) then
  1199. opcode:=A_ADDQ
  1200. else
  1201. opcode:=A_SUBQ;
  1202. list.concat(taicpu.op_const_ref(opcode, opsize, a, href));
  1203. end
  1204. else
  1205. if not(current_settings.cputype in cpu_coldfire) then
  1206. begin
  1207. fixref(list,href,false);
  1208. list.concat(taicpu.op_const_ref(opcode, opsize, a, href));
  1209. end
  1210. else
  1211. { on ColdFire, ADDI/SUBI cannot act on memory
  1212. so we can only go through a register }
  1213. inherited;
  1214. end;
  1215. else begin
  1216. // list.concat(tai_comment.create(strpnew('a_op_const_ref inherited')));
  1217. inherited;
  1218. end;
  1219. end;
  1220. end;
  1221. procedure tcg68k.a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; src, dst: TRegister);
  1222. var
  1223. hreg1, hreg2: tregister;
  1224. opcode : tasmop;
  1225. opsize : topsize;
  1226. begin
  1227. opcode := topcg2tasmop[op];
  1228. if current_settings.cputype in cpu_coldfire then
  1229. opsize := S_L
  1230. else
  1231. opsize := TCGSize2OpSize[size];
  1232. case op of
  1233. OP_ADD,
  1234. OP_SUB:
  1235. begin
  1236. if current_settings.cputype in cpu_coldfire then
  1237. begin
  1238. { operation only allowed only a longword }
  1239. sign_extend(list, size, src);
  1240. sign_extend(list, size, dst);
  1241. end;
  1242. list.concat(taicpu.op_reg_reg(opcode, opsize, src, dst));
  1243. end;
  1244. OP_AND,OP_OR,
  1245. OP_SAR,OP_SHL,
  1246. OP_SHR,OP_XOR:
  1247. begin
  1248. { load to data registers }
  1249. hreg1 := force_to_dataregister(list, size, src);
  1250. hreg2 := force_to_dataregister(list, size, dst);
  1251. if current_settings.cputype in cpu_coldfire then
  1252. begin
  1253. { operation only allowed only a longword }
  1254. {!***************************************
  1255. in the case of shifts, the value to
  1256. shift by, should already be valid, so
  1257. no need to sign extend the value
  1258. !
  1259. }
  1260. if op in [OP_AND,OP_OR,OP_XOR] then
  1261. sign_extend(list, size, hreg1);
  1262. sign_extend(list, size, hreg2);
  1263. end;
  1264. list.concat(taicpu.op_reg_reg(opcode, opsize, hreg1, hreg2));
  1265. { move back result into destination register }
  1266. move_if_needed(list, size, hreg2, dst);
  1267. end;
  1268. OP_DIV,
  1269. OP_IDIV :
  1270. begin
  1271. internalerror(20020816);
  1272. end;
  1273. OP_MUL,
  1274. OP_IMUL:
  1275. begin
  1276. if not (CPUM68K_HAS_32BITMUL in cpu_capabilities[current_settings.cputype]) then
  1277. if op = OP_MUL then
  1278. call_rtl_mul_reg_reg(list,src,dst,'fpc_mul_dword')
  1279. else
  1280. call_rtl_mul_reg_reg(list,src,dst,'fpc_mul_longint')
  1281. else
  1282. begin
  1283. { 68020+ and ColdFire codepath, probably could be improved }
  1284. hreg1 := force_to_dataregister(list, size, src);
  1285. hreg2 := force_to_dataregister(list, size, dst);
  1286. sign_extend(list, size, hreg1);
  1287. sign_extend(list, size, hreg2);
  1288. list.concat(taicpu.op_reg_reg(opcode, opsize, hreg1, hreg2));
  1289. { move back result into destination register }
  1290. move_if_needed(list, size, hreg2, dst);
  1291. end;
  1292. end;
  1293. OP_NEG,
  1294. OP_NOT :
  1295. begin
  1296. { if there are two operands, move the register,
  1297. since the operation will only be done on the result
  1298. register. }
  1299. if (src<>dst) then
  1300. a_load_reg_reg(list,size,size,src,dst);
  1301. hreg2 := force_to_dataregister(list, size, dst);
  1302. { coldfire only supports long version }
  1303. if current_settings.cputype in cpu_ColdFire then
  1304. sign_extend(list, size, hreg2);
  1305. list.concat(taicpu.op_reg(opcode, opsize, hreg2));
  1306. { move back the result to the result register if needed }
  1307. move_if_needed(list, size, hreg2, dst);
  1308. end;
  1309. else
  1310. internalerror(20020729);
  1311. end;
  1312. end;
  1313. procedure tcg68k.a_op_reg_ref(list : TAsmList; Op: TOpCG; size: TCGSize; reg: TRegister; const ref: TReference);
  1314. var
  1315. opcode : tasmop;
  1316. opsize : topsize;
  1317. href : treference;
  1318. hreg : tregister;
  1319. begin
  1320. opcode := topcg2tasmop[op];
  1321. opsize := TCGSize2OpSize[size];
  1322. { on ColdFire all arithmetic operations are only possible on 32bit
  1323. and addressing modes are limited }
  1324. if needs_unaligned(ref.alignment,size) or
  1325. ((current_settings.cputype in cpu_coldfire) and (opsize <> S_L)) then
  1326. begin
  1327. //list.concat(tai_comment.create(strpnew('a_op_reg_ref: inherited #1')));
  1328. inherited;
  1329. exit;
  1330. end;
  1331. case op of
  1332. OP_ADD,
  1333. OP_SUB,
  1334. OP_OR,
  1335. OP_XOR,
  1336. OP_AND:
  1337. begin
  1338. //list.concat(tai_comment.create(strpnew('a_op_reg_ref: normal op')));
  1339. href:=ref;
  1340. fixref(list,href,false);
  1341. { areg -> ref arithmetic operations are impossible on 68k }
  1342. hreg:=force_to_dataregister(list,size,reg);
  1343. { add/sub works the same way, so have it unified here }
  1344. list.concat(taicpu.op_reg_ref(opcode, opsize, hreg, href));
  1345. end;
  1346. else begin
  1347. //list.concat(tai_comment.create(strpnew('a_op_reg_ref inherited #2')));
  1348. inherited;
  1349. end;
  1350. end;
  1351. end;
  1352. procedure tcg68k.a_op_ref_reg(list : TAsmList; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister);
  1353. var
  1354. opcode : tasmop;
  1355. opsize : topsize;
  1356. href : treference;
  1357. hreg : tregister;
  1358. begin
  1359. opcode := topcg2tasmop[op];
  1360. opsize := TCGSize2OpSize[size];
  1361. { on ColdFire all arithmetic operations are only possible on 32bit
  1362. and addressing modes are limited }
  1363. if needs_unaligned(ref.alignment,size) or
  1364. ((current_settings.cputype in cpu_coldfire) and (opsize <> S_L)) then
  1365. begin
  1366. //list.concat(tai_comment.create(strpnew('a_op_ref_reg: inherited #1')));
  1367. inherited;
  1368. exit;
  1369. end;
  1370. case op of
  1371. OP_ADD,
  1372. OP_SUB,
  1373. OP_OR,
  1374. OP_AND,
  1375. OP_MUL,
  1376. OP_IMUL:
  1377. begin
  1378. //list.concat(tai_comment.create(strpnew('a_op_ref_reg: normal op')));
  1379. href:=ref;
  1380. { Coldfire doesn't support d(Ax,Dx) for long MULx... }
  1381. fixref(list,href,(op in [OP_MUL,OP_IMUL]) and
  1382. (current_settings.cputype in cpu_coldfire));
  1383. list.concat(taicpu.op_ref_reg(opcode, opsize, href, reg));
  1384. end;
  1385. else begin
  1386. //list.concat(tai_comment.create(strpnew('a_op_ref_reg inherited #2')));
  1387. inherited;
  1388. end;
  1389. end;
  1390. end;
  1391. procedure tcg68k.a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister;
  1392. l : tasmlabel);
  1393. var
  1394. hregister : tregister;
  1395. instr : taicpu;
  1396. need_temp_reg : boolean;
  1397. temp_size: topsize;
  1398. begin
  1399. need_temp_reg := false;
  1400. { plain 68000 doesn't support address registers for TST }
  1401. need_temp_reg := (current_settings.cputype = cpu_mc68000) and
  1402. (a = 0) and isaddressregister(reg);
  1403. { ColdFire doesn't support address registers for CMPI }
  1404. need_temp_reg := need_temp_reg or ((current_settings.cputype in cpu_coldfire)
  1405. and (a <> 0) and isaddressregister(reg));
  1406. if need_temp_reg then
  1407. begin
  1408. hregister := getintregister(list,OS_INT);
  1409. temp_size := TCGSize2OpSize[size];
  1410. if temp_size < S_W then
  1411. temp_size := S_W;
  1412. instr:=taicpu.op_reg_reg(A_MOVE,temp_size,reg,hregister);
  1413. add_move_instruction(instr);
  1414. list.concat(instr);
  1415. reg := hregister;
  1416. { do sign extension if size had to be modified }
  1417. if temp_size <> TCGSize2OpSize[size] then
  1418. begin
  1419. sign_extend(list, size, reg);
  1420. size:=OS_INT;
  1421. end;
  1422. end;
  1423. if a = 0 then
  1424. list.concat(taicpu.op_reg(A_TST,TCGSize2OpSize[size],reg))
  1425. else
  1426. begin
  1427. { ColdFire ISA A also needs S_L for CMPI }
  1428. { Note: older QEMU pukes from CMPI sizes <> .L even on ISA B/C, but
  1429. it's actually *LEGAL*, see CFPRM, page 4-30, the bug also seems
  1430. fixed in recent QEMU, but only when CPU cfv4e is forced, not by
  1431. default. (KB) }
  1432. if current_settings.cputype in cpu_coldfire{-[cpu_isa_b,cpu_isa_c,cpu_cfv4e]} then
  1433. begin
  1434. sign_extend(list, size, reg);
  1435. size:=OS_INT;
  1436. end;
  1437. list.concat(taicpu.op_const_reg(A_CMPI,TCGSize2OpSize[size],a,reg));
  1438. end;
  1439. { emit the actual jump to the label }
  1440. a_jmp_cond(list,cmp_op,l);
  1441. end;
  1442. procedure tcg68k.a_cmp_const_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;const ref : treference; l : tasmlabel);
  1443. var
  1444. tmpref: treference;
  1445. begin
  1446. { optimize for usage of TST here, so ref compares against zero, which is the
  1447. most common case by far in the RTL code at least (KB) }
  1448. if not needs_unaligned(ref.alignment,size) and (a = 0) then
  1449. begin
  1450. //list.concat(tai_comment.create(strpnew('a_cmp_const_ref_label with TST')));
  1451. tmpref:=ref;
  1452. fixref(list,tmpref,false);
  1453. list.concat(taicpu.op_ref(A_TST,tcgsize2opsize[size],tmpref));
  1454. a_jmp_cond(list,cmp_op,l);
  1455. end
  1456. else
  1457. begin
  1458. //list.concat(tai_comment.create(strpnew('a_cmp_const_ref_label inherited')));
  1459. inherited;
  1460. end;
  1461. end;
  1462. procedure tcg68k.a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
  1463. begin
  1464. if (current_settings.cputype in cpu_coldfire-[cpu_isa_b,cpu_isa_c,cpu_cfv4e]) then
  1465. begin
  1466. sign_extend(list,size,reg1);
  1467. sign_extend(list,size,reg2);
  1468. size:=OS_INT;
  1469. end;
  1470. list.concat(taicpu.op_reg_reg(A_CMP,tcgsize2opsize[size],reg1,reg2));
  1471. { emit the actual jump to the label }
  1472. a_jmp_cond(list,cmp_op,l);
  1473. end;
  1474. procedure tcg68k.a_jmp_name(list: TAsmList; const s: string);
  1475. var
  1476. ai: taicpu;
  1477. begin
  1478. ai := Taicpu.op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(s,AT_FUNCTION));
  1479. ai.is_jmp := true;
  1480. list.concat(ai);
  1481. end;
  1482. procedure tcg68k.a_jmp_always(list : TAsmList;l: tasmlabel);
  1483. var
  1484. ai: taicpu;
  1485. begin
  1486. ai := Taicpu.op_sym(A_JMP,S_NO,l);
  1487. ai.is_jmp := true;
  1488. list.concat(ai);
  1489. end;
  1490. procedure tcg68k.a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel);
  1491. var
  1492. ai : taicpu;
  1493. begin
  1494. if not (f in FloatResFlags) then
  1495. ai := Taicpu.op_sym(A_BXX,S_NO,l)
  1496. else
  1497. ai := Taicpu.op_sym(A_FBXX,S_NO,l);
  1498. ai.SetCondition(flags_to_cond(f));
  1499. ai.is_jmp := true;
  1500. list.concat(ai);
  1501. end;
  1502. procedure tcg68k.g_flags2reg(list: TAsmList; size: TCgSize; const f: tresflags; reg: TRegister);
  1503. var
  1504. ai : taicpu;
  1505. htrue: tasmlabel;
  1506. begin
  1507. if isaddressregister(reg) then
  1508. internalerror(2017051701);
  1509. if (f in FloatResFlags) then
  1510. begin
  1511. //list.concat(tai_comment.create(strpnew('flags2reg: float resflags')));
  1512. current_asmdata.getjumplabel(htrue);
  1513. a_load_const_reg(current_asmdata.CurrAsmList,OS_32,1,reg);
  1514. a_jmp_flags(list, f, htrue);
  1515. a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,reg);
  1516. a_label(current_asmdata.CurrAsmList,htrue);
  1517. exit;
  1518. end;
  1519. ai:=Taicpu.Op_reg(A_Sxx,S_B,reg);
  1520. ai.SetCondition(flags_to_cond(f));
  1521. list.concat(ai);
  1522. { Scc stores a complete byte of 1s, but the compiler expects only one
  1523. bit set, so ensure this is the case }
  1524. if not (current_settings.cputype in cpu_coldfire) then
  1525. begin
  1526. if size in [OS_S8,OS_8] then
  1527. list.concat(taicpu.op_reg(A_NEG,S_B,reg))
  1528. else
  1529. list.concat(taicpu.op_const_reg(A_AND,TCgSize2OpSize[size],1,reg));
  1530. end
  1531. else
  1532. list.concat(taicpu.op_const_reg(A_AND,S_L,1,reg));
  1533. end;
  1534. procedure tcg68k.g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);
  1535. const
  1536. lentocgsize: array[1..4] of tcgsize = (OS_8,OS_16,OS_NO,OS_32);
  1537. var
  1538. helpsize : longint;
  1539. i : byte;
  1540. hregister : tregister;
  1541. iregister : tregister;
  1542. jregister : tregister;
  1543. hl : tasmlabel;
  1544. srcrefp,dstrefp : treference;
  1545. srcref,dstref : treference;
  1546. begin
  1547. if (len = 1) or ((len in [2,4]) and (current_settings.cputype <> cpu_mc68000)) then
  1548. begin
  1549. //list.concat(tai_comment.create(strpnew('g_concatcopy: small')));
  1550. a_load_ref_ref(list,lentocgsize[len],lentocgsize[len],source,dest);
  1551. exit;
  1552. end;
  1553. //list.concat(tai_comment.create(strpnew('g_concatcopy')));
  1554. hregister := getintregister(list,OS_INT);
  1555. iregister:=getaddressregister(list);
  1556. reference_reset_base(srcref,iregister,0,source.temppos,source.alignment,source.volatility);
  1557. srcrefp:=srcref;
  1558. srcrefp.direction := dir_inc;
  1559. jregister:=getaddressregister(list);
  1560. reference_reset_base(dstref,jregister,0,dest.temppos,dest.alignment,dest.volatility);
  1561. dstrefp:=dstref;
  1562. dstrefp.direction := dir_inc;
  1563. { iregister = source }
  1564. { jregister = destination }
  1565. a_loadaddr_ref_reg(list,source,iregister);
  1566. a_loadaddr_ref_reg(list,dest,jregister);
  1567. if not (needs_unaligned(source.alignment,OS_INT) or needs_unaligned(dest.alignment,OS_INT)) then
  1568. begin
  1569. if not ((len<=8) or (not(cs_opt_size in current_settings.optimizerswitches) and (len<=16))) then
  1570. begin
  1571. //list.concat(tai_comment.create(strpnew('g_concatcopy tight copy loop 020+')));
  1572. helpsize := len - len mod 4;
  1573. len := len mod 4;
  1574. a_load_const_reg(list,OS_INT,(helpsize div 4)-1,hregister);
  1575. current_asmdata.getjumplabel(hl);
  1576. a_label(list,hl);
  1577. list.concat(taicpu.op_ref_ref(A_MOVE,S_L,srcrefp,dstrefp));
  1578. if (current_settings.cputype in cpu_coldfire) or ((helpsize div 4)-1 > high(smallint)) then
  1579. begin
  1580. { Coldfire does not support DBRA, also it is word only }
  1581. list.concat(taicpu.op_const_reg(A_SUBQ,S_L,1,hregister));
  1582. list.concat(taicpu.op_sym(A_BPL,S_NO,hl));
  1583. end
  1584. else
  1585. list.concat(taicpu.op_reg_sym(A_DBRA,S_NO,hregister,hl));
  1586. end;
  1587. helpsize:=len div 4;
  1588. { move a dword x times }
  1589. for i:=1 to helpsize do
  1590. begin
  1591. dec(len,4);
  1592. if (len > 0) then
  1593. list.concat(taicpu.op_ref_ref(A_MOVE,S_L,srcrefp,dstrefp))
  1594. else
  1595. list.concat(taicpu.op_ref_ref(A_MOVE,S_L,srcref,dstref));
  1596. end;
  1597. { move a word }
  1598. if len>1 then
  1599. begin
  1600. dec(len,2);
  1601. if (len > 0) then
  1602. list.concat(taicpu.op_ref_ref(A_MOVE,S_W,srcrefp,dstrefp))
  1603. else
  1604. list.concat(taicpu.op_ref_ref(A_MOVE,S_W,srcref,dstref));
  1605. end;
  1606. { move a single byte }
  1607. if len>0 then
  1608. list.concat(taicpu.op_ref_ref(A_MOVE,S_B,srcref,dstref));
  1609. end
  1610. else
  1611. begin
  1612. { Fast 68010 loop mode with no possible alignment problems }
  1613. //list.concat(tai_comment.create(strpnew('g_concatcopy tight byte copy loop')));
  1614. a_load_const_reg(list,OS_INT,len - 1,hregister);
  1615. current_asmdata.getjumplabel(hl);
  1616. a_label(list,hl);
  1617. list.concat(taicpu.op_ref_ref(A_MOVE,S_B,srcrefp,dstrefp));
  1618. if (len - 1) > high(smallint) then
  1619. begin
  1620. list.concat(taicpu.op_const_reg(A_SUBQ,S_L,1,hregister));
  1621. list.concat(taicpu.op_sym(A_BPL,S_NO,hl));
  1622. end
  1623. else
  1624. list.concat(taicpu.op_reg_sym(A_DBRA,S_NO,hregister,hl));
  1625. end;
  1626. end;
  1627. procedure tcg68k.g_overflowcheck(list: TAsmList; const l:tlocation; def:tdef);
  1628. var
  1629. hl : tasmlabel;
  1630. ai : taicpu;
  1631. cond : TAsmCond;
  1632. begin
  1633. if not(cs_check_overflow in current_settings.localswitches) then
  1634. exit;
  1635. current_asmdata.getjumplabel(hl);
  1636. if not ((def.typ=pointerdef) or
  1637. ((def.typ=orddef) and
  1638. (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
  1639. pasbool1,pasbool8,pasbool16,pasbool32,pasbool64]))) then
  1640. cond:=C_VC
  1641. else
  1642. begin
  1643. { MUL/DIV always sets the overflow flag, and never the carry flag }
  1644. { Note/Fixme: This still doesn't cover the ColdFire, where none of these opcodes
  1645. set either the overflow or the carry flag. So CF must be handled in other ways. }
  1646. if taicpu(list.last).opcode in [A_MULU,A_MULS,A_DIVS,A_DIVU,A_DIVUL,A_DIVSL] then
  1647. cond:=C_VC
  1648. else
  1649. cond:=C_CC;
  1650. end;
  1651. ai:=Taicpu.Op_Sym(A_Bxx,S_NO,hl);
  1652. ai.SetCondition(cond);
  1653. ai.is_jmp:=true;
  1654. list.concat(ai);
  1655. a_call_name(list,'FPC_OVERFLOW',false);
  1656. a_label(list,hl);
  1657. end;
  1658. procedure tcg68k.g_proc_entry(list: TAsmList; localsize: longint; nostackframe:boolean);
  1659. begin
  1660. { Carl's original code used 2x MOVE instead of LINK when localsize = 0.
  1661. However, a LINK seems faster than two moves on everything from 68000
  1662. to '060, so the two move branch here was dropped. (KB) }
  1663. if not nostackframe then
  1664. begin
  1665. localsize:=align(localsize,4);
  1666. if (localsize > high(smallint)) then
  1667. begin
  1668. list.concat(taicpu.op_reg_const(A_LINK,S_W,NR_FRAME_POINTER_REG,0));
  1669. list.concat(taicpu.op_const_reg(A_SUBA,S_L,localsize,NR_STACK_POINTER_REG));
  1670. end
  1671. else
  1672. list.concat(taicpu.op_reg_const(A_LINK,S_W,NR_FRAME_POINTER_REG,-localsize));
  1673. end;
  1674. end;
  1675. procedure tcg68k.g_proc_exit(list : TAsmList; parasize: longint; nostackframe: boolean);
  1676. var
  1677. r,hregister : TRegister;
  1678. ref : TReference;
  1679. ref2: TReference;
  1680. begin
  1681. if not nostackframe then
  1682. begin
  1683. list.concat(taicpu.op_reg(A_UNLK,S_NO,NR_FRAME_POINTER_REG));
  1684. { if parasize is less than zero here, we probably have a cdecl function.
  1685. According to the info here: http://www.makestuff.eu/wordpress/gcc-68000-abi/
  1686. 68k GCC uses two different methods to free the stack, depending if the target
  1687. architecture supports RTD or not, and one does callee side, the other does
  1688. caller side free, which looks like a PITA to support. We have to figure this
  1689. out later. More info welcomed. (KB) }
  1690. if (parasize > 0) and not (current_procinfo.procdef.proccalloption in clearstack_pocalls) then
  1691. begin
  1692. if current_settings.cputype in cpu_mc68020p then
  1693. list.concat(taicpu.op_const(A_RTD,S_NO,parasize))
  1694. else
  1695. begin
  1696. { We must pull the PC Counter from the stack, before }
  1697. { restoring the stack pointer, otherwise the PC would }
  1698. { point to nowhere! }
  1699. { Instead of doing a slow copy of the return address while trying }
  1700. { to feed it to the RTS instruction, load the PC to A1 (scratch reg) }
  1701. { then free up the stack allocated for paras, then use a JMP (A1) to }
  1702. { return to the caller with the paras freed. (KB) }
  1703. hregister:=NR_A1;
  1704. cg.a_reg_alloc(list,hregister);
  1705. reference_reset_base(ref,NR_STACK_POINTER_REG,0,ctempposinvalid,4,[]);
  1706. list.concat(taicpu.op_ref_reg(A_MOVE,S_L,ref,hregister));
  1707. { instead of using a postincrement above (which also writes the }
  1708. { stackpointer reg) simply add 4 to the parasize, the instructions }
  1709. { below then take that size into account as well, so SP reg is only }
  1710. { written once (KB) }
  1711. parasize:=parasize+4;
  1712. r:=NR_SP;
  1713. { can we do a quick addition ... }
  1714. if (parasize < 9) then
  1715. list.concat(taicpu.op_const_reg(A_ADDQ,S_L,parasize,r))
  1716. else { nope ... }
  1717. begin
  1718. reference_reset_base(ref2,NR_STACK_POINTER_REG,parasize,ctempposinvalid,4,[]);
  1719. list.concat(taicpu.op_ref_reg(A_LEA,S_NO,ref2,r));
  1720. end;
  1721. reference_reset_base(ref,hregister,0,ctempposinvalid,4,[]);
  1722. list.concat(taicpu.op_ref(A_JMP,S_NO,ref));
  1723. end;
  1724. end
  1725. else
  1726. list.concat(taicpu.op_none(A_RTS,S_NO));
  1727. end
  1728. else
  1729. begin
  1730. list.concat(taicpu.op_none(A_RTS,S_NO));
  1731. end;
  1732. { Routines with the poclearstack flag set use only a ret.
  1733. also routines with parasize=0 }
  1734. { TODO: figure out if these are still relevant to us (KB) }
  1735. (*
  1736. if current_procinfo.procdef.proccalloption in clearstack_pocalls then
  1737. begin
  1738. { complex return values are removed from stack in C code PM }
  1739. if paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then
  1740. list.concat(taicpu.op_const(A_RTD,S_NO,4))
  1741. else
  1742. list.concat(taicpu.op_none(A_RTS,S_NO));
  1743. end
  1744. else if (parasize=0) then
  1745. begin
  1746. list.concat(taicpu.op_none(A_RTS,S_NO));
  1747. end
  1748. else
  1749. *)
  1750. end;
  1751. procedure tcg68k.g_save_registers(list:TAsmList);
  1752. var
  1753. dataregs: tcpuregisterset;
  1754. addrregs: tcpuregisterset;
  1755. fpuregs: tcpuregisterset;
  1756. href : treference;
  1757. hreg : tregister;
  1758. hfreg : tregister;
  1759. size : longint;
  1760. fsize : longint;
  1761. r : integer;
  1762. regs_to_save_int,
  1763. regs_to_save_address,
  1764. regs_to_save_fpu: tcpuregisterarray;
  1765. begin
  1766. { The code generated by the section below, particularly the movem.l
  1767. instruction is known to cause an issue when compiled by some GNU
  1768. assembler versions (I had it with 2.17, while 2.24 seems OK.)
  1769. when you run into this problem, just call inherited here instead
  1770. to skip the movem.l generation. But better just use working GNU
  1771. AS version instead. (KB) }
  1772. dataregs:=[];
  1773. addrregs:=[];
  1774. fpuregs:=[];
  1775. regs_to_save_int:=paramanager.get_saved_registers_int(current_procinfo.procdef.proccalloption);
  1776. regs_to_save_address:=paramanager.get_saved_registers_address(current_procinfo.procdef.proccalloption);
  1777. regs_to_save_fpu:=paramanager.get_saved_registers_fpu(current_procinfo.procdef.proccalloption);
  1778. { calculate temp. size }
  1779. size:=0;
  1780. fsize:=0;
  1781. hreg:=NR_NO;
  1782. hfreg:=NR_NO;
  1783. for r:=low(regs_to_save_int) to high(regs_to_save_int) do
  1784. if regs_to_save_int[r] in rg[R_INTREGISTER].used_in_proc then
  1785. begin
  1786. hreg:=newreg(R_INTREGISTER,regs_to_save_int[r],R_SUBWHOLE);
  1787. inc(size,sizeof(aint));
  1788. dataregs:=dataregs + [regs_to_save_int[r]];
  1789. end;
  1790. if uses_registers(R_ADDRESSREGISTER) then
  1791. for r:=low(regs_to_save_address) to high(regs_to_save_address) do
  1792. if regs_to_save_address[r] in rg[R_ADDRESSREGISTER].used_in_proc then
  1793. begin
  1794. hreg:=newreg(R_ADDRESSREGISTER,regs_to_save_address[r],R_SUBWHOLE);
  1795. inc(size,sizeof(aint));
  1796. addrregs:=addrregs + [regs_to_save_address[r]];
  1797. end;
  1798. if uses_registers(R_FPUREGISTER) then
  1799. for r:=low(regs_to_save_fpu) to high(regs_to_save_fpu) do
  1800. if regs_to_save_fpu[r] in rg[R_FPUREGISTER].used_in_proc then
  1801. begin
  1802. hfreg:=newreg(R_FPUREGISTER,regs_to_save_fpu[r],R_SUBNONE);
  1803. inc(fsize,fpuregsize);
  1804. fpuregs:=fpuregs + [regs_to_save_fpu[r]];
  1805. end;
  1806. { 68k has no MM registers }
  1807. if uses_registers(R_MMREGISTER) then
  1808. internalerror(2014030201);
  1809. if (size+fsize) > 0 then
  1810. begin
  1811. tg.GetTemp(list,size+fsize,sizeof(aint),tt_noreuse,current_procinfo.save_regs_ref);
  1812. include(current_procinfo.flags,pi_has_saved_regs);
  1813. { Copy registers to temp }
  1814. { NOTE: virtual registers allocated here won't be translated --> no higher-level stuff. }
  1815. href:=current_procinfo.save_regs_ref;
  1816. if (href.offset<low(smallint)) and (current_settings.cputype in cpu_coldfire+[cpu_mc68000]) then
  1817. begin
  1818. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,href.base,NR_A0));
  1819. list.concat(taicpu.op_const_reg(A_ADDA,S_L,href.offset,NR_A0));
  1820. reference_reset_base(href,NR_A0,0,ctempposinvalid,sizeof(pint),[]);
  1821. end;
  1822. if size > 0 then
  1823. if size = sizeof(aint) then
  1824. list.concat(taicpu.op_reg_ref(A_MOVE,S_L,hreg,href))
  1825. else
  1826. list.concat(taicpu.op_regset_ref(A_MOVEM,S_L,dataregs,addrregs,[],href));
  1827. if fsize > 0 then
  1828. begin
  1829. { size is always longword aligned, while fsize is not }
  1830. inc(href.offset,size);
  1831. if fsize = fpuregsize then
  1832. list.concat(taicpu.op_reg_ref(A_FMOVE,fpuregopsize,hfreg,href))
  1833. else
  1834. list.concat(taicpu.op_regset_ref(A_FMOVEM,fpuregopsize,[],[],fpuregs,href));
  1835. end;
  1836. end;
  1837. end;
  1838. procedure tcg68k.g_restore_registers(list:TAsmList);
  1839. var
  1840. dataregs: tcpuregisterset;
  1841. addrregs: tcpuregisterset;
  1842. fpuregs : tcpuregisterset;
  1843. href : treference;
  1844. r : integer;
  1845. hreg : tregister;
  1846. hfreg : tregister;
  1847. size : longint;
  1848. fsize : longint;
  1849. regs_to_save_int,
  1850. regs_to_save_address,
  1851. regs_to_save_fpu: tcpuregisterarray;
  1852. begin
  1853. { see the remark about buggy GNU AS versions in g_save_registers() (KB) }
  1854. dataregs:=[];
  1855. addrregs:=[];
  1856. fpuregs:=[];
  1857. if not(pi_has_saved_regs in current_procinfo.flags) then
  1858. exit;
  1859. regs_to_save_int:=paramanager.get_saved_registers_int(current_procinfo.procdef.proccalloption);
  1860. regs_to_save_address:=paramanager.get_saved_registers_address(current_procinfo.procdef.proccalloption);
  1861. regs_to_save_fpu:=paramanager.get_saved_registers_fpu(current_procinfo.procdef.proccalloption);
  1862. { Copy registers from temp }
  1863. size:=0;
  1864. fsize:=0;
  1865. hreg:=NR_NO;
  1866. hfreg:=NR_NO;
  1867. for r:=low(regs_to_save_int) to high(regs_to_save_int) do
  1868. if regs_to_save_int[r] in rg[R_INTREGISTER].used_in_proc then
  1869. begin
  1870. inc(size,sizeof(aint));
  1871. hreg:=newreg(R_INTREGISTER,regs_to_save_int[r],R_SUBWHOLE);
  1872. { Allocate register so the optimizer does not remove the load }
  1873. a_reg_alloc(list,hreg);
  1874. dataregs:=dataregs + [regs_to_save_int[r]];
  1875. end;
  1876. if uses_registers(R_ADDRESSREGISTER) then
  1877. for r:=low(regs_to_save_address) to high(regs_to_save_address) do
  1878. if regs_to_save_address[r] in rg[R_ADDRESSREGISTER].used_in_proc then
  1879. begin
  1880. inc(size,sizeof(aint));
  1881. hreg:=newreg(R_ADDRESSREGISTER,regs_to_save_address[r],R_SUBWHOLE);
  1882. { Allocate register so the optimizer does not remove the load }
  1883. a_reg_alloc(list,hreg);
  1884. addrregs:=addrregs + [regs_to_save_address[r]];
  1885. end;
  1886. if uses_registers(R_FPUREGISTER) then
  1887. for r:=low(regs_to_save_fpu) to high(regs_to_save_fpu) do
  1888. if regs_to_save_fpu[r] in rg[R_FPUREGISTER].used_in_proc then
  1889. begin
  1890. inc(fsize,fpuregsize);
  1891. hfreg:=newreg(R_FPUREGISTER,regs_to_save_fpu[r],R_SUBNONE);
  1892. { Allocate register so the optimizer does not remove the load }
  1893. a_reg_alloc(list,hfreg);
  1894. fpuregs:=fpuregs + [regs_to_save_fpu[r]];
  1895. end;
  1896. { 68k has no MM registers }
  1897. if uses_registers(R_MMREGISTER) then
  1898. internalerror(2014030202);
  1899. { Restore registers from temp }
  1900. href:=current_procinfo.save_regs_ref;
  1901. if (href.offset<low(smallint)) and (current_settings.cputype in cpu_coldfire+[cpu_mc68000]) then
  1902. begin
  1903. list.concat(taicpu.op_reg_reg(A_MOVE,S_L,href.base,NR_A0));
  1904. list.concat(taicpu.op_const_reg(A_ADDA,S_L,href.offset,NR_A0));
  1905. reference_reset_base(href,NR_A0,0,ctempposinvalid,sizeof(pint),[]);
  1906. end;
  1907. if size > 0 then
  1908. if size = sizeof(aint) then
  1909. list.concat(taicpu.op_ref_reg(A_MOVE,S_L,href,hreg))
  1910. else
  1911. list.concat(taicpu.op_ref_regset(A_MOVEM,S_L,href,dataregs,addrregs,[]));
  1912. if fsize > 0 then
  1913. begin
  1914. { size is always longword aligned, while fsize is not }
  1915. inc(href.offset,size);
  1916. if fsize = fpuregsize then
  1917. list.concat(taicpu.op_ref_reg(A_FMOVE,fpuregopsize,href,hfreg))
  1918. else
  1919. list.concat(taicpu.op_ref_regset(A_FMOVEM,fpuregopsize,href,[],[],fpuregs));
  1920. end;
  1921. tg.UnGetTemp(list,current_procinfo.save_regs_ref);
  1922. end;
  1923. procedure tcg68k.sign_extend(list: TAsmList;_oldsize : tcgsize; _newsize : tcgsize; reg: tregister);
  1924. begin
  1925. case _newsize of
  1926. OS_S16, OS_16:
  1927. case _oldsize of
  1928. OS_S8:
  1929. begin { 8 -> 16 bit sign extend }
  1930. if (isaddressregister(reg)) then
  1931. internalerror(2014031201);
  1932. list.concat(taicpu.op_reg(A_EXT,S_W,reg));
  1933. end;
  1934. OS_8: { 8 -> 16 bit zero extend }
  1935. begin
  1936. if (current_settings.cputype in cpu_coldfire) then
  1937. { ColdFire has no ANDI.W }
  1938. list.concat(taicpu.op_const_reg(A_AND,S_L,$FF,reg))
  1939. else
  1940. list.concat(taicpu.op_const_reg(A_AND,S_W,$FF,reg));
  1941. end;
  1942. end;
  1943. OS_S32, OS_32:
  1944. case _oldsize of
  1945. OS_S8:
  1946. begin { 8 -> 32 bit sign extend }
  1947. if (isaddressregister(reg)) then
  1948. internalerror(2014031202);
  1949. if (current_settings.cputype = cpu_MC68000) then
  1950. begin
  1951. list.concat(taicpu.op_reg(A_EXT,S_W,reg));
  1952. list.concat(taicpu.op_reg(A_EXT,S_L,reg));
  1953. end
  1954. else
  1955. begin
  1956. //list.concat(tai_comment.create(strpnew('sign extend byte')));
  1957. list.concat(taicpu.op_reg(A_EXTB,S_L,reg));
  1958. end;
  1959. end;
  1960. OS_8: { 8 -> 32 bit zero extend }
  1961. begin
  1962. if (isaddressregister(reg)) then
  1963. internalerror(2015031501);
  1964. //list.concat(tai_comment.create(strpnew('zero extend byte')));
  1965. list.concat(taicpu.op_const_reg(A_AND,S_L,$FF,reg));
  1966. end;
  1967. OS_S16: { 16 -> 32 bit sign extend }
  1968. begin
  1969. { address registers are sign-extended from 16->32 bit anyway
  1970. automagically on every W operation by the CPU, so this is a NOP }
  1971. if not isaddressregister(reg) then
  1972. begin
  1973. //list.concat(tai_comment.create(strpnew('sign extend word')));
  1974. list.concat(taicpu.op_reg(A_EXT,S_L,reg));
  1975. end;
  1976. end;
  1977. OS_16:
  1978. begin
  1979. if (isaddressregister(reg)) then
  1980. internalerror(2015031502);
  1981. //list.concat(tai_comment.create(strpnew('zero extend word')));
  1982. list.concat(taicpu.op_const_reg(A_AND,S_L,$FFFF,reg));
  1983. end;
  1984. end;
  1985. end; { otherwise the size is already correct }
  1986. end;
  1987. procedure tcg68k.sign_extend(list: TAsmList;_oldsize : tcgsize; reg: tregister);
  1988. begin
  1989. sign_extend(list, _oldsize, OS_INT, reg);
  1990. end;
  1991. procedure tcg68k.a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel);
  1992. var
  1993. ai : taicpu;
  1994. begin
  1995. if cond=OC_None then
  1996. ai := Taicpu.Op_sym(A_JMP,S_NO,l)
  1997. else
  1998. begin
  1999. ai:=Taicpu.Op_sym(A_Bxx,S_NO,l);
  2000. ai.SetCondition(TOpCmp2AsmCond[cond]);
  2001. end;
  2002. ai.is_jmp:=true;
  2003. list.concat(ai);
  2004. end;
  2005. { ensures a register is a dataregister. this is often used, as 68k can't do lots of
  2006. operations on an address register. if the register is a dataregister anyway, it
  2007. just returns it untouched.}
  2008. function tcg68k.force_to_dataregister(list: TAsmList; size: TCGSize; reg: TRegister): TRegister;
  2009. var
  2010. scratch_reg: TRegister;
  2011. instr: Taicpu;
  2012. begin
  2013. if isaddressregister(reg) then
  2014. begin
  2015. scratch_reg:=getintregister(list,OS_INT);
  2016. instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg,scratch_reg);
  2017. add_move_instruction(instr);
  2018. list.concat(instr);
  2019. result:=scratch_reg;
  2020. end
  2021. else
  2022. result:=reg;
  2023. end;
  2024. { moves source register to destination register, if the two are not the same. can be used in pair
  2025. with force_to_dataregister() }
  2026. procedure tcg68k.move_if_needed(list: TAsmList; size: TCGSize; src: TRegister; dest: TRegister);
  2027. var
  2028. instr: Taicpu;
  2029. begin
  2030. if (src <> dest) then
  2031. begin
  2032. instr:=taicpu.op_reg_reg(A_MOVE,S_L,src,dest);
  2033. add_move_instruction(instr);
  2034. list.concat(instr);
  2035. end;
  2036. end;
  2037. procedure tcg68k.g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: tcgint);
  2038. var
  2039. hsym : tsym;
  2040. href : treference;
  2041. paraloc : Pcgparalocation;
  2042. begin
  2043. { calculate the parameter info for the procdef }
  2044. procdef.init_paraloc_info(callerside);
  2045. hsym:=tsym(procdef.parast.Find('self'));
  2046. if not(assigned(hsym) and
  2047. (hsym.typ=paravarsym)) then
  2048. internalerror(2013100702);
  2049. paraloc:=tparavarsym(hsym).paraloc[callerside].location;
  2050. while paraloc<>nil do
  2051. with paraloc^ do
  2052. begin
  2053. case loc of
  2054. LOC_REGISTER:
  2055. a_op_const_reg(list,OP_SUB,size,ioffset,register);
  2056. LOC_REFERENCE:
  2057. begin
  2058. { offset in the wrapper needs to be adjusted for the stored
  2059. return address }
  2060. reference_reset_base(href,reference.index,reference.offset+sizeof(pint),ctempposinvalid,sizeof(pint),[]);
  2061. { plain 68k could use SUBI on href directly, but this way it works on Coldfire too
  2062. and it's probably smaller code for the majority of cases (if ioffset small, the
  2063. load will use MOVEQ) (KB) }
  2064. a_load_const_reg(list,OS_ADDR,ioffset,NR_D0);
  2065. list.concat(taicpu.op_reg_ref(A_SUB,S_L,NR_D0,href));
  2066. end
  2067. else
  2068. internalerror(2013100703);
  2069. end;
  2070. paraloc:=next;
  2071. end;
  2072. end;
  2073. procedure tcg68k.g_stackpointer_alloc(list : TAsmList;localsize : longint);
  2074. begin
  2075. list.concat(taicpu.op_const_reg(A_SUB,S_L,localsize,NR_STACK_POINTER_REG));
  2076. end;
  2077. procedure tcg68k.check_register_size(size:tcgsize;reg:tregister);
  2078. begin
  2079. if TCGSize2OpSize[size]<>TCGSize2OpSize[reg_cgsize(reg)] then
  2080. internalerror(201512131);
  2081. end;
  2082. function tcg68k.optimize_const_mul_to_shift_sub_add(list: TAsmList; maxops: longint; a: tcgint; size: tcgsize; reg: TRegister): boolean;
  2083. var
  2084. i: longint;
  2085. nextpower: tcgint;
  2086. powerbit: longint;
  2087. submask: tcgint;
  2088. lastshift: longint;
  2089. hreg: tregister;
  2090. firstmov: boolean;
  2091. begin
  2092. nextpower:=nextpowerof2(a,powerbit);
  2093. submask:=nextpower-a;
  2094. result:=not ((popcnt(qword(a)) > maxops) and ((popcnt(qword(submask))+1) > maxops));
  2095. if not result then
  2096. exit;
  2097. list.concat(tai_comment.create(strpnew('optimize_const_mul_to_shift_sub_add, multiplier: '+tostr(a))));
  2098. lastshift:=0;
  2099. hreg:=getintregister(list,OS_INT);
  2100. if (popcnt(qword(a)) < (popcnt(qword(submask))+1)) then
  2101. begin
  2102. { doing additions }
  2103. firstmov:=(a and 1) = 0;
  2104. if not firstmov then
  2105. a_load_reg_reg(list,size,OS_INT,reg,hreg);
  2106. for i:=1 to bsrqword(a) do
  2107. if ((a shr i) and 1) = 1 then
  2108. begin
  2109. if firstmov then
  2110. begin
  2111. a_op_const_reg(list,OP_SHL,OS_INT,i-lastshift,reg);
  2112. a_load_reg_reg(list,OS_INT,OS_INT,reg,hreg);
  2113. firstmov:=false;
  2114. end
  2115. else
  2116. begin
  2117. a_op_const_reg(list,OP_SHL,OS_INT,i-lastshift,hreg);
  2118. a_op_reg_reg(list,OP_ADD,OS_INT,hreg,reg);
  2119. end;
  2120. lastshift:=i;
  2121. end;
  2122. end
  2123. else
  2124. begin
  2125. { doing subtractions }
  2126. a_load_const_reg(list,OS_INT,0,hreg);
  2127. for i:=0 to bsrqword(submask) do
  2128. if ((submask shr i) and 1) = 1 then
  2129. begin
  2130. a_op_const_reg(list,OP_SHL,OS_INT,i-lastshift,reg);
  2131. a_op_reg_reg(list,OP_SUB,OS_INT,reg,hreg);
  2132. lastshift:=i;
  2133. end;
  2134. a_op_const_reg(list,OP_SHL,OS_INT,powerbit-lastshift,reg);
  2135. a_op_reg_reg(list,OP_ADD,OS_INT,hreg,reg);
  2136. end;
  2137. result:=true;
  2138. end;
  2139. {****************************************************************************}
  2140. { TCG64F68K }
  2141. {****************************************************************************}
  2142. procedure tcg64f68k.a_op64_reg_reg(list : TAsmList;op:TOpCG;size: tcgsize; regsrc,regdst : tregister64);
  2143. var
  2144. opcode : tasmop;
  2145. xopcode : tasmop;
  2146. instr : taicpu;
  2147. begin
  2148. opcode := topcg2tasmop[op];
  2149. xopcode := topcg2tasmopx[op];
  2150. case op of
  2151. OP_ADD,OP_SUB:
  2152. begin
  2153. { if one of these three registers is an address
  2154. register, we'll really get into problems! }
  2155. if isaddressregister(regdst.reglo) or
  2156. isaddressregister(regdst.reghi) or
  2157. isaddressregister(regsrc.reghi) then
  2158. internalerror(2014030101);
  2159. list.concat(taicpu.op_reg_reg(opcode,S_L,regsrc.reglo,regdst.reglo));
  2160. list.concat(taicpu.op_reg_reg(xopcode,S_L,regsrc.reghi,regdst.reghi));
  2161. end;
  2162. OP_AND,OP_OR:
  2163. begin
  2164. { at least one of the registers must be a data register }
  2165. if (isaddressregister(regdst.reglo) and
  2166. isaddressregister(regsrc.reglo)) or
  2167. (isaddressregister(regsrc.reghi) and
  2168. isaddressregister(regdst.reghi)) then
  2169. internalerror(2014030102);
  2170. cg.a_op_reg_reg(list,op,OS_32,regsrc.reglo,regdst.reglo);
  2171. cg.a_op_reg_reg(list,op,OS_32,regsrc.reghi,regdst.reghi);
  2172. end;
  2173. { this is handled in 1st pass for 32-bit cpu's (helper call) }
  2174. OP_IDIV,OP_DIV,
  2175. OP_IMUL,OP_MUL:
  2176. internalerror(2002081701);
  2177. { this is also handled in 1st pass for 32-bit cpu's (helper call) }
  2178. OP_SAR,OP_SHL,OP_SHR:
  2179. internalerror(2002081702);
  2180. OP_XOR:
  2181. begin
  2182. if isaddressregister(regdst.reglo) or
  2183. isaddressregister(regsrc.reglo) or
  2184. isaddressregister(regsrc.reghi) or
  2185. isaddressregister(regdst.reghi) then
  2186. internalerror(2014030103);
  2187. cg.a_op_reg_reg(list,op,OS_32,regsrc.reglo,regdst.reglo);
  2188. cg.a_op_reg_reg(list,op,OS_32,regsrc.reghi,regdst.reghi);
  2189. end;
  2190. OP_NEG,OP_NOT:
  2191. begin
  2192. if isaddressregister(regdst.reglo) or
  2193. isaddressregister(regdst.reghi) then
  2194. internalerror(2014030104);
  2195. instr:=taicpu.op_reg_reg(A_MOVE,S_L,regsrc.reglo,regdst.reglo);
  2196. cg.add_move_instruction(instr);
  2197. list.concat(instr);
  2198. instr:=taicpu.op_reg_reg(A_MOVE,S_L,regsrc.reghi,regdst.reghi);
  2199. cg.add_move_instruction(instr);
  2200. list.concat(instr);
  2201. if (op = OP_NOT) then
  2202. xopcode:=opcode;
  2203. list.concat(taicpu.op_reg(opcode,S_L,regdst.reglo));
  2204. list.concat(taicpu.op_reg(xopcode,S_L,regdst.reghi));
  2205. end;
  2206. end; { end case }
  2207. end;
  2208. procedure tcg64f68k.a_op64_ref_reg(list : TAsmList;op:TOpCG;size : tcgsize;const ref : treference;reg : tregister64);
  2209. var
  2210. href : treference;
  2211. hreg: tregister;
  2212. begin
  2213. case op of
  2214. OP_NEG,OP_NOT:
  2215. begin
  2216. a_load64_ref_reg(list,ref,reg);
  2217. a_op64_reg_reg(list,op,size,reg,reg);
  2218. end;
  2219. OP_AND,OP_OR:
  2220. begin
  2221. href:=ref;
  2222. tcg68k(cg).fixref(list,href,false);
  2223. list.concat(taicpu.op_ref_reg(topcg2tasmop[op],S_L,href,reg.reghi));
  2224. inc(href.offset,4);
  2225. list.concat(taicpu.op_ref_reg(topcg2tasmop[op],S_L,href,reg.reglo));
  2226. end;
  2227. OP_ADD,OP_SUB:
  2228. begin
  2229. href:=ref;
  2230. tcg68k(cg).fixref(list,href,false);
  2231. hreg:=cg.getintregister(list,OS_32);
  2232. cg.a_load_ref_reg(list,OS_32,OS_32,href,hreg);
  2233. inc(href.offset,4);
  2234. list.concat(taicpu.op_ref_reg(topcg2tasmop[op],S_L,href,reg.reglo));
  2235. list.concat(taicpu.op_reg_reg(topcg2tasmopx[op],S_L,hreg,reg.reghi));
  2236. end;
  2237. else
  2238. { XOR does not allow reference for source; ADD/SUB do not allow reference for
  2239. high dword, although low dword can still be handled directly. }
  2240. inherited a_op64_ref_reg(list,op,size,ref,reg);
  2241. end;
  2242. end;
  2243. procedure tcg64f68k.a_op64_reg_ref(list : TAsmList;op:TOpCG;size : tcgsize;reg : tregister64;const ref : treference);
  2244. var
  2245. href: treference;
  2246. hreg: tregister;
  2247. begin
  2248. case op of
  2249. OP_AND,OP_OR,OP_XOR:
  2250. begin
  2251. href:=ref;
  2252. tcg68k(cg).fixref(list,href,false);
  2253. list.concat(taicpu.op_reg_ref(topcg2tasmop[op],S_L,reg.reghi,href));
  2254. inc(href.offset,4);
  2255. list.concat(taicpu.op_reg_ref(topcg2tasmop[op],S_L,reg.reglo,href));
  2256. end;
  2257. OP_ADD,OP_SUB:
  2258. begin
  2259. href:=ref;
  2260. tcg68k(cg).fixref(list,href,false);
  2261. hreg:=cg.getintregister(list,OS_32);
  2262. cg.a_load_ref_reg(list,OS_32,OS_32,href,hreg);
  2263. inc(href.offset,4);
  2264. list.concat(taicpu.op_reg_ref(topcg2tasmop[op],S_L,reg.reglo,href));
  2265. list.concat(taicpu.op_reg_reg(topcg2tasmopx[op],S_L,reg.reghi,hreg));
  2266. dec(href.offset,4);
  2267. cg.a_load_reg_ref(list,OS_32,OS_32,hreg,href);
  2268. end;
  2269. else
  2270. inherited a_op64_reg_ref(list,op,size,reg,ref);
  2271. end;
  2272. end;
  2273. procedure tcg64f68k.a_op64_const_reg(list : TAsmList;op:TOpCG;size: tcgsize; value : int64;regdst : tregister64);
  2274. var
  2275. lowvalue : cardinal;
  2276. highvalue : cardinal;
  2277. opcode : tasmop;
  2278. xopcode : tasmop;
  2279. hreg : tregister;
  2280. begin
  2281. { is it optimized out ? }
  2282. { optimize64_op_const_reg doesn't seem to be used in any cg64f32 right now. why? (KB) }
  2283. { if cg.optimize64_op_const_reg(list,op,value,reg) then
  2284. exit; }
  2285. lowvalue := cardinal(value);
  2286. highvalue := value shr 32;
  2287. opcode := topcg2tasmop[op];
  2288. xopcode := topcg2tasmopx[op];
  2289. { the destination registers must be data registers }
  2290. if isaddressregister(regdst.reglo) or
  2291. isaddressregister(regdst.reghi) then
  2292. internalerror(2014030105);
  2293. case op of
  2294. OP_ADD,OP_SUB:
  2295. begin
  2296. hreg:=cg.getintregister(list,OS_INT);
  2297. { cg.a_load_const_reg provides optimized loading to register for special cases }
  2298. cg.a_load_const_reg(list,OS_S32,longint(highvalue),hreg);
  2299. { don't use cg.a_op_const_reg() here, because a possible optimized
  2300. ADDQ/SUBQ wouldn't set the eXtend bit }
  2301. list.concat(taicpu.op_const_reg(opcode,S_L,longint(lowvalue),regdst.reglo));
  2302. list.concat(taicpu.op_reg_reg(xopcode,S_L,hreg,regdst.reghi));
  2303. end;
  2304. OP_AND,OP_OR,OP_XOR:
  2305. begin
  2306. cg.a_op_const_reg(list,op,OS_S32,longint(lowvalue),regdst.reglo);
  2307. cg.a_op_const_reg(list,op,OS_S32,longint(highvalue),regdst.reghi);
  2308. end;
  2309. { this is handled in 1st pass for 32-bit cpus (helper call) }
  2310. OP_IDIV,OP_DIV,
  2311. OP_IMUL,OP_MUL:
  2312. internalerror(2002081701);
  2313. { this is also handled in 1st pass for 32-bit cpus (helper call) }
  2314. OP_SAR,OP_SHL,OP_SHR:
  2315. internalerror(2002081702);
  2316. { these should have been handled already by earlier passes }
  2317. OP_NOT,OP_NEG:
  2318. internalerror(2012110403);
  2319. end; { end case }
  2320. end;
  2321. procedure tcg64f68k.a_load64_reg_ref(list : TAsmList;reg : tregister64;const ref : treference);
  2322. var
  2323. tmpref: treference;
  2324. begin
  2325. tmpref:=ref;
  2326. tcg68k(cg).fixref(list,tmpref,false);
  2327. cg.a_load_reg_ref(list,OS_32,OS_32,reg.reghi,tmpref);
  2328. inc(tmpref.offset,4);
  2329. cg.a_load_reg_ref(list,OS_32,OS_32,reg.reglo,tmpref);
  2330. end;
  2331. procedure tcg64f68k.a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64);
  2332. var
  2333. tmpref: treference;
  2334. begin
  2335. { do not allow 64bit values to be loaded to address registers }
  2336. if isaddressregister(reg.reglo) or
  2337. isaddressregister(reg.reghi) then
  2338. internalerror(2016050501);
  2339. tmpref:=ref;
  2340. tcg68k(cg).fixref(list,tmpref,false);
  2341. cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reghi);
  2342. inc(tmpref.offset,4);
  2343. cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reglo);
  2344. end;
  2345. procedure create_codegen;
  2346. begin
  2347. cg := tcg68k.create;
  2348. cg64 :=tcg64f68k.create;
  2349. end;
  2350. end.