cgcpu.pas 81 KB

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