cgcpu.pas 81 KB

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