cgcpu.pas 78 KB

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