cgcpu.pas 82 KB

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